Merge pull request #875 from kakkun61/improve-authentication-docs
Improve authentication docs
This commit is contained in:
commit
bba8cecf9f
2 changed files with 15 additions and 8 deletions
|
@ -69,6 +69,7 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck),
|
||||||
import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
|
import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
|
||||||
mkAuthHandler)
|
mkAuthHandler)
|
||||||
import Servant.Server.Experimental.Auth()
|
import Servant.Server.Experimental.Auth()
|
||||||
|
import Web.Cookie (parseCookies)
|
||||||
|
|
||||||
-- | private data that needs protection
|
-- | private data that needs protection
|
||||||
newtype PrivateData = PrivateData { ssshhh :: Text }
|
newtype PrivateData = PrivateData { ssshhh :: Text }
|
||||||
|
@ -284,17 +285,22 @@ lookupAccount key = case Map.lookup key database of
|
||||||
For generalized authentication, servant exposes the `AuthHandler` type,
|
For generalized authentication, servant exposes the `AuthHandler` type,
|
||||||
which is used to wrap the `Request -> Handler Account` logic. Let's
|
which is used to wrap the `Request -> Handler Account` logic. Let's
|
||||||
create a value of type `AuthHandler Request Account` using the above `lookupAccount`
|
create a value of type `AuthHandler Request Account` using the above `lookupAccount`
|
||||||
method:
|
method (note: we depend upon [`cookie`](https://hackage.haskell.org/package/cookie)'s
|
||||||
|
`parseCookies` for this):
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
-- | The auth handler wraps a function from Request -> Handler Account
|
|
||||||
-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
|
--- | The auth handler wraps a function from Request -> Handler Account.
|
||||||
|
--- We look for a token in the request headers that we expect to be in the cookie.
|
||||||
|
--- The token is then passed to our `lookupAccount` function.
|
||||||
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
|
||||||
|
|
|
@ -55,6 +55,7 @@ library
|
||||||
, transformers
|
, transformers
|
||||||
, markdown-unlit >= 0.4
|
, markdown-unlit >= 0.4
|
||||||
, http-client
|
, http-client
|
||||||
|
, cookie
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
ghc-options: -Wall -pgmL markdown-unlit
|
||||||
build-tool-depends: markdown-unlit:markdown-unlit
|
build-tool-depends: markdown-unlit:markdown-unlit
|
||||||
|
|
Loading…
Reference in a new issue