Avoiding Errors caused by IO when talking to a database inside of a WAI handler

Question

I am writing a web service in haskell using warp, wai, and acid-state. As of now, I have two handler functions that require database interaction, the latter of which is giving me trouble.

The first, is registration:

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

As you can see, I manage to avoid IO from infecting the response by performing the update in the let _ = ...

In the login function (which currently only returns the user map), I can't avoid IO, because I need to actually send back the result in a response:

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

This causes the following error:

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

I believe the error is caused by the db query returning an IO value. My first thought was to change Response in the type signature to IO Response, but then the top level function complained as it needs a Response, not an IO Response.

On a similar note, I would have liked to write registerUser like this:

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

But this causes a very similar error.

For completeness, here is the function that calls registerUser and 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."

How can I avoid these IO errors?

Answer 1

You are mixing between value in the context i.e. IO (* ->) and value (). You can not do "do" type syntax for a value. Simple solution would be to use unsafePerformIO. Usage depends on your context (paying attention to word "unsafe"). Recommended approach would be to use monad transformer stack with IO at the end and then use liftIO to do your IO actions.

Answer 2

You seem to be having trouble with how to work with the IO type in Haskell. Your question isn't really related to warp, wai or acid-state. I will try to explain it in the context you asked the question.

So the first thing you need to know is that you cant avoid IO infecting your types when you actually perform IO. Talking to a database is inherently IO operations, so they will be infected. Your first example never actually adds anything to the database. You can go to GHCI and try it:

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

Now check the type of this function:

>:t myStrangeId
myStrangeId :: a -> a

Now try to run it:

> myStrangeId "Hello"
"Hello"

As you see, it never actually prints the message, it just returns the argument. So actually the code defined in the let statement is completely dead, it doesn't do anything at all. The same thing is true in your registerUser function.

So, as I stated above, you cant avoid your functions having a IO type because you want to do IO in the functions. This might seem like a problem, but its actually a very good thing because it makes it very explicit which parts of your program are doing IO and which aren't. You need to learn the haskell way which is to combine IO actions together to make a complete program.

If you look at the Application type in Wai you will see that its just a type synonym that looks like this:

type Application = Request -> IO Response

When you have finished your program this is the type signature you want to have. As you can see the Response is wrapped in an IO here.

So lets start with your top function authRoutes. It currently has this signature:

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

We actually want it to have a slightly different signature, the Response should instead be IO Response:

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

Wrapping something in IO is pretty easy. Since IO is a monad you can use the return :: a -> IO a function to do it. To get the required signature you could just add return after = in your function definition. This however doesn't accomplish what you want because loginUser and registerUser also will return a IO Response, so you would end up with some doubly wrapped responses. Instead you can start by wrapping the pure responses:

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

Notice that I added return before resPlain to wrap them in IO.

Now lets look at registerUser. In fact its very possible to write it how you want to write it. Im going to assume that nextRandom has a signature that looks something like this: nextRandom :: IO something, then you can do:

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

And your loginUser function only needs some small changes:

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

So to sum it up, you cant avoid IO infecting your types when you want to actually do IO. Instead you have to embrace it, and wrap your non-IO values in IO. It is best practice to limit the IO the smallest part of your application that is possible. If you can write a function without IO in the signature you should, and then rather wrap it with return later. However its very logical that a loginUser function has to perform some IO, so its not a problem that it has that signature.

Edit:

So as you said in the comment Wai has changed its application type to:

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

You can read about why here and here.

To use your IO Response types with this you can do:

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