diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,12 @@ ## [Unreleased] +## [0.4.4.0] - 2019-03-02 + +### Added +- #141 Support Stream combinator [@domenkozar] +- #143 Allow servant-0.16 [@phadej] + ## [0.4.3.0] - 2019-01-17 ## Changed diff --git a/servant-auth-server.cabal b/servant-auth-server.cabal --- a/servant-auth-server.cabal +++ b/servant-auth-server.cabal @@ -1,5 +1,5 @@ name: servant-auth-server -version: 0.4.3.0 +version: 0.4.4.0 synopsis: servant-server/servant-auth compatibility description: This package provides the required instances for using the @Auth@ combinator in your 'servant' server. @@ -46,9 +46,9 @@ , memory >= 0.14.16 && < 0.15 , monad-time >= 0.3.1.0 && < 0.4 , mtl >= 2.2.2 && < 2.3 - , servant >= 0.13 && < 0.16 + , servant >= 0.13 && < 0.17 , servant-auth == 0.3.* - , servant-server >= 0.13 && < 0.16 + , servant-server >= 0.13 && < 0.17 , tagged >= 0.8.4 && < 0.9 , text >= 1.2.3.0 && < 1.3 , time >= 1.5.0.1 && < 1.9 @@ -97,7 +97,7 @@ test default-extensions: AutoDeriveTypeable 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.7 + build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8 -- dependencies with bounds inherited from the library stanza build-depends: @@ -111,15 +111,16 @@ , time , http-types , wai + , servant , servant-server , transformers -- test dependencies build-depends: servant-auth-server - , hspec >= 2.5.5 && < 2.7.0 + , hspec >= 2.5.5 && < 2.8 , QuickCheck >= 2.11.3 && < 2.13 - , http-client >= 0.5.13.1 && < 0.6 + , http-client >= 0.5.13.1 && < 0.7 , lens-aeson >= 1.0.2 && < 1.1 , warp >= 3.2.25 && < 3.3 , wreq >= 0.5.2.1 && < 0.6 diff --git a/src/Servant/Auth/Server/Internal.hs b/src/Servant/Auth/Server/Internal.hs --- a/src/Servant/Auth/Server/Internal.hs +++ b/src/Servant/Auth/Server/Internal.hs @@ -17,7 +17,7 @@ import Servant.Auth.Server.Internal.JWT import Servant.Auth.Server.Internal.Types -import Servant.Server.Internal.RoutingApplication +import Servant.Server.Internal (DelayedIO, addAuthCheck, withRequest) instance ( n ~ 'S ('S 'Z) , HasServer (AddSetCookiesApi n api) ctxs, AreAuths auths ctxs v 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 @@ -1,6 +1,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} module Servant.Auth.Server.Internal.AddSetCookie where @@ -36,6 +37,10 @@ type instance AddSetCookieApi (Verb method stat ctyps a) = Verb method stat ctyps (AddSetCookieApiVerb a) type instance AddSetCookieApi Raw = Raw +#if MIN_VERSION_servant_server(0,15,0) +type instance AddSetCookieApi (Stream method stat framing ctyps a) + = Stream method stat framing ctyps (AddSetCookieApiVerb a) +#endif type instance AddSetCookieApi (Headers hs a) = AddSetCookieApiVerb (Headers hs a) data SetCookieList (n :: Nat) :: * where diff --git a/src/Servant/Auth/Server/Internal/BasicAuth.hs b/src/Servant/Auth/Server/Internal/BasicAuth.hs --- a/src/Servant/Auth/Server/Internal/BasicAuth.hs +++ b/src/Servant/Auth/Server/Internal/BasicAuth.hs @@ -1,18 +1,22 @@ +{-# LANGUAGE CPP #-} module Servant.Auth.Server.Internal.BasicAuth where +#if !MIN_VERSION_servant_server(0,16,0) +#define ServerError ServantErr +#endif + import qualified Data.ByteString as BS import Servant (BasicAuthData (..), - ServantErr (..), err401) + ServerError (..), err401) import Servant.Server.Internal.BasicAuth (decodeBAHdr, mkBAChallengerHdr) - import Servant.Auth.Server.Internal.Types --- | A 'ServantErr' that asks the client to authenticate via Basic +-- | A 'ServerError' that asks the client to authenticate via Basic -- Authentication, should be invoked by an application whenever -- appropriate. The argument is the realm. -wwwAuthenticatedErr :: BS.ByteString -> ServantErr +wwwAuthenticatedErr :: BS.ByteString -> ServerError wwwAuthenticatedErr realm = err401 { errHeaders = [mkBAChallengerHdr realm] } type family BasicAuthCfg diff --git a/src/Servant/Auth/Server/Internal/ThrowAll.hs b/src/Servant/Auth/Server/Internal/ThrowAll.hs --- a/src/Servant/Auth/Server/Internal/ThrowAll.hs +++ b/src/Servant/Auth/Server/Internal/ThrowAll.hs @@ -1,9 +1,14 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} module Servant.Auth.Server.Internal.ThrowAll where +#if !MIN_VERSION_servant_server(0,16,0) +#define ServerError ServantErr +#endif + import Control.Monad.Error.Class import Data.Tagged (Tagged (..)) -import Servant ((:<|>) (..), ServantErr(..)) +import Servant ((:<|>) (..), ServerError(..)) import Network.HTTP.Types import Network.Wai @@ -16,7 +21,7 @@ -- -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c -- > == throwError err400 :<|> throwError err400 :<|> err400 - throwAll :: ServantErr -> a + throwAll :: ServerError -> a instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where throwAll e = throwAll e :<|> throwAll e @@ -26,7 +31,7 @@ instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where throwAll e = const $ throwAll e -instance {-# OVERLAPPABLE #-} (MonadError ServantErr m) => ThrowAll (m a) where +instance {-# OVERLAPPABLE #-} (MonadError ServerError m) => ThrowAll (m a) where throwAll = throwError -- | for @servant <0.11@ @@ -37,7 +42,7 @@ (errBody e) -- | for @servant >=0.11@ -instance {-# OVERLAPPING #-} MonadError ServantErr m => ThrowAll (Tagged m Application) where +instance {-# OVERLAPPING #-} MonadError ServerError m => ThrowAll (Tagged m Application) where throwAll e = Tagged $ \_req respond -> respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e)) (errHeaders e) 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 @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} module Servant.Auth.ServerSpec (spec) where +#if !MIN_VERSION_servant_server(0,16,0) +#define ServerError ServantErr +#endif + import Control.Lens import Control.Monad.Except (runExceptT) import Control.Monad.IO.Class (liftIO) @@ -49,6 +53,9 @@ import Servant.Auth.Server import Servant.Auth.Server.Internal.Cookie (expireTime) import Servant.Auth.Server.SetCookieOrphan () +#if MIN_VERSION_servant_server(0,15,0) +import qualified Servant.Types.SourceT as S +#endif import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Test.QuickCheck @@ -380,12 +387,12 @@ throwAllSpec = describe "throwAll" $ do it "works for plain values" $ do - let t :: Either ServantErr Int :<|> Either ServantErr Bool :<|> Either ServantErr String + let t :: Either ServerError Int :<|> Either ServerError Bool :<|> Either ServerError String t = throwAll err401 t `shouldBe` throwError err401 :<|> throwError err401 :<|> throwError err401 it "works for function types" $ property $ \i -> do - let t :: Int -> (Either ServantErr Bool :<|> Either ServantErr String) + let t :: Int -> (Either ServerError Bool :<|> Either ServerError String) t = throwAll err401 expected _ = throwError err401 :<|> throwError err401 t i `shouldBe` expected i @@ -399,6 +406,9 @@ ( Get '[JSON] Int :<|> ReqBody '[JSON] Int :> Post '[JSON] Int :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int) +#if MIN_VERSION_servant_server(0,15,0) + :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString) +#endif :<|> "raw" :> Raw ) :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie @@ -467,6 +477,9 @@ Authenticated usr -> getInt usr :<|> postInt usr :<|> getHeaderInt +#if MIN_VERSION_servant_server(0,15,0) + :<|> return (S.source ["bytestring"]) +#endif :<|> raw Indefinite -> throwAll err401 _ -> throwAll err403