git.iko.soy/servant
on 7af73d6 help sign in
servant/servant-examples/basic-auth/basic-auth.hs
105 lines 3.7 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TypeOperators #-}
7module Main where
9import Data.Aeson (ToJSON)
10import Data.Proxy (Proxy (Proxy))
11import Data.Text (Text)
12import GHC.Generics (Generic)
13import Network.Wai.Handler.Warp (run)
14import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
15 Get, JSON)
16import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
17import Servant.Server (BasicAuthCheck (BasicAuthCheck),
18 BasicAuthResult( Authorized
19 , Unauthorized
20 ),
21 Context ((:.), EmptyContext), Server,
22 serveWithContext)
24-- | let's define some types that our API returns.
26-- | private data that needs protection
27newtype PrivateData = PrivateData { ssshhh :: Text }
28 deriving (Eq, Show, Generic)
30instance ToJSON PrivateData
32-- | public data that anyone can use.
33newtype PublicData = PublicData { somedata :: Text }
34 deriving (Eq, Show, Generic)
36instance ToJSON PublicData
38-- | A user we'll grab from the database when we authenticate someone
39newtype User = User { userName :: Text }
40 deriving (Eq, Show)
42-- | a type to wrap our public api
43type PublicAPI = Get '[JSON] [PublicData]
45-- | a type to wrap our private api
46type PrivateAPI = Get '[JSON] PrivateData
48-- | our API
49type API = "public" :> PublicAPI
50 :<|> "private" :> BasicAuth "foo-realm" User :> PrivateAPI
52-- | a value holding a proxy of our API type
53api :: Proxy API
54api = Proxy
56-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
57authCheck :: BasicAuthCheck User
58authCheck =
59 let check (BasicAuthData username password) =
60 if username == "servant" && password == "server"
61 then return (Authorized (User "servant"))
62 else return Unauthorized
63 in BasicAuthCheck check
65-- | We need to supply our handlers with the right Context. In this case,
66-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
67-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
68-- to the BasicAuth HasServer handlers.
69serverContext :: Context (BasicAuthCheck User ': '[])
70serverContext = authCheck :. EmptyContext
72-- | an implementation of our server. Here is where we pass all the handlers to our endpoints.
73-- In particular, for the BasicAuth protected handler, we need to supply a function
74-- that takes 'User' as an argument.
75server :: Server API
76server =
77 let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
78 privateAPIHandler (user :: User) = return (PrivateData (userName user))
79 in publicAPIHandler :<|> privateAPIHandler
81-- | hello, server!
82main :: IO ()
83main = run 8080 (serveWithContext api serverContext server)
85{- Sample session
87$ curl -XGET localhost:8080/public
88[{"somedata":"foo"},{"somedata":"bar"}
90$ curl -iXGET localhost:8080/private
91HTTP/1.1 401 Unauthorized
92transfer-encoding: chunked
93Date: Thu, 07 Jan 2016 22:36:38 GMT
94Server: Warp/3.1.8
95WWW-Authenticate: Basic realm="foo-realm"
97$ curl -iXGET localhost:8080/private -H "Authorization: Basic c2VydmFudDpzZXJ2ZXI="
98HTTP/1.1 200 OK
99transfer-encoding: chunked
100Date: Thu, 07 Jan 2016 22:37:58 GMT
101Server: Warp/3.1.8
102Content-Type: application/json
104{"ssshhh":"servant"}
105-}