servant-auth-client 0.4.2.0 → 0.4.9.2
raw patch · 5 files changed
+80/−74 lines, 5 filesdep ~basedep ~bytestringdep ~containerssetup-changed
Dependency ranges changed: base, bytestring, containers, jose, servant, servant-auth, servant-client-core
Files
- Setup.hs +1/−0
- servant-auth-client.cabal +13/−13
- src/Servant/Auth/Client.hs +2/−2
- src/Servant/Auth/Client/Internal.hs +21/−23
- test/Servant/Auth/ClientSpec.hs +43/−36
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
servant-auth-client.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: servant-auth-client-version: 0.4.2.0+version: 0.4.9.2 synopsis: servant-client/servant-auth compatibility description: This package provides instances that allow generating clients from <https://hackage.haskell.org/package/servant servant>@@ -16,7 +16,7 @@ copyright: (c) Julian K. Arni license: BSD-3-Clause license-file: LICENSE-tested-with: GHC==8.6.5, GHC==8.8.4, GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.7, GHC ==9.4.4, GHC ==9.10.1+tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.4 || ==9.10.1 || ==9.12.1 build-type: Simple extra-source-files: CHANGELOG.md@@ -31,12 +31,12 @@ default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators ghc-options: -Wall build-depends:- base >= 4.14 && < 4.21+ base >= 4.16.4.0 && < 4.22 , bytestring >= 0.10.6.0 && < 0.13- , containers >= 0.5.6.2 && < 0.8- , servant-auth >= 0.4.2.0 && < 0.5- , servant >= 0.20.2 && < 0.21- , servant-client-core >= 0.20.2 && < 0.21+ , containers >=0.6.5.1 && < 0.9+ , servant-auth == 0.4.9.2+ , servant >= 0.20.3 && < 0.21+ , servant-client-core >= 0.20.3 && < 0.21 exposed-modules: Servant.Auth.Client@@ -49,12 +49,12 @@ hs-source-dirs: test default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators- ghc-options: -Wall+ ghc-options: -Wall -threaded build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.12 -- dependencies with bounds inherited from the library stanza build-depends:- base+ base >=4.16.4.0 , servant-client , servant-auth , servant@@ -63,18 +63,18 @@ -- test dependencies build-depends: hspec >= 2.5.5 && < 2.12- , QuickCheck >= 2.11.3 && < 2.16+ , QuickCheck >= 2.11.3 && < 2.17 , aeson >= 1.3.1.1 && < 3- , bytestring >= 0.10.6.0 && < 0.13+ , bytestring >= 0.11 && < 0.13 , http-client >= 0.5.13.1 && < 0.8 , http-types >= 0.12.2 && < 0.13 , servant-auth-server >= 0.4.2.0 && < 0.5 , servant-server >= 0.20.2 && < 0.21- , time >= 1.5.0.1 && < 1.13+ , time >= 1.5.0.1 && < 1.15 , transformers >= 0.4.2.0 && < 0.7 , wai >= 3.2.1.2 && < 3.3 , warp >= 3.2.25 && < 3.5- , jose >= 0.10 && < 0.12+ , jose >= 0.10 && < 0.13 other-modules: Servant.Auth.ClientSpec default-language: Haskell2010
src/Servant/Auth/Client.hs view
@@ -1,3 +1,3 @@-module Servant.Auth.Client (Token(..), Bearer) where+module Servant.Auth.Client (Token (..), Bearer) where -import Servant.Auth.Client.Internal (Bearer, Token(..))+import Servant.Auth.Client.Internal (Bearer, Token (..))
src/Servant/Auth/Client/Internal.hs view
@@ -1,33 +1,32 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UndecidableInstances #-}+{-# 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 ((<|))+import qualified Data.ByteString as BS+import Data.Monoid+import Data.Proxy (Proxy (..))+import Data.Sequence ((<|))+import Data.String (IsString)+import GHC.Exts (Constraint)+import GHC.Generics (Generic)+import Servant.API ((:>))+import Servant.Auth+import Servant.Client.Core -- | A simple bearer token.-newtype Token = Token { getToken :: BS.ByteString }- deriving (Eq, Show, Read, Generic, IsString)+newtype Token = Token {getToken :: BS.ByteString}+ deriving (Eq, Generic, IsString, Read, Show) type family HasBearer xs :: Constraint where HasBearer (Bearer ': xs) = () HasBearer (JWT ': xs) = ()- HasBearer (x ': xs) = HasBearer xs- HasBearer '[] = BearerAuthNotEnabled+ HasBearer (x ': xs) = HasBearer xs+ HasBearer '[] = BearerAuthNotEnabled class BearerAuthNotEnabled @@ -36,16 +35,15 @@ 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 m _ req (Token token)- = clientWithRoute m (Proxy :: Proxy api)- $ req { requestHeaders = ("Authorization", headerVal) <| requestHeaders req }- where- headerVal = "Bearer " <> token+ clientWithRoute m _ req (Token token) =+ clientWithRoute m (Proxy :: Proxy api) $+ req{requestHeaders = ("Authorization", headerVal) <| requestHeaders req}+ where+ headerVal = "Bearer " <> token #if MIN_VERSION_servant_client_core(0,14,0) hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl #endif- -- * Authentication combinators
test/Servant/Auth/ClientSpec.hs view
@@ -1,34 +1,34 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE CPP #-}+ module Servant.Auth.ClientSpec (spec) where -import Crypto.JOSE (JWK,- KeyMaterialGenParam (OctGenParam),- genJWK)-import Data.Aeson (FromJSON (..), ToJSON (..))-import qualified Data.ByteString.Lazy as BSL-import Data.Time (UTCTime, defaultTimeLocale,- parseTimeOrError)-import GHC.Generics (Generic)-import Network.HTTP.Client (Manager, defaultManagerSettings,- newManager)-import Network.HTTP.Types (status401)-import Network.Wai.Handler.Warp (testWithApplication)-import Servant-import Servant.Client (BaseUrl (..), Scheme (Http),- ClientError (FailureResponse),+import Crypto.JOSE (JWK, KeyMaterialGenParam (OctGenParam), genJWK)+import Data.Aeson (FromJSON (..), ToJSON (..))+import qualified Data.ByteString.Lazy as BSL+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import GHC.Generics (Generic)+import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)+import Network.HTTP.Types (status401)+import Network.Wai.Handler.Warp (testWithApplication)+import Servant+import Servant.Client+ ( BaseUrl (..)+ , ClientError (FailureResponse)+ , Scheme (Http)+ , client+ ) #if MIN_VERSION_servant_client(0,16,0)- ResponseF(..),+import Servant.Client (ResponseF (..)) #elif MIN_VERSION_servant_client(0,13,0)- GenResponse(..),+import Servant.Client (GenResponse (..)) #elif MIN_VERSION_servant_client(0,12,0)- Response(..),+import Servant.Client (Response (..)) #endif- client)-import System.IO.Unsafe (unsafePerformIO)-import Test.Hspec-import Test.QuickCheck +import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec+import Test.QuickCheck+ #if MIN_VERSION_servant_client(0,13,0) import Servant.Client (mkClientEnv, runClientM) #elif MIN_VERSION_servant_client(0,9,0)@@ -36,29 +36,30 @@ #else import Control.Monad.Trans.Except (runExceptT) #endif+ #if !MIN_VERSION_servant_server(0,16,0) #define ClientError ServantError #endif -import Servant.Auth.Client import Servant.Auth.Server import Servant.Auth.Server.SetCookieOrphan () +import Servant.Auth.Client+ spec :: Spec spec = describe "The JWT combinator" $ do hasClientSpec - ------------------------------------------------------------------------------+ -- * HasClient {{{ hasClientSpec :: Spec-hasClientSpec = describe "HasClient" $ aroundAll (testWithApplication $ return app) $ do-+hasClientSpec = describe "HasClient" $ aroundAll (testWithApplication $ pure app) $ do let mkTok :: User -> Maybe UTCTime -> IO Token mkTok user mexp = do Right tok <- makeJWT user jwtCfg mexp- return $ Token $ BSL.toStrict tok+ pure $ Token $ BSL.toStrict tok it "succeeds when the token does not have expiry" $ \port -> property $ \user -> do tok <- mkTok user Nothing@@ -70,6 +71,7 @@ v <- getIntClient tok mgr (BaseUrl Http "localhost" port "") v `shouldBe` Right (length $ name user) +{- FOURMOLU_DISABLE -} it "fails when token is expired" $ \port -> property $ \user -> do tok <- mkTok user (Just past) #if MIN_VERSION_servant_client(0,16,0)@@ -83,7 +85,7 @@ #endif <- getIntClient tok mgr (BaseUrl Http "localhost" port "") stat `shouldBe` status401-+{- FOURMOLU_ENABLE -} getIntClient :: Token -> Manager -> BaseUrl -> IO (Either ClientError Int) #if MIN_VERSION_servant(0,13,0)@@ -93,8 +95,10 @@ #else getIntClient tok m burl = runExceptT $ client api tok m burl #endif+ -- }}} ------------------------------------------------------------------------------+ -- * API and Server {{{ type API = Auth '[JWT] User :> Get '[JSON] Int@@ -121,17 +125,16 @@ cookieCfg :: CookieSettings cookieCfg = defaultCookieSettings - server :: Server API server = getInt where getInt :: AuthResult User -> Handler Int- getInt (Authenticated u) = return . length $ name u+ getInt (Authenticated u) = pure . length $ name u getInt _ = throwAll err401 - -- }}} ------------------------------------------------------------------------------+ -- * Utils {{{ past :: UTCTime@@ -140,19 +143,23 @@ future :: UTCTime future = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01" - -- }}} ------------------------------------------------------------------------------+ -- * Types {{{ data User = User { name :: String- , _id :: String- } deriving (Eq, Show, Read, Generic)+ , _id :: String+ }+ deriving (Eq, Generic, Read, Show) instance FromJWT User+ instance ToJWT User+ instance FromJSON User+ instance ToJSON User instance Arbitrary User where