@@ -0,0 +1,252 @@
1+# Combining JWT-based authentication with basic access authentication
2+
3+In this example we will make a service with
4+[basic HTTP authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)
5+for Haskell clients and other programs, as well as
6+with [JWT](https://en.wikipedia.org/wiki/JSON_Web_Token)-based
7+authentication for web browsers. Web browsers will still use basic
8+HTTP authentication to retrieve JWTs though.
9+
10+**Warning**: this is insecure when done over plain HTTP,
11+so [TLS](https://en.wikipedia.org/wiki/Transport_Layer_Security)
12+should be used.
13+See [warp-tls](https://hackage.haskell.org/package/warp-tls) for that.
14+
15+While basic authentication comes with Servant itself,
16+[servant-auth](https://hackage.haskell.org/package/servant-auth) and
17+[servant-auth-server](https://hackage.haskell.org/package/servant-auth-server)
18+packages are needed for the JWT-based one.
19+
20+This recipe uses the following ingredients:
21+
22+```haskell
23+{-# LANGUAGE OverloadedStrings, TypeFamilies, DataKinds,
24+ DeriveGeneric, TypeOperators #-}
25+import Data.Aeson
26+import GHC.Generics
27+import Data.Proxy
28+import System.IO
29+import Network.HTTP.Client (newManager, defaultManagerSettings)
30+import Network.Wai.Handler.Warp
31+import Servant as S
32+import Servant.Client
33+import Servant.Auth as SA
34+import Servant.Auth.Server as SAS
35+import Control.Monad.IO.Class (liftIO)
36+import Data.Map as M
37+import Data.ByteString (ByteString)
38+
39+port :: Int
40+port = 3001
41+```
42+
43+
44+## Authentication
45+
46+Below is how we'll represent a user: usually user identifier is handy
47+to keep around, along with their role if
48+[role-based access control](https://en.wikipedia.org/wiki/Role-based_access_control)
49+is used, and other commonly needed information, such as an
50+organization identifier:
51+
52+```haskell
53+data AuthenticatedUser = AUser { auID :: Int
54+ , auOrgID :: Int
55+ } deriving (Show, Generic)
56+```
57+
58+The following instances are needed for JWT:
59+
60+```haskell
61+instance ToJSON AuthenticatedUser
62+instance FromJSON AuthenticatedUser
63+instance ToJWT AuthenticatedUser
64+instance FromJWT AuthenticatedUser
65+```
66+
67+We'll have to use a bit of imagination to pretend that the following
68+`Map` is a database connection pool:
69+
70+```haskell
71+type Login = ByteString
72+type Password = ByteString
73+type DB = Map (Login, Password) AuthenticatedUser
74+type Connection = DB
75+type Pool a = a
76+
77+initConnPool :: IO (Pool Connection)
78+initConnPool = pure $ fromList [ (("user", "pass"), AUser 1 1)
79+ , (("user2", "pass2"), AUser 2 1) ]
80+```
81+
82+See the "PostgreSQL connection pool" recipe for actual connection
83+pooling, and we proceed to an authentication function that would use
84+our improvised DB connection pool and credentials provided by a user:
85+
86+```haskell
87+authCheck :: Pool Connection
88+ -> BasicAuthData
89+ -> IO (AuthResult AuthenticatedUser)
90+authCheck connPool (BasicAuthData login password) = pure $
91+ maybe SAS.Indefinite Authenticated $ M.lookup (login, password) connPool
92+```
93+
94+**Warning**: make sure to use a proper password hashing function in
95+functions like this: see [bcrypt](https://en.wikipedia.org/wiki/Bcrypt),
96+[scrypt](https://en.wikipedia.org/wiki/Scrypt),
97+[pgcrypto](https://www.postgresql.org/docs/current/static/pgcrypto.html).
98+
99+Unlike `Servant.BasicAuth`, `Servant.Auth` uses `FromBasicAuthData`
100+type class for the authentication process itself. But since our
101+connection pool will be initialized elsewhere, we'll have to pass it
102+somehow: it can be done via a context entry and `BasicAuthCfg` type
103+family. We can actually pass a function at once, to make it a bit more
104+generic:
105+
106+
107+```haskell
108+type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
109+
110+instance FromBasicAuthData AuthenticatedUser where
111+ fromBasicAuthData authData authCheckFunction = authCheckFunction authData
112+```
113+
114+
115+## API
116+
117+Test API with a couple of endpoints:
118+
119+```haskell
120+type TestAPI = "foo" :> Capture "i" Int :> Get '[JSON] ()
121+ :<|> "bar" :> Get '[JSON] ()
122+```
123+
124+We'll use this for server-side functions, listing the allowed
125+authentication methods using the `Auth` combinator:
126+
127+```haskell
128+type TestAPIServer =
129+ Auth '[SA.JWT, SA.BasicAuth] AuthenticatedUser :> TestAPI
130+```
131+
132+But `Servant.Auth.Client` only supports JWT-based authentication, so
133+we'll have to use regular `Servant.BasicAuth` to derive client
134+functions that use basic access authentication:
135+
136+```haskell
137+type TestAPIClient = S.BasicAuth "test" AuthenticatedUser :> TestAPI
138+```
139+
140+
141+## Client
142+
143+Client code in this setting is the same as it would be with just
144+`Servant.BasicAuth`, using
145+[servant-client](https://hackage.haskell.org/package/servant-client):
146+
147+```haskell
148+testClient :: IO ()
149+testClient = do
150+ mgr <- newManager defaultManagerSettings
151+ let (foo :<|> _) = client (Proxy :: Proxy TestAPIClient)
152+ (BasicAuthData "name" "pass")
153+ res <- runClientM (foo 42)
154+ (ClientEnv mgr (BaseUrl Http "localhost" port ""))
155+ hPutStrLn stderr $ case res of
156+ Left err -> "Error: " ++ show err
157+ Right r -> "Success: " ++ show r
158+```
159+
160+
161+## Server
162+
163+Server code is slightly different -- we're getting `AuthResult` here:
164+
165+```haskell
166+server :: Server TestAPIServer
167+server (Authenticated user) = handleFoo :<|> handleBar
168+ where
169+ handleFoo :: Int -> Handler ()
170+ handleFoo n = liftIO $ hPutStrLn stderr $
171+ concat ["foo: ", show user, " / ", show n]
172+ handleBar :: Handler ()
173+ handleBar = liftIO testClient
174+```
175+
176+Catch-all for `BadPassword`, `NoSuchUser`, and `Indefinite`:
177+
178+```haskell
179+server _ = throwAll err401
180+```
181+
182+With `Servant.Auth`, we'll have to put both `CookieSettings` and
183+`JWTSettings` into context even if we're not using those, and we'll
184+put a partially applied `authCheck` function there as well, so that
185+`FromBasicAuthData` will be able to use it, while it will use our
186+connection pool. Otherwise it is similar to the usual way:
187+
188+```haskell
189+mkApp :: Pool Connection -> IO Application
190+mkApp connPool = do
191+ myKey <- generateKey
192+ let jwtCfg = defaultJWTSettings myKey
193+ authCfg = authCheck connPool
194+ cfg = jwtCfg :. defaultCookieSettings :. authCfg :. EmptyContext
195+ api = Proxy :: Proxy TestAPIServer
196+ pure $ serveWithContext api cfg server
197+```
198+
199+Finally, the main function:
200+
201+```haskell
202+main :: IO ()
203+main = do
204+ connPool <- initConnPool
205+ let settings =
206+ setPort port $
207+ setBeforeMainLoop (hPutStrLn stderr
208+ ("listening on port " ++ show port)) $
209+ defaultSettings
210+ runSettings settings =<< mkApp connPool
211+```
212+
213+
214+## Usage
215+
216+Now we can try it out with `curl`. First of all, let's ensure that it
217+fails with `err401` if we're not authenticated:
218+
219+```
220+$ curl -v 'http://localhost:3001/bar'
221+…
222+< HTTP/1.1 401 Unauthorized
223+```
224+
225+```
226+$ curl -v 'http://user:wrong_password@localhost:3001/bar'
227+…
228+< HTTP/1.1 401 Unauthorized
229+```
230+
231+Now let's see that basic HTTP authentication works, and that we get
232+JWTs:
233+
234+```
235+$ curl -v 'http://user:pass@localhost:3001/bar'
236+…
237+< HTTP/1.1 200 OK
238+…
239+< Set-Cookie: XSRF-TOKEN=lQE/sb1fW4rZ/FYUQZskI6RVRllG0CWZrQ0d3fXU4X0=; Path=/; Secure
240+< Set-Cookie: JWT-Cookie=eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiYXVPcmdJRCI6MSwiYXVJRCI6MX19.6ZQba-Co5Ul4wpmU34zXlI75wmasxDfaGRmO3BsOx-ONupX93OBfyYBCIJ3tbWMXKBVVqMDt0Pz-5CakyF2wng; Path=/; HttpOnly; Secure
241+```
242+
243+And authenticate using JWTs alone, using the token from `JWT-Cookie`:
244+
245+```
246+curl -v -H 'Authorization: Bearer eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiYXVPcmdJRCI6MSwiYXVJRCI6MX19.6ZQba-Co5Ul4wpmU34zXlI75wmasxDfaGRmO3BsOx-ONupX93OBfyYBCIJ3tbWMXKBVVqMDt0Pz-5CakyF2wng' 'http://localhost:3001/bar'
247+…
248+< HTTP/1.1 200 OK
249+```
250+
251+This program is available as a cabal project
252+[here](https://github.com/haskell-servant/servant/tree/master/doc/cookbook/jwt-and-basic-auth).