{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ == 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Servant.Auth.Client.Internal where
import qualified Data.ByteString as BS
import Data.Monoid
import Data.Proxy (Proxy (..))
import Data.String (IsString)
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import Servant.API ((:>))
import Servant.Auth
import Servant.Client.Core
import Data.Sequence ((<|))
newtype Token = Token { Token -> ByteString
getToken :: BS.ByteString }
deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS Token
Read, forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, String -> Token
forall a. (String -> a) -> IsString a
fromString :: String -> Token
$cfromString :: String -> Token
IsString)
type family HasBearer xs :: Constraint where
HasBearer (Bearer ': xs) = ()
HasBearer (JWT ': xs) = ()
HasBearer (x ': xs) = HasBearer xs
HasBearer '[] = BearerAuthNotEnabled
class BearerAuthNotEnabled
instance (HasBearer auths, HasClient m api) => HasClient m (Auth auths a :> api) where
type Client m (Auth auths a :> api) = Token -> Client m api
clientWithRoute :: Proxy m
-> Proxy (Auth auths a :> api)
-> Request
-> Client m (Auth auths a :> api)
clientWithRoute Proxy m
m Proxy (Auth auths a :> api)
_ Request
req (Token ByteString
token)
= forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
m (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
forall a b. (a -> b) -> a -> b
$ Request
req { requestHeaders :: Seq Header
requestHeaders = (HeaderName
"Authorization", ByteString
headerVal) forall a. a -> Seq a -> Seq a
<| forall body path. RequestF body path -> Seq Header
requestHeaders Request
req }
where
headerVal :: ByteString
headerVal = ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<> ByteString
token
#if MIN_VERSION_servant_client_core(0,14,0)
hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (Auth auths a :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (Auth auths a :> api)
-> Client mon' (Auth auths a :> api)
hoistClientMonad Proxy m
pm Proxy (Auth auths a :> api)
_ forall x. mon x -> mon' x
nt Client mon (Auth auths a :> api)
cl = forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Client mon (Auth auths a :> api)
cl
#endif
data Bearer