diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,15 @@ ## [Unreleased] +## [0.4.9.0] - 2024-08-28 +- Allow newer versions dependencies, and newer versions of GHC. [#1747](https://github.com/haskell-servant/servant/pull/1747) among others. +- Use `Type` instead of `*`. [#1710](https://github.com/haskell-servant/servant/pull/1710) +- Add AddSetCookies instance for when the left tree is the same before and after the transformation. [#1601](https://github.com/haskell-servant/servant/issues/1601) [#1702](https://github.com/haskell-servant/servant/pull/1702) + +## [0.4.8.0] - 2023-06-25 + +- No changelog available. + ## [0.4.6.0] - 2020-10-06 ## Changed diff --git a/servant-auth-server.cabal b/servant-auth-server.cabal --- a/servant-auth-server.cabal +++ b/servant-auth-server.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: servant-auth-server -version: 0.4.8.0 +version: 0.4.9.0 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server. @@ -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 +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 build-type: Simple extra-source-files: CHANGELOG.md @@ -31,26 +31,26 @@ 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.10 && < 4.19 + base >= 4.14 && < 4.21 , aeson >= 1.0.0.1 && < 3 , base64-bytestring >= 1.0.0.1 && < 2 , blaze-builder >= 0.4.1.0 && < 0.5 - , bytestring >= 0.10.6.0 && < 0.12 + , bytestring >= 0.10.6.0 && < 0.13 , case-insensitive >= 1.2.0.11 && < 1.3 - , cookie >= 0.4.4 && < 0.5 + , cookie >= 0.4.4 && < 0.6 , data-default-class >= 0.1.2.0 && < 0.2 , entropy >= 0.4.1.3 && < 0.5 , http-types >= 0.12.2 && < 0.13 - , jose >= 0.10 && < 0.11 - , lens >= 4.16.1 && < 5.3 + , jose >= 0.10 && < 0.12 + , lens >= 4.16.1 && < 5.4 , memory >= 0.14.16 && < 0.19 - , monad-time >= 0.3.1.0 && < 0.4 + , monad-time >= 0.3.1.0 && < 0.5 , mtl ^>= 2.2.2 || ^>= 2.3.1 - , servant >= 0.13 && < 0.21 - , servant-auth == 0.4.* - , servant-server >= 0.13 && < 0.21 + , servant >= 0.20.2 && < 0.21 + , servant-auth >= 0.4.2.0 && < 0.5 + , servant-server >= 0.20.2 && < 0.21 , tagged >= 0.8.4 && < 0.9 - , text >= 1.2.3.0 && < 2.1 + , text >= 1.2.3.0 && < 2.2 , time >= 1.5.0.1 && < 1.13 , unordered-containers >= 0.2.9.0 && < 0.3 , wai >= 3.2.1.2 && < 3.3 @@ -102,7 +102,7 @@ test default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.11 + build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.12 -- dependencies with bounds inherited from the library stanza build-depends: @@ -123,13 +123,13 @@ -- test dependencies build-depends: servant-auth-server - , hspec >= 2.5.5 && < 2.11 - , QuickCheck >= 2.11.3 && < 2.15 + , hspec >= 2.5.5 && < 2.12 + , QuickCheck >= 2.11.3 && < 2.16 , http-client >= 0.5.13.1 && < 0.8 , lens-aeson >= 1.0.2 && < 1.3 - , warp >= 3.2.25 && < 3.4 + , warp >= 3.2.25 && < 3.5 , wreq >= 0.5.2.1 && < 0.6 - , text >= 1.2.3.0 && < 2.1 + , text >= 1.2.3.0 && < 2.2 other-modules: Servant.Auth.ServerSpec default-language: Haskell2010 diff --git a/src/Servant/Auth/Server/Internal/AddSetCookie.hs b/src/Servant/Auth/Server/Internal/AddSetCookie.hs --- a/src/Servant/Auth/Server/Internal/AddSetCookie.hs +++ b/src/Servant/Auth/Server/Internal/AddSetCookie.hs @@ -7,11 +7,10 @@ import Blaze.ByteString.Builder (toByteString) import qualified Data.ByteString as BS -import Data.Tagged (Tagged (..)) +import Data.Kind (Type) import qualified Network.HTTP.Types as HTTP import Network.Wai (mapResponseHeaders) import Servant -import Servant.API.UVerb.Union import Servant.API.Generic import Servant.Server.Generic import Web.Cookie @@ -35,12 +34,12 @@ AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a #if MIN_VERSION_servant_server(0,18,1) -type family MapAddSetCookieApiVerb (as :: [*]) where +type family MapAddSetCookieApiVerb (as :: [Type]) where MapAddSetCookieApiVerb '[] = '[] MapAddSetCookieApiVerb (a ': as) = (AddSetCookieApiVerb a ': MapAddSetCookieApiVerb as) #endif -type family AddSetCookieApi a :: * +type family AddSetCookieApi a :: Type type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b #if MIN_VERSION_servant_server(0,19,0) @@ -59,7 +58,7 @@ #endif type instance AddSetCookieApi (Headers hs a) = AddSetCookieApiVerb (Headers hs a) -data SetCookieList (n :: Nat) :: * where +data SetCookieList (n :: Nat) :: Type where SetCookieNil :: SetCookieList 'Z SetCookieCons :: Maybe SetCookie -> SetCookieList n -> SetCookieList ('S n) @@ -76,17 +75,22 @@ instance {-# OVERLAPPABLE #-} ( Functor m , AddSetCookies n (m old) (m cookied) - , AddHeader "Set-Cookie" SetCookie cookied new + , AddHeader mods "Set-Cookie" SetCookie cookied new ) => AddSetCookies ('S n) (m old) (m new) where addSetCookies (mCookie `SetCookieCons` rest) oldVal = case mCookie of - Nothing -> noHeader <$> addSetCookies rest oldVal - Just cookie -> addHeader cookie <$> addSetCookies rest oldVal + Nothing -> noHeader' <$> addSetCookies rest oldVal + Just cookie -> addHeader' cookie <$> addSetCookies rest oldVal instance {-# OVERLAPS #-} (AddSetCookies ('S n) a a', AddSetCookies ('S n) b b') => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b + +instance {-# OVERLAPPING #-} + (AddSetCookies ('S n) a a, AddSetCookies ('S n) b b') + => AddSetCookies ('S n) (a :<|> b) (a :<|> b') where + addSetCookies cookies ( a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b instance {-# OVERLAPS #-} ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi diff --git a/src/Servant/Auth/Server/Internal/Class.hs b/src/Servant/Auth/Server/Internal/Class.hs --- a/src/Servant/Auth/Server/Internal/Class.hs +++ b/src/Servant/Auth/Server/Internal/Class.hs @@ -2,6 +2,7 @@ module Servant.Auth.Server.Internal.Class where import Servant.Auth +import Data.Kind (Type) import Data.Monoid import Servant hiding (BasicAuth) @@ -16,7 +17,7 @@ -- elements of @ctx@ to be the in the Context and whose authentication check -- returns an @AuthCheck v@. class IsAuth a v where - type family AuthArgs a :: [*] + type family AuthArgs a :: [Type] runAuth :: proxy a -> proxy v -> Unapp (AuthArgs a) (AuthCheck v) instance FromJWT usr => IsAuth Cookie usr where @@ -33,7 +34,7 @@ -- * Helper -class AreAuths (as :: [*]) (ctxs :: [*]) v where +class AreAuths (as :: [Type]) (ctxs :: [Type]) v where runAuths :: proxy as -> Context ctxs -> AuthCheck v instance AreAuths '[] ctxs v where diff --git a/src/Servant/Auth/Server/Internal/Cookie.hs b/src/Servant/Auth/Server/Internal/Cookie.hs --- a/src/Servant/Auth/Server/Internal/Cookie.hs +++ b/src/Servant/Auth/Server/Internal/Cookie.hs @@ -5,8 +5,6 @@ import Control.Monad (MonadPlus(..), guard) import Control.Monad.Except import Control.Monad.Reader -import qualified Crypto.JOSE as Jose -import qualified Crypto.JWT as Jose import Data.ByteArray (constEq) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as BS64 @@ -18,11 +16,11 @@ import Network.HTTP.Types (methodGet) import Network.HTTP.Types.Header(hCookie) import Network.Wai (Request, requestHeaders, requestMethod) -import Servant (AddHeader, addHeader) +import Servant (AddHeader, addHeader') import System.Entropy (getEntropy) import Web.Cookie -import Servant.Auth.JWT (FromJWT (decodeJWT), ToJWT) +import Servant.Auth.JWT (FromJWT, ToJWT) import Servant.Auth.Server.Internal.ConfigTypes import Servant.Auth.Server.Internal.JWT (makeJWT, verifyJWT) import Servant.Auth.Server.Internal.Types @@ -132,8 +130,8 @@ -- provided response object with XSRF and session cookies. This should be used -- when a user successfully authenticates with credentials. acceptLogin :: ( ToJWT session - , AddHeader "Set-Cookie" SetCookie response withOneCookie - , AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies ) + , AddHeader mods "Set-Cookie" SetCookie response withOneCookie + , AddHeader mods "Set-Cookie" SetCookie withOneCookie withTwoCookies ) => CookieSettings -> JWTSettings -> session @@ -144,7 +142,7 @@ Nothing -> pure Nothing Just sessionCookie -> do xsrfCookie <- makeXsrfCookie cookieSettings - return $ Just $ addHeader sessionCookie . addHeader xsrfCookie + return $ Just $ addHeader' sessionCookie . addHeader' xsrfCookie -- | Arbitrary cookie expiry time set back in history after unix time 0 expireTime :: UTCTime @@ -152,12 +150,12 @@ -- | Adds headers to a response that clears all session cookies -- | using max-age and expires cookie attributes. -clearSession :: ( AddHeader "Set-Cookie" SetCookie response withOneCookie - , AddHeader "Set-Cookie" SetCookie withOneCookie withTwoCookies ) +clearSession :: ( AddHeader mods "Set-Cookie" SetCookie response withOneCookie + , AddHeader mods "Set-Cookie" SetCookie withOneCookie withTwoCookies ) => CookieSettings -> response -> withTwoCookies -clearSession cookieSettings = addHeader clearedSessionCookie . addHeader clearedXsrfCookie +clearSession cookieSettings = addHeader' clearedSessionCookie . addHeader' clearedXsrfCookie where -- According to RFC6265 max-age takes precedence, but IE/Edge ignore it completely so we set both cookieSettingsExpires = cookieSettings diff --git a/test/Servant/Auth/ServerSpec.hs b/test/Servant/Auth/ServerSpec.hs --- a/test/Servant/Auth/ServerSpec.hs +++ b/test/Servant/Auth/ServerSpec.hs @@ -80,7 +80,7 @@ authSpec :: Spec authSpec = describe "The Auth combinator" - $ around (testWithApplication . return $ app jwtAndCookieApi) $ do + $ aroundAll (testWithApplication . return $ app jwtAndCookieApi) $ do it "returns a 401 if all authentications are Indefinite" $ \port -> do get (url port) `shouldHTTPErrorWith` status401 @@ -172,7 +172,7 @@ cookieAuthSpec = describe "The Auth combinator" $ do describe "With XSRF check" $ - around (testWithApplication . return $ app cookieOnlyApi) $ do + aroundAll (testWithApplication . return $ app cookieOnlyApi) $ do it "fails if XSRF header and cookie don't match" $ \port -> property $ \(user :: User) -> do @@ -243,7 +243,7 @@ describe "With no XSRF check for GET requests" $ let noXsrfGet xsrfCfg = xsrfCfg { xsrfExcludeGet = True } cookieCfgNoXsrfGet = cookieCfg { cookieXsrfSetting = fmap noXsrfGet $ cookieXsrfSetting cookieCfg } - in around (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrfGet) $ do + in aroundAll (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrfGet) $ do it "succeeds with no XSRF header or cookie for GET" $ \port -> property $ \(user :: User) -> do @@ -260,7 +260,7 @@ describe "With no XSRF check at all" $ let cookieCfgNoXsrf = cookieCfg { cookieXsrfSetting = Nothing } - in around (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrf) $ do + in aroundAll (testWithApplication . return $ appWithCookie cookieOnlyApi cookieCfgNoXsrf) $ do it "succeeds with no XSRF header or cookie for GET" $ \port -> property $ \(user :: User) -> do @@ -313,7 +313,7 @@ jwtAuthSpec :: Spec jwtAuthSpec = describe "The JWT combinator" - $ around (testWithApplication . return $ app jwtOnlyApi) $ do + $ aroundAll (testWithApplication . return $ app jwtOnlyApi) $ do it "fails if 'aud' does not match predicate" $ \port -> property $ \(user :: User) -> do @@ -378,7 +378,7 @@ basicAuthSpec :: Spec basicAuthSpec = describe "The BasicAuth combinator" - $ around (testWithApplication . return $ app basicAuthApi) $ do + $ aroundAll (testWithApplication . return $ app basicAuthApi) $ do it "succeeds with the correct password and username" $ \port -> do resp <- getWith (defaults & auth ?~ basicAuth "ali" "Open sesame") (url port)