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?