Look inside cookies instead of just the header
This commit is contained in:
parent
265b4276db
commit
400bd564dc
1 changed files with 9 additions and 7 deletions
|
@ -284,14 +284,16 @@ create a value of type `AuthHandler Request Account` using the above `lookupAcco
|
||||||
method:
|
method:
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
-- | The auth handler wraps a function from Request -> Handler Account
|
import Web.Cookie (parseCookies)
|
||||||
-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
|
|
||||||
authHandler :: AuthHandler Request Account
|
authHandler :: AuthHandler Request Account
|
||||||
authHandler =
|
authHandler = mkAuthHandler handler
|
||||||
let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
|
where
|
||||||
Nothing -> throwError (err401 { errBody = "Missing auth header" })
|
maybeToEither e = maybe (Left e) Right
|
||||||
Just authCookieKey -> lookupAccount authCookieKey
|
throw401 msg = throwError $ err401 { errBody = msg }
|
||||||
in mkAuthHandler handler
|
handler req = either throw401 lookupAccount $ do
|
||||||
|
cookie <- maybeToEither "Missing cookie header" $ lookup "cookie" $ requestHeaders req
|
||||||
|
maybeToEither "Missing token in cookie" $ lookup "servant-auth-cookie" $ parseCookies cookie
|
||||||
```
|
```
|
||||||
|
|
||||||
Let's now protect our API with our new, bespoke authentication scheme. We'll
|
Let's now protect our API with our new, bespoke authentication scheme. We'll
|
||||||
|
|
Loading…
Reference in a new issue