eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
defanor 2017-12-07 17:30:54 +03:00 committed by Alp Mestanogullari
parent c8dbcea5a2
commit b8c6c0b7c7
2 changed files with 283 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

249
doc/cookbook/jwt-and-basic-auth/JWTAndBasicAuth.lhs Normal file
View file

@ -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
```

34
doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal Normal file
View file

@ -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