在与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 _ = ...

在登录功能(目前只返回用户地图)中,我无法避免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类型的问题.你的问题与warp,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动作组合在一起以制作完整的程序.

如果您查看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

你可以在这里和这里了解原因.

要使用IO Response此类型,您可以:

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