diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,22 @@ +5.1.0 +----- + +* Breaking: `MultiVerb` now documents each response alternative under its own + content types. `RespondAs ct` keeps `ct`, `Respond` inherits the endpoint's + media-type list, and `RespondEmpty` stays bodyless. Previously every + alternative was rendered against a JSON default and then had the endpoint's + content-type list reapplied wholesale, which discarded a `RespondAs` + content type. Alternatives sharing a status code now retain every media type + they declared instead of collapsing to one. +* Breaking: `Servant.OpenApi.Internal`'s `IsSwaggerResponse` and + `IsSwaggerResponseList` take the enclosing `MultiVerb` content-type slot as an + additional poly-kinded parameter, and the separate `'()` and `[Type]` + `HasOpenApi (MultiVerb …)` instances are replaced by a single instance. +* Breaking: narrow the `openapi-hs` bound to `>=5.0 && <5.1`. Under PVP the + breaking axis is `A.B`, so the previous `<6` promised compatibility with an + `openapi-hs` 5.1 that the policy explicitly permits to break this package. +* Document the package's PVP versioning policy in the README. + 5.0.0 ----- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -119,6 +119,23 @@ nix run nixpkgs#vacuum-go -- lint -d openapi.json ``` +## Versioning + +This package follows the Haskell +[Package Versioning Policy (PVP)](https://pvp.haskell.org/). Versions have the +form `A.B.C`, optionally followed by further components, where **`A.B` together +is the major version**: it changes only when the public API breaks. A release +that only adds to the API bumps `C`, and one that does not touch the API bumps a +fourth component `D`. The PVP-recommended bound is therefore: + +```cabal +build-depends: servant-openapi-hs >=5.0 && <5.1 +``` + +Releases up to and including `5.0.0` numbered themselves like SemVer; `4.1.0` in +particular was additive-only and would be `4.0.1` under the policy above. From +`5.0.0` onward the policy holds. + ## License `servant-openapi-hs` retains the original **BSD-3-Clause** license of the upstream diff --git a/servant-openapi-hs.cabal b/servant-openapi-hs.cabal --- a/servant-openapi-hs.cabal +++ b/servant-openapi-hs.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: servant-openapi-hs -version: 5.0.0 +version: 5.1.0 synopsis: Generate an OpenAPI 3.1 specification for your servant API. description: [OpenAPI](https://spec.openapis.org/oas/v3.1.0) is a language-agnostic format @@ -65,7 +65,7 @@ , hspec >=2.6.0 && <2.12 , http-media >=0.7.1.3 && <0.9 , lens >=5.3.3 && <5.4 - , openapi-hs >=5.0 && <6 + , openapi-hs >=5.0 && <5.1 , QuickCheck >=2.9 && <2.17 , servant >=0.17 && <0.21 , singleton-bool >=0.1.4 && <0.2 @@ -84,7 +84,7 @@ , base , bytestring , lens - , openapi-hs >=5.0 && <6 + , openapi-hs >=5.0 && <5.1 , servant , servant-openapi-hs , text @@ -105,7 +105,7 @@ , hspec >=2.6.0 && <2.12 , lens , lens-aeson >=1.0.2 && <1.3 - , openapi-hs >=5.0 && <6 + , openapi-hs >=5.0 && <5.1 , QuickCheck , servant , servant-openapi-hs diff --git a/src/Servant/OpenApi/Internal.hs b/src/Servant/OpenApi/Internal.hs --- a/src/Servant/OpenApi/Internal.hs +++ b/src/Servant/OpenApi/Internal.hs @@ -32,7 +32,6 @@ import Data.HashMap.Strict.InsOrd.Compat (InsOrdHashMap) import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrdHashMap import Data.Kind (Type) -import Data.Maybe (listToMaybe) import Data.OpenApi hiding (Header, contentType) import Data.OpenApi qualified as OpenApi import Data.OpenApi.Declare @@ -575,17 +574,17 @@ -- | Produce the OpenAPI 'Response' object for one MultiVerb response -- alternative. -class IsSwaggerResponse a where +class IsSwaggerResponse (cs :: k) a where responseSwagger :: DeclareDefinition Response instance - (AllToResponseHeader hs, IsSwaggerResponse r) => - IsSwaggerResponse (WithHeaders hs a r) + (AllToResponseHeader hs, IsSwaggerResponse cs r) => + IsSwaggerResponse cs (WithHeaders hs a r) where responseSwagger = fmap (headers .~ fmap Inline (toAllResponseHeaders (Proxy @hs))) - (responseSwagger @r) + (responseSwagger @_ @cs @r) -- | Build a 'Response' carrying a single schema, exposed under the given list -- of content types. @@ -606,23 +605,26 @@ cs = allMime (Proxy @cs) instance + (KnownSymbol desc, ToSchema a, AllMime cs) => + IsSwaggerResponse (cs :: [Type]) (Respond s desc a) + where + responseSwagger = simpleResponseSwagger @a @cs @desc + +instance (KnownSymbol desc, ToSchema a) => - IsSwaggerResponse (Respond s desc a) + IsSwaggerResponse '() (Respond s desc a) where - -- Default the schema's content type to JSON: openapi needs *some* media type - -- to hang the schema on, and the enclosing MultiVerb instance reapplies the - -- real content-type list afterwards. responseSwagger = simpleResponseSwagger @a @'[JSON] @desc instance (KnownSymbol desc, ToSchema a, Accept ct) => - IsSwaggerResponse (RespondAs (ct :: Type) s desc a) + IsSwaggerResponse cs (RespondAs (ct :: Type) s desc a) where responseSwagger = simpleResponseSwagger @a @'[ct] @desc instance (KnownSymbol desc) => - IsSwaggerResponse (RespondEmpty s desc) + IsSwaggerResponse cs (RespondEmpty s desc) where responseSwagger = pure $ @@ -631,25 +633,25 @@ -- | Fold a MultiVerb's list of response alternatives into a -- status-code-keyed map of 'Response' objects, merging alternatives that -- share a status code. -class IsSwaggerResponseList (as :: [Type]) where +class IsSwaggerResponseList (cs :: k) (as :: [Type]) where responseListSwagger :: DeclareDefinition (InsOrdHashMap HttpStatusCode Response) -instance IsSwaggerResponseList '[] where +instance IsSwaggerResponseList cs '[] where responseListSwagger = pure mempty instance - ( IsSwaggerResponse a + ( IsSwaggerResponse cs a , KnownNat (MultiVerbStatus a) - , IsSwaggerResponseList as + , IsSwaggerResponseList cs as ) => - IsSwaggerResponseList (a ': as) + IsSwaggerResponseList cs (a ': as) where responseListSwagger = InsOrdHashMap.insertWith combineResponseSwagger (fromIntegral (natVal (Proxy @(MultiVerbStatus a)))) - <$> responseSwagger @a - <*> responseListSwagger @as + <$> responseSwagger @_ @cs @a + <*> responseListSwagger @_ @cs @as -- | Merge two responses that share a status code: concatenate descriptions and -- union their content maps. @@ -682,11 +684,9 @@ <>~ (s2 ^. properties . ix "label" . _Inline . enum_ . _Just) | otherwise = s1 --- | MultiVerb whose request-mime-types slot is @'()@ (no content types given): --- the response schemas keep their JSON default. instance - (OpenApiMethod method, IsSwaggerResponseList as) => - HasOpenApi (MultiVerb method '() as r) + (OpenApiMethod method, IsSwaggerResponseList cs as) => + HasOpenApi (MultiVerb method cs as r) where toOpenApi _ = mempty @@ -696,34 +696,6 @@ (mempty & responses . responses .~ refResps)) where method = openApiMethod (Proxy @method) - (schemaDefs, resps) = runDeclare (responseListSwagger @as) mempty + (schemaDefs, resps) = runDeclare (responseListSwagger @_ @cs @as) mempty refResps = Inline <$> resps - --- | MultiVerb with an explicit content-type list @cs@: reapply @cs@ to every --- response's single schema. -instance - (OpenApiMethod method, IsSwaggerResponseList as, AllMime cs) => - HasOpenApi (MultiVerb method (cs :: [Type]) as r) - where - toOpenApi _ = - mempty - & components . schemas <>~ schemaDefs - & paths . at "/" ?~ - (mempty & method ?~ - (mempty & responses . responses .~ refResps)) - where - method = openApiMethod (Proxy @method) - cs = allMime (Proxy @cs) - (schemaDefs, resps) = runDeclare (responseListSwagger @as) mempty - -- Each alternative already holds a single (JSON-defaulted) schema; swap in - -- the MultiVerb's own content types, reusing that one schema for each. - addMime :: Response -> Response - addMime resp = - resp - & content %~ - ( foldMap (\c -> InsOrdHashMap.fromList $ (,c) <$> cs) - . listToMaybe - . toList - ) - refResps = Inline . addMime <$> resps #endif diff --git a/test/Servant/OpenApiSpec.hs b/test/Servant/OpenApiSpec.hs --- a/test/Servant/OpenApiSpec.hs +++ b/test/Servant/OpenApiSpec.hs @@ -70,6 +70,26 @@ codes "201" `shouldSatisfy` has _Just codes "202" `shouldSatisfy` has _Just codes "204" `shouldSatisfy` has _Just + it "MultiVerb documents each alternative under its own content type" $ do + let doc = toJSON coverageOpenApi + keys k = doc ^.. key "paths" . key "/cov" . key "get" . key "responses" + . key k . key "content" . members . asIndex + keys "200" `shouldMatchList` ["application/json", "application/json;charset=utf-8"] + keys "201" `shouldMatchList` ["text/plain;charset=utf-8"] + keys "202" `shouldMatchList` ["application/json", "application/json;charset=utf-8"] + keys "204" `shouldMatchList` [] + (doc ^? key "paths" . key "/cov" . key "get" . key "responses" + . key "202" . key "headers" . key "X-Trace") + `shouldSatisfy` has _Just + it "MultiVerb preserves every media type when alternatives share a status" $ do + let doc = toJSON coverageOpenApi + keys = doc ^.. key "paths" . key "/shared" . key "get" . key "responses" + . key "200" . key "content" . members . asIndex + keys `shouldMatchList` + [ "application/json" + , "application/json;charset=utf-8" + , "text/plain;charset=utf-8" + ] #endif -- Layer 1: every generated document round-trips through openapi-hs's @@ -731,8 +751,14 @@ , WithHeaders '[Servant.API.Header "X-Trace" Text] Int (Respond 202 "Accepted" Int) ] +type SharedContentResponses = + '[ RespondAs PlainText 200 "Plain text form" String + , RespondAs JSON 200 "JSON form" Int + ] + type CoverageAPI = - "cov" :> MultiVerb 'GET '[JSON] CoverageResponses () + ("cov" :> MultiVerb 'GET '[JSON] CoverageResponses ()) + :<|> ("shared" :> MultiVerb 'GET '[JSON] SharedContentResponses ()) coverageOpenApi :: OpenApi coverageOpenApi = toOpenApi (Proxy :: Proxy CoverageAPI)