@@ -0,0 +1,179 @@
1+# Basic Authentication
2+
3+Let's see a simple example of a web application with a
4+single endpoint, protected by
5+[Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication).
6+
7+First, some throat clearing.
8+
9+``` haskell
10+{-# LANGUAGE DataKinds #-}
11+{-# LANGUAGE OverloadedStrings #-}
12+{-# LANGUAGE TypeOperators #-}
13+import Control.Concurrent
14+import Control.Exception
15+import Control.Monad.IO.Class
16+import qualified Data.Map as Map
17+import qualified Data.Text as T
18+import Data.Text.Encoding (decodeUtf8)
19+import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
20+import Network.Wai.Handler.Warp
21+import Servant
22+import Servant.Client
23+```
24+
25+We will be dealing with a very simple model of users, as shown below.
26+Our "user database" will just be a map from usernames to full user details.
27+For the sake of simplicity, it will just be read only but the same code could
28+be used with mutable references, database connections, files and more in place
29+of our `Map`.
30+
31+```
32+type Username = T.Text
33+type Password = T.Text
34+type Website = T.Text
35+
36+data User = User
37+ { user :: Username
38+ , pass :: Password
39+ , site :: Website
40+ } deriving (Eq, Show)
41+
42+-- could be a postgres connection, a file, anything.
43+type UserDB = Map.Map Username User
44+
45+-- create a "database" from a list of users
46+createUserDB :: [User] -> UserDB
47+createUserDB users = Map.fromList [ (user u, u) | u <- users ]
48+
49+-- our test database
50+userDB :: UserDB
51+userDB = createUserDB
52+ [ User "john" "shhhh" "john.com"
53+ , User "foo" "bar" "foobar.net"
54+ ]
55+```
56+
57+Our API will contain a single endpoint, returning the authenticated
58+user's own website.
59+
60+``` haskell
61+-- a 'GET /mysite' endpoint, protected by basic authentication
62+type API = BasicAuth "People's websites" User :> "mysite" :> Get '[JSON] Website
63+
64+{- if there were more endpoints to be protected, one could write:
65+type API = BasicAuth "People's websites" User :>
66+ ( "foo" :> Get '[JSON] Foo
67+ :<|> "bar" :> Get '[JSON] Bar
68+ )
69+-}
70+
71+api :: Proxy API
72+api = Proxy
73+
74+server :: Server API
75+server usr = return (site usr)
76+```
77+
78+In order to protect our endpoint (`"mysite" :> Get '[JSON] Website`), we simply
79+drop the `BasicAuth` combinator in front of it. Its first parameter,
80+`"People's websites"` in our example, is the realm, which is an arbitrary string
81+identifying the protected resources. The second parameter, `User` in our example,
82+corresponds to the type we want to use to represent authenticated users. It could
83+be anything.
84+
85+When using `BasicAuth` in an API, the server implementation "gets" an argument
86+of the authenticated user type used with `BasicAuth`, `User` in our case, in the
87+"corresponding spot". In this example, the server implementation simply returns
88+the `site` field of the authenticated user. More realistic applications would
89+have endpoints that take other arguments and where a lot more logic would
90+be implemented. But in a sense, `BasicAuth` adds an argument just like `Capture`,
91+`QueryParam`, `ReqBody` and friends. But instead of performing some form of
92+decoding logic behind the scenes, servant runs some "basic auth check" that the
93+user provides.
94+
95+In our case, we need access to our user database, so we simply
96+take it as an argument. A more serious implementation would probably take
97+a database connection or even a connection pool.
98+
99+``` haskell
100+-- provided we are given a user database, we can supply
101+-- a function that checks the basic auth credentials
102+-- against our database.
103+checkBasicAuth :: UserDB -> BasicAuthCheck User
104+checkBasicAuth db = BasicAuthCheck $ \basicAuthData ->
105+ let username = decodeUtf8 (basicAuthUsername basicAuthData)
106+ password = decodeUtf8 (basicAuthPassword basicAuthData)
107+ in
108+ case Map.lookup username db of
109+ Nothing -> return NoSuchUser
110+ Just u -> if pass u == password
111+ then return (Authorized u)
112+ else return BadPassword
113+```
114+
115+This check simply looks up the user in the "database" and makes sure the
116+right password was used. For reference, here are the definitions of
117+`BasicAuthResult` and `BasicAuthCheck`:
118+
119+```
120+-- | The result of authentication/authorization
121+data BasicAuthResult usr
122+ = Unauthorized
123+ | BadPassword
124+ | NoSuchUser
125+ | Authorized usr
126+ deriving (Eq, Show, Read, Generic, Typeable, Functor)
127+
128+-- | Datatype wrapping a function used to check authentication.
129+newtype BasicAuthCheck usr = BasicAuthCheck
130+ { unBasicAuthCheck :: BasicAuthData
131+ -> IO (BasicAuthResult usr)
132+ }
133+ deriving (Generic, Typeable, Functor)
134+```
135+
136+This is all great, but how is our `BasicAuth` combinator supposed to know
137+that it should use our `checkBasicAuth` from above? The answer is that it
138+simply expects to find a `BasicAuthCheck` value for the right user type in
139+the `Context` with which we serve the application, where `Context` is just
140+servant's way to allow users to communicate some configuration of sorts to
141+combinators. It is nothing more than an heterogeneous list and we can create
142+a context with our auth check and run our application with it with the following
143+code:
144+
145+``` haskell
146+runApp :: UserDB -> IO ()
147+runApp db = run 8080 (serveWithContext api ctx server)
148+
149+ where ctx = checkBasicAuth db :. EmptyContext
150+```
151+
152+`ctx` above is just a context with one element, `checkBasicAuth db`,
153+whose type is `BasicAuthCheck User`. In order to say that we want to serve our
154+application using the supplied context, we just have to use `serveWithContext`
155+in place of `serve`.
156+
157+Finally, let's derive a client to this endpoint as well in order to see our
158+server in action!
159+
160+``` haskell
161+getSite :: BasicAuthData -> ClientM Website
162+getSite = client api
163+
164+main :: IO ()
165+main = do
166+ mgr <- newManager defaultManagerSettings
167+ bracket (forkIO $ runApp userDB) killThread $ \_ ->
168+ runClientM (getSite u) (ClientEnv mgr (BaseUrl Http "localhost" 8080 ""))
169+ >>= print
170+
171+ where u = BasicAuthData "foo" "bar"
172+```
173+
174+This program prints `Right "foobar.net"`, as expected. Feel free to change this
175+code and see what happens when you specify credentials that are not in the
176+database.
177+
178+The entire program covered here is available as a literate Haskell file
179+[here](...).