Redirect after authentication

[centromere]

I am writing a SPA which authenticates the user via an OAuth flow. In my callback handler I would like to generate a JWT and set it in a cookie as well as issue a 303 See Other back to /. The type of my handler is as follows:

callbackHandler :: (MonadIO m, MonadError ServantErr m)
                => Text
                -> Maybe Text
                -> Maybe Text
                -> m (Headers '[ Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie ] NoContent)

The acceptLogin function allows me to decorate my NoContent response, but unfortunately I can't seem to use it because Servant requires me to use throwError to issue HTTP status codes other than 200.

I believe the best solution would be to provide a function that returns a ServantErr. Something like:

Just x <- acceptLoginErr cookieSettings jwtSettings foo err303
throwError x

Is there a better way to accomplish my goal of issuing a redirect simultaneously with the Set-Cookie headers?

[domenkozar]

Something like the following works:

loginCallback :: Maybe Code -> Maybe Text -> App (Headers '[ Header "Location" Text
                                                           , Header "Set-Cookie" SetCookie
                                                           , Header "Set-Cookie" SetCookie] NoContent)
loginCallback Nothing _ = throwM err401
loginCallback (Just code) _ = do
      ...
      applyCookies <- escalate . maybeToEither err401 =<< (liftIO $ acceptLogin (envCookieSettings env) (envJWTSettings env) (Session uid))
      return $ addHeader "/" (applyCookies NoContent)

and api should indicate response code 302.

[centromere]

Thanks for that. What is the definition of escalate? Also, in addition to the code above I'd have to do something like:

throwError $ err303 { errHeaders = getHeaders x }

Where x :: Headers '[ Header "Location" Text, ... ] NoContent.

[centromere]

After doing some research, I discovered that I can re-formulate my API definition to avoid using throwError. I've adapted the approach from haskell-servant/servant#117 as follows:

type Get303 (cts :: [*]) (hs :: [*]) a = Verb 'GET 303 cts (Headers (Header "Location" Text ': hs) a)

and I changed my API type from:

Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie ] NoContent)

to:

Get303 '[JSON] '[ Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie ] NoContent

A key insight I had was in recognizing that Get is merely a useful type synonym for the common use case of returning a 200.

The issue of redirects seems out of scope for this project, so I am closing this issue.

[domenkozar]

I do think this is very common use case, so maybe #129 should address it.

[bratfizyk]

Hi guys, thanks for the discussion. Based on this I managed to come up with a full implementation. Let me paste it here in order to save tears the next generations ;).

type Post303 (cts :: [*]) (hs :: [*]) a = Verb 'POST 303 cts (Headers (Header "Location" Text ': hs) a)

type Unprotected =
      "login" 
            :> ReqBody '[FormUrlEncoded] Credentials 
            :> Post303 '[JSON] '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] NoContent

checkCreds :: CookieSettings -> JWTSettings -> Credentials
           -> Handler (Headers '[ Header "Location" Text, Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] NoContent)
checkCreds cookieSettings jwtSettings (Credentials { credentialsUserName = "Ali Baba", credentialsPassword = "Open Sesame"}) = do
    mApplyCookies <- liftIO $ acceptLogin cookieSettings jwtSettings (User "Ali Baba")
    case mApplyCookies of
        Nothing           -> trace "Nothing" $ throwError err401
        Just applyCookies -> return $ addHeader (pack "/") (applyCookies NoContent)
            
checkCreds _ _ (Credentials { credentialsUserName = user, credentialsPassword = _}) = 
    trace ("Received " ++ user)
        throwError err401

Also, based on information found here: haskell-servant/servant#608 one can also declare a type alias for the Headers:

type LoginHeader v = 
    Headers '[ Header "Location" Text, Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie ] v

Things I suffered with:

• if a type has Headers on it, then addHeader PREPENDS the new header
• Working with Data.Text requires pack and unpack when String type is involved. Otherwise you can get a very cryptic error message.