diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/servant-auth-client.cabal b/servant-auth-client.cabal --- a/servant-auth-client.cabal +++ b/servant-auth-client.cabal @@ -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 @@ -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 diff --git a/src/Servant/Auth/Client.hs b/src/Servant/Auth/Client.hs --- a/src/Servant/Auth/Client.hs +++ b/src/Servant/Auth/Client.hs @@ -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 (..)) diff --git a/src/Servant/Auth/Client/Internal.hs b/src/Servant/Auth/Client/Internal.hs --- a/src/Servant/Auth/Client/Internal.hs +++ b/src/Servant/Auth/Client/Internal.hs @@ -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 diff --git a/test/Servant/Auth/ClientSpec.hs b/test/Servant/Auth/ClientSpec.hs --- a/test/Servant/Auth/ClientSpec.hs +++ b/test/Servant/Auth/ClientSpec.hs @@ -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