haskell - 在 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."

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

在登录功能(目前只返回用户 map )中，我无法避免 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 引起的。值(value)。我的第一个想法是改变 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哪些不是。你需要学习结合 IO的haskell方式 Action 共同构成一个完整的程序。

如果你看 Application输入 Wai你会看到它只是一个看起来像这样的类型同义词:

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."

请注意，我添加了 return之前 resPlain将它们包装在 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