From 042d6c6c1cc1269097bedcea2d639127fd3aafbe Mon Sep 17 00:00:00 2001 From: Andres Loeh Date: Wed, 12 May 2021 10:20:11 +0200 Subject: [PATCH] Generalise over the Swagger datatype. This change modifies the previously introduced generalisation of the Haskell datatype that holds the Swagger specification to an aeson Value. By using an aeson Value, all ordering information of object fields is being lost. This information is in principle preserved by aeson, when going via Encoding rather than Value. With this patch, we do not perform any aeson-related translation in the servant-swagger-ui code, and simply use the original datatype. It is servant's own responsibility to handle the actual conversion of the datatype to JSON. --- .../servant-swagger-ui-core.cabal | 1 - .../src/Servant/Swagger/UI/Core.hs | 18 +++++++++--------- servant-swagger-ui-example/src/Main.hs | 8 ++++---- .../servant-swagger-ui-jensoleg.cabal | 1 - .../src/Servant/Swagger/UI/JensOleG.hs | 3 +-- .../servant-swagger-ui-redoc.cabal | 1 - .../src/Servant/Swagger/UI/ReDoc.hs | 5 ++--- servant-swagger-ui/servant-swagger-ui.cabal | 1 - servant-swagger-ui/src/Servant/Swagger/UI.hs | 6 +++--- 9 files changed, 19 insertions(+), 25 deletions(-) diff --git a/servant-swagger-ui-core/servant-swagger-ui-core.cabal b/servant-swagger-ui-core/servant-swagger-ui-core.cabal index fcca9f7..3c45709 100644 --- a/servant-swagger-ui-core/servant-swagger-ui-core.cabal +++ b/servant-swagger-ui-core/servant-swagger-ui-core.cabal @@ -36,7 +36,6 @@ library ghc-options: -Wall build-depends: base >=4.7 && <4.15 - , aeson >=0.8.0.2 && <1.6 , blaze-markup >=0.7.0.2 && <0.9 , bytestring >=0.10.4.0 && <0.11 , http-media >=0.7.1.3 && <0.9 diff --git a/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs b/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs index 0b9a1bc..19ad54f 100644 --- a/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs +++ b/servant-swagger-ui-core/src/Servant/Swagger/UI/Core.hs @@ -23,7 +23,7 @@ -- :\<|> "cat" :> Capture ":name" CatName :> Get '[JSON] Cat -- -- -- | API type with bells and whistles, i.e. schema file and swagger-ui. --- type API = 'SwaggerSchemaUI' "swagger-ui" "swagger.json" +-- type API = 'SwaggerSchemaUI' "swagger-ui" "swagger.json" Swagger -- :\<|> BasicAPI -- -- -- | Servant server for an API @@ -46,7 +46,6 @@ module Servant.Swagger.UI.Core ( Handler, ) where -import Data.Aeson (ToJSON (..), Value) import Data.ByteString (ByteString) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Network.Wai.Application.Static (embeddedSettings, staticApp) @@ -58,7 +57,7 @@ import qualified Data.Text as T -- | Swagger schema + ui api. -- --- @SwaggerSchemaUI "swagger-ui" "swagger.json"@ will result into following hierarchy: +-- @SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger@ will result into following hierarchy: -- -- @ -- \/swagger.json @@ -67,10 +66,11 @@ import qualified Data.Text as T -- \/swagger-ui\/... -- @ -- --- This type does not actually force served type to be @Swagger@ from @swagger2@ package, --- it could be arbitrary @aeson@ 'Value'. -type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) = - SwaggerSchemaUI' dir (schema :> Get '[JSON] Value) +-- The third type parameter specifies which Haskell datatype contains the Swagger +-- description. Typical instantiations are @Swagger@ from the @swagger2@ package, +-- and @OpenApi@ from the @openapi3@ package. +type SwaggerSchemaUI (dir :: Symbol) (schema :: Symbol) (a :: *) = + SwaggerSchemaUI' dir (schema :> Get '[JSON] a) -- | Use 'SwaggerSchemaUI'' when you need even more control over -- where @swagger.json@ is served (e.g. subdirectory). @@ -103,11 +103,11 @@ instance (KnownSymbol dir, HasLink api, Link ~ MkLink api Link, IsElem api api) proxyApi = Proxy :: Proxy api swaggerSchemaUIServerImpl - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => T.Text -> [(FilePath, ByteString)] -> a -> ServerT (SwaggerSchemaUI' dir api) m swaggerSchemaUIServerImpl indexTemplate files swagger - = swaggerSchemaUIServerImpl' indexTemplate files $ return $ toJSON swagger + = swaggerSchemaUIServerImpl' indexTemplate files $ return $ swagger -- | Use a custom server to serve the Swagger spec source. swaggerSchemaUIServerImpl' diff --git a/servant-swagger-ui-example/src/Main.hs b/servant-swagger-ui-example/src/Main.hs index dcd1dd7..dd77679 100644 --- a/servant-swagger-ui-example/src/Main.hs +++ b/servant-swagger-ui-example/src/Main.hs @@ -16,7 +16,7 @@ import Prelude () import Prelude.Compat import Control.Lens hiding ((.=)) -import Data.Aeson (FromJSON, ToJSON, Value) +import Data.Aeson (FromJSON, ToJSON) import Data.Maybe (fromMaybe) import Data.String (IsString (..)) import Data.Text (Text) @@ -136,13 +136,13 @@ type BasicAPI = Get '[PlainText, JSON] Text type API = -- this serves both: swagger.json and swagger-ui - SwaggerSchemaUI "swagger-ui" "swagger.json" + SwaggerSchemaUI "swagger-ui" "swagger.json" Swagger :<|> BasicAPI -- To test nested case type API' = API :<|> "nested" :> API - :<|> SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Value) + :<|> SwaggerSchemaUI' "foo-ui" ("foo" :> "swagger.json" :> Get '[JSON] Swagger) -- Implementation @@ -174,7 +174,7 @@ server' uiFlavour = server Normal -- Unfortunately we have to specify the basePath manually atm. schemaUiServer - :: (Server api ~ Handler Value) + :: (Server api ~ Handler Swagger) => Swagger -> Server (SwaggerSchemaUI' dir api) schemaUiServer = case uiFlavour of Original -> swaggerSchemaUIServer diff --git a/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal b/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal index 92ad52a..bc536df 100644 --- a/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal +++ b/servant-swagger-ui-jensoleg/servant-swagger-ui-jensoleg.cabal @@ -85,7 +85,6 @@ library build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 build-depends: base >=4.7 && <4.15 - , aeson >=0.8.0.2 && <1.6 , bytestring >=0.10.4.0 && <0.11 , file-embed-lzma >=0 && <0.1 , servant >=0.14 && <0.19 diff --git a/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs b/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs index 3311908..14a04e6 100644 --- a/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs +++ b/servant-swagger-ui-jensoleg/src/Servant/Swagger/UI/JensOleG.hs @@ -55,7 +55,6 @@ module Servant.Swagger.UI.JensOleG ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) import FileEmbedLzma @@ -67,7 +66,7 @@ import Servant -- -- See jensolegSwaggerSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) jensolegSwaggerSchemaUIServer = swaggerSchemaUIServerImpl jensolegIndexTemplate jensolegFiles diff --git a/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal b/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal index f8f7240..aea7f9c 100644 --- a/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal +++ b/servant-swagger-ui-redoc/servant-swagger-ui-redoc.cabal @@ -35,7 +35,6 @@ library build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 build-depends: base >=4.7 && <4.15 - , aeson >=0.8.0.2 && <1.6 , bytestring >=0.10.4.0 && <0.11 , file-embed-lzma >=0 && <0.1 , servant >=0.14 && <0.19 diff --git a/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs b/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs index 8c7399e..7bb234a 100644 --- a/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs +++ b/servant-swagger-ui-redoc/src/Servant/Swagger/UI/ReDoc.hs @@ -57,7 +57,6 @@ module Servant.Swagger.UI.ReDoc ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) import FileEmbedLzma @@ -67,7 +66,7 @@ import Servant -- -- See redocSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) redocSchemaUIServer = swaggerSchemaUIServerImpl redocIndexTemplate redocFiles @@ -80,7 +79,7 @@ redocSchemaUIServer = -- redocSchemaUIServerT :: Swagger -> ServerT (SwaggerSchemaUI schema dir) m -- @ redocSchemaUIServerT - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => a -> ServerT (SwaggerSchemaUI' dir api) m redocSchemaUIServerT = swaggerSchemaUIServerImpl redocIndexTemplate redocFiles diff --git a/servant-swagger-ui/servant-swagger-ui.cabal b/servant-swagger-ui/servant-swagger-ui.cabal index 6b30e1d..2b031eb 100644 --- a/servant-swagger-ui/servant-swagger-ui.cabal +++ b/servant-swagger-ui/servant-swagger-ui.cabal @@ -45,7 +45,6 @@ library build-depends: servant-swagger-ui-core >=0.3.5 && <0.4 build-depends: base >=4.7 && <4.15 - , aeson >=0.8.0.2 && <1.6 , bytestring >=0.10.4.0 && <0.11 , file-embed-lzma >=0 && <0.1 , servant >=0.14 && <0.19 diff --git a/servant-swagger-ui/src/Servant/Swagger/UI.hs b/servant-swagger-ui/src/Servant/Swagger/UI.hs index 602dd40..f16c816 100644 --- a/servant-swagger-ui/src/Servant/Swagger/UI.hs +++ b/servant-swagger-ui/src/Servant/Swagger/UI.hs @@ -62,7 +62,7 @@ module Servant.Swagger.UI ( import Servant.Swagger.UI.Core -import Data.Aeson (ToJSON, Value) +-- import Data.Aeson (ToJSON, Value) import Data.ByteString (ByteString) import Data.Text (Text) import FileEmbedLzma @@ -75,7 +75,7 @@ import Servant -- swaggerSchemaUIServer :: OpenApi -> Server (SwaggerSchemaUI schema dir) -- @ swaggerSchemaUIServer - :: (Server api ~ Handler Value, ToJSON a) + :: (Server api ~ Handler a) => a -> Server (SwaggerSchemaUI' dir api) swaggerSchemaUIServer = swaggerSchemaUIServerImpl swaggerUiIndexTemplate swaggerUiFiles @@ -89,7 +89,7 @@ swaggerSchemaUIServer = -- swaggerSchemaUIServerT :: OpenApi -> ServerT (SwaggerSchemaUI schema dir) m -- @ swaggerSchemaUIServerT - :: (Monad m, ServerT api m ~ m Value, ToJSON a) + :: (Monad m, ServerT api m ~ m a) => a -> ServerT (SwaggerSchemaUI' dir api) m swaggerSchemaUIServerT = swaggerSchemaUIServerImpl swaggerUiIndexTemplate swaggerUiFiles