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