@@ -69,6 +69,7 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck),
69import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
69import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
70 mkAuthHandler)
70 mkAuthHandler)
71import Servant.Server.Experimental.Auth()
71import Servant.Server.Experimental.Auth()
72+import Web.Cookie (parseCookies)
73-- | private data that needs protection
74-- | private data that needs protection
74newtype PrivateData = PrivateData { ssshhh :: Text }
75newtype PrivateData = PrivateData { ssshhh :: Text }
@@ -284,17 +285,22 @@ lookupAccount key = case Map.lookup key database of
284For generalized authentication, servant exposes the `AuthHandler` type,
285For generalized authentication, servant exposes the `AuthHandler` type,
285which is used to wrap the `Request -> Handler Account` logic. Let's
286which is used to wrap the `Request -> Handler Account` logic. Let's
286create a value of type `AuthHandler Request Account` using the above `lookupAccount`
287create 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):
289```haskell
291```haskell
290−-- | The auth handler wraps a function from Request -> Handler Account
293+--- | 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`.
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.
292authHandler :: AuthHandler Request Account
296authHandler :: AuthHandler Request Account
293−authHandler =
297+authHandler = mkAuthHandler handler
294− let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
298+ where
299+ maybeToEither e = maybe (Left e) Right
295− Nothing -> throwError (err401 { errBody = "Missing auth header" })
300+ throw401 msg = throwError $ err401 { errBody = msg }
296− Just authCookieKey -> lookupAccount authCookieKey
301+ handler req = either throw401 lookupAccount $ do
297− in mkAuthHandler handler
302+ cookie <- maybeToEither "Missing cookie header" $ lookup "cookie" $ requestHeaders req
303+ maybeToEither "Missing token in cookie" $ lookup "servant-auth-cookie" $ parseCookies cookie
300Let's now protect our API with our new, bespoke authentication scheme. We'll
306Let's now protect our API with our new, bespoke authentication scheme. We'll