Export AuthenticateRequest instance for BasicAuth
This commit is contained in:
parent
3fb8f6ff66
commit
4e4bbff8bc
3 changed files with 16 additions and 10 deletions
|
@ -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.*
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue