Closed tchoutri closed 2 years ago
Simplifying the redirect
helper to:
redirect :: Text -> Headers '[Header "Location" Text] NoContent
redirect destination = addHeader destination NoContent
brings me with such a handler:
createSessionHandler :: LoginForm -> FloraPageM (Html ())
createSessionHandler LoginForm{email, password, remember} = do
session <- ask
FloraEnv{pool} <- liftIO $ fetchFloraEnv (session ^. #webEnvStore)
mUser <- liftIO $ withPool pool $ getUserByEmail email
case mUser of
Nothing -> do
liftIO $ putStrLn "[+] Couldn't find user"
templateDefaults <- fromSession session defaultTemplateEnv
let templateEnv = templateDefaults
& (#flashError ?~ mkError "Could not authenticate")
render templateEnv Sessions.newSession
Just user ->
if validatePassword (mkPassword password) (user ^. #password)
then do
liftIO $ putStrLn "[+] User connected!"
sessionId <- persistSession pool (session ^. #sessionId) (user ^. #userId)
let sessionCookie = craftSessionCookie sessionId (isJust remember)
addSessionCookie (session ^. #webEnvStore) sessionCookie
redirect "/"
else do
liftIO $ putStrLn "[+] Couldn't authenticate user"
templateDefaults <- fromSession session defaultTemplateEnv
let templateEnv = templateDefaults
& (#flashError ?~ mkError "Could not authenticate")
render templateEnv Sessions.newSession
And the error:
src/FloraWeb/Server/Pages/Sessions.hs:65:9: error:
• Couldn't match type ‘Servant.API.ResponseHeaders.Headers
'[Servant.API.Header.Header "Location" T.Text]’
with ‘ReaderT Session Servant.Server.Internal.Handler.Handler’
Expected type: ReaderT
Session Servant.Server.Internal.Handler.Handler (Html ())
Actual type: Servant.API.ResponseHeaders.Headers
'[Servant.API.Header.Header "Location" T.Text]
Servant.API.ContentTypes.NoContent
• In a stmt of a 'do' block: redirect "/"
In the expression:
do liftIO $ putStrLn "[+] User connected!"
sessionId <- persistSession
pool (session ^. #sessionId) (user ^. #userId)
let sessionCookie = craftSessionCookie sessionId (isJust remember)
addSessionCookie (session ^. #webEnvStore) sessionCookie
....
In the expression:
if validatePassword (mkPassword password) (user ^. #password) then
do liftIO $ putStrLn "[+] User connected!"
sessionId <- persistSession
pool (session ^. #sessionId) (user ^. #userId)
let sessionCookie = ...
....
else
do liftIO $ putStrLn "[+] Couldn't authenticate user"
templateDefaults <- fromSession session defaultTemplateEnv
let templateEnv = ...
....
|
65 | redirect "/"
| ^^^^^^^^^^^^
Did you try passing an explicit type parameter to the addHeader
function in your first attempt ? The problem is that the header name ("Location"
) is ambiguous, which prevents unification between:
WithStatus 301 (Headers '[Header "Location" Text] NoContent)
and
WithStatus 301 (Headers '[Header h0 Text] NoContent)
(h0
does not mean “any name”, but “a specific name I can't figure out, which might differ from what you want”).
It seems to me that:
addHeader @"Location" destination NoContent
should do the trick.
Wonderful. :)
In the end I've reached a solution that is a little bit meaty but correct wrt. Servant, so I think I'll put this in a cookbook on Friday. :)
I am trying to setup a workflow where I'm using UVerb to achieve a better way to handle redirects in Flora.
At the moment, here are my cards:
My custom monad is:
My route is
And the last line basically translates to “Send back
Html ()
in case of logging error, or redirect if the log-in succeeds”.Now, I have my
redirect
function, which goes like:And reading the UVerb cookbook, I would think that Servant would be happy with it, but it tells me instead:
Here are my questions:
lift
ing?