git.iko.soy/typeable/servant
on master help sign in
Add basic-auth support to servant-client
d989d15aaron levin
servant-client/servant-client.cabal+2
compare with master
unifiedsplit
@@ -28,11 +28,13 @@ library
28 exposed-modules:
28 exposed-modules:
29 Servant.Client
29 Servant.Client
30 Servant.Common.BaseUrl
30 Servant.Common.BaseUrl
31+ Servant.Common.BasicAuth
31 Servant.Common.Req
32 Servant.Common.Req
32 build-depends:
33 build-depends:
33 base >=4.7 && <5
34 base >=4.7 && <5
34 , aeson
35 , aeson
35 , attoparsec
36 , attoparsec
37+ , base64-bytestring
36 , bytestring
38 , bytestring
37 , exceptions
39 , exceptions
38 , http-api-data >= 0.1 && < 0.3
40 , http-api-data >= 0.1 && < 0.3
servant-client/src/Servant/Client.hs+10
@@ -37,6 +37,7 @@ import qualified Network.HTTP.Types as H
37import qualified Network.HTTP.Types.Header as HTTP
37import qualified Network.HTTP.Types.Header as HTTP
38import Servant.API
38import Servant.API
39import Servant.Common.BaseUrl
39import Servant.Common.BaseUrl
40+import Servant.Common.BasicAuth
40import Servant.Common.Req
41import Servant.Common.Req
41
42
42-- * Accessing APIs as a Client
43-- * Accessing APIs as a Client
@@ -424,6 +425,15 @@ instance HasClient subapi =>
424 clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
425 clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
425
426
426
427
428+-- * Basic Authentication
429+
430+instance HasClient api => HasClient (BasicAuth realm usr :> api) where
431+ type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
432+
433+ clientWithRoute Proxy req baseurl manager val =
434+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager
435+
436+
427{- Note [Non-Empty Content Types]
437{- Note [Non-Empty Content Types]
428~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
438~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
429Rather than have
439Rather than have
servant-client/src/Servant/Common/BasicAuth.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeSynonymInstances #-}
3+{-# LANGUAGE TypeFamilies #-}
4+
5+-- | Basic Authentication for clients
6+
7+module Servant.Common.BasicAuth (
8+ basicAuthReq
9+ ) where
10+
11+import Data.ByteString.Base64 (encode)
12+import Data.Monoid ((<>))
13+import Data.Text.Encoding (decodeUtf8)
14+import Servant.Common.Req (addHeader, Req)
15+import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))
16+
17+-- | Authenticate a request using Basic Authentication
18+basicAuthReq :: BasicAuthData -> Req -> Req
19+basicAuthReq (BasicAuthData user pass) req =
20+ let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))
21+ in addHeader "Authorization" authText req
servant-client/test/Servant/ClientSpec.hs+40
@@ -62,6 +62,7 @@ spec = describe "Servant.Client" $ do
62 sucessSpec
62 sucessSpec
63 failSpec
63 failSpec
64 wrappedApiSpec
64 wrappedApiSpec
65+ basicAuthSpec
65
66
66-- * test data types
67-- * test data types
67
68
@@ -148,6 +149,29 @@ failServer = serve failApi (
148 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
149 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
149 )
150 )
150
151
152+
153+-- * auth stuff
154+
155+type BasicAuthAPI =
156+ BasicAuth "foo-realm" () :> "private" :> "basic" :> Get '[JSON] Person
157+
158+basicAuthAPI :: Proxy BasicAuthAPI
159+basicAuthAPI = Proxy
160+
161+basicAuthHandler :: BasicAuthCheck ()
162+basicAuthHandler =
163+ let check (BasicAuthData username password) =
164+ if username == "servant" && password == "server"
165+ then return (Authorized ())
166+ else return Unauthorized
167+ in BasicAuthCheck check
168+
169+serverConfig :: Config '[ BasicAuthCheck () ]
170+serverConfig = basicAuthHandler :. EmptyConfig
171+
172+basicAuthServer :: Application
173+basicAuthServer = serve basicAuthAPI serverConfig (const (return alice))
174+
151{-# NOINLINE manager #-}
175{-# NOINLINE manager #-}
152manager :: C.Manager
176manager :: C.Manager
153manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
177manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -292,6 +316,22 @@ data WrappedApi where
292 HasClient api, Client api ~ ExceptT ServantError IO ()) =>
316 HasClient api, Client api ~ ExceptT ServantError IO ()) =>
293 Proxy api -> WrappedApi
317 Proxy api -> WrappedApi
294
318
319+basicAuthSpec :: Spec
320+basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ do
321+ context "Authentication works when requests are properly authenticated" $ do
322+
323+ it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
324+ let getBasic = client basicAuthAPI baseUrl manager
325+ let basicAuthData = BasicAuthData "servant" "server"
326+ (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice
327+
328+ context "Authentication is rejected when requests are not authenticated properly" $ do
329+
330+ it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
331+ let getBasic = client basicAuthAPI baseUrl manager
332+ let basicAuthData = BasicAuthData "not" "password"
333+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)
334+ responseStatus `shouldBe` Status 403 "Forbidden"
295
335
296-- * utils
336-- * utils
297
337