git.iko.soy/typeable/servant
on master help sign in
Add basic-auth support to servant-client
commitd989d15e4c6daa8aeeb97158f7183ca53c8a9f82 authoraaron levin <aaron.levin@soundcloud.com> dateWed 17 Feb 2016, 20:12 (11 years ago) parent104ac29
4 files changed+73
compare with master
unifiedsplit
servant-client/servant-client.cabal+2 servant-client/src/Servant/Client.hs+10 servant-client/src/Servant/Common/BasicAuth.hs+21 servant-client/test/Servant/ClientSpec.hs+40
servant-client/servant-client.cabal+2
@@ -28,11 +28,13 @@ library
2828 exposed-modules:
2929 Servant.Client
3030 Servant.Common.BaseUrl
31+ Servant.Common.BasicAuth
3132 Servant.Common.Req
3233 build-depends:
3334 base >=4.7 && <5
3435 , aeson
3536 , attoparsec
37+ , base64-bytestring
3638 , bytestring
3739 , exceptions
3840 , 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
3737import qualified Network.HTTP.Types.Header as HTTP
3838import Servant.API
3939import Servant.Common.BaseUrl
40+import Servant.Common.BasicAuth
4041import Servant.Common.Req
4142
4243-- * Accessing APIs as a Client
@@ -424,6 +425,15 @@ instance HasClient subapi =>
424425 clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
425426
426427
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+
427437{- Note [Non-Empty Content Types]
428438~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
429439Rather 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
6262 sucessSpec
6363 failSpec
6464 wrappedApiSpec
65+ basicAuthSpec
6566
6667-- * test data types
6768
@@ -148,6 +149,29 @@ failServer = serve failApi (
148149 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
149150 )
150151
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+
151175{-# NOINLINE manager #-}
152176manager :: C.Manager
153177manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -292,6 +316,22 @@ data WrappedApi where
292316 HasClient api, Client api ~ ExceptT ServantError IO ()) =>
293317 Proxy api -> WrappedApi
294318
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"
295335
296336-- * utils
297337