packages feed

webgear-openapi 1.0.5 → 1.1.0

raw patch · 11 files changed

+109/−62 lines, 11 filesdep ~textdep ~webgear-core

Dependency ranges changed: text, webgear-core

Files

CHANGELOG.md view
@@ -2,6 +2,16 @@  ## [Unreleased] +## [1.1.0] - 2023-12-29++### Added+- Streaming responses support (#26)+- Support for cookies (#29)+- Support file uploads (#32)++### Changed+- Redesign APIs for ease of use (breaking change) (#24)+ ## [1.0.5] - 2023-05-04  ### Changed@@ -32,7 +42,8 @@ ### Added - First version of webgear-openapi -[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.0.5...HEAD+[Unreleased]: https://github.com/haskell-webgear/webgear/compare/v1.1.0...HEAD+[1.1.0]: https://github.com/haskell-webgear/webgear/releases/tag/v1.1.0 [1.0.5]: https://github.com/haskell-webgear/webgear/releases/tag/v1.0.5 [1.0.4]: https://github.com/haskell-webgear/webgear/releases/tag/v1.0.4 [1.0.3]: https://github.com/haskell-webgear/webgear/releases/tag/v1.0.3
src/WebGear/OpenApi/Handler.hs view
@@ -24,6 +24,7 @@ import Network.HTTP.Media.MediaType (MediaType) import qualified Network.HTTP.Types as HTTP import WebGear.Core.Handler (Description (..), Handler (..), RouteMismatch, RoutePath (..), Summary (..))+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)  -- | A tree where internal nodes have one or two children. data Tree a@@ -36,7 +37,7 @@ data DocNode   = DocSecurityScheme Text SecurityScheme   | DocRequestBody (Definitions Schema) RequestBody-  | DocResponseBody (Definitions Schema) MediaType MediaTypeObject+  | DocResponseBody (Definitions Schema) (InsOrdHashMap MediaType MediaTypeObject)   | DocRequestHeader Param   | DocResponseHeader HeaderName Header   | DocMethod HTTP.StdMethod@@ -52,7 +53,7 @@ data CompactDocNode   = CDocSecurityScheme Text SecurityScheme   | CDocRequestBody (Definitions Schema) RequestBody-  | CDocResponseBody (Definitions Schema) MediaType MediaTypeObject+  | CDocResponseBody (Definitions Schema) (InsOrdHashMap MediaType MediaTypeObject)   | CDocRequestHeader Param   | CDocResponseHeader HeaderName Header   | CDocMethod HTTP.StdMethod@@ -184,8 +185,8 @@       let (descr, summ, child') = go child           body' = body & description .~ fmap getDescription descr        in (Nothing, summ, SingleNode (CDocRequestBody defs body') child')-    compactDoc (DocResponseBody defs mediaType mediaTypeObject) child =-      SingleNode (CDocResponseBody defs mediaType mediaTypeObject) <$> go child+    compactDoc (DocResponseBody defs mediaTypes) child =+      SingleNode (CDocResponseBody defs mediaTypes) <$> go child     compactDoc (DocRequestHeader param) child =       let (descr, summ, child') = go child           param' = param & description .~ fmap getDescription descr@@ -251,7 +252,7 @@  combineOpenApi :: OpenApi -> OpenApi -> OpenApi combineOpenApi s t =-  OpenApi+  (mempty @OpenApi)     { _openApiInfo = _openApiInfo s <> _openApiInfo t     , _openApiServers = _openApiServers s <> _openApiServers t     , _openApiPaths = Map.unionWith combinePathItem (_openApiPaths s) (_openApiPaths t)@@ -319,9 +320,9 @@             & patch ?~ opr             & trace ?~ opr      in doc' & paths <>~ [("/", pathItem)]-mergeDoc (CDocResponseBody defs mediaType mediaTypeObject) child doc =+mergeDoc (CDocResponseBody defs mediaTypes) child doc =   postOrder child doc $ \doc' ->-    let resp = mempty @Response & content <>~ [(mediaType, mediaTypeObject)]+    let resp = mempty @Response & content <>~ mediaTypes      in doc'           & allOperations . responses . responses %~ Map.map (`swaggerMappend` Inline resp)           & components . schemas %~ (<> defs)
src/WebGear/OpenApi/Trait/Auth/Basic.hs view
@@ -8,7 +8,7 @@ import Data.String (fromString) import GHC.TypeLits (KnownSymbol, symbolVal) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Attribute, Get (..), Linked, TraitAbsence (Absence))+import WebGear.Core.Trait (Attribute, Get (..), TraitAbsence (Absence), With) import WebGear.Core.Trait.Auth.Basic (BasicAuth' (..)) import WebGear.OpenApi.Handler (DocNode (DocSecurityScheme), OpenApiHandler (..), singletonNode) @@ -16,7 +16,7 @@   {-# INLINE getTrait #-}   getTrait ::     BasicAuth' x scheme m e a ->-    OpenApiHandler m (Linked ts Request) (Either (Absence (BasicAuth' x scheme m e a) Request) (Attribute (BasicAuth' x scheme m e a) Request))+    OpenApiHandler m (Request `With` ts) (Either (Absence (BasicAuth' x scheme m e a) Request) (Attribute (BasicAuth' x scheme m e a) Request))   getTrait _ =     let schemeName = "http" <> fromString (symbolVal (Proxy @scheme))         securityScheme =
src/WebGear/OpenApi/Trait/Auth/JWT.hs view
@@ -8,7 +8,7 @@ import Data.Typeable (Proxy (..)) import GHC.TypeLits (KnownSymbol, symbolVal) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Attribute, Get (..), Linked, TraitAbsence (..))+import WebGear.Core.Trait (Attribute, Get (..), TraitAbsence (..), With) import WebGear.Core.Trait.Auth.JWT (JWTAuth' (..)) import WebGear.OpenApi.Handler (DocNode (DocSecurityScheme), OpenApiHandler (..), singletonNode) @@ -19,7 +19,7 @@   {-# INLINE getTrait #-}   getTrait ::     JWTAuth' x scheme m e a ->-    OpenApiHandler m (Linked ts Request) (Either (Absence (JWTAuth' x scheme m e a) Request) (Attribute (JWTAuth' x scheme m e a) Request))+    OpenApiHandler m (Request `With` ts) (Either (Absence (JWTAuth' x scheme m e a) Request) (Attribute (JWTAuth' x scheme m e a) Request))   getTrait _ =     let schemeName = "http" <> fromString (symbolVal (Proxy @scheme))         securityScheme =
src/WebGear/OpenApi/Trait/Body.hs view
@@ -4,57 +4,49 @@ module WebGear.OpenApi.Trait.Body where  import Control.Lens ((&), (.~), (?~))-import Data.Maybe (fromMaybe)-import Data.OpenApi hiding (Response)+import Data.OpenApi hiding (Response, contentType) import Data.OpenApi.Declare (runDeclare) import Data.Proxy (Proxy (..)) import Data.Text (Text)+import GHC.Exts (fromList)+import WebGear.Core.MIMETypes (MIMEType (..)) import WebGear.Core.Request (Request)-import WebGear.Core.Response (Response (..))-import WebGear.Core.Trait (Get (..), Linked, Set (..))-import WebGear.Core.Trait.Body (Body (..), JSONBody (..))+import WebGear.Core.Response (Response (..), ResponseBody)+import WebGear.Core.Trait (Get (..), Set (..), With)+import WebGear.Core.Trait.Body (Body (..), UnknownContentBody (..)) import WebGear.OpenApi.Handler (   DocNode (DocRequestBody, DocResponseBody),   OpenApiHandler (..),   singletonNode,  ) -instance ToSchema val => Get (OpenApiHandler m) (Body val) Request where+instance (ToSchema val, MIMEType mt) => Get (OpenApiHandler m) (Body mt val) Request where   {-# INLINE getTrait #-}-  getTrait :: Body val -> OpenApiHandler m (Linked ts Request) (Either Text val)-  getTrait (Body maybeMediaType) =-    let mediaType = fromMaybe "*/*" maybeMediaType+  getTrait :: Body mt val -> OpenApiHandler m (Request `With` ts) (Either Text val)+  getTrait (Body mt) =+    let mediaType = mimeType mt         (defs, ref) = runDeclare (declareSchemaRef $ Proxy @val) mempty         body =           (mempty @RequestBody)-            & content .~ [(mediaType, mempty @MediaTypeObject & schema ?~ ref)]+            & content .~ fromList [(mediaType, mempty @MediaTypeObject & schema ?~ ref)]      in OpenApiHandler $ singletonNode (DocRequestBody defs body) -instance ToSchema val => Set (OpenApiHandler m) (Body val) Response where+instance (ToSchema val, MIMEType mt) => Set (OpenApiHandler m) (Body mt val) Response where   {-# INLINE setTrait #-}   setTrait ::-    Body val ->-    (Linked ts Response -> Response -> val -> Linked (Body val : ts) Response) ->-    OpenApiHandler m (Linked ts Response, val) (Linked (Body val : ts) Response)-  setTrait (Body maybeMediaType) _ =-    let mediaType = fromMaybe "*/*" maybeMediaType+    Body mt val ->+    (Response `With` ts -> Response -> val -> Response `With` (Body mt val : ts)) ->+    OpenApiHandler m (Response `With` ts, val) (Response `With` (Body mt val : ts))+  setTrait (Body mt) _ =+    let mediaType = mimeType mt         (defs, ref) = runDeclare (declareSchemaRef $ Proxy @val) mempty         body = mempty @MediaTypeObject & schema ?~ ref-     in OpenApiHandler $ singletonNode (DocResponseBody defs mediaType body)--instance ToSchema val => Get (OpenApiHandler m) (JSONBody val) Request where-  {-# INLINE getTrait #-}-  getTrait :: JSONBody val -> OpenApiHandler m (Linked ts Request) (Either Text val)-  getTrait (JSONBody maybeMediaType) = getTrait (Body @val maybeMediaType)+     in OpenApiHandler $ singletonNode (DocResponseBody defs $ fromList [(mediaType, body)]) -instance ToSchema val => Set (OpenApiHandler m) (JSONBody val) Response where+instance Set (OpenApiHandler m) UnknownContentBody Response where   {-# INLINE setTrait #-}   setTrait ::-    JSONBody val ->-    (Linked ts Response -> Response -> t -> Linked (JSONBody val : ts) Response) ->-    OpenApiHandler m (Linked ts Response, t) (Linked (JSONBody val : ts) Response)-  setTrait (JSONBody maybeMediaType) _ =-    let mediaType = fromMaybe "*/*" maybeMediaType-        (defs, ref) = runDeclare (declareSchemaRef $ Proxy @val) mempty-        body = mempty @MediaTypeObject & schema ?~ ref-     in OpenApiHandler $ singletonNode (DocResponseBody defs mediaType body)+    UnknownContentBody ->+    (Response `With` ts -> Response -> ResponseBody -> Response `With` (UnknownContentBody : ts)) ->+    OpenApiHandler m (Response `With` ts, ResponseBody) (Response `With` (UnknownContentBody : ts))+  setTrait UnknownContentBody _ = OpenApiHandler $ singletonNode (DocResponseBody mempty mempty)
+ src/WebGear/OpenApi/Trait/Cookie.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- | OpenApi implementation of 'Cookie' and 'SetCookie' traits.+module WebGear.OpenApi.Trait.Cookie () where++import Data.OpenApi hiding (Response)+import Data.Proxy (Proxy (Proxy))+import Data.String (fromString)+import Data.Text (Text)+import GHC.TypeLits (KnownSymbol, symbolVal)+import WebGear.Core.Request (Request)+import WebGear.Core.Response (Response)+import WebGear.Core.Trait (Get (..), Set (..), Trait, TraitAbsence)+import qualified WebGear.Core.Trait.Cookie as WG+import WebGear.OpenApi.Handler (DocNode (..), OpenApiHandler (..), nullNode, singletonNode)++instance (KnownSymbol name, TraitAbsence (WG.Cookie e name val) Request) => Get (OpenApiHandler m) (WG.Cookie e name val) Request where+  {-# INLINE getTrait #-}+  getTrait WG.Cookie =+    OpenApiHandler $ singletonNode $ DocSecurityScheme cookieName securityScheme+    where+      cookieName = fromString @Text $ symbolVal $ Proxy @name++      securityScheme :: SecurityScheme+      securityScheme =+        SecurityScheme+          { _securitySchemeType =+              SecuritySchemeApiKey+                ApiKeyParams+                  { _apiKeyName = cookieName+                  , _apiKeyIn = ApiKeyCookie+                  }+          , _securitySchemeDescription = Nothing+          }++-- Response cookie information is not captured by OpenAPI++instance (Trait (WG.SetCookie e name) Response) => Set (OpenApiHandler m) (WG.SetCookie e name) Response where+  {-# INLINE setTrait #-}+  setTrait WG.SetCookie _ = OpenApiHandler nullNode
src/WebGear/OpenApi/Trait/Header.hs view
@@ -12,7 +12,7 @@ import WebGear.Core.Modifiers (Existence (..)) import WebGear.Core.Request (Request) import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Get (..), Set (..), Trait, TraitAbsence)+import WebGear.Core.Trait (Get (..), Set (..), TraitAbsence) import qualified WebGear.Core.Trait.Header as WG import WebGear.OpenApi.Handler (DocNode (..), OpenApiHandler (..), nullNode, singletonNode) @@ -30,19 +30,19 @@     & required ?~ isRequired     & schema ?~ Inline (toSchema $ Proxy @val) -instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Required ps name val) Request) => Get (OpenApiHandler m) (WG.Header Required ps name val) Request where+instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.RequestHeader Required ps name val) Request) => Get (OpenApiHandler m) (WG.RequestHeader Required ps name val) Request where   {-# INLINE getTrait #-}-  getTrait WG.Header =+  getTrait WG.RequestHeader =     OpenApiHandler $ singletonNode (DocRequestHeader $ mkParam (Proxy @name) (Proxy @val) True) -instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.Header Optional ps name val) Request) => Get (OpenApiHandler m) (WG.Header Optional ps name val) Request where+instance (KnownSymbol name, ToSchema val, TraitAbsence (WG.RequestHeader Optional ps name val) Request) => Get (OpenApiHandler m) (WG.RequestHeader Optional ps name val) Request where   {-# INLINE getTrait #-}-  getTrait WG.Header =+  getTrait WG.RequestHeader =     OpenApiHandler $ singletonNode (DocRequestHeader $ mkParam (Proxy @name) (Proxy @val) False) -instance (KnownSymbol name, ToSchema val, Trait (WG.Header Required ps name val) Response) => Set (OpenApiHandler m) (WG.Header Required ps name val) Response where+instance (KnownSymbol name, ToSchema val) => Set (OpenApiHandler m) (WG.ResponseHeader Required name val) Response where   {-# INLINE setTrait #-}-  setTrait WG.Header _ =+  setTrait WG.ResponseHeader _ =     let headerName = fromString $ symbolVal $ Proxy @name         header =           mempty @Header@@ -52,9 +52,9 @@           then OpenApiHandler nullNode           else OpenApiHandler $ singletonNode (DocResponseHeader headerName header) -instance (KnownSymbol name, ToSchema val, Trait (WG.Header Optional ps name val) Response) => Set (OpenApiHandler m) (WG.Header Optional ps name val) Response where+instance (KnownSymbol name, ToSchema val) => Set (OpenApiHandler m) (WG.ResponseHeader Optional name val) Response where   {-# INLINE setTrait #-}-  setTrait WG.Header _ =+  setTrait WG.ResponseHeader _ =     let headerName = fromString $ symbolVal $ Proxy @name         header =           mempty @Header
src/WebGear/OpenApi/Trait/Path.hs view
@@ -8,7 +8,7 @@ import Data.String (fromString) import GHC.TypeLits (KnownSymbol, symbolVal) import WebGear.Core.Request (Request)-import WebGear.Core.Trait (Get (..), Linked)+import WebGear.Core.Trait (Get (..), With) import WebGear.Core.Trait.Path (Path (..), PathEnd (..), PathVar (..), PathVarError (..)) import WebGear.OpenApi.Handler (   DocNode (DocPathElem, DocPathVar),@@ -18,12 +18,12 @@  instance Get (OpenApiHandler m) Path Request where   {-# INLINE getTrait #-}-  getTrait :: Path -> OpenApiHandler m (Linked ts Request) (Either () ())+  getTrait :: Path -> OpenApiHandler m (Request `With` ts) (Either () ())   getTrait (Path p) = OpenApiHandler $ singletonNode (DocPathElem p)  instance (KnownSymbol tag, ToSchema val) => Get (OpenApiHandler m) (PathVar tag val) Request where   {-# INLINE getTrait #-}-  getTrait :: PathVar tag val -> OpenApiHandler m (Linked ts Request) (Either PathVarError val)+  getTrait :: PathVar tag val -> OpenApiHandler m (Request `With` ts) (Either PathVarError val)   getTrait PathVar =     let param =           (mempty :: Param)@@ -36,5 +36,5 @@  instance Get (OpenApiHandler m) PathEnd Request where   {-# INLINE getTrait #-}-  getTrait :: PathEnd -> OpenApiHandler m (Linked ts Request) (Either () ())+  getTrait :: PathEnd -> OpenApiHandler m (Request `With` ts) (Either () ())   getTrait PathEnd = OpenApiHandler $ singletonNode (DocPathElem "/")
src/WebGear/OpenApi/Trait/Status.hs view
@@ -5,7 +5,7 @@  import qualified Network.HTTP.Types as HTTP import WebGear.Core.Response (Response)-import WebGear.Core.Trait (Linked, Set, setTrait)+import WebGear.Core.Trait (Set, With, setTrait) import WebGear.Core.Trait.Status (Status (..)) import WebGear.OpenApi.Handler (DocNode (DocStatus), OpenApiHandler (..), singletonNode) @@ -13,6 +13,6 @@   {-# INLINE setTrait #-}   setTrait ::     Status ->-    (Linked ts Response -> Response -> HTTP.Status -> Linked (Status : ts) Response) ->-    OpenApiHandler m (Linked ts Response, HTTP.Status) (Linked (Status : ts) Response)+    (Response `With` ts -> Response -> HTTP.Status -> Response `With` (Status : ts)) ->+    OpenApiHandler m (Response `With` ts, HTTP.Status) (Response `With` (Status : ts))   setTrait (Status status) _ = OpenApiHandler $ singletonNode (DocStatus status)
src/WebGear/OpenApi/Traits.hs view
@@ -8,6 +8,7 @@ import WebGear.OpenApi.Trait.Auth.Basic () import WebGear.OpenApi.Trait.Auth.JWT () import WebGear.OpenApi.Trait.Body ()+import WebGear.OpenApi.Trait.Cookie () import WebGear.OpenApi.Trait.Header () import WebGear.OpenApi.Trait.Method () import WebGear.OpenApi.Trait.Path ()
webgear-openapi.cabal view
@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                webgear-openapi-version:             1.0.5+version:             1.1.0 synopsis:            Composable, type-safe library to build HTTP API servers description:     WebGear is a library to for building composable, type-safe HTTP API servers.@@ -32,6 +32,7 @@                     , WebGear.OpenApi.Trait.Auth.Basic                     , WebGear.OpenApi.Trait.Auth.JWT                     , WebGear.OpenApi.Trait.Body+                    , WebGear.OpenApi.Trait.Cookie                     , WebGear.OpenApi.Trait.Header                     , WebGear.OpenApi.Trait.Method                     , WebGear.OpenApi.Trait.Path@@ -63,6 +64,7 @@                       ScopedTypeVariables                       StandaloneDeriving                       TemplateHaskellQuotes+                      TupleSections                       TypeApplications                       TypeFamilies                       TypeOperators@@ -73,8 +75,8 @@                     , insert-ordered-containers ==0.2.*                     , lens >=4.18.1 && <5.3                     , openapi3 >=3.1.0 && <3.3-                    , text >=1.2.0.0 && <2.1-                    , webgear-core ==1.0.5+                    , text >=1.2.0.0 && <2.2+                    , webgear-core ==1.1.0   ghc-options:        -Wall                       -Wno-unticked-promoted-constructors                       -Wcompat