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?