packages feed

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 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  [![Hackage](https://img.shields.io/hackage/v/servant-openapi3.svg)](http://hackage.haskell.org/package/servant-openapi3)-[![Build Status](https://travis-ci.org/biocad/servant-openapi3.svg?branch=master)](https://travis-ci.org/biocad/servant-openapi3)-[![Stackage LTS](http://stackage.org/package/servant-openapi3/badge/lts)](http://stackage.org/lts/package/servant-openapi3)-[![Stackage Nightly](http://stackage.org/package/servant-openapi3/badge/nightly)](http://stackage.org/nightly/package/servant-openapi3)  OpenAPI 3.0 conforming json for [servant](https://github.com/haskell-servant/servant) APIs. -![servant-swagger robot](http://s16.postimg.org/rndz1wbyt/servant.png)- ### 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