@@ -44,26 +44,33 @@ You can use this combinator to protect an API as follows:
4444
4545module Authentication where
4646
47+import Control.Monad.Trans.Except (ExceptT, throwE)
4748import Data.Aeson (ToJSON)
49+import Data.ByteString (ByteString)
50+import Data.Map (Map, fromList)
51+import Data.Monoid ((<>))
52+import qualified Data.Map as Map
4853import Data.Proxy (Proxy (Proxy))
4954import Data.Text (Text)
5055import GHC.Generics (Generic)
56+import Network.Wai (Request, requestHeaders)
5157import Network.Wai.Handler.Warp (run)
5258import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
5359 Get, JSON)
5460import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
55−import Servant.API.Experimental (AuthProtect)
61+import Servant.API.Experimental.Auth (AuthProtect)
5662import Servant.Server (BasicAuthCheck (BasicAuthCheck),
5763 BasicAuthResult( Authorized
5864 , Unauthorized
5965 ),
60− Context ((:.), EmptyContext), Server,
61− serveWithContext)
66+ Context ((:.), EmptyContext),
67+ err401, err403, errBody, Server,
68+ ServantErr, serveWithContext)
6269import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
6370 mkAuthHandler)
64−import Servant.Server.Experimenta.Auth()
71+import Servant.Server.Experimental.Auth()
6572
66−- | private data that needs protection
73+-- | private data that needs protection
6774newtype PrivateData = PrivateData { ssshhh :: Text }
6875 deriving (Eq, Show, Generic)
6976
@@ -168,8 +175,8 @@ And now we create the `Context` used by servant to find `BasicAuthCheck`:
168175-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
169176-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
170177-- to the BasicAuth HasServer handlers.
171−serverContext :: Context (BasicAuthCheck User ': '[])
172−serverContext = authCheck :. EmptyContext
178+basicAuthServerContext :: Context (BasicAuthCheck User ': '[])
179+basicAuthServerContext = authCheck :. EmptyContext
173180```
174181
175182We're now ready to write our `server` method that will tie everything together:
@@ -178,8 +185,8 @@ We're now ready to write our `server` method that will tie everything together:
178185-- | an implementation of our server. Here is where we pass all the handlers to our endpoints.
179186-- In particular, for the BasicAuth protected handler, we need to supply a function
180187-- that takes 'User' as an argument.
181−server :: Server BasicAPI
182−server =
188+basicAuthServer :: Server BasicAPI
189+basicAuthServer =
183190 let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
184191 privateAPIHandler (user :: User) = return (PrivateData (userName user))
185192 in publicAPIHandler :<|> privateAPIHandler
@@ -190,7 +197,10 @@ Finally, our main method and a sample session working with our server:
190197```haskell
191198-- | hello, server!
192199basicAuthMain :: IO ()
193−basicAuthMain = run 8080 (serveWithContext basicAuthApi serverContext server)
200+basicAuthMain = run 8080 (serveWithContext basicAuthApi
201+ basicAuthServerContext
202+ basicAuthServer
203+ )
194204
195205{- Sample session
196206
@@ -251,36 +261,36 @@ contain a key from which we can lookup a `User`.
251261```haskell
252262-- | A user type that we "fetch from the database" after
253263-- performing authentication
254−newtype User = User { unUser :: Text }
264+newtype Account = Account { unAccount :: Text }
255265
256266-- | A (pure) database mapping keys to users.
257−database :: Map ByteString User
258−database = fromList [ ("key1", User "Anne Briggs")
259− , ("key2", User "Bruce Cockburn")
260− , ("key3", User "Ghédalia Tazartès")
267+database :: Map ByteString Account
268+database = fromList [ ("key1", Account "Anne Briggs")
269+ , ("key2", Account "Bruce Cockburn")
270+ , ("key3", Account "Ghédalia Tazartès")
261271 ]
262272
263−-- | A method that, when given a password, will return a User.
273+-- | A method that, when given a password, will return a Account.
264274-- This is our bespoke (and bad) authentication logic.
265−lookupUser :: ByteString -> ExceptT ServantErr IO User
266−lookupUser key = case Map.lookup key database of
275+lookupAccount :: ByteString -> ExceptT ServantErr IO Account
276+lookupAccount key = case Map.lookup key database of
267277 Nothing -> throwE (err403 { errBody = "Invalid Cookie" })
268278 Just usr -> return usr
269279```
270280
271281For generalized authentication, servant exposes the `AuthHandler` type,
272282which is used to wrap the `Request -> ExceptT IO ServantErr user` logic. Let's
273−create a value of type `AuthHandler Request User` using the above `lookupUser`
283+create a value of type `AuthHandler Request Account` using the above `lookupAccount`
274284method:
275285
276286```haskell
277−-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO User
278−-- we look for a Cookie and pass the value of the cookie to `lookupUser`.
279−authHandler :: AuthHandler Request User
287+-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO Account
288+-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
289+authHandler :: AuthHandler Request Account
280290authHandler =
281291 let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
282292 Nothing -> throwE (err401 { errBody = "Missing auth header" })
283− Just authCookieKey -> lookupUser authCookieKey
293+ Just authCookieKey -> lookupAccount authCookieKey
284294 in mkAuthHandler handler
285295```
286296
@@ -293,22 +303,22 @@ type AuthGenAPI = "private" :> AuthProtect "cookie-auth" :> PrivateAPI
293303 :<|> "public" :> PublicAPI
294304
295305-- | A value holding our type-level API
296−genAuthApi :: Proxy AuthGenAPI
297−genAuthApi = Proxy
306+genAuthAPI :: Proxy AuthGenAPI
307+genAuthAPI = Proxy
298308```
299309
300310Now we need to bring everything together for the server. We have the
301−`AuthHandler Request User` value and an `AuthProtected` endpoint. To bind these
311+`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these
302312together, we need to provide a [Type Family](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html)
303313instance that tells the `HasServer` instance that our `Context` will supply a
304−`User` (via `AuthHandler Request User`) and that downstream combinators will
305−have access to this `User` value (or an error will be thrown if authentication
314+`Account` (via `AuthHandler Request Account`) and that downstream combinators will
315+have access to this `Account` value (or an error will be thrown if authentication
306316fails).
307317
308318```haskell
309319
310320-- | We need to specify the data returned after authentication
311−type instance AuthServerData (AuthProtect "cookie-auth") = User
321+type instance AuthServerData (AuthProtect "cookie-auth") = Account
312322```
313323
314324Note that we specify the type-level tag `"cookie-auth"` when defining the type
@@ -322,19 +332,19 @@ value of type `Server AuthGenAPI`, in addition to the server value:
322332-- | The context that will be made available to request handlers. We supply the
323333-- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance
324334-- of 'AuthProtect' can extract the handler and run it on the request.
325−serverContext :: Context (AuthHandler Request User ': '[])
326−serverContext = authHandler :. EmptyContext
335+genAuthServerContext :: Context (AuthHandler Request Account ': '[])
336+genAuthServerContext = authHandler :. EmptyContext
327337
328338-- | Our API, where we provide all the author-supplied handlers for each end
329−-- point. Note that 'privateDataFunc' is a function that takes 'User' as an
339+-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an
330340-- argument. We dont' worry about the authentication instrumentation here,
331341-- that is taken care of by supplying context
332−server :: Server AuthGenAPI
333−server =
334− let privateDataFunc (User name) =
335− return [PrivateData ("this is a secret: " <> name)]
336− publicData = [PublicData "this is a public piece of data"]
337− in privateDataFunc :<|> return publicData
342+genAuthServer :: Server AuthGenAPI
343+genAuthServer =
344+ let privateDataFunc (Account name) =
345+ return (PrivateData ("this is a secret: " <> name))
346+ publicData = return [PublicData "this is a public piece of data"]
347+ in privateDataFunc :<|> publicData
338348```
339349
340350We're now ready to start our server (and provide a sample session)!
@@ -342,7 +352,7 @@ We're now ready to start our server (and provide a sample session)!
342352```haskell
343353-- | run our server
344354genAuthMain :: IO ()
345−genAuthMain = run 8080 (serveWithContext api serverContext server)
355+genAuthMain = run 8080 (serveWithContext genAuthAPI genAuthServerContext genAuthServer)
346356
347357{- Sample Session:
348358