servant-openapi3 2.0.1.6 → 2.0.2.0
raw patch · 10 files changed
+403/−120 lines, 10 filesdep +generics-sopdep +servant-client-coredep +servant-servernew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: generics-sop, servant-client-core, servant-server
API changes (from Hackage documentation)
- Servant.OpenApi.Internal: instance Servant.OpenApi.Internal.HasOpenApi sub => Servant.OpenApi.Internal.HasOpenApi (Servant.API.WithNamedContext.WithNamedContext x c sub)
+ Servant.OpenApi.Internal: class IsSwaggerResponse (a :: k)
+ Servant.OpenApi.Internal: class IsSwaggerResponseList (as :: [Type])
+ Servant.OpenApi.Internal: combineMediaTypeObject :: MediaTypeObject -> MediaTypeObject -> MediaTypeObject
+ Servant.OpenApi.Internal: combineResponseSwagger :: Response -> Response -> Response
+ Servant.OpenApi.Internal: combineSwaggerSchema :: Schema -> Schema -> Schema
+ Servant.OpenApi.Internal: instance (GHC.TypeLits.KnownSymbol desc, Data.OpenApi.Internal.Schema.ToSchema a) => Servant.OpenApi.Internal.IsSwaggerResponse (Servant.API.MultiVerb.Respond s desc a)
+ Servant.OpenApi.Internal: instance (GHC.TypeLits.KnownSymbol desc, Data.OpenApi.Internal.Schema.ToSchema a, Servant.API.ContentTypes.Accept ct) => Servant.OpenApi.Internal.IsSwaggerResponse (Servant.API.MultiVerb.RespondAs ct s desc a)
+ Servant.OpenApi.Internal: instance (Servant.OpenApi.Internal.AllToResponseHeader hs, Servant.OpenApi.Internal.IsSwaggerResponse r) => Servant.OpenApi.Internal.IsSwaggerResponse (Servant.API.MultiVerb.WithHeaders hs a r)
+ Servant.OpenApi.Internal: instance (Servant.OpenApi.Internal.IsSwaggerResponse a, GHC.TypeNats.KnownNat (Servant.Server.Internal.ResponseRender.ResponseStatus a), Servant.OpenApi.Internal.IsSwaggerResponseList as) => Servant.OpenApi.Internal.IsSwaggerResponseList (a : as)
+ Servant.OpenApi.Internal: instance (Servant.OpenApi.Internal.OpenApiMethod method, Servant.OpenApi.Internal.IsSwaggerResponseList as) => Servant.OpenApi.Internal.HasOpenApi (Servant.API.MultiVerb.MultiVerb method '() as r)
+ Servant.OpenApi.Internal: instance (Servant.OpenApi.Internal.OpenApiMethod method, Servant.OpenApi.Internal.IsSwaggerResponseList as, Servant.API.ContentTypes.AllMime cs) => Servant.OpenApi.Internal.HasOpenApi (Servant.API.MultiVerb.MultiVerb method cs as r)
+ Servant.OpenApi.Internal: instance GHC.TypeLits.KnownSymbol desc => Servant.OpenApi.Internal.IsSwaggerResponse (Servant.API.MultiVerb.RespondEmpty s desc)
+ Servant.OpenApi.Internal: instance Servant.OpenApi.Internal.IsSwaggerResponseList '[]
+ Servant.OpenApi.Internal: instance forall k (sub :: k) (x :: GHC.Types.Symbol) (c :: [*]). Servant.OpenApi.Internal.HasOpenApi sub => Servant.OpenApi.Internal.HasOpenApi (Servant.API.WithNamedContext.WithNamedContext x c sub)
+ Servant.OpenApi.Internal: instance forall k sub (res :: k). Servant.OpenApi.Internal.HasOpenApi sub => Servant.OpenApi.Internal.HasOpenApi (Servant.API.WithResource.WithResource res Servant.API.Sub.:> sub)
+ Servant.OpenApi.Internal: responseListSwagger :: IsSwaggerResponseList as => DeclareDefinition (InsOrdHashMap HttpStatusCode Response)
+ Servant.OpenApi.Internal: responseSwagger :: IsSwaggerResponse a => DeclareDefinition Response
+ Servant.OpenApi.Internal: simpleResponseSwagger :: forall a (cs :: [Type]) (desc :: Symbol). (ToSchema a, KnownSymbol desc, AllMime cs) => DeclareDefinition Response
+ Servant.OpenApi.Internal: type DeclareDefinition = Declare Definitions Schema
- Servant.OpenApi: class HasOpenApi api
+ Servant.OpenApi: class HasOpenApi (api :: k)
- Servant.OpenApi: validateEveryToJSON :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
+ Servant.OpenApi: validateEveryToJSON :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
- Servant.OpenApi: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
+ Servant.OpenApi: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
- Servant.OpenApi.Internal: class AllAccept cs
+ Servant.OpenApi.Internal: class AllAccept (cs :: k)
- Servant.OpenApi.Internal: class AllToResponseHeader hs
+ Servant.OpenApi.Internal: class AllToResponseHeader (hs :: k)
- Servant.OpenApi.Internal: class HasOpenApi api
+ Servant.OpenApi.Internal: class HasOpenApi (api :: k)
- Servant.OpenApi.Internal: class OpenApiMethod method
+ Servant.OpenApi.Internal: class OpenApiMethod (method :: k)
- Servant.OpenApi.Internal: class ToResponseHeader h
+ Servant.OpenApi.Internal: class ToResponseHeader (h :: k)
- Servant.OpenApi.Internal: mkEndpoint :: forall a cs hs proxy method status. (ToSchema a, AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
+ Servant.OpenApi.Internal: mkEndpoint :: forall {k1} a (cs :: [Type]) (hs :: [Type]) proxy (method :: k1) (status :: Nat). (ToSchema a, AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
- Servant.OpenApi.Internal: mkEndpointNoContent :: forall nocontent cs hs proxy method status. (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => FilePath -> proxy (Verb method status cs (Headers hs nocontent)) -> OpenApi
+ Servant.OpenApi.Internal: mkEndpointNoContent :: forall {k1} nocontent (cs :: [Type]) (hs :: [Type]) proxy (method :: k1) (status :: Nat). (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => FilePath -> proxy (Verb method status cs (Headers hs nocontent)) -> OpenApi
- Servant.OpenApi.Internal: mkEndpointNoContentVerb :: forall proxy method. OpenApiMethod method => FilePath -> proxy (NoContentVerb method) -> OpenApi
+ Servant.OpenApi.Internal: mkEndpointNoContentVerb :: forall {k1} proxy (method :: k1). OpenApiMethod method => FilePath -> proxy (NoContentVerb method) -> OpenApi
- Servant.OpenApi.Internal: mkEndpointWithSchemaRef :: forall cs hs proxy method status a. (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => Maybe (Referenced Schema) -> FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
+ Servant.OpenApi.Internal: mkEndpointWithSchemaRef :: forall {k1} (cs :: [Type]) (hs :: [Type]) proxy (method :: k1) (status :: Nat) a. (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status) => Maybe (Referenced Schema) -> FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
- Servant.OpenApi.Internal.Test: prettyValidateWith :: forall a. (ToJSON a, ToSchema a) => (a -> [ValidationError]) -> a -> Maybe String
+ Servant.OpenApi.Internal.Test: prettyValidateWith :: (ToJSON a, ToSchema a) => (a -> [ValidationError]) -> a -> Maybe String
- Servant.OpenApi.Internal.Test: props :: forall p p'' cs xs. TMap (Every (Typeable : (Show : (Arbitrary : cs)))) xs => p cs -> (forall x. EveryTF cs x => x -> Property) -> p'' xs -> Spec
+ Servant.OpenApi.Internal.Test: props :: forall p p'' (cs :: [Type -> Constraint]) (xs :: [Type]). TMap (Every ((Typeable :: Type -> Constraint) ': (Show ': (Arbitrary ': cs)))) xs => p cs -> (forall x. EveryTF cs x => x -> Property) -> p'' xs -> Spec
- Servant.OpenApi.Internal.Test: validateEveryToJSON :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
+ Servant.OpenApi.Internal.Test: validateEveryToJSON :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
- Servant.OpenApi.Internal.Test: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
+ Servant.OpenApi.Internal.Test: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
- Servant.OpenApi.Internal.TypeLevel.API: type AddBodyType c cs a as = If (Elem c cs) (a : as) as
+ Servant.OpenApi.Internal.TypeLevel.API: type AddBodyType (c :: a1) (cs :: [a1]) (a2 :: a) (as :: [a]) = If Elem c cs a2 ': as as
- Servant.OpenApi.Internal.TypeLevel.API: type BodyTypes c api = Nub (BodyTypes' c api)
+ Servant.OpenApi.Internal.TypeLevel.API: type BodyTypes c api = Nub BodyTypes' c api
- Servant.OpenApi.Internal.TypeLevel.API: type family BodyTypes' c api :: [*]
+ Servant.OpenApi.Internal.TypeLevel.API: type family MultiVerbResponseBodies (as :: [Type]) :: [Type]
- Servant.OpenApi.Internal.TypeLevel.Every: class EveryTF cs x => Every (cs :: [* -> Constraint]) (x :: *)
+ Servant.OpenApi.Internal.TypeLevel.Every: class EveryTF cs x => Every (cs :: [Type -> Constraint]) x
- Servant.OpenApi.Internal.TypeLevel.Every: tmapEvery :: forall a cs p p'' xs. TMap (Every cs) xs => p cs -> (forall x p'. Every cs x => p' x -> a) -> p'' xs -> [a]
+ Servant.OpenApi.Internal.TypeLevel.Every: tmapEvery :: forall a (cs :: [Type -> Constraint]) p p'' (xs :: [Type]). TMap (Every cs) xs => p cs -> (forall x (p' :: Type -> Type). Every cs x => p' x -> a) -> p'' xs -> [a]
- Servant.OpenApi.Internal.TypeLevel.Every: type family EveryTF cs x :: Constraint
+ Servant.OpenApi.Internal.TypeLevel.Every: type family EveryTF (cs :: [k -> Constraint]) (x :: k)
- Servant.OpenApi.Internal.TypeLevel.TMap: tmap :: TMap q xs => p q -> (forall x p'. q x => p' x -> a) -> p'' xs -> [a]
+ Servant.OpenApi.Internal.TypeLevel.TMap: tmap :: TMap q xs => p q -> (forall (x :: k) (p' :: k -> Type). q x => p' x -> a) -> p'' xs -> [a]
- Servant.OpenApi.Test: validateEveryToJSON :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
+ Servant.OpenApi.Test: validateEveryToJSON :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => proxy api -> Spec
- Servant.OpenApi.Test: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
+ Servant.OpenApi.Test: validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every '[Typeable :: Type -> Constraint, Show, Arbitrary, ToJSON, ToSchema]) (BodyTypes JSON api) => (Pattern -> Text -> Bool) -> proxy api -> Spec
- Servant.OpenApi.TypeLevel: type BodyTypes c api = Nub (BodyTypes' c api)
+ Servant.OpenApi.TypeLevel: type BodyTypes c api = Nub BodyTypes' c api
- Servant.OpenApi.TypeLevel: type family EndpointsList api
+ Servant.OpenApi.TypeLevel: type family EndpointsList api :: [Type]
Files
- CHANGELOG.md +6/−1
- README.md +1/−6
- example/example.cabal +8/−3
- example/src/Todo.hs +30/−1
- example/swagger.json +95/−56
- servant-openapi3.cabal +29/−20
- src/Servant/OpenApi.hs +5/−4
- src/Servant/OpenApi/Internal.hs +183/−20
- src/Servant/OpenApi/Internal/Test.hs +10/−8
- src/Servant/OpenApi/Internal/TypeLevel/API.hs +36/−1
CHANGELOG.md view
@@ -1,5 +1,10 @@-1.1.8+2.0.2.0 -------++* Support for `servant-0.20.3.0` features, including `MultiVerb` and `WithHeaders`++1.1.8+----- * Support `servant-0.17`
README.md view
@@ -1,14 +1,9 @@ # servant-openapi3 [](http://hackage.haskell.org/package/servant-openapi3)-[](https://travis-ci.org/biocad/servant-openapi3)-[](http://stackage.org/lts/package/servant-openapi3)-[](http://stackage.org/nightly/package/servant-openapi3) OpenAPI 3.0 conforming json for [servant](https://github.com/haskell-servant/servant) APIs. -- ### Motivation Swagger is a project used to describe and document RESTful APIs.@@ -43,4 +38,4 @@ We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. -Please report bugs via the [github issue tracker](https://github.com/biocad/servant-openapi3/issues).+Please report bugs via the [github issue tracker](https://github.com/bitnomial/servant-openapi3/issues).
example/example.cabal view
@@ -18,15 +18,19 @@ || ==8.8.4 || ==8.10.7 || ==9.0.2- || ==9.2.2- || ==9.4.3+ || ==9.2.8+ || ==9.4.8+ || ==9.6.3+ || ==9.8.1+ || ==9.10.2+ || ==9.12.1 library ghc-options: -Wall hs-source-dirs: src/ exposed-modules: Todo- build-depends: base+ build-depends: base < 5 , aeson , aeson-pretty , bytestring@@ -37,6 +41,7 @@ , openapi3 , text , time+ , generics-sop default-language: Haskell2010 executable swagger-server
example/src/Todo.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DerivingVia #-} module Todo where import Control.Lens@@ -18,6 +19,8 @@ import GHC.Generics import Servant import Servant.OpenApi+import qualified Generics.SOP as GSOP+import Servant.API.MultiVerb todoAPI :: Proxy TodoAPI todoAPI = Proxy@@ -28,7 +31,8 @@ :<|> "todo" :> ReqBody '[JSON] Todo :> Post '[JSON] TodoId :<|> "todo" :> Capture "id" TodoId :> Get '[JSON] Todo :<|> "todo" :> Capture "id" TodoId :> ReqBody '[JSON] Todo :> Put '[JSON] TodoId-+ :<|> "todo" :> "choices" :> MultipleChoicesInt+ -- | API for serving @swagger.json@. type SwaggerAPI = "swagger.json" :> Get '[JSON] OpenApi @@ -71,3 +75,28 @@ -- | Output generated @swagger.json@ file for the @'TodoAPI'@. writeSwaggerJSON :: IO () writeSwaggerJSON = BL8.writeFile "example/swagger.json" (encodePretty todoSwagger)++type MultiResponses =+ '[ RespondEmpty 400 "Negative"+ , Respond 200 "Even number" Bool+ , Respond 200 "Odd number" Int+ ]++-- All possible return types+data MultiResult+ = NegativeNumber+ | Even Bool+ | Odd Int+ deriving stock (Generic)+ deriving (AsUnion MultiResponses)+ via GenericAsUnion MultiResponses MultiResult++instance GSOP.Generic MultiResult++type MultipleChoicesInt =+ Capture "int" Int+ :> MultiVerb+ 'GET+ '[JSON]+ MultiResponses+ MultiResult
example/swagger.json view
@@ -1,14 +1,48 @@ {- "openapi": "3.0.0",+ "components": {+ "schemas": {+ "Todo": {+ "description": "This is some real Todo right here",+ "example": {+ "created": "2015-12-31T00:00:00Z",+ "summary": "get milk"+ },+ "properties": {+ "created": {+ "$ref": "#/components/schemas/UTCTime"+ },+ "summary": {+ "type": "string"+ }+ },+ "required": [+ "created",+ "summary"+ ],+ "type": "object"+ },+ "TodoId": {+ "maximum": 9223372036854775807,+ "minimum": -9223372036854775808,+ "type": "integer"+ },+ "UTCTime": {+ "example": "2016-07-22T00:00:00Z",+ "format": "yyyy-mm-ddThh:MM:ssZ",+ "type": "string"+ }+ }+ }, "info": {- "version": "1.0",- "title": "Todo API",+ "description": "This is an API that tests swagger integration", "license": {- "url": "http://mit.com",- "name": "MIT"+ "name": "MIT",+ "url": "http://mit.com" },- "description": "This is an API that tests swagger integration"+ "title": "Todo API",+ "version": "1.0" },+ "openapi": "3.0.0", "paths": { "/todo": { "get": {@@ -39,9 +73,6 @@ } }, "responses": {- "400": {- "description": "Invalid `body`"- }, "200": { "content": { "application/json;charset=utf-8": {@@ -51,28 +82,67 @@ } }, "description": ""+ },+ "400": {+ "description": "Invalid `body`" } } } },- "/todo/{id}": {+ "/todo/choices/{int}": { "get": { "parameters": [ {+ "in": "path",+ "name": "int", "required": true, "schema": { "maximum": 9223372036854775807, "minimum": -9223372036854775808, "type": "integer"+ }+ }+ ],+ "responses": {+ "200": {+ "content": {+ "application/json": {+ "schema": {+ "type": "boolean"+ }+ },+ "application/json;charset=utf-8": {+ "schema": {+ "type": "boolean"+ }+ } },+ "description": "Even number\n\nOdd number"+ },+ "400": {+ "description": "Negative"+ },+ "404": {+ "description": "`int` not found"+ }+ }+ }+ },+ "/todo/{id}": {+ "get": {+ "parameters": [+ { "in": "path",- "name": "id"+ "name": "id",+ "required": true,+ "schema": {+ "maximum": 9223372036854775807,+ "minimum": -9223372036854775808,+ "type": "integer"+ } } ], "responses": {- "404": {- "description": "`id` not found"- }, "200": { "content": { "application/json;charset=utf-8": {@@ -82,20 +152,23 @@ } }, "description": ""+ },+ "404": {+ "description": "`id` not found" } } }, "put": { "parameters": [ {+ "in": "path",+ "name": "id", "required": true, "schema": { "maximum": 9223372036854775807, "minimum": -9223372036854775808, "type": "integer"- },- "in": "path",- "name": "id"+ } } ], "requestBody": {@@ -108,12 +181,6 @@ } }, "responses": {- "404": {- "description": "`id` not found"- },- "400": {- "description": "Invalid `body`"- }, "200": { "content": { "application/json;charset=utf-8": {@@ -123,42 +190,14 @@ } }, "description": ""- }- }- }- }- },- "components": {- "schemas": {- "Todo": {- "example": {- "summary": "get milk",- "created": "2015-12-31T00:00:00Z"- },- "required": [- "created",- "summary"- ],- "type": "object",- "description": "This is some real Todo right here",- "properties": {- "summary": {- "type": "string" },- "created": {- "$ref": "#/components/schemas/UTCTime"+ "400": {+ "description": "Invalid `body`"+ },+ "404": {+ "description": "`id` not found" } }- },- "UTCTime": {- "example": "2016-07-22T00:00:00Z",- "format": "yyyy-mm-ddThh:MM:ssZ",- "type": "string"- },- "TodoId": {- "maximum": 9223372036854775807,- "minimum": -9223372036854775808,- "type": "integer" } } }
servant-openapi3.cabal view
@@ -1,5 +1,5 @@ name: servant-openapi3-version: 2.0.1.6+version: 2.0.2.0 synopsis: Generate a Swagger/OpenAPI/OAS 3.0 specification for your servant API. description: Swagger is a project used to describe and document RESTful APIs. The core of the @@ -18,13 +18,15 @@ * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/); . * and [many others](http://swagger.io/open-source-integrations/).-homepage: https://github.com/biocad/servant-openapi3-bug-reports: https://github.com/biocad/servant-openapi3/issues+homepage: https://github.com/bitnomial/servant-openapi3+bug-reports: https://github.com/bitnomial/servant-openapi3/issues license: BSD3 license-file: LICENSE author: David Johnson, Nickolay Kudasov, Maxim Koltsov-maintainer: nickolay.kudasov@gmail.com, kolmax94@gmail.com+maintainer: Laurent P. Rene de Cotret copyright: (c) 2015-2020, Servant contributors+ (c) 2020-2025 Maxim Koltsov+ (c) 2026 servant-openapi3 contributors category: Web, Servant, Swagger build-type: Custom cabal-version: 1.18@@ -33,8 +35,12 @@ || ==8.8.4 || ==8.10.7 || ==9.0.2- || ==9.2.2- || ==9.4.3+ || ==9.2.8+ || ==9.4.8+ || ==9.6.3+ || ==9.8.1+ || ==9.10.2+ || ==9.12.1 extra-source-files: README.md@@ -51,12 +57,12 @@ source-repository head type: git- location: https://github.com/biocad/servant-openapi3.git+ location: https://github.com/bitnomial/servant-openapi3.git custom-setup setup-depends:- base >=4.9 && <4.18,- Cabal >= 1.24,+ base >=4.9 && <4.22,+ Cabal >= 1.24 && < 4, cabal-doctest >=1.0.6 && <1.1 library@@ -75,19 +81,22 @@ Servant.OpenApi.Internal.TypeLevel.Every Servant.OpenApi.Internal.TypeLevel.TMap hs-source-dirs: src- build-depends: aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && <2.2+ build-depends: aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && <2.3 , aeson-pretty >=0.8.7 && <0.9- , base >=4.9.1.0 && <4.18- , base-compat >=0.10.5 && <0.13- , bytestring >=0.10.8.1 && <0.12+ , base >=4.9.1.0 && <4.22+ , base-compat >=0.10.5 && <0.15+ , bytestring >=0.10.8.1 && <0.13 , http-media >=0.7.1.3 && <0.9 , insert-ordered-containers >=0.2.1.0 && <0.3- , lens >=4.17 && <5.3- , servant >=0.17 && <0.20+ , lens >=4.17 && <5.4+ , servant >=0.17 && <0.21+ , servant-server >=0.17 && <0.21+ , servant-client-core >=0.17 && <0.21 , singleton-bool >=0.1.4 && <0.2 , openapi3 >=3.2.3 && <3.3 , text >=1.2.3.0 && <3 , unordered-containers >=0.2.9.0 && <0.3+ , generics-sop >=0.5.1 , hspec , QuickCheck@@ -96,9 +105,9 @@ test-suite doctests ghc-options: -Wall build-depends:- base,+ base <5, directory >= 1.0,- doctest >= 0.11.1 && <0.21,+ doctest >= 0.11.1 && <0.25, servant, QuickCheck, filepath@@ -112,11 +121,11 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.11- build-depends: base+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.12+ build-depends: base <5 , base-compat , aeson- , hspec >=2.6.0 && <2.11+ , hspec >=2.6.0 && <2.12 , QuickCheck , lens , lens-aeson >=1.0.2 && <1.3
src/Servant/OpenApi.hs view
@@ -506,13 +506,14 @@ -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- <BLANKLINE> -- [User]...--- ...+-- +++ OK, passed 100 tests. -- User...--- ...+-- +++ OK, passed 100 tests. -- UserId...--- ...+-- +++ OK, passed 100 tests.+-- <BLANKLINE> -- Finished in ... seconds--- ...3 examples, 0 failures...+-- 3 examples, 0 failures -- -- Although servant is great, chances are that your API clients don't use Haskell. -- In many cases @swagger.json@ serves as a specification, not a Haskell type.
src/Servant/OpenApi/Internal.hs view
@@ -1,25 +1,25 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-#if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE UndecidableInstances #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Servant.OpenApi.Internal where import Prelude () import Prelude.Compat -#if MIN_VERSION_servant(0,18,1)-import Control.Applicative ((<|>))-#endif+import Control.Applicative ((<|>)) import Control.Lens import Data.Aeson import Data.Foldable (toList)@@ -38,11 +38,14 @@ import Servant.API import Servant.API.Description (FoldDescription, reflectDescription) import Servant.API.Modifiers (FoldRequired)-#if MIN_VERSION_servant(0,19,0)-import Servant.API.Generic (ToServantApi)-#endif- import Servant.OpenApi.Internal.TypeLevel.API+import Data.Kind (Type)+import Servant.API.ContentTypes (AllMime, allMime)+#if MIN_VERSION_servant(0,20,3)+import qualified Servant.Server.Internal.ResponseRender as Server+import Servant.API.MultiVerb+#endif+import qualified Data.Maybe as List -- | Generate a OpenApi specification for a servant API. --@@ -287,6 +290,12 @@ instance (HasOpenApi sub) => HasOpenApi (HttpVersion :> sub) where toOpenApi _ = toOpenApi (Proxy :: Proxy sub) +#if MIN_VERSION_servant(0,20,0)+-- | @'WithResource'@ combinator does not change our specification at all.+instance (HasOpenApi sub) => HasOpenApi (WithResource res :> sub) where+ toOpenApi _ = toOpenApi (Proxy :: Proxy sub)+#endif+ -- | @'WithNamedContext'@ combinator does not change our specification at all. instance (HasOpenApi sub) => HasOpenApi (WithNamedContext x c sub) where toOpenApi _ = toOpenApi (Proxy :: Proxy sub)@@ -461,3 +470,157 @@ instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where toAllResponseHeaders _ = toAllResponseHeaders (Proxy :: Proxy hs)++#if MIN_VERSION_servant(0,20,3)+type DeclareDefinition = Declare (Definitions Schema)++class IsSwaggerResponse a where+ responseSwagger :: DeclareDefinition Response++instance+ (AllToResponseHeader hs, IsSwaggerResponse r) =>+ IsSwaggerResponse (WithHeaders hs a r)+ where+ responseSwagger =+ fmap+ (headers .~ fmap Inline (toAllResponseHeaders (Proxy @hs)))+ (responseSwagger @r)++simpleResponseSwagger :: forall a cs desc. (ToSchema a, KnownSymbol desc, AllMime cs) => DeclareDefinition Response+simpleResponseSwagger = do+ ref <- declareSchemaRef (Proxy @a)+ let resps :: InsOrdHashMap MediaType MediaTypeObject+ resps = InsOrdHashMap.fromList $ (,MediaTypeObject (pure ref) Nothing mempty mempty) <$> cs+ pure $+ mempty+ & description .~ Text.pack (symbolVal (Proxy @desc))+ & content .~ resps+ where+ cs :: [MediaType]+ cs = allMime $ Proxy @cs++instance+ (KnownSymbol desc, ToSchema a) =>+ IsSwaggerResponse (Respond s desc a)+ where+ -- Defaulting this to JSON, as openapi3 needs something to map a schema against.+ responseSwagger = simpleResponseSwagger @a @'[JSON] @desc++instance+ (KnownSymbol desc, ToSchema a, Accept ct) =>+ IsSwaggerResponse (RespondAs (ct :: Type) s desc a)+ where+ responseSwagger = simpleResponseSwagger @a @'[ct] @desc++instance+ (KnownSymbol desc) =>+ IsSwaggerResponse (RespondEmpty s desc)+ where+ responseSwagger =+ pure $+ mempty+ & description .~ Text.pack (symbolVal (Proxy @desc))++class IsSwaggerResponseList (as :: [Type]) where+ responseListSwagger :: DeclareDefinition (InsOrdHashMap HttpStatusCode Response)++instance IsSwaggerResponseList '[] where+ responseListSwagger = pure mempty++instance+ ( IsSwaggerResponse a,+ KnownNat (Server.ResponseStatus a),+ IsSwaggerResponseList as+ ) =>+ IsSwaggerResponseList (a ': as)+ where+ responseListSwagger =+ InsOrdHashMap.insertWith+ combineResponseSwagger+ (fromIntegral (natVal (Proxy @(Server.ResponseStatus a))))+ <$> responseSwagger @a+ <*> responseListSwagger @as++combineResponseSwagger :: Response -> Response -> Response+combineResponseSwagger r1 r2 =+ r1+ & description <>~ ("\n\n" <> r2 ^. description)+ & content %~ flip (InsOrdHashMap.unionWith combineMediaTypeObject) (r2 ^. content)++combineMediaTypeObject :: MediaTypeObject -> MediaTypeObject -> MediaTypeObject+combineMediaTypeObject m1 m2 =+ m1 & schema .~ merge (m1 ^. schema) (m2 ^. schema)+ where+ merge Nothing a = a+ merge a Nothing = a+ merge (Just (Inline a)) (Just (Inline b)) = pure $ Inline $ combineSwaggerSchema a b+ merge a@(Just (Ref _)) _ = a+ merge _ a@(Just (Ref _)) = a++combineSwaggerSchema :: Schema -> Schema -> Schema+combineSwaggerSchema s1 s2+ -- if they are both errors, merge label enums+ | notNullOf (properties . ix "code") s1+ && notNullOf (properties . ix "code") s2 =+ s1+ & properties . ix "label" . _Inline . enum_ . _Just+ <>~ (s2 ^. properties . ix "label" . _Inline . enum_ . _Just)+ | otherwise = s1++instance+ (OpenApiMethod method, IsSwaggerResponseList as) =>+ HasOpenApi (MultiVerb method '() as r)+ where+ toOpenApi _ =+ mempty+ & components . schemas <>~ defs+ & paths+ . at "/"+ ?~ ( mempty+ & method+ ?~ ( mempty+ & responses . responses .~ refResps+ )+ )+ where+ method = openApiMethod (Proxy @method)+ (defs, resps) = runDeclare (responseListSwagger @as) mempty+ refResps = Inline <$> resps++instance+ (OpenApiMethod method, IsSwaggerResponseList as, AllMime cs) =>+ HasOpenApi (MultiVerb method (cs :: [Type]) as r)+ where+ toOpenApi _ =+ mempty+ & components . schemas <>~ defs+ & paths+ . at "/"+ ?~ ( mempty+ & method+ ?~ ( mempty+ & responses . responses .~ refResps+ )+ )+ where+ method = openApiMethod (Proxy @method)+ -- This has our content types.+ cs = allMime (Proxy @cs)+ -- This has our schemas+ (defs, resps) = runDeclare (responseListSwagger @as) mempty+ -- We need to zip them together, and stick it all back into the contentMap+ -- Since we have a single schema per type, and are only changing the content-types,+ -- we should be able to pick a schema out of the resps' map, and then use it for+ -- all of the values of cs+ addMime :: Response -> Response+ addMime resp =+ resp+ & content+ %~+ -- pick out an element from the map, if any exist.+ -- These will all have the same schemas, and we are reapplying the content types.+ foldMap (\c -> InsOrdHashMap.fromList $ (,c) <$> cs)+ . List.listToMaybe+ . toList+ refResps = Inline . addMime <$> resps+#endif
src/Servant/OpenApi/Internal/Test.hs view
@@ -52,11 +52,12 @@ -- <BLANKLINE> -- ToJSON matches ToSchema -- User...--- ...+-- +++ OK, passed 100 tests. -- UserId...--- ...+-- +++ OK, passed 100 tests.+-- <BLANKLINE> -- Finished in ... seconds--- ...2 examples, 0 failures...+-- 2 examples, 0 failures -- -- For the test to compile all body types should have the following instances: --@@ -73,7 +74,7 @@ -- >>> type ContactAPI = Get '[JSON] Contact -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy ContactAPI) -- ...--- ...No instance for (Arbitrary Contact)+-- ...No instance for ...Arbitrary Contact... -- ... arising from a use of ‘validateEveryToJSON’ -- ... validateEveryToJSON@@ -116,13 +117,14 @@ -- <BLANKLINE> -- read . show == id -- Bool...--- ...+-- +++ OK, passed 100 tests. -- Int...--- ...+-- +++ OK, passed 100 tests. -- [Char]...--- ...+-- +++ OK, passed 100 tests.+-- <BLANKLINE> -- Finished in ... seconds--- ...3 examples, 0 failures...+-- 3 examples, 0 failures props :: forall p p'' cs xs. TMap (Every (Typeable ': Show ': Arbitrary ': cs)) xs => p cs -- ^ A list of constraints. -> (forall x. EveryTF cs x => x -> Property) -- ^ Property predicate.
src/Servant/OpenApi/Internal/TypeLevel/API.hs view
@@ -13,7 +13,10 @@ #if MIN_VERSION_servant(0,19,0) import Servant.API.Generic (ToServantApi) #endif-+#if MIN_VERSION_servant(0,20,3)+import Servant.API.MultiVerb (MultiVerb, Respond, RespondAs, RespondStreaming, WithHeaders, GenericAsConstructor)+import Data.ByteString (ByteString)+#endif -- | Build a list of endpoints from an API. type family EndpointsList api where EndpointsList (a :<|> b) = AppendList (EndpointsList a) (EndpointsList b)@@ -89,6 +92,9 @@ BodyTypes' c (Verb verb b cs (Headers hdrs a)) = AddBodyType c cs a '[] BodyTypes' c (Verb verb b cs NoContent) = '[] BodyTypes' c (Verb verb b cs a) = AddBodyType c cs a '[]+#if MIN_VERSION_servant(0,20,3)+ BodyTypes' c (MultiVerb verb cs as _) = AddBodyType c cs () (MultiVerbResponseBodies as)+#endif BodyTypes' c (ReqBody' mods cs a :> api) = AddBodyType c cs a (BodyTypes' c api) BodyTypes' c (e :> api) = BodyTypes' c api BodyTypes' c (a :<|> b) = AppendList (BodyTypes' c a) (BodyTypes' c b)@@ -96,3 +102,32 @@ BodyTypes' c (NamedRoutes api) = BodyTypes' c (ToServantApi api) #endif BodyTypes' c api = '[]+++#if MIN_VERSION_servant(0,20,3)+-- | The 'ResponseTypes' class allows to extract all types+-- involved in a response, whether or not this type is+-- in the body of the response, or, for example, in a header.+--+-- This is problematic because, if the response contains a header (e.g. `Header "Set-Cookie" SetCookie`),+-- then the header type also needs instances for `To/FromJSON` and `Arbitrary`+-- for testing purposes, even though this isn't needed in practice.+--+-- We want to extract only the body, for which there is no+-- built-in functionality at this time.+--+-- See Servant.API.MultiVerb.ResponseTypes for an example of how+-- this mechanism can be implemented+type family MultiVerbResponseBody a++type instance MultiVerbResponseBody (Respond s description a) = a+type instance MultiVerbResponseBody (RespondAs contentType s description a) = a+type instance MultiVerbResponseBody (RespondStreaming s description framing contentType) = SourceIO ByteString+-- The following instance is the main difference between 'MultiVerbResponseBody' and 'ResponseType'+type instance MultiVerbResponseBody (WithHeaders headers returnType response) = MultiVerbResponseBody response+type instance MultiVerbResponseBody (GenericAsConstructor r) = MultiVerbResponseBody r++type family MultiVerbResponseBodies (as :: [*]) where+ MultiVerbResponseBodies '[] = '[]+ MultiVerbResponseBodies (a ': as) = MultiVerbResponseBody a ': MultiVerbResponseBodies as+#endif