@@ -0,0 +1,105 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE TypeOperators #-}
6+
7+module Main where
8+
9+import Data.Aeson (ToJSON)
10+import Data.Proxy (Proxy (Proxy))
11+import Data.Text (Text)
12+import GHC.Generics (Generic)
13+import Network.Wai.Handler.Warp (run)
14+import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
15+ Get, JSON)
16+import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
17+import Servant.Server (BasicAuthCheck (BasicAuthCheck),
18+ BasicAuthResult( Authorized
19+ , Unauthorized
20+ ),
21+ Config ((:.), EmptyConfig), Server,
22+ serve)
23+
24+-- | let's define some types that our API returns.
25+
26+-- | private data that needs protection
27+newtype PrivateData = PrivateData { ssshhh :: Text }
28+ deriving (Eq, Show, Generic)
29+
30+instance ToJSON PrivateData
31+
32+-- | public data that anyone can use.
33+newtype PublicData = PublicData { somedata :: Text }
34+ deriving (Eq, Show, Generic)
35+
36+instance ToJSON PublicData
37+
38+-- | A user we'll grab from the database when we authenticate someone
39+newtype User = User { userName :: Text }
40+ deriving (Eq, Show)
41+
42+-- | a type to wrap our public api
43+type PublicAPI = Get '[JSON] [PublicData]
44+
45+-- | a type to wrap our private api
46+type PrivateAPI = Get '[JSON] PrivateData
47+
48+-- | our API
49+type API = "public" :> PublicAPI
50+ :<|> "private" :> BasicAuth "foo-realm" User :> PrivateAPI
51+
52+-- | a value holding a proxy of our API type
53+api :: Proxy API
54+api = Proxy
55+
56+-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
57+authCheck :: BasicAuthCheck User
58+authCheck =
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
64+
65+-- | We need to supply our handlers with the right configuration. In this case,
66+-- Basic Authentication requires a Config Entry with the 'BasicAuthCheck' value
67+-- tagged with "foo-tag" This config is then supplied to 'server' and threaded
68+-- to the BasicAuth HasServer handlers.
69+serverConfig :: Config (BasicAuthCheck User ': '[])
70+serverConfig = authCheck :. EmptyConfig
71+
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.
75+server :: Server API
76+server =
77+ let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
78+ privateAPIHandler (user :: User) = return (PrivateData (userName user))
79+ in publicAPIHandler :<|> privateAPIHandler
80+
81+-- | hello, server!
82+main :: IO ()
83+main = run 8080 (serve api serverConfig server)
84+
85+{- Sample session
86+
87+$ curl -XGET localhost:8080/public
88+[{"somedata":"foo"},{"somedata":"bar"}
89+
90+$ curl -iXGET localhost:8080/private
91+HTTP/1.1 401 Unauthorized
92+transfer-encoding: chunked
93+Date: Thu, 07 Jan 2016 22:36:38 GMT
94+Server: Warp/3.1.8
95+WWW-Authenticate: Basic realm="foo-realm"
96+
97+$ curl -iXGET localhost:8080/private -H "Authorization: Basic c2VydmFudDpzZXJ2ZXI="
98+HTTP/1.1 200 OK
99+transfer-encoding: chunked
100+Date: Thu, 07 Jan 2016 22:37:58 GMT
101+Server: Warp/3.1.8
102+Content-Type: application/json
103+
104+{"ssshhh":"servant"}
105+-}