diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,5 @@ # servant-swagger -[![Build Status](https://travis-ci.org/haskell-servant/servant-swagger.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-swagger) [![Hackage](https://img.shields.io/hackage/v/servant-swagger.svg)](http://hackage.haskell.org/package/servant-swagger) [![Stackage LTS](http://stackage.org/package/servant-swagger/badge/lts)](http://stackage.org/lts/package/servant-swagger) [![Stackage Nightly](http://stackage.org/package/servant-swagger/badge/nightly)](http://stackage.org/nightly/package/servant-swagger) @@ -25,7 +24,7 @@ ### Usage -Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger). +Please refer to [haddock documentation](http://hackage.haskell.org/package/servant/servant-swagger). Some examples can be found in [`example/` directory](/example). @@ -43,5 +42,5 @@ We are happy to receive bug reports, fixes, documentation enhancements, and other improvements. -Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant-swagger/issues). +Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant/issues). diff --git a/example/example.cabal b/example/example.cabal --- a/example/example.cabal +++ b/example/example.cabal @@ -1,15 +1,15 @@ +cabal-version: 2.2 name: example version: 1.0 synopsis: servant-swagger demonstration description: servant-swagger demonstration -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: David Johnson, Nickolay Kudasov maintainer: nickolay.kudasov@gmail.com copyright: (c) 2015-2016, Servant contributors category: Web build-type: Simple -cabal-version: >=1.10 data-files: swagger.json diff --git a/example/swagger.json b/example/swagger.json --- a/example/swagger.json +++ b/example/swagger.json @@ -45,8 +45,8 @@ "/todo/{id}": { "get": { "responses": { - "404": { - "description": "`id` not found" + "400": { + "description": "Invalid `id`" }, "200": { "schema": { @@ -74,11 +74,8 @@ "application/json;charset=utf-8" ], "responses": { - "404": { - "description": "`id` not found" - }, "400": { - "description": "Invalid `body`" + "description": "Invalid `body` or `id`" }, "200": { "schema": { diff --git a/servant-swagger.cabal b/servant-swagger.cabal --- a/servant-swagger.cabal +++ b/servant-swagger.cabal @@ -1,11 +1,12 @@ +cabal-version: 2.2 name: servant-swagger -version: 1.1.10 +version: 1.1.11 synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API. description: - Swagger is a project used to describe and document RESTful APIs. The core of the - project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/). - This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is - quite popular among developers in different languages. It has also existed for a longer time + Swagger is a project used to describe and document RESTful APIs. The core of the + project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/). + This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is + quite popular among developers in different languages. It has also existed for a longer time and has more helpful tooling. . This package provides means to generate a Swagger/OAS specification for a Servant API @@ -18,22 +19,16 @@ * 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/haskell-servant/servant-swagger -bug-reports: https://github.com/haskell-servant/servant-swagger/issues -license: BSD3 +homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme +bug-reports: https://github.com/haskell-servant/servant/issues +license: BSD-3-Clause license-file: LICENSE -author: David Johnson, Nickolay Kudasov -maintainer: nickolay.kudasov@gmail.com +author: Servant Contributors +maintainer: haskell-servant-maintainers@googlegroups.com copyright: (c) 2015-2018, Servant contributors category: Web, Servant, Swagger build-type: Custom -cabal-version: 1.18 -tested-with: - GHC ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.1 +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 extra-source-files: README.md @@ -50,12 +45,12 @@ source-repository head type: git - location: https://github.com/haskell-servant/servant-swagger.git + location: https://github.com/haskell-servant/servant.git custom-setup setup-depends: - base >=4.9 && <4.15, - Cabal >= 1.24 && <3.3, + base >=4.9 && <5, + Cabal >= 1.24, cabal-doctest >=1.0.6 && <1.1 library @@ -74,18 +69,18 @@ Servant.Swagger.Internal.TypeLevel.Every Servant.Swagger.Internal.TypeLevel.TMap hs-source-dirs: src - build-depends: aeson >=1.4.2.0 && <1.6 + build-depends: aeson >=1.4.2.0 && <3 , aeson-pretty >=0.8.7 && <0.9 - , base >=4.9.1.0 && <4.15 - , base-compat >=0.10.5 && <0.12 - , bytestring >=0.10.8.1 && <0.11 + , base >=4.9.1.0 && <5 + , base-compat >=0.10.5 && <0.13 + , bytestring >=0.10.8.1 && <0.12 , http-media >=0.7.1.3 && <0.9 , insert-ordered-containers >=0.2.1.0 && <0.3 - , lens >=4.17 && <4.20 - , servant >=0.17 && <0.19 + , lens >=4.17 && <6 + , servant >=0.18.2 && <0.20 , singleton-bool >=0.1.4 && <0.2 - , swagger2 >=2.3.0.1 && <2.7 - , text >=1.2.3.0 && <1.3 + , swagger2 >=2.3.0.1 && <3 + , text >=1.2.3.0 && <2.1 , unordered-containers >=0.2.9.0 && <0.3 , hspec @@ -97,7 +92,7 @@ build-depends: base, directory >= 1.0, - doctest >= 0.11.1 && <0.18, + doctest >= 0.17 && <0.21, servant, QuickCheck, filepath @@ -111,14 +106,14 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs - build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8 + build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10 build-depends: base , base-compat - , aeson - , hspec >=2.6.0 && <2.8 + , aeson >=1.4.2.0 && <3 + , hspec >=2.6.0 && <2.10 , QuickCheck , lens - , lens-aeson >=1.0.2 && <1.2 + , lens-aeson >=1.0.2 && <1.3 , servant , servant-swagger , swagger2 diff --git a/src/Servant/Swagger.hs b/src/Servant/Swagger.hs --- a/src/Servant/Swagger.hs +++ b/src/Servant/Swagger.hs @@ -50,6 +50,7 @@ -- >>> import Control.Applicative -- >>> import Control.Lens -- >>> import Data.Aeson +-- >>> import Data.Aeson.Encode.Pretty -- >>> import Data.Swagger -- >>> import Data.Typeable -- >>> import GHC.Generics @@ -73,6 +74,7 @@ -- >>> type GetUser = Capture "user_id" UserId :> Get '[JSON] User -- >>> type PostUser = ReqBody '[JSON] User :> Post '[JSON] UserId -- >>> type UserAPI = GetUsers :<|> GetUser :<|> PostUser +-- >>> orderedKeys = encodePretty' (defConfig { confCompare = compare, confIndent = Spaces 0 }) -- $howto -- @@ -98,12 +100,12 @@ -- $generate -- In order to generate @'Swagger'@ specification for a servant API, just use @'toSwagger'@: -- --- >>> BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI) --- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}} +-- >>> BSL8.putStrLn . orderedKeys $ toSwagger (Proxy :: Proxy UserAPI) +-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"} -- -- By default @'toSwagger'@ will generate specification for all API routes, parameters, headers, responses and data schemas. -- --- For some parameters it will also add 400 and/or 404 responses with a description mentioning parameter name. +-- For some parameters it will also add 400 responses with a description mentioning parameter name. -- -- Data schemas come from @'ToParamSchema'@ and @'ToSchema'@ classes. @@ -113,14 +115,14 @@ -- We can add this information using field lenses from @"Data.Swagger"@: -- -- >>> :{ --- BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI) +-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI) -- & info.title .~ "User API" -- & info.version .~ "1.0" -- & info.description ?~ "This is an API for the Users service" -- & info.license ?~ "MIT" -- & host ?~ "example.com" -- :} --- {"swagger":"2.0","info":{"version":"1.0","title":"User API","license":{"name":"MIT"},"description":"This is an API for the Users service"},"host":"example.com","paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}} +-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"host":"example.com","info":{"description":"This is an API for the Users service","license":{"name":"MIT"},"title":"User API","version":"1.0"},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}}},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}}}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}}}}},"swagger":"2.0"} -- -- It is also useful to annotate or modify certain endpoints. -- @'subOperations'@ provides a convenient way to zoom into a part of an API. @@ -134,11 +136,11 @@ -- >>> let getOps = subOperations (Proxy :: Proxy (GetUsers :<|> GetUser)) (Proxy :: Proxy UserAPI) -- >>> let postOps = subOperations (Proxy :: Proxy PostUser) (Proxy :: Proxy UserAPI) -- >>> :{ --- BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI) +-- BSL8.putStrLn $ orderedKeys $ toSwagger (Proxy :: Proxy UserAPI) -- & applyTagsFor getOps ["get" & description ?~ "GET operations"] -- & applyTagsFor postOps ["post" & description ?~ "POST operations"] -- :} --- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"tags":["post"],"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}},"tags":[{"name":"get","description":"GET operations"},{"name":"post","description":"POST operations"}]} +-- {"definitions":{"User":{"properties":{"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"name":{"type":"string"}},"required":["name","age"],"type":"object"},"UserId":{"type":"integer"}},"info":{"title":"","version":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"items":{"$ref":"#/definitions/User"},"type":"array"}}},"tags":["get"]},"post":{"consumes":["application/json;charset=utf-8"],"parameters":[{"in":"body","name":"body","required":true,"schema":{"$ref":"#/definitions/User"}}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/UserId"}},"400":{"description":"Invalid `body`"}},"tags":["post"]}},"/{user_id}":{"get":{"parameters":[{"in":"path","name":"user_id","required":true,"type":"integer"}],"produces":["application/json;charset=utf-8"],"responses":{"200":{"description":"","schema":{"$ref":"#/definitions/User"}},"400":{"description":"Invalid `user_id`"}},"tags":["get"]}}},"swagger":"2.0","tags":[{"description":"GET operations","name":"get"},{"description":"POST operations","name":"post"}]} -- -- This applies @\"get\"@ tag to the @GET@ endpoints and @\"post\"@ tag to the @POST@ endpoint of the User API. @@ -158,11 +160,11 @@ -- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary -- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- --- [User] +-- [User]... -- ... --- User +-- User... -- ... --- UserId +-- UserId... -- ... -- Finished in ... seconds -- 3 examples, 0 failures diff --git a/src/Servant/Swagger/Internal.hs b/src/Servant/Swagger/Internal.hs --- a/src/Servant/Swagger/Internal.hs +++ b/src/Servant/Swagger/Internal.hs @@ -16,12 +16,14 @@ import Prelude () import Prelude.Compat +import Control.Applicative ((<|>)) import Control.Lens import Data.Aeson import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Foldable (toList) import Data.Proxy +import Data.Typeable import Data.Singletons.Bool import Data.Swagger hiding (Header) import qualified Data.Swagger as Swagger @@ -155,14 +157,6 @@ markdownCode :: Text -> Text markdownCode s = "`" <> s <> "`" -addDefaultResponse404 :: ParamName -> Swagger -> Swagger -addDefaultResponse404 pname = setResponseWith (\old _new -> alter404 old) 404 (return response404) - where - sname = markdownCode pname - description404 = sname <> " not found" - alter404 = description %~ ((sname <> " or ") <>) - response404 = mempty & description .~ description404 - addDefaultResponse400 :: ParamName -> Swagger -> Swagger addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400) where @@ -183,6 +177,73 @@ instance SwaggerMethod 'HEAD where swaggerMethod _ = head_ instance SwaggerMethod 'PATCH where swaggerMethod _ = patch +instance HasSwagger (UVerb method cs '[]) where + toSwagger _ = mempty + +-- | @since +instance + {-# OVERLAPPABLE #-} + ( ToSchema a, + HasStatus a, + AllAccept cs, + SwaggerMethod method, + HasSwagger (UVerb method cs as) + ) => + HasSwagger (UVerb method cs (a ': as)) + where + toSwagger _ = + toSwagger (Proxy :: Proxy (Verb method (StatusOf a) cs a)) + `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as)) + +-- ATTENTION: do not remove this instance! +-- A similar instance above will always use the more general +-- polymorphic -- HasSwagger instance and will result in a type error +-- since 'NoContent' does not have a 'ToSchema' instance. +instance + ( KnownNat status, + AllAccept cs, + SwaggerMethod method, + HasSwagger (UVerb method cs as) + ) => + HasSwagger (UVerb method cs (WithStatus status NoContent ': as)) + where + toSwagger _ = + toSwagger (Proxy :: Proxy (Verb method status cs NoContent)) + `combineSwagger` toSwagger (Proxy :: Proxy (UVerb method cs as)) + + +-- workaround for https://github.com/GetShopTV/swagger2/issues/218 +-- We'd like to juse use (<>) but the instances are wrong +combinePathItem :: PathItem -> PathItem -> PathItem +combinePathItem s t = PathItem + { _pathItemGet = _pathItemGet s <> _pathItemGet t + , _pathItemPut = _pathItemPut s <> _pathItemPut t + , _pathItemPost = _pathItemPost s <> _pathItemPost t + , _pathItemDelete = _pathItemDelete s <> _pathItemDelete t + , _pathItemOptions = _pathItemOptions s <> _pathItemOptions t + , _pathItemHead = _pathItemHead s <> _pathItemHead t + , _pathItemPatch = _pathItemPatch s <> _pathItemPatch t + , _pathItemParameters = _pathItemParameters s <> _pathItemParameters t + } + +combineSwagger :: Swagger -> Swagger -> Swagger +combineSwagger s t = Swagger + { _swaggerInfo = _swaggerInfo s <> _swaggerInfo t + , _swaggerHost = _swaggerHost s <|> _swaggerHost t + , _swaggerBasePath = _swaggerBasePath s <|> _swaggerBasePath t + , _swaggerSchemes = _swaggerSchemes s <> _swaggerSchemes t + , _swaggerConsumes = _swaggerConsumes s <> _swaggerConsumes t + , _swaggerProduces = _swaggerProduces s <> _swaggerProduces t + , _swaggerPaths = InsOrdHashMap.unionWith combinePathItem (_swaggerPaths s) (_swaggerPaths t) + , _swaggerDefinitions = _swaggerDefinitions s <> _swaggerDefinitions t + , _swaggerParameters = _swaggerParameters s <> _swaggerParameters t + , _swaggerResponses = _swaggerResponses s <> _swaggerResponses t + , _swaggerSecurityDefinitions = _swaggerSecurityDefinitions s <> _swaggerSecurityDefinitions t + , _swaggerSecurity = _swaggerSecurity s <> _swaggerSecurity t + , _swaggerTags = _swaggerTags s <> _swaggerTags t + , _swaggerExternalDocs = _swaggerExternalDocs s <|> _swaggerExternalDocs t + } + instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Verb method status cs (Headers '[] a))) @@ -223,6 +284,10 @@ instance (HasSwagger sub) => HasSwagger (RemoteHost :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) +-- | @'Fragment'@ combinator does not change our specification at all. +instance HasSwagger sub => HasSwagger (Fragment a :> sub) where + toSwagger _ = toSwagger (Proxy :: Proxy sub) + -- | @'HttpVersion'@ combinator does not change our specification at all. instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) @@ -236,13 +301,16 @@ where piece = symbolVal (Proxy :: Proxy sym) -instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where +instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) & addParam param & prependPath capture - & addDefaultResponse404 tname + & addDefaultResponse400 tname where - pname = symbolVal (Proxy :: Proxy sym) + symbol = symbolVal (Proxy :: Proxy sym) + pname = if symbol == "" + then camelTo2 '-' . tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a) + else symbol tname = Text.pack pname transDesc "" = Nothing transDesc desc = Just (Text.pack desc) @@ -256,7 +324,7 @@ & paramSchema .~ toParamSchema (Proxy :: Proxy a)) -- | Swagger Spec doesn't have a notion of CaptureAll, this instance is the best effort. -instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where +instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy (Capture sym a :> sub)) instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Description desc :> api) where @@ -352,7 +420,7 @@ & schema .~ ParamBody ref -- | This instance is an approximation. --- +-- -- @since 1.1.7 instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (StreamBody' mods fr ct a :> sub) where toSwagger _ = toSwagger (Proxy :: Proxy sub) diff --git a/src/Servant/Swagger/Internal/Orphans.hs b/src/Servant/Swagger/Internal/Orphans.hs --- a/src/Servant/Swagger/Internal/Orphans.hs +++ b/src/Servant/Swagger/Internal/Orphans.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} module Servant.Swagger.Internal.Orphans where import Data.Proxy @@ -7,6 +10,9 @@ import Data.Swagger import Servant.Types.SourceT (SourceT) +#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0) +import Servant.API (WithStatus(..)) +#endif -- | Pretend that 'SourceT m a' is '[a]'. -- @@ -14,3 +20,8 @@ -- instance ToSchema a => ToSchema (SourceT m a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a]) + +#if MIN_VERSION_GLASGOW_HASKELL(8,8,1,0) +-- @since 1.1.11 +deriving instance ToSchema a => ToSchema (WithStatus s a) +#endif diff --git a/src/Servant/Swagger/Internal/Test.hs b/src/Servant/Swagger/Internal/Test.hs --- a/src/Servant/Swagger/Internal/Test.hs +++ b/src/Servant/Swagger/Internal/Test.hs @@ -4,10 +4,12 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} module Servant.Swagger.Internal.Test where import Data.Aeson (ToJSON (..)) -import Data.Aeson.Encode.Pretty (encodePretty) +import Data.Aeson.Encode.Pretty (encodePretty', defConfig, + confCompare) import Data.Swagger (Pattern, ToSchema, toSchema) import Data.Swagger.Schema.Validation @@ -51,10 +53,10 @@ -- -- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI) -- --- ToJSON matches ToSchema --- User +-- ToJSON matches ToSchema... +-- User... -- ... --- UserId +-- UserId... -- ... -- Finished in ... seconds -- 2 examples, 0 failures @@ -116,11 +118,11 @@ -- :} -- -- read . show == id --- Bool +-- Bool... -- ... --- Int +-- Int... -- ... --- [Char] +-- [Char]... -- ... -- Finished in ... seconds -- 3 examples, 0 failures @@ -158,19 +160,19 @@ -- -- Swagger Schema: -- { --- "required": [ --- "name", --- "phone" --- ], --- "type": "object", -- "properties": { --- "phone": { --- "type": "integer" --- }, -- "name": { -- "type": "string" +-- }, +-- "phone": { +-- "type": "integer" -- } --- } +-- }, +-- "required": [ +-- "name", +-- "phone" +-- ], +-- "type": "object" -- } -- -- @@ -191,7 +193,8 @@ , ppJSONString (toJSON schema) ] where - ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty + ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty' ppCfg + ppCfg = defConfig { confCompare = compare } json = toJSON x schema = toSchema (Proxy :: Proxy a) diff --git a/src/Servant/Swagger/Internal/TypeLevel/API.hs b/src/Servant/Swagger/Internal/TypeLevel/API.hs --- a/src/Servant/Swagger/Internal/TypeLevel/API.hs +++ b/src/Servant/Swagger/Internal/TypeLevel/API.hs @@ -7,7 +7,6 @@ {-# LANGUAGE UndecidableInstances #-} module Servant.Swagger.Internal.TypeLevel.API where -import Data.Type.Bool (If) import GHC.Exts (Constraint) import Servant.API diff --git a/test/Servant/SwaggerSpec.hs b/test/Servant/SwaggerSpec.hs --- a/test/Servant/SwaggerSpec.hs +++ b/test/Servant/SwaggerSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PackageImports #-} module Servant.SwaggerSpec where @@ -40,6 +41,7 @@ it "Todo API" $ checkAPI (Proxy :: Proxy TodoAPI) todoAPI it "Hackage API (with tags)" $ checkSwagger hackageSwaggerWithTags hackageAPI it "GetPost API (test subOperations)" $ checkSwagger getPostSwagger getPostAPI + it "UVerb API" $ checkSwagger uverbSwagger uverbAPI it "Comprehensive API" $ do let _x = toSwagger comprehensiveAPI True `shouldBe` True -- type-level test @@ -107,7 +109,7 @@ "schema": { "$ref":"#/definitions/Todo" }, "description": "" }, - "404": { "description": "`id` not found" } + "400": { "description": "Invalid `id`" } }, "produces": [ "application/json;charset=utf-8" ], "parameters": @@ -297,8 +299,8 @@ "/user/{username}":{ "get":{ "responses":{ - "404":{ - "description":"`username` not found" + "400":{ + "description":"Invalid `username`" }, "200":{ "schema":{ @@ -406,3 +408,82 @@ } |] +-- ======================================================================= +-- UVerb API +-- ======================================================================= + +data Lunch = Lunch {name :: String} + deriving (Eq, Show, Generic) + +instance ToSchema Lunch + +instance HasStatus Lunch where + type StatusOf Lunch = 200 + +data NoLunch = NoLunch + deriving (Eq, Show, Generic) + +instance ToSchema NoLunch + +instance HasStatus NoLunch where + type StatusOf NoLunch = 404 + +type UVerbAPI2 = + "lunch" :> UVerb 'GET '[JSON] '[Lunch, NoLunch] + +uverbSwagger :: Swagger +uverbSwagger = toSwagger (Proxy :: Proxy UVerbAPI2) + +uverbAPI :: Value +uverbAPI = + [aesonQQ| + { + "swagger": "2.0", + "info": { + "version": "", + "title": "" + }, + "definitions": { + "Lunch": { + "required": [ + "name" + ], + "type": "object", + "properties": { + "name": { + "type": "string" + } + } + }, + "NoLunch": { + "type": "string", + "enum": [ + "NoLunch" + ] + } + }, + "paths": { + "/lunch": { + "get": { + "responses": { + "404": { + "schema": { + "$ref": "#/definitions/NoLunch" + }, + "description": "" + }, + "200": { + "schema": { + "$ref": "#/definitions/Lunch" + }, + "description": "" + } + }, + "produces": [ + "application/json;charset=utf-8" + ] + } + } + } +} +|]