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 2023-01-18 13:10:33 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-servant-server (Old) and /work/SRC/openSUSE:Factory/.ghc-servant-server.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-servant-server" Wed Jan 18 13:10:33 2023 rev:7 rq:1059107 version:0.19.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-servant-server/ghc-servant-server.changes 2022-08-01 21:31:59.713931243 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-servant-server.new.32243/ghc-servant-server.changes 2023-01-18 13:10:56.944870147 +0100 @@ -1,0 +2,9 @@ +Thu Oct 27 22:28:50 UTC 2022 - Peter Simons <[email protected]> + +- Update servant-server to version 0.19.2. + 0.19.2 + ------ + + Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/servant/pull/1592). + +------------------------------------------------------------------- Old: ---- servant-server-0.19.1.tar.gz servant-server.cabal New: ---- servant-server-0.19.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-servant-server.spec ++++++ --- /var/tmp/diff_new_pack.UhdP1V/_old 2023-01-18 13:10:58.000876406 +0100 +++ /var/tmp/diff_new_pack.UhdP1V/_new 2023-01-18 13:10:58.004876430 +0100 @@ -19,13 +19,12 @@ %global pkg_name servant-server %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.19.1 +Version: 0.19.2 Release: 0 Summary: A family of combinators for defining webservices APIs and serving them License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal BuildRequires: chrpath BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel @@ -94,8 +93,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal -cabal-tweak-dep-ver http-api-data '< 0.4.4' '< 1' %build %ghc_lib_build ++++++ servant-server-0.19.1.tar.gz -> servant-server-0.19.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/CHANGELOG.md new/servant-server-0.19.2/CHANGELOG.md --- old/servant-server-0.19.1/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -3,6 +3,11 @@ Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions. +0.19.2 +------ + +Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/servant/pull/1592). + 0.19.1 ------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/example/greet.hs new/servant-server-0.19.2/example/greet.hs --- old/servant-server-0.19.1/example/greet.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/example/greet.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,7 +18,6 @@ import Servant import Servant.Server.Generic () -import Servant.API.Generic -- * Example diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/servant-server.cabal new/servant-server-0.19.2/servant-server.cabal --- old/servant-server-0.19.1/servant-server.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/servant-server.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: 2.2 name: servant-server -version: 0.19.1 +version: 0.19.2 synopsis: A family of combinators for defining webservices APIs and serving them category: Servant, Web @@ -60,7 +60,7 @@ -- 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.17 + base >= 4.9 && < 4.18 , bytestring >= 0.10.8.1 && < 0.12 , constraints >= 0.2 && < 0.14 , containers >= 0.5.7.1 && < 0.7 @@ -72,8 +72,8 @@ -- Servant dependencies -- strict dependency as we re-export 'servant' things. build-depends: - servant >= 0.19 - , http-api-data >= 0.4.1 && < 0.4.4 + servant >= 0.19 && < 0.20 + , http-api-data >= 0.4.1 && < 0.5.1 -- 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. @@ -159,7 +159,7 @@ build-depends: aeson >= 1.4.1.0 && < 3 , directory >= 1.3.0.0 && < 1.4 - , hspec >= 2.6.0 && < 2.9 + , hspec >= 2.6.0 && < 2.10 , hspec-wai >= 0.10.1 && < 0.12 , QuickCheck >= 2.12.6.1 && < 2.15 , should-not-typecheck >= 2.1.0 && < 2.2 @@ -167,4 +167,4 @@ , wai-extra >= 3.0.24.3 && < 3.2 build-tool-depends: - hspec-discover:hspec-discover >= 2.6.0 && <2.9 + hspec-discover:hspec-discover >= 2.6.0 && <2.10 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/src/Servant/Server/Internal/Router.hs new/servant-server-0.19.2/src/Servant/Server/Internal/Router.hs --- old/servant-server-0.19.1/src/Servant/Server/Internal/Router.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/src/Servant/Server/Internal/Router.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,12 +9,16 @@ import Data.Function (on) +import Data.List + (nub) import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T +import Data.Typeable + (TypeRep) import Network.Wai (Response, pathInfo) import Servant.Server.Internal.ErrorFormatter @@ -24,6 +28,18 @@ type Router env = Router' env RoutingApplication +data CaptureHint = CaptureHint + { captureName :: Text + , captureType :: TypeRep + } + deriving (Show, Eq) + +toCaptureTag :: CaptureHint -> Text +toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint) + +toCaptureTags :: [CaptureHint] -> Text +toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">" + -- | Internal representation of a router. -- -- The first argument describes an environment type that is @@ -36,10 +52,10 @@ -- ^ the map contains routers for subpaths (first path component used -- for lookup and removed afterwards), the list contains handlers -- for the empty path, to be tried in order - | CaptureRouter (Router' (Text, env) a) + | CaptureRouter [CaptureHint] (Router' (Text, env) a) -- ^ first path component is passed to the child router in its -- environment and removed afterwards - | CaptureAllRouter (Router' ([Text], env) a) + | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a) -- ^ all path components are passed to the child router in its -- environment and are removed afterwards | RawRouter (env -> a) @@ -69,8 +85,8 @@ choice :: Router' env a -> Router' env a -> Router' env a choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) = StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2) -choice (CaptureRouter router1) (CaptureRouter router2) = - CaptureRouter (choice router1 router2) +choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) = + CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2) choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3 choice router1 router2 = Choice router1 router2 @@ -84,7 +100,7 @@ -- data RouterStructure = StaticRouterStructure (Map Text RouterStructure) Int - | CaptureRouterStructure RouterStructure + | CaptureRouterStructure [CaptureHint] RouterStructure | RawRouterStructure | ChoiceStructure RouterStructure RouterStructure deriving (Eq, Show) @@ -98,11 +114,11 @@ routerStructure :: Router' env a -> RouterStructure routerStructure (StaticRouter m ls) = StaticRouterStructure (fmap routerStructure m) (length ls) -routerStructure (CaptureRouter router) = - CaptureRouterStructure $ +routerStructure (CaptureRouter hints router) = + CaptureRouterStructure hints $ routerStructure router -routerStructure (CaptureAllRouter router) = - CaptureRouterStructure $ +routerStructure (CaptureAllRouter hints router) = + CaptureRouterStructure hints $ routerStructure router routerStructure (RawRouter _) = RawRouterStructure @@ -114,8 +130,8 @@ -- | Compare the structure of two routers. -- sameStructure :: Router' env a -> Router' env b -> Bool -sameStructure r1 r2 = - routerStructure r1 == routerStructure r2 +sameStructure router1 router2 = + routerStructure router1 == routerStructure router2 -- | Provide a textual representation of the -- structure of a router. @@ -126,7 +142,8 @@ where mkRouterLayout :: Bool -> RouterStructure -> [Text] mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n - mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r) + mkRouterLayout c (CaptureRouterStructure hints r) = + mkSubTree c (toCaptureTags hints) (mkRouterLayout False r) mkRouterLayout c RawRouterStructure = if c then ["ââ <raw>"] else ["ââ <raw>"] mkRouterLayout c (ChoiceStructure r1 r2) = @@ -169,7 +186,7 @@ -> let request' = request { pathInfo = rest } in runRouterEnv fmt router' env request' respond _ -> respond $ Fail $ fmt request - CaptureRouter router' -> + CaptureRouter _ router' -> case pathInfo request of [] -> respond $ Fail $ fmt request -- This case is to handle trailing slashes. @@ -177,7 +194,7 @@ first : rest -> let request' = request { pathInfo = rest } in runRouterEnv fmt router' (first, env) request' respond - CaptureAllRouter router' -> + CaptureAllRouter _ router' -> let segments = pathInfo request request' = request { pathInfo = [] } in runRouterEnv fmt router' (segments, env) request' respond diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/src/Servant/Server/Internal.hs new/servant-server-0.19.2/src/Servant/Server/Internal.hs --- old/servant-server-0.19.1/src/Servant/Server/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/src/Servant/Server/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} @@ -94,6 +95,8 @@ import Web.HttpApiData (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece, parseUrlPieces) +import Data.Kind + (Type) import Servant.Server.Internal.BasicAuth import Servant.Server.Internal.Context @@ -173,7 +176,7 @@ -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ... -instance (KnownSymbol capture, FromHttpApiData a +instance (KnownSymbol capture, FromHttpApiData a, Typeable a , HasServer api context, SBoolI (FoldLenient mods) , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) @@ -185,7 +188,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context d = - CaptureRouter $ + CaptureRouter [hint] $ route (Proxy :: Proxy api) context (addCapture d $ \ txt -> withRequest $ \ request -> @@ -197,6 +200,7 @@ where rep = typeRep (Proxy :: Proxy Capture') formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a)) -- | If you use 'CaptureAll' in one of the endpoints for your API, -- this automatically requires your server-side handler to be a @@ -215,7 +219,7 @@ -- > server = getSourceFile -- > where getSourceFile :: [Text] -> Handler Book -- > getSourceFile pathSegments = ... -instance (KnownSymbol capture, FromHttpApiData a +instance (KnownSymbol capture, FromHttpApiData a, Typeable a , HasServer api context , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) @@ -227,7 +231,7 @@ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context d = - CaptureAllRouter $ + CaptureAllRouter [hint] $ route (Proxy :: Proxy api) context (addCapture d $ \ txts -> withRequest $ \ request -> @@ -238,6 +242,7 @@ where rep = typeRep (Proxy :: Proxy CaptureAll) formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context) + hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a])) allowedMethodHead :: Method -> Request -> Bool allowedMethodHead method request = method == methodGet && requestMethod request == methodHead @@ -819,7 +824,11 @@ ------------------------------------------------------------------------------- -- Erroring instance for 'HasServer' when a combinator is not fully applied -instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context +instance TypeError (PartialApplication +#if __GLASGOW_HASKELL__ >= 904 + @(Type -> [Type] -> Constraint) +#endif + HasServer arr) => HasServer ((arr :: a -> b) :> sub) context where type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr) route = error "unreachable" @@ -863,7 +872,11 @@ -- XXX: This omits the @context@ parameter, e.g.: -- -- "There is no instance for HasServer (Bool :> â¦)". Do we care ? -instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub +#if __GLASGOW_HASKELL__ >= 904 + @(Type -> [Type] -> Constraint) +#endif + HasServer ty) => HasServer (ty :> sub) context instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/src/Servant/Server.hs new/servant-server-0.19.2/src/Servant/Server.hs --- old/servant-server-0.19.1/src/Servant/Server.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/src/Servant/Server.hs 2001-09-09 03:46:40.000000000 +0200 @@ -235,7 +235,7 @@ -- > â ââ e/ -- > â ââ⢠-- > ââ b/ --- > â ââ <capture>/ +-- > â ââ <x::Int>/ -- > â ââ⢠-- > â â -- > â ââ⢠@@ -252,7 +252,8 @@ -- -- [@ââ¢@] Leaves reflect endpoints. -- --- [@\<capture\>/@] This is a delayed capture of a path component. +-- [@\<x::Int\>/@] This is a delayed capture of a single +-- path component named @x@, of expected type @Int@. -- -- [@\<raw\>@] This is a part of the API we do not know anything about. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/servant-server-0.19.1/test/Servant/Server/RouterSpec.hs new/servant-server-0.19.2/test/Servant/Server/RouterSpec.hs --- old/servant-server-0.19.1/test/Servant/Server/RouterSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/servant-server-0.19.2/test/Servant/Server/RouterSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,7 +9,9 @@ import Data.Proxy (Proxy (..)) import Data.Text - (unpack) + (Text, unpack) +import Data.Typeable + (typeRep) import Network.HTTP.Types (Status (..)) import Network.Wai @@ -27,6 +29,7 @@ spec = describe "Servant.Server.Internal.Router" $ do routerSpec distributivitySpec + serverLayoutSpec routerSpec :: Spec routerSpec = do @@ -51,7 +54,7 @@ toApp = toApplication . runRouter (const err404) cap :: Router () - cap = CaptureRouter $ + cap = CaptureRouter [hint] $ let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400) in leafRouter $ \env req res -> @@ -59,6 +62,9 @@ . const $ Route success + hint :: CaptureHint + hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ()) + router :: Router () router = leafRouter (\_ _ res -> res $ Route success) `Choice` cap @@ -98,12 +104,30 @@ it "properly handles mixing static paths at different levels" $ do level `shouldHaveSameStructureAs` levelRef +serverLayoutSpec :: Spec +serverLayoutSpec = + describe "serverLayout" $ do + it "correctly represents the example API" $ do + exampleLayout `shouldHaveLayout` expectedExampleLayout + it "aggregates capture hints when different" $ do + captureDifferentTypes `shouldHaveLayout` expectedCaptureDifferentTypes + it "nubs capture hints when equal" $ do + captureSameType `shouldHaveLayout` expectedCaptureSameType + it "properly displays CaptureAll hints" $ do + captureAllLayout `shouldHaveLayout` expectedCaptureAllLayout + shouldHaveSameStructureAs :: (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation shouldHaveSameStructureAs p1 p2 = unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $ expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1)) +shouldHaveLayout :: + (HasServer api '[]) => Proxy api -> Text -> Expectation +shouldHaveLayout p l = + unless (routerLayout (makeTrivialRouter p) == l) $ + expectationFailure ("expected:\n" ++ unpack l ++ "\nbut got:\n" ++ unpack (layout p)) + makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router () makeTrivialRouter p = route p EmptyContext (emptyDelayed (FailFatal err501)) @@ -144,12 +168,12 @@ -- structure: type Dynamic = - "a" :> Capture "foo" Int :> "b" :> End - :<|> "a" :> Capture "bar" Bool :> "c" :> End - :<|> "a" :> Capture "baz" Char :> "d" :> End + "a" :> Capture "foo" Int :> "b" :> End + :<|> "a" :> Capture "foo" Int :> "c" :> End + :<|> "a" :> Capture "foo" Int :> "d" :> End type DynamicRef = - "a" :> Capture "anything" () :> + "a" :> Capture "foo" Int :> ("b" :> End :<|> "c" :> End :<|> "d" :> End) dynamic :: Proxy Dynamic @@ -339,3 +363,100 @@ levelRef :: Proxy LevelRef levelRef = Proxy + +-- The example API for the 'layout' function. +-- Should get factorized by the 'choice' smart constructor. +type ExampleLayout = + "a" :> "d" :> Get '[JSON] NoContent + :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool + :<|> "c" :> Put '[JSON] Bool + :<|> "a" :> "e" :> Get '[JSON] Int + :<|> "b" :> Capture "x" Int :> Put '[JSON] Bool + :<|> Raw + +exampleLayout :: Proxy ExampleLayout +exampleLayout = Proxy + +-- The expected representation of the example API layout +-- +expectedExampleLayout :: Text +expectedExampleLayout = + "/\n\ + \ââ a/\n\ + \â ââ d/\n\ + \â â âââ¢\n\ + \â ââ e/\n\ + \â âââ¢\n\ + \ââ b/\n\ + \â ââ <x::Int>/\n\ + \â âââ¢\n\ + \â â\n\ + \â âââ¢\n\ + \ââ c/\n\ + \â âââ¢\n\ + \â\n\ + \ââ <raw>\n" + +-- A capture API with all capture types being the same +-- +type CaptureSameType = + "a" :> Capture "foo" Int :> "b" :> End + :<|> "a" :> Capture "foo" Int :> "c" :> End + :<|> "a" :> Capture "foo" Int :> "d" :> End + +captureSameType :: Proxy CaptureSameType +captureSameType = Proxy + +-- The expected representation of the CaptureSameType API layout. +-- +expectedCaptureSameType :: Text +expectedCaptureSameType = + "/\n\ + \ââ a/\n\ + \ ââ <foo::Int>/\n\ + \ ââ b/\n\ + \ â âââ¢\n\ + \ ââ c/\n\ + \ â âââ¢\n\ + \ ââ d/\n\ + \ âââ¢\n" + +-- A capture API capturing different types +-- +type CaptureDifferentTypes = + "a" :> Capture "foo" Int :> "b" :> End + :<|> "a" :> Capture "bar" Bool :> "c" :> End + :<|> "a" :> Capture "baz" Char :> "d" :> End + +captureDifferentTypes :: Proxy CaptureDifferentTypes +captureDifferentTypes = Proxy + +-- The expected representation of the CaptureDifferentTypes API layout. +-- +expectedCaptureDifferentTypes :: Text +expectedCaptureDifferentTypes = + "/\n\ + \ââ a/\n\ + \ ââ <foo::Int|bar::Bool|baz::Char>/\n\ + \ ââ b/\n\ + \ â âââ¢\n\ + \ ââ c/\n\ + \ â âââ¢\n\ + \ ââ d/\n\ + \ âââ¢\n" + +-- An API with a CaptureAll part + +type CaptureAllLayout = "a" :> CaptureAll "foos" Int :> End + +captureAllLayout :: Proxy CaptureAllLayout +captureAllLayout = Proxy + +-- The expected representation of the CaptureAllLayout API. +-- +expectedCaptureAllLayout :: Text +expectedCaptureAllLayout = + "/\n\ + \ââ a/\n\ + \ ââ <foos::[Int]>/\n\ + \ âââ¢\n"
