@@ -69,6 +69,7 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck),
6969import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
7070 mkAuthHandler)
7171import Servant.Server.Experimental.Auth()
72+import Web.Cookie (parseCookies)
7273
7374-- | private data that needs protection
7475newtype PrivateData = PrivateData { ssshhh :: Text }
@@ -284,17 +285,22 @@ lookupAccount key = case Map.lookup key database of
284285For generalized authentication, servant exposes the `AuthHandler` type,
285286which is used to wrap the `Request -> Handler Account` logic. Let's
286287create a value of type `AuthHandler Request Account` using the above `lookupAccount`
287−method:
288+method (note: we depend upon [`cookie`](https://hackage.haskell.org/package/cookie)'s
289+`parseCookies` for this):
288290
289291```haskell
290−-- | The auth handler wraps a function from Request -> Handler Account
291−-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
292+
293+--- | The auth handler wraps a function from Request -> Handler Account.
294+--- We look for a token in the request headers that we expect to be in the cookie.
295+--- The token is then passed to our `lookupAccount` function.
292296authHandler :: AuthHandler Request Account
293−authHandler =
294− let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
295− Nothing -> throwError (err401 { errBody = "Missing auth header" })
296− Just authCookieKey -> lookupAccount authCookieKey
297− in mkAuthHandler handler
297+authHandler = mkAuthHandler handler
298+ where
299+ maybeToEither e = maybe (Left e) Right
300+ throw401 msg = throwError $ err401 { errBody = msg }
301+ handler req = either throw401 lookupAccount $ do
302+ cookie <- maybeToEither "Missing cookie header" $ lookup "cookie" $ requestHeaders req
303+ maybeToEither "Missing token in cookie" $ lookup "servant-auth-cookie" $ parseCookies cookie
298304```
299305
300306Let's now protect our API with our new, bespoke authentication scheme. We'll