Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-servant-server for openSUSE:Factory checked in at 2021-07-05 22:22:43 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-servant-server (Old) and /work/SRC/openSUSE:Factory/.ghc-servant-server.new.2625 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-servant-server" Mon Jul 5 22:22:43 2021 rev:3 rq:903731 version:0.18.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-servant-server/ghc-servant-server.changes 2021-01-20 18:26:33.447468323 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-servant-server.new.2625/ghc-servant-server.changes 2021-07-05 22:22:59.745714619 +0200 @@ -1,0 +2,22 @@ +Thu Jun 24 11:52:02 UTC 2021 - [email protected] + +- Update servant-server to version 0.18.3. + 0.18.3 + ------ + + ### Significant changes + + - Add response header support to UVerb (#1420) + + ### Other changes + + - Support GHC-9.0.1. + - Bump `bytestring`, `hspec` and `base64-bytestring` dependencies. + +------------------------------------------------------------------- +Sat May 15 15:58:31 UTC 2021 - [email protected] + +- Update servant-server to version 0.18.2 revision 1. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- Old: ---- servant-server-0.18.2.tar.gz New: ---- servant-server-0.18.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-servant-server.spec ++++++ --- /var/tmp/diff_new_pack.m9mdq6/_old 2021-07-05 22:23:00.197711122 +0200 +++ /var/tmp/diff_new_pack.m9mdq6/_new 2021-07-05 22:23:00.197711122 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-servant-server # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2021 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name servant-server %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.18.2 +Version: 0.18.3 Release: 0 Summary: A family of combinators for defining webservices APIs and serving them License: BSD-3-Clause @@ -92,8 +92,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cabal-tweak-dep-ver base64-bytestring '< 1.2' '< 1.3' -cabal-tweak-dep-ver http-api-data '< 0.4.3' '< 0.5' %build %ghc_lib_build ++++++ servant-server-0.18.2.tar.gz -> servant-server-0.18.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.18.2/CHANGELOG.md new/servant-server-0.18.3/CHANGELOG.md --- old/servant-server-0.18.2/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.18.3/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,18 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.18.3 +------ + +### Significant changes + +- Add response header support to UVerb (#1420) + +### Other changes + +- Support GHC-9.0.1. +- Bump `bytestring`, `hspec` and `base64-bytestring` dependencies. + 0.18.2 ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.18.2/servant-server.cabal new/servant-server-0.18.3/servant-server.cabal --- old/servant-server-0.18.2/servant-server.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.18.3/servant-server.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: servant-server -version: 0.18.2 +version: 0.18.3 synopsis: A family of combinators for defining webservices APIs and serving them category: Servant, Web @@ -23,7 +23,7 @@ maintainer: [email protected] copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 +tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 extra-source-files: CHANGELOG.md @@ -60,8 +60,8 @@ -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4 build-depends: - base >= 4.9 && < 4.15 - , bytestring >= 0.10.8.1 && < 0.11 + base >= 4.9 && < 4.16 + , bytestring >= 0.10.8.1 && < 0.12 , containers >= 0.5.7.1 && < 0.7 , mtl >= 2.2.2 && < 2.3 , text >= 1.2.3.0 && < 1.3 @@ -71,14 +71,14 @@ -- Servant dependencies -- strict dependency as we re-export 'servant' things. build-depends: - servant >= 0.18.2 && < 0.18.3 - , http-api-data >= 0.4.1 && < 0.4.3 + servant >= 0.18.3 && < 0.18.4 + , http-api-data >= 0.4.1 && < 0.4.4 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends: base-compat >= 0.10.5 && < 0.12 - , base64-bytestring >= 1.0.0.1 && < 1.2 + , base64-bytestring >= 1.0.0.1 && < 1.3 , exceptions >= 0.10.0 && < 0.11 , http-media >= 0.7.1.3 && < 0.9 , http-types >= 0.12.2 && < 0.13 @@ -147,6 +147,7 @@ , safe , servant , servant-server + , sop-core , string-conversions , text , transformers @@ -157,7 +158,7 @@ build-depends: aeson >= 1.4.1.0 && < 1.6 , directory >= 1.3.0.0 && < 1.4 - , hspec >= 2.6.0 && < 2.8 + , hspec >= 2.6.0 && < 2.9 , hspec-wai >= 0.10.1 && < 0.12 , QuickCheck >= 2.12.6.1 && < 2.15 , should-not-typecheck >= 2.1.0 && < 2.2 @@ -165,4 +166,4 @@ , wai-extra >= 3.0.24.3 && < 3.2 build-tool-depends: - hspec-discover:hspec-discover >= 2.6.0 && <2.8 + hspec-discover:hspec-discover >= 2.6.0 && <2.9 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.18.2/src/Servant/Server/UVerb.hs new/servant-server-0.18.3/src/Servant/Server/UVerb.hs --- old/servant-server-0.18.2/src/Servant/Server/UVerb.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.18.3/src/Servant/Server/UVerb.hs 2001-09-09 03:46:40.000000000 +0200 @@ -22,15 +22,17 @@ ) where +import qualified Data.ByteString as B import Data.Proxy (Proxy (Proxy)) import Data.SOP (I (I)) import Data.SOP.Constraint (All, And) import Data.String.Conversions (LBS, cs) -import Network.HTTP.Types (Status, hContentType) -import Network.Wai (responseLBS) +import Network.HTTP.Types (Status, HeaderName, hContentType) +import Network.Wai (responseLBS, Request) import Servant.API (ReflectMethod, reflectMethod) import Servant.API.ContentTypes (AllCTRender (handleAcceptH), AllMime) -import Servant.API.UVerb (HasStatus, IsMember, Statuses, UVerb, Union, Unique, foldMapUnion, inject, statusOf) +import Servant.API.ResponseHeaders (GetHeaders (..), Headers (..)) +import Servant.API.UVerb (HasStatus, IsMember, Statuses, UVerb, Union, Unique, WithStatus (..), foldMapUnion, inject, statusOf) import Servant.Server.Internal (Context, Delayed, Handler, HasServer (..), RouteResult (FailFatal, Route), Router, Server, ServerT, acceptCheck, addAcceptCheck, addMethodCheck, allowedMethodHead, err406, getAcceptHeader, leafRouter, methodCheck, runAction) @@ -43,13 +45,38 @@ f (Union xs) respond = pure . inject . I --- | Helper constraint used in @instance 'HasServer' 'UVerb'@. -type IsServerResource contentTypes = AllCTRender contentTypes `And` HasStatus +class IsServerResource (cts :: [*]) a where + resourceResponse :: Request -> Proxy cts -> a -> Maybe (LBS, LBS) + resourceHeaders :: Proxy cts -> a -> [(HeaderName, B.ByteString)] + +instance {-# OVERLAPPABLE #-} AllCTRender cts a + => IsServerResource cts a where + resourceResponse request p res = handleAcceptH p (getAcceptHeader request) res + resourceHeaders _ _ = [] + +instance {-# OVERLAPPING #-} (IsServerResource cts a, GetHeaders (Headers h a)) + => IsServerResource cts (Headers h a) where + resourceResponse request p res = resourceResponse request p (getResponse res) + resourceHeaders cts res = getHeaders res ++ resourceHeaders cts (getResponse res) + +instance {-# OVERLAPPING #-} IsServerResource cts a + => IsServerResource cts (WithStatus n a) where + resourceResponse request p (WithStatus x) = resourceResponse request p x + resourceHeaders cts (WithStatus x) = resourceHeaders cts x + +encodeResource :: forall a cts . (IsServerResource cts a, HasStatus a) + => Request -> Proxy cts -> a + -> (Status, Maybe (LBS, LBS), [(HeaderName, B.ByteString)]) +encodeResource request cts res = (statusOf (Proxy @a), + resourceResponse request cts res, + resourceHeaders cts res) + +type IsServerResourceWithStatus cts = IsServerResource cts `And` HasStatus instance ( ReflectMethod method, AllMime contentTypes, - All (IsServerResource contentTypes) as, + All (IsServerResourceWithStatus contentTypes) as, Unique (Statuses as) -- for consistency with servant-swagger (server would work fine -- without; client is a bit of a corner case, because it dispatches -- the parser based on the status code. with this uniqueness @@ -77,20 +104,13 @@ action `addMethodCheck` methodCheck method request `addAcceptCheck` acceptCheck (Proxy @contentTypes) (getAcceptHeader request) - mkProxy :: a -> Proxy a - mkProxy _ = Proxy runAction action' env request cont $ \(output :: Union as) -> do - let encodeResource :: (AllCTRender contentTypes a, HasStatus a) => a -> (Status, Maybe (LBS, LBS)) - encodeResource res = - ( statusOf $ mkProxy res, - handleAcceptH (Proxy @contentTypes) (getAcceptHeader request) res - ) - pickResource :: Union as -> (Status, Maybe (LBS, LBS)) - pickResource = foldMapUnion (Proxy @(IsServerResource contentTypes)) encodeResource - + let cts = Proxy @contentTypes + pickResource :: Union as -> (Status, Maybe (LBS, LBS), [(HeaderName, B.ByteString)]) + pickResource = foldMapUnion (Proxy @(IsServerResourceWithStatus contentTypes)) (encodeResource request cts) case pickResource output of - (_, Nothing) -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does - (status, Just (contentT, body)) -> + (_, Nothing, _) -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does + (status, Just (contentT, body), headers) -> let bdy = if allowedMethodHead method request then "" else body - in Route $ responseLBS status ((hContentType, cs contentT) : []) bdy + in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.18.2/test/Servant/Server/Internal/ContextSpec.hs new/servant-server-0.18.3/test/Servant/Server/Internal/ContextSpec.hs --- old/servant-server-0.18.2/test/Servant/Server/Internal/ContextSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.18.3/test/Servant/Server/Internal/ContextSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds #-} -{-# OPTIONS_GHC -fdefer-type-errors -Wwarn #-} +{-# OPTIONS_GHC -fdefer-type-errors -Wwarn -Wno-deferred-type-errors #-} module Servant.Server.Internal.ContextSpec (spec) where import Data.Proxy diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.18.2/test/Servant/ServerSpec.hs new/servant-server-0.18.3/test/Servant/ServerSpec.hs --- old/servant-server-0.18.2/test/Servant/ServerSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.18.3/test/Servant/ServerSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -28,6 +28,8 @@ (fromMaybe) import Data.Proxy (Proxy (Proxy)) +import Data.SOP + (I (..), NS (..)) import Data.String (fromString) import Data.String.Conversions @@ -53,7 +55,7 @@ NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict, - UVerb, Union, Verb, addHeader) + UVerb, Union, Verb, WithStatus (..), addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), emptyServer, err401, err403, err404, respond, serve, @@ -98,6 +100,7 @@ rawSpec alternativeSpec responseHeadersSpec + uverbResponseHeadersSpec miscCombinatorSpec basicAuthSpec genAuthSpec @@ -686,6 +689,31 @@ -- }}} ------------------------------------------------------------------------------ +-- * uverbResponseHeaderSpec {{{ +------------------------------------------------------------------------------ +type UVerbHeaderResponse = '[ + WithStatus 200 (Headers '[Header "H1" Int] String), + WithStatus 404 String ] + +type UVerbResponseHeadersApi = + Capture "ok" Bool :> UVerb 'GET '[JSON] UVerbHeaderResponse + +uverbResponseHeadersServer :: Server UVerbResponseHeadersApi +uverbResponseHeadersServer True = pure . Z . I . WithStatus $ addHeader 5 "foo" +uverbResponseHeadersServer False = pure . S . Z . I . WithStatus $ "bar" + +uverbResponseHeadersSpec :: Spec +uverbResponseHeadersSpec = describe "UVerbResponseHeaders" $ do + with (return $ serve (Proxy :: Proxy UVerbResponseHeadersApi) uverbResponseHeadersServer) $ do + + it "includes the headers in the response" $ + THW.request methodGet "/true" [] "" + `shouldRespondWith` "\"foo\"" { matchHeaders = ["H1" <:> "5"] + , matchStatus = 200 + } + +-- }}} +------------------------------------------------------------------------------ -- * miscCombinatorSpec {{{ ------------------------------------------------------------------------------ type MiscCombinatorsAPI
