diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 71cb2ee6..8e20f1a3 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -28,11 +28,13 @@ library exposed-modules: Servant.Client Servant.Common.BaseUrl + Servant.Common.BasicAuth Servant.Common.Req build-depends: base >=4.7 && <5 , aeson , attoparsec + , base64-bytestring , bytestring , exceptions , http-api-data >= 0.1 && < 0.3 diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index ed27b3c7..d3373708 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -37,6 +37,7 @@ import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP import Servant.API import Servant.Common.BaseUrl +import Servant.Common.BasicAuth import Servant.Common.Req -- * Accessing APIs as a Client @@ -424,6 +425,15 @@ instance HasClient subapi => clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi) +-- * Basic Authentication + +instance HasClient api => HasClient (BasicAuth realm usr :> api) where + type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api + + clientWithRoute Proxy req baseurl manager val = + clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager + + {- Note [Non-Empty Content Types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Rather than have diff --git a/servant-client/src/Servant/Common/BasicAuth.hs b/servant-client/src/Servant/Common/BasicAuth.hs new file mode 100644 index 00000000..e2802699 --- /dev/null +++ b/servant-client/src/Servant/Common/BasicAuth.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Basic Authentication for clients + +module Servant.Common.BasicAuth ( + basicAuthReq + ) where + +import Data.ByteString.Base64 (encode) +import Data.Monoid ((<>)) +import Data.Text.Encoding (decodeUtf8) +import Servant.Common.Req (addHeader, Req) +import Servant.API.BasicAuth (BasicAuthData(BasicAuthData)) + +-- | Authenticate a request using Basic Authentication +basicAuthReq :: BasicAuthData -> Req -> Req +basicAuthReq (BasicAuthData user pass) req = + let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass)) + in addHeader "Authorization" authText req diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 2bca7c13..291b9786 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -62,6 +62,7 @@ spec = describe "Servant.Client" $ do sucessSpec failSpec wrappedApiSpec + basicAuthSpec -- * test data types @@ -148,6 +149,29 @@ failServer = serve failApi ( :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "") ) + +-- * auth stuff + +type BasicAuthAPI = + BasicAuth "foo-realm" () :> "private" :> "basic" :> Get '[JSON] Person + +basicAuthAPI :: Proxy BasicAuthAPI +basicAuthAPI = Proxy + +basicAuthHandler :: BasicAuthCheck () +basicAuthHandler = + let check (BasicAuthData username password) = + if username == "servant" && password == "server" + then return (Authorized ()) + else return Unauthorized + in BasicAuthCheck check + +serverConfig :: Config '[ BasicAuthCheck () ] +serverConfig = basicAuthHandler :. EmptyConfig + +basicAuthServer :: Application +basicAuthServer = serve basicAuthAPI serverConfig (const (return alice)) + {-# NOINLINE manager #-} manager :: C.Manager manager = unsafePerformIO $ C.newManager C.defaultManagerSettings @@ -292,6 +316,22 @@ data WrappedApi where HasClient api, Client api ~ ExceptT ServantError IO ()) => Proxy api -> WrappedApi +basicAuthSpec :: Spec +basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ do + context "Authentication works when requests are properly authenticated" $ do + + it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do + let getBasic = client basicAuthAPI baseUrl manager + let basicAuthData = BasicAuthData "servant" "server" + (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice + + context "Authentication is rejected when requests are not authenticated properly" $ do + + it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do + let getBasic = client basicAuthAPI baseUrl manager + let basicAuthData = BasicAuthData "not" "password" + Left FailureResponse{..} <- runExceptT (getBasic basicAuthData) + responseStatus `shouldBe` Status 403 "Forbidden" -- * utils