避免在与WAI处理程序内部的数据库对话时由IO导致的错误

Question

我正在使用warp、wai和acid-state在haskell中编写web服务。到目前为止，我有两个需要数据库交互的处理函数，后者给我带来了麻烦。

第一，是注册：

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> let _ = fmap (\id -> update db (StoreUser (toString id) u)) (nextRandom)
                in resPlain status200 "User Created."
    Nothing  -> resPlain status401 "Invalid user JSON."

如您所见，我通过在let _ = ..中执行更新来避免IO感染响应。

在登录函数(目前只返回用户映射)中，我无法避免IO，因为我需要在响应中实际返回结果：

loginUser :: AcidState UserDatabase -> String -> Response
loginUser db username = do
  maybeUserMap <- (query db (FetchUser username))
  case maybeUserMap of
    (Just u) -> resJSON u
    Nothing  -> resPlain status401 "Invalid username."

这会导致以下错误：

src/Main.hs:40:3:
    Couldn't match type ‘IO b0’ with ‘Response’
    Expected type: IO (EventResult FetchUser)
                   -> (EventResult FetchUser -> IO b0) -> Response
      Actual type: IO (EventResult FetchUser)
                   -> (EventResult FetchUser -> IO b0) -> IO b0
    In a stmt of a 'do' block:
      maybeUserMap <- (query db (FetchUser username))
    In the expression:
      do { maybeUserMap <- (query db (FetchUser username));
           case maybeUserMap of {
             (Just u) -> resJSON u
             Nothing -> resPlain status401 "Invalid username." } }
    In an equation for ‘loginUser’:
        loginUser db username
          = do { maybeUserMap <- (query db (FetchUser username));
                 case maybeUserMap of {
                   (Just u) -> resJSON u
                   Nothing -> resPlain status401 "Invalid username." } }

src/Main.hs:42:17:
    Couldn't match expected type ‘IO b0’ with actual type ‘Response’
    In the expression: resJSON u
    In a case alternative: (Just u) -> resJSON u

src/Main.hs:43:17:
    Couldn't match expected type ‘IO b0’ with actual type ‘Response’
    In the expression: resPlain status401 "Invalid username."
    In a case alternative:
        Nothing -> resPlain status401 "Invalid username."

我认为这个错误是由db查询返回一个IO值引起的。我的第一个想法是将类型签名中的Response更改为IO Response，但随后顶级函数抱怨说它需要一个Response，而不是IO Response。

在类似的情况下，我想要这样编写registerUser：

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> do uuid <- (nextRandom)
                   update db (StoreUser (toString uuid) u)
                   resPlain status200 (toString uuid)
    Nothing  -> resPlain status401 "Invalid user JSON."

但这会导致一个非常类似的错误。

为了完整起见，下面是调用registerUser和loginUser的函数

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> Response
authRoutes db request path body =
  case path of
    ("register":rest) -> registerUser db (decode (LB.pack body) :: Maybe (Map.Map String String))
    ("login":rest) -> loginUser db body
    ("access":rest) -> resPlain status404 "Not implemented."
    _ -> resPlain status404 "Not Found."

如何避免这些IO错误？

Answer 1

在Haskell中，您似乎遇到了如何使用IO类型的问题。你的问题并不是真的与曲折、外星或酸状态相关。我会试着在你问的问题的上下文中解释它。

所以你需要知道的第一件事是，当你实际执行IO时，你无法避免IO感染你的类型。与数据库对话本质上是IO操作，因此它们会被感染。您的第一个示例实际上从未向数据库中添加任何内容。你可以去GHCI体验一下：

> let myStrangeId x = let _ = print "Haskell is fun!" in x

现在检查此函数的类型：

>:t myStrangeId
myStrangeId :: a -> a

现在试着运行它：

> myStrangeId "Hello"
"Hello"

如您所见，它实际上从不打印消息，它只是返回参数。所以实际上let语句中定义的代码是完全死的，它什么也不做。在您的registerUser函数中也是如此。

所以，正如我上面所说的，你不能避免你的函数有一个IO类型，因为你想在函数中做IO。这看起来可能是个问题，但它实际上是一件非常好的事情，因为它让你的程序的哪些部分在做IO，哪些没有做，你需要学习haskell的方法，那就是把IO的动作组合在一起，组成一个完整的程序。

如果您查看Wai中的Application类型，您将看到它只是一个类型同义词，如下所示：

type Application = Request -> IO Response

当你完成你的程序时，这是你想要的类型签名。正如您在这里看到的，Response被包装在一个IO中。

因此，让我们从您的顶级函数authRoutes开始。它目前有这样的签名：

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> Response

我们实际上希望它有一个稍微不同的签名，Response应该是IO Response

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> IO Response

在IO中包装一些东西非常简单。因为IO是一个monad，所以您可以使用return :: a -> IO a函数来执行此操作。要获得所需的签名，只需在函数定义中的=后面添加return即可。但是，这并不能实现您想要的结果，因为loginUser和registerUser还将返回一个IO Response，因此您最终会得到一些双重包装的响应。相反，您可以从包装纯响应开始：

authRoutes :: AcidState UserDatabase -> Request -> [Text.Text] -> String -> IO Response
authRoutes db request path body =
  case path of
    ("register":rest) -> registerUser db (decode (LB.pack body) :: Maybe (Map.Map String String))
    ("login":rest)    -> loginUser db body
    ("access":rest)   -> return $ resPlain status404 "Not implemented."
    _                 -> return $ resPlain status404 "Not Found."

请注意，我在resPlain之前添加了return，以便将它们包装在IO中。

现在让我们来看一下registerUser。事实上，你可以按照你想要的方式来编写它。我假设nextRandom有一个类似如下的签名：nextRandom :: IO something，然后你可以这样做：

registerUser :: AcidState UserDatabase -> Maybe (Map.Map String String) -> IO Response
registerUser db maybeUserMap =
  case maybeUserMap of
    (Just u) -> do
        uuid <- nextRandom 
        update db (StoreUser (toString uuid) u)
        return $ resPlain status200 (toString uuid)
    Nothing  -> return $ resPlain status401 "Invalid user JSON."

并且您的loginUser函数只需要做一些小的更改：

loginUser :: AcidState UserDatabase -> String -> IO Response
loginUser db username = do
  maybeUserMap <- query db (FetchUser username)
  case maybeUserMap of
    (Just u) -> return $ resJSON u
    Nothing  -> return $ resPlain status401 "Invalid username."

所以总而言之，当你想实际做IO时，你无法避免IO感染你的类型。相反，您必须接受它，并将您的非IO值包装在IO中。最佳实践是将IO限制为应用程序中可能的最小部分。如果您可以在签名中没有IO的情况下编写函数，那么您应该这样做，然后用return包装它。然而，loginUser函数必须执行一些IO是非常合乎逻辑的，因此它具有该签名并不是问题。

编辑：

因此，正如您在评论中所说的，Wai已将其应用程序类型更改为：

type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

你可以读到为什么here和here。

要在其中使用IO Response类型，您可以执行以下操作：

myApp :: Application
myApp request respond = do
    response <- authRoutes db request path body
    respond response

Answer 2

您混合了上下文中的值，即IO (* ->)和值()。您不能对值执行" do“类型语法。简单的解决方案是使用unsafePerformIO。用法取决于你的上下文(注意单词"unsafe")。推荐的方法是使用monad transformer堆栈，最后使用IO，然后使用liftIO执行IO操作。