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

Question

我正在haskell中使用warp、wai和acid state编写一个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."

我相信这个错误是由数据库查询返回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类型的问题。你的问题实际上与曲速、wai或酸性状态无关。我将试着在你提出这个问题的背景下加以解释。

因此，您需要知道的第一件事是，在实际执行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

你可以在这里和这里阅读为什么。

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

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

Answer 2

您正在混合上下文中的值，即IO(*->)和值()。不能对值执行"do"类型语法。简单的解决方案是使用unsafePerformIO。用法取决于上下文(注意"不安全"一词)。建议的方法是使用带有IO的monad变压器堆栈，然后使用liftIO执行IO操作。