Add a cookbook recipe for JWT and basic authentication combination (#871)

2017-12-07 17:30:54 +03:00 · 2017-12-07 17:30:54 +03:00 · b8c6c0b7c7
commit b8c6c0b7c7
parent c8dbcea5a2
2 changed files with 283 additions and 0 deletions
--- a/doc/cookbook/jwt-and-basic-auth/JWTAndBasicAuth.lhs
+++ b/doc/cookbook/jwt-and-basic-auth/JWTAndBasicAuth.lhs
@ -0,0 +1,249 @@
+# Combining JWT-based authentication with basic access authentication
+
+In this example we will make a service with
+[basic HTTP authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)
+for Haskell clients and other programs, as well as
+with [JWT](https://en.wikipedia.org/wiki/JSON_Web_Token)-based
+authentication for web browsers. Web browsers will still use basic
+HTTP authentication to retrieve JWTs though.
+
+**Warning**: this is insecure when done over plain HTTP,
+so [TLS](https://en.wikipedia.org/wiki/Transport_Layer_Security)
+should be used.
+See [warp-tls](https://hackage.haskell.org/package/warp-tls) for that.
+
+While basic authentication comes with Servant itself,
+[servant-auth](https://hackage.haskell.org/package/servant-auth) and
+[servant-auth-server](https://hackage.haskell.org/package/servant-auth-server)
+packages are needed for the JWT-based one.
+
+This recipe uses the following ingredients:
+
+```haskell
+{-# LANGUAGE OverloadedStrings, TypeFamilies, DataKinds,
+  DeriveGeneric, TypeOperators #-}
+import Data.Aeson
+import GHC.Generics
+import Data.Proxy
+import System.IO
+import Network.HTTP.Client (newManager, defaultManagerSettings)
+import Network.Wai.Handler.Warp
+import Servant as S
+import Servant.Client
+import Servant.Auth as SA
+import Servant.Auth.Server as SAS
+import Control.Monad.IO.Class (liftIO)
+import Data.Map as M
+import Data.ByteString (ByteString)
+
+port :: Int
+port = 3001
+```
+
+
+## Authentication
+
+Below is how we'll represent a user: usually user identifier is handy
+to keep around, along with their role if
+[role-based access control](https://en.wikipedia.org/wiki/Role-based_access_control)
+is used, and other commonly needed information, such as an
+organization identifier:
+
+```haskell
+data AuthenticatedUser = AUser { auID :: Int
+                               , auOrgID :: Int
+                               } deriving (Show, Generic)
+```
+
+The following instances are needed for JWT:
+
+```haskell
+instance ToJSON AuthenticatedUser
+instance FromJSON AuthenticatedUser
+instance ToJWT AuthenticatedUser
+instance FromJWT AuthenticatedUser
+```
+
+We'll have to use a bit of imagination to pretend that the following
+`Map` is a database connection pool:
+
+```haskell
+type Login      = ByteString
+type Password   = ByteString
+type DB         = Map (Login, Password) AuthenticatedUser
+type Connection = DB
+type Pool a     = a
+
+initConnPool :: IO (Pool Connection)
+initConnPool = pure $ fromList [ (("user", "pass"), AUser 1 1)
+                               , (("user2", "pass2"), AUser 2 1) ]
+```
+
+See the "PostgreSQL connection pool" recipe for actual connection
+pooling, and we proceed to an authentication function that would use
+our improvised DB connection pool and credentials provided by a user:
+
+```haskell
+authCheck :: Pool Connection
+          -> BasicAuthData
+          -> IO (AuthResult AuthenticatedUser)
+authCheck connPool (BasicAuthData login password) = pure $
+  maybe SAS.Indefinite Authenticated $ M.lookup (login, password) connPool
+```
+
+**Warning**: make sure to use a proper password hashing function in
+functions like this: see [bcrypt](https://en.wikipedia.org/wiki/Bcrypt),
+[scrypt](https://en.wikipedia.org/wiki/Scrypt),
+[pgcrypto](https://www.postgresql.org/docs/current/static/pgcrypto.html).
+
+Unlike `Servant.BasicAuth`, `Servant.Auth` uses `FromBasicAuthData`
+type class for the authentication process itself. But since our
+connection pool will be initialized elsewhere, we'll have to pass it
+somehow: it can be done via a context entry and `BasicAuthCfg` type
+family. We can actually pass a function at once, to make it a bit more
+generic:
+
+
+```haskell
+type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
+
+instance FromBasicAuthData AuthenticatedUser where
+  fromBasicAuthData authData authCheckFunction = authCheckFunction authData
+```
+
+
+## API
+
+Test API with a couple of endpoints:
+
+```haskell
+type TestAPI = "foo" :> Capture "i" Int :> Get '[JSON] ()
+               :<|> "bar" :> Get '[JSON] ()
+```
+
+We'll use this for server-side functions, listing the allowed
+authentication methods using the `Auth` combinator:
+
+```haskell
+type TestAPIServer =
+  Auth '[SA.JWT, SA.BasicAuth] AuthenticatedUser :> TestAPI
+```
+
+But `Servant.Auth.Client` only supports JWT-based authentication, so
+we'll have to use regular `Servant.BasicAuth` to derive client
+functions that use basic access authentication:
+
+```haskell
+type TestAPIClient = S.BasicAuth "test" AuthenticatedUser :> TestAPI
+```
+
+
+## Client
+
+Client code in this setting is the same as it would be with just
+`Servant.BasicAuth`, using
+[servant-client](https://hackage.haskell.org/package/servant-client):
+
+```haskell
+testClient :: IO ()
+testClient = do
+  mgr <- newManager defaultManagerSettings
+  let (foo :<|> _) = client (Proxy :: Proxy TestAPIClient)
+                     (BasicAuthData "name" "pass")
+  res <- runClientM (foo 42)
+    (ClientEnv mgr (BaseUrl Http "localhost" port ""))
+  hPutStrLn stderr $ case res of
+    Left err -> "Error: " ++ show err
+    Right r -> "Success: " ++ show r
+```
+
+
+## Server
+
+Server code is slightly different -- we're getting `AuthResult` here:
+
+```haskell
+server :: Server TestAPIServer
+server (Authenticated user) = handleFoo :<|> handleBar
+  where
+    handleFoo :: Int -> Handler ()
+    handleFoo n = liftIO $ hPutStrLn stderr $
+      concat ["foo: ", show user, " / ", show n]
+    handleBar :: Handler ()
+    handleBar = liftIO testClient
+```
+
+Catch-all for `BadPassword`, `NoSuchUser`, and `Indefinite`:
+
+```haskell
+server _ = throwAll err401
+```
+
+With `Servant.Auth`, we'll have to put both `CookieSettings` and
+`JWTSettings` into context even if we're not using those, and we'll
+put a partially applied `authCheck` function there as well, so that
+`FromBasicAuthData` will be able to use it, while it will use our
+connection pool. Otherwise it is similar to the usual way:
+
+```haskell
+mkApp :: Pool Connection -> IO Application
+mkApp connPool = do
+  myKey <- generateKey
+  let jwtCfg = defaultJWTSettings myKey
+      authCfg = authCheck connPool
+      cfg = jwtCfg :. defaultCookieSettings :. authCfg :. EmptyContext
+      api = Proxy :: Proxy TestAPIServer
+  pure $ serveWithContext api cfg server
+```
+
+Finally, the main function:
+
+```haskell
+main :: IO ()
+main = do
+  connPool <- initConnPool
+  let settings =
+        setPort port $
+        setBeforeMainLoop (hPutStrLn stderr
+                           ("listening on port " ++ show port)) $
+        defaultSettings
+  runSettings settings =<< mkApp connPool
+```
+
+
+## Usage
+
+Now we can try it out with `curl`. First of all, let's ensure that it
+fails with `err401` if we're not authenticated:
+
+```
+$ curl -v 'http://localhost:3001/bar'
+…
+< HTTP/1.1 401 Unauthorized
+```
+
+```
+$ curl -v 'http://user:wrong_password@localhost:3001/bar'
+…
+< HTTP/1.1 401 Unauthorized
+```
+
+Now let's see that basic HTTP authentication works, and that we get
+JWTs:
+
+```
+$ curl -v 'http://user:pass@localhost:3001/bar'
+…
+< HTTP/1.1 200 OK
+…
+< Set-Cookie: XSRF-TOKEN=lQE/sb1fW4rZ/FYUQZskI6RVRllG0CWZrQ0d3fXU4X0=; Path=/; Secure
+< Set-Cookie: JWT-Cookie=eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiYXVPcmdJRCI6MSwiYXVJRCI6MX19.6ZQba-Co5Ul4wpmU34zXlI75wmasxDfaGRmO3BsOx-ONupX93OBfyYBCIJ3tbWMXKBVVqMDt0Pz-5CakyF2wng; Path=/; HttpOnly; Secure
+```
+
+And authenticate using JWTs alone, using the token from `JWT-Cookie`:
+
+```
+curl -v -H 'Authorization: Bearer eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiYXVPcmdJRCI6MSwiYXVJRCI6MX19.6ZQba-Co5Ul4wpmU34zXlI75wmasxDfaGRmO3BsOx-ONupX93OBfyYBCIJ3tbWMXKBVVqMDt0Pz-5CakyF2wng' 'http://localhost:3001/bar'
+…
+< HTTP/1.1 200 OK
+```
--- a/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal
+++ b/doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal
@ -0,0 +1,34 @@
+name:                cookbook-jwt-and-basic-auth
+version:             0.0.1
+synopsis:            JWT and basic access authentication cookbook example
+description:         Using servant-auth to support both JWT-based and basic
+                     authentication.
+homepage:            http://haskell-servant.readthedocs.org/
+license:             BSD3
+license-file:        ../../../servant/LICENSE
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+category:            Servant
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable cookbook-jwt-and-basic-auth
+  main-is:             JWTAndBasicAuth.lhs
+  build-depends:       base == 4.*
+                     , text
+                     , aeson
+                     , containers
+                     , servant
+                     , servant-client
+                     , servant-server
+                     , servant-auth
+                     , servant-auth-server
+                     , warp
+                     , wai
+                     , http-types
+                     , markdown-unlit >= 0.4
+                     , http-client
+                     , bytestring
+  default-language:    Haskell2010
+  ghc-options:         -Wall -pgmL markdown-unlit
+  build-tool-depends:  markdown-unlit:markdown-unlit