Export AuthenticateRequest instance for BasicAuth

This commit is contained in:
aaron levin 2015-08-20 15:16:05 -04:00 committed by aaron levin
parent 3fb8f6ff66
commit 4e4bbff8bc
3 changed files with 16 additions and 10 deletions

View file

@ -33,6 +33,7 @@ library
base >=4.7 && <5
, aeson
, attoparsec
, base64-bytestring
, bytestring
, exceptions
, http-api-data >= 0.1 && < 0.3
@ -66,7 +67,6 @@ test-suite spec
, transformers
, transformers-compat
, aeson
, base64-bytestring
, bytestring
, deepseq
, hspec == 2.*

View file

@ -1,12 +1,25 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Authentication for clients
module Servant.Client.Authentication (
AuthenticateRequest ( authReq )
) where
import Servant.Common.Req (Req)
import Data.ByteString.Base64 (encode)
import Data.Monoid ((<>))
import Data.Text.Encoding (decodeUtf8)
import Servant.API.Authentication (BasicAuth(BasicAuth))
import Servant.Common.Req (addHeader, Req)
-- | Class to represent the ability to authenticate a 'Request'
-- object. For example, we may add special headers to the 'Request'.
class AuthenticateRequest a where
authReq :: a -> Req -> Req
instance AuthenticateRequest (BasicAuth realm) where
authReq (BasicAuth user pass) req =
let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass)) in
addHeader "Authorization" authText req

View file

@ -30,7 +30,6 @@ import Control.Concurrent (forkIO, killThread, ThreadId)
import Control.Exception (bracket)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Data.Aeson
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Lazy (ByteString)
import Data.Foldable (forM_)
import Data.Monoid hiding (getLast)
@ -56,8 +55,7 @@ import Test.QuickCheck
import Servant.API
import Servant.API.Authentication
import Servant.Client
import qualified Servant.Common.Req as SCR
import Servant.Client.Authentication (AuthenticateRequest(authReq))
import Servant.Client.Authentication()
import Servant.Server
import Servant.Server.Internal.Authentication
@ -128,11 +126,6 @@ basicAuthCheck (BasicAuth user pass) = if user == "servant" && pass == "server"
then return (Just $ Person "servant" 17)
else return Nothing
instance AuthenticateRequest (BasicAuth realm) where
authReq (BasicAuth user pass) req =
let authText = TE.decodeUtf8 ("Basic " <> B64.encode (user <> ":" <> pass)) in
SCR.addHeader "Authorization" authText req
api :: Proxy Api
api = Proxy