diff --git a/src/Data/OpenApi.hs b/src/Data/OpenApi.hs
index e8c8ea6e..10d9445f 100644
--- a/src/Data/OpenApi.hs
+++ b/src/Data/OpenApi.hs
@@ -9,127 +9,128 @@
-- These files can then be used by the Swagger-UI project to display the API
-- and Swagger-Codegen to generate clients in various languages.
-- Additional utilities can also take advantage of the resulting files, such as testing tools.
-module Data.OpenApi (
- -- * How to use this library
- -- $howto
+module Data.OpenApi
+ ( -- * How to use this library
+ -- $howto
- -- ** @'Monoid'@ instances
- -- $monoids
+ -- ** @'Monoid'@ instances
+ -- $monoids
- -- ** Lenses and prisms
- -- $lens
+ -- ** Lenses and prisms
+ -- $lens
- -- ** Schema specification
- -- $schema
+ -- ** Schema specification
+ -- $schema
- -- ** Manipulation
- -- $manipulation
+ -- ** Manipulation
+ -- $manipulation
- -- ** Validation
- -- $validation
+ -- ** Validation
+ -- $validation
- -- * Re-exports
- module Data.OpenApi.Lens,
- module Data.OpenApi.Optics,
- module Data.OpenApi.Operation,
- module Data.OpenApi.ParamSchema,
- module Data.OpenApi.Schema,
- module Data.OpenApi.Schema.Validation,
+ -- * Re-exports
+ module Data.OpenApi.Lens,
+ module Data.OpenApi.Optics,
+ module Data.OpenApi.Operation,
+ module Data.OpenApi.ParamSchema,
+ module Data.OpenApi.Schema,
+ module Data.OpenApi.Schema.Validation,
- -- * Swagger specification
- OpenApi(..),
- Server(..),
- ServerVariable(..),
- Components(..),
+ -- * Swagger specification
+ OpenApi (..),
+ Server (..),
+ ServerVariable (..),
+ Components (..),
- -- ** Info types
- Info(..),
- Contact(..),
- License(..),
+ -- ** Info types
+ Info (..),
+ Contact (..),
+ License (..),
- -- ** PathItem
- PathItem(..),
+ -- ** PathItem
+ PathItem (..),
- -- ** Operations
- Operation(..),
- Tag(..),
- TagName,
+ -- ** Operations
+ Operation (..),
+ Tag (..),
+ TagName,
- -- ** Types and formats
- OpenApiType(..),
- Format,
- Definitions,
- Style(..),
+ -- ** Types and formats
+ OpenApiType (..),
+ Format,
+ Definitions,
+ Style (..),
- -- ** Parameters
- Param(..),
- ParamLocation(..),
- ParamName,
- Header(..),
- HeaderName,
- Example(..),
- RequestBody(..),
- MediaTypeObject(..),
- Encoding(..),
+ -- ** Parameters
+ Param (..),
+ ParamLocation (..),
+ ParamName,
+ Header (..),
+ HeaderName,
+ Example (..),
+ RequestBody (..),
+ MediaTypeObject (..),
+ Encoding (..),
- -- ** Schemas
- Schema(..),
- NamedSchema(..),
- OpenApiItems(..),
- Xml(..),
- Pattern,
- AdditionalProperties(..),
- Discriminator(..),
+ -- ** Schemas
+ Schema (..),
+ NamedSchema (..),
+ OpenApiItems (..),
+ Xml (..),
+ Pattern,
+ AdditionalProperties (..),
+ Discriminator (..),
- -- ** Responses
- Responses(..),
- Response(..),
- HttpStatusCode,
- Link(..),
- Callback(..),
+ -- ** Responses
+ Responses (..),
+ Response (..),
+ HttpStatusCode,
+ Link (..),
+ Callback (..),
- -- ** Security
- SecurityScheme(..),
- SecuritySchemeType(..),
- HttpSchemeType(..),
- SecurityDefinitions(..),
- SecurityRequirement(..),
+ -- ** Security
+ SecurityScheme (..),
+ SecuritySchemeType (..),
+ HttpSchemeType (..),
+ SecurityDefinitions (..),
+ SecurityRequirement (..),
- -- *** API key
- ApiKeyParams(..),
- ApiKeyLocation(..),
+ -- *** API key
+ ApiKeyParams (..),
+ ApiKeyLocation (..),
- -- *** OAuth2
- OAuth2Flows(..),
- OAuth2Flow(..),
- OAuth2ImplicitFlow(..),
- OAuth2PasswordFlow(..),
- OAuth2ClientCredentialsFlow(..),
- OAuth2AuthorizationCodeFlow(..),
- AuthorizationURL,
- TokenURL,
+ -- *** OAuth2
+ OAuth2Flows (..),
+ OAuth2Flow (..),
+ OAuth2ImplicitFlow (..),
+ OAuth2PasswordFlow (..),
+ OAuth2ClientCredentialsFlow (..),
+ OAuth2AuthorizationCodeFlow (..),
+ AuthorizationURL,
+ TokenURL,
- -- ** External documentation
- ExternalDocs(..),
+ -- ** External documentation
+ ExternalDocs (..),
- -- ** References
- Reference(..),
- Referenced(..),
+ -- ** References
+ Reference (..),
+ Referenced (..),
- -- ** Miscellaneous
- MimeList(..),
- URL(..),
-) where
+ -- ** Miscellaneous
+ MimeList (..),
+ URL (..),
+ SpecificationExtensions (..),
+ )
+where
+import Data.OpenApi.Internal
import Data.OpenApi.Lens
-import Data.OpenApi.Optics ()
import Data.OpenApi.Operation
+import Data.OpenApi.Optics ()
import Data.OpenApi.ParamSchema
import Data.OpenApi.Schema
import Data.OpenApi.Schema.Validation
-import Data.OpenApi.Internal
-
-- $setup
-- >>> import Control.Lens
-- >>> import Data.Aeson
diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index f6ae8811..87cc06b0 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -13,49 +13,66 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-module Data.OpenApi.Internal where
-import Prelude ()
-import Prelude.Compat
+module Data.OpenApi.Internal where
-import Control.Applicative
-import Control.Lens ((&), (.~), (?~))
-import Data.Aeson hiding (Encoding)
-import qualified Data.Aeson.Types as JSON
-import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
- constrIndex, mkConstr, mkDataType)
-import Data.Hashable (Hashable (..))
-import qualified Data.HashMap.Strict as HashMap
-import Data.HashSet.InsOrd (InsOrdHashSet)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Monoid (Monoid (..))
-import Data.Scientific (Scientific)
-import Data.Semigroup.Compat (Semigroup (..))
-import Data.String (IsString (..))
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Data.Text.Encoding (encodeUtf8)
-import GHC.Generics (Generic)
-import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
- (/:))
-import Network.Socket (HostName, PortNumber)
-import Text.Read (readMaybe)
-
-import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
+import Control.Applicative
+import Control.Lens ((&), (.~), (?~))
+import Data.Aeson hiding (Encoding)
+import qualified Data.Aeson.Types as JSON
+import Data.Data
+ ( Constr,
+ Data (..),
+ DataType,
+ Fixity (..),
+ Typeable,
+ constrIndex,
+ mkConstr,
+ mkDataType,
+ )
+import qualified Data.HashMap.Strict as HashMap
+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
-
-import Generics.SOP.TH (deriveGeneric)
-import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON
- ,sopSwaggerGenericToJSONWithOpts
- ,sopSwaggerGenericParseJSON
- ,HasSwaggerAesonOptions(..)
- ,AesonDefaultValue(..)
- ,mkSwaggerAesonOptions
- ,saoAdditionalPairs
- ,saoSubObject)
+import Data.HashSet.InsOrd (InsOrdHashSet)
+import Data.Hashable (Hashable (..))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
+import Data.Monoid (Monoid (..))
+import Data.OpenApi.Internal.AesonUtils
+ ( AesonDefaultValue (..),
+ HasSwaggerAesonOptions (..),
+ mkSwaggerAesonOptions,
+ saoAdditionalPairs,
+ saoSubObject,
+ sopSwaggerGenericParseJSON,
+ sopSwaggerGenericToEncoding,
+ sopSwaggerGenericToEncodingWithOpts,
+ sopSwaggerGenericToJSON,
+ sopSwaggerGenericToJSONWithOpts,
+ )
import Data.OpenApi.Internal.Utils
-import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)
+import Data.Scientific (Scientific)
+import Data.Semigroup.Compat (Semigroup (..))
+import Data.String (IsString (..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.Text.Encoding (encodeUtf8)
+import GHC.Generics (Generic)
+import Generics.SOP.TH (deriveGeneric)
+import Network.HTTP.Media
+ ( MediaType,
+ mainType,
+ parameters,
+ parseAccept,
+ subType,
+ (//),
+ (/:),
+ )
+import Network.Socket (HostName, PortNumber)
+import Prelude.Compat
+import Text.Read (readMaybe)
+import Prelude ()
-- $setup
-- >>> :seti -XDataKinds
@@ -70,85 +87,83 @@ type Definitions = InsOrdHashMap Text
data OpenApi = OpenApi
{ -- | Provides metadata about the API.
-- The metadata can be used by the clients if needed.
- _openApiInfo :: Info
-
+ _openApiInfo :: Info,
-- | An array of Server Objects, which provide connectivity information
-- to a target server. If the servers property is not provided, or is an empty array,
-- the default value would be a 'Server' object with a url value of @/@.
- , _openApiServers :: [Server]
-
+ _openApiServers :: [Server],
-- | The available paths and operations for the API.
- , _openApiPaths :: InsOrdHashMap FilePath PathItem
-
+ _openApiPaths :: InsOrdHashMap FilePath PathItem,
-- | An element to hold various schemas for the specification.
- , _openApiComponents :: Components
-
+ _openApiComponents :: Components,
-- | A declaration of which security mechanisms can be used across the API.
-- The list of values includes alternative security requirement objects that can be used.
-- Only one of the security requirement objects need to be satisfied to authorize a request.
-- Individual operations can override this definition.
-- To make security optional, an empty security requirement can be included in the array.
- , _openApiSecurity :: [SecurityRequirement]
-
+ _openApiSecurity :: [SecurityRequirement],
-- | A list of tags used by the specification with additional metadata.
-- The order of the tags can be used to reflect on their order by the parsing tools.
-- Not all tags that are used by the 'Operation' Object must be declared.
-- The tags that are not declared MAY be organized randomly or based on the tools' logic.
-- Each tag name in the list MUST be unique.
- , _openApiTags :: InsOrdHashSet Tag
-
+ _openApiTags :: InsOrdHashSet Tag,
-- | Additional external documentation.
- , _openApiExternalDocs :: Maybe ExternalDocs
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _openApiExternalDocs :: Maybe ExternalDocs,
+ -- | Specification Extensions
+ _openApiExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | The object provides metadata about the API.
-- The metadata MAY be used by the clients if needed,
-- and MAY be presented in editing or documentation generation tools for convenience.
data Info = Info
{ -- | The title of the API.
- _infoTitle :: Text
-
+ _infoTitle :: Text,
-- | A short description of the API.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- , _infoDescription :: Maybe Text
-
+ _infoDescription :: Maybe Text,
-- | A URL to the Terms of Service for the API. MUST be in the format of a URL.
- , _infoTermsOfService :: Maybe Text
-
+ _infoTermsOfService :: Maybe Text,
-- | The contact information for the exposed API.
- , _infoContact :: Maybe Contact
-
+ _infoContact :: Maybe Contact,
-- | The license information for the exposed API.
- , _infoLicense :: Maybe License
-
+ _infoLicense :: Maybe License,
-- | The version of the OpenAPI document (which is distinct from the
-- OpenAPI Specification version or the API implementation version).
- , _infoVersion :: Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _infoVersion :: Text,
+ -- | Specification Extensions
+ _infoExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | Contact information for the exposed API.
data Contact = Contact
{ -- | The identifying name of the contact person/organization.
- _contactName :: Maybe Text
-
+ _contactName :: Maybe Text,
-- | The URL pointing to the contact information.
- , _contactUrl :: Maybe URL
-
+ _contactUrl :: Maybe URL,
-- | The email address of the contact person/organization.
- , _contactEmail :: Maybe Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _contactEmail :: Maybe Text,
+ -- | Specification Extensions
+ _contactExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | License information for the exposed API.
data License = License
{ -- | The license name used for the API.
- _licenseName :: Text
-
+ _licenseName :: Text,
-- | A URL to the license used for the API.
- , _licenseUrl :: Maybe URL
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _licenseUrl :: Maybe URL,
+ -- | Specification Extensions
+ _licenseExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
instance IsString License where
- fromString s = License (fromString s) Nothing
+ fromString s = License (fromString s) Nothing mempty
-- | An object representing a Server.
data Server = Server
@@ -156,50 +171,54 @@ data Server = Server
-- to indicate that the host location is relative to the location where
-- the OpenAPI document is being served. Variable substitutions will be made when
-- a variable is named in @{brackets}@.
- _serverUrl :: Text
-
+ _serverUrl :: Text,
-- | An optional string describing the host designated by the URL.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- , _serverDescription :: Maybe Text
-
+ _serverDescription :: Maybe Text,
-- | A map between a variable name and its value.
-- The value is used for substitution in the server's URL template.
- , _serverVariables :: InsOrdHashMap Text ServerVariable
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _serverVariables :: InsOrdHashMap Text ServerVariable,
+ -- | Specification Extensions
+ _serverExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
data ServerVariable = ServerVariable
{ -- | An enumeration of string values to be used if the substitution options
-- are from a limited set. The array SHOULD NOT be empty.
- _serverVariableEnum :: Maybe (InsOrdHashSet Text) -- TODO NonEmpty
+ _serverVariableEnum :: Maybe (InsOrdHashSet Text), -- TODO NonEmpty
-- | The default value to use for substitution, which SHALL be sent if an alternate value
-- is not supplied. Note this behavior is different than the 'Schema\ Object's treatment
-- of default values, because in those cases parameter values are optional.
-- If the '_serverVariableEnum' is defined, the value SHOULD exist in the enum's values.
- , _serverVariableDefault :: Text
-
+ _serverVariableDefault :: Text,
-- | An optional description for the server variable.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- , _serverVariableDescription :: Maybe Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _serverVariableDescription :: Maybe Text,
+ -- | Specification Extensions
+ _serverVariableExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
instance IsString Server where
- fromString s = Server (fromString s) Nothing mempty
+ fromString s = Server (fromString s) Nothing mempty mempty
-- | Holds a set of reusable objects for different aspects of the OAS.
-- All objects defined within the components object will have no effect on the API
-- unless they are explicitly referenced from properties outside the components object.
data Components = Components
- { _componentsSchemas :: Definitions Schema
- , _componentsResponses :: Definitions Response
- , _componentsParameters :: Definitions Param
- , _componentsExamples :: Definitions Example
- , _componentsRequestBodies :: Definitions RequestBody
- , _componentsHeaders :: Definitions Header
- , _componentsSecuritySchemes :: Definitions SecurityScheme
- , _componentsLinks :: Definitions Link
- , _componentsCallbacks :: Definitions Callback
- } deriving (Eq, Show, Generic, Data, Typeable)
+ { _componentsSchemas :: Definitions Schema,
+ _componentsResponses :: Definitions Response,
+ _componentsParameters :: Definitions Param,
+ _componentsExamples :: Definitions Example,
+ _componentsRequestBodies :: Definitions RequestBody,
+ _componentsHeaders :: Definitions Header,
+ _componentsSecuritySchemes :: Definitions SecurityScheme,
+ _componentsLinks :: Definitions Link,
+ _componentsCallbacks :: Definitions Callback
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | Describes the operations available on a single path.
-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -207,110 +226,94 @@ data Components = Components
-- but they will not know which operations and parameters are available.
data PathItem = PathItem
{ -- | An optional, string summary, intended to apply to all operations in this path.
- _pathItemSummary :: Maybe Text
-
+ _pathItemSummary :: Maybe Text,
-- | An optional, string description, intended to apply to all operations in this path.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- , _pathItemDescription :: Maybe Text
-
+ _pathItemDescription :: Maybe Text,
-- | A definition of a GET operation on this path.
- , _pathItemGet :: Maybe Operation
-
+ _pathItemGet :: Maybe Operation,
-- | A definition of a PUT operation on this path.
- , _pathItemPut :: Maybe Operation
-
+ _pathItemPut :: Maybe Operation,
-- | A definition of a POST operation on this path.
- , _pathItemPost :: Maybe Operation
-
+ _pathItemPost :: Maybe Operation,
-- | A definition of a DELETE operation on this path.
- , _pathItemDelete :: Maybe Operation
-
+ _pathItemDelete :: Maybe Operation,
-- | A definition of a OPTIONS operation on this path.
- , _pathItemOptions :: Maybe Operation
-
+ _pathItemOptions :: Maybe Operation,
-- | A definition of a HEAD operation on this path.
- , _pathItemHead :: Maybe Operation
-
+ _pathItemHead :: Maybe Operation,
-- | A definition of a PATCH operation on this path.
- , _pathItemPatch :: Maybe Operation
-
+ _pathItemPatch :: Maybe Operation,
-- | A definition of a TRACE operation on this path.
- , _pathItemTrace :: Maybe Operation
-
+ _pathItemTrace :: Maybe Operation,
-- | An alternative server array to service all operations in this path.
- , _pathItemServers :: [Server]
-
+ _pathItemServers :: [Server],
-- | A list of parameters that are applicable for all the operations described under this path.
-- These parameters can be overridden at the operation level, but cannot be removed there.
-- The list MUST NOT include duplicated parameters.
-- A unique parameter is defined by a combination of a name and location.
- , _pathItemParameters :: [Referenced Param]
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _pathItemParameters :: [Referenced Param],
+ -- | Specification Extensions
+ _pathItemExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | Describes a single API operation on a path.
data Operation = Operation
{ -- | A list of tags for API documentation control.
-- Tags can be used for logical grouping of operations by resources or any other qualifier.
- _operationTags :: InsOrdHashSet TagName
-
+ _operationTags :: InsOrdHashSet TagName,
-- | A short summary of what the operation does.
-- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
- , _operationSummary :: Maybe Text
-
+ _operationSummary :: Maybe Text,
-- | A verbose explanation of the operation behavior.
-- [CommonMark syntax](https://spec.commonmark.org/) can be used for rich text representation.
- , _operationDescription :: Maybe Text
-
+ _operationDescription :: Maybe Text,
-- | Additional external documentation for this operation.
- , _operationExternalDocs :: Maybe ExternalDocs
-
+ _operationExternalDocs :: Maybe ExternalDocs,
-- | Unique string used to identify the operation.
-- The id MUST be unique among all operations described in the API.
-- The operationId value is **case-sensitive**.
-- Tools and libraries MAY use the operationId to uniquely identify an operation, therefore,
-- it is RECOMMENDED to follow common programming naming conventions.
- , _operationOperationId :: Maybe Text
-
+ _operationOperationId :: Maybe Text,
-- | A list of parameters that are applicable for this operation.
-- If a parameter is already defined at the @'PathItem'@,
-- the new definition will override it, but can never remove it.
-- The list MUST NOT include duplicated parameters.
-- A unique parameter is defined by a combination of a name and location.
- , _operationParameters :: [Referenced Param]
-
+ _operationParameters :: [Referenced Param],
-- | The request body applicable for this operation.
-- The requestBody is only supported in HTTP methods where the HTTP 1.1
-- specification [RFC7231](https://tools.ietf.org/html/rfc7231#section-4.3.1)
-- has explicitly defined semantics for request bodies.
-- In other cases where the HTTP spec is vague, requestBody SHALL be ignored by consumers.
- , _operationRequestBody :: Maybe (Referenced RequestBody)
-
+ _operationRequestBody :: Maybe (Referenced RequestBody),
-- | The list of possible responses as they are returned from executing this operation.
- , _operationResponses :: Responses
-
+ _operationResponses :: Responses,
-- | A map of possible out-of band callbacks related to the parent operation.
-- The key is a unique identifier for the 'Callback' Object.
-- Each value in the map is a 'Callback' Object that describes a request
-- that may be initiated by the API provider and the expected responses.
- , _operationCallbacks :: InsOrdHashMap Text (Referenced Callback)
-
+ _operationCallbacks :: InsOrdHashMap Text (Referenced Callback),
-- | Declares this operation to be deprecated.
-- Usage of the declared operation should be refrained.
-- Default value is @False@.
- , _operationDeprecated :: Maybe Bool
-
+ _operationDeprecated :: Maybe Bool,
-- | A declaration of which security schemes are applied for this operation.
-- The list of values describes alternative security schemes that can be used
-- (that is, there is a logical OR between the security requirements).
-- This definition overrides any declared top-level security.
-- To remove a top-level security declaration, @Just []@ can be used.
- , _operationSecurity :: [SecurityRequirement]
-
+ _operationSecurity :: [SecurityRequirement],
-- | An alternative server array to service this operation.
-- If an alternative server object is specified at the 'PathItem' Object or Root level,
-- it will be overridden by this value.
- , _operationServers :: [Server]
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _operationServers :: [Server],
+ -- | Specification Extensions
+ _operationExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- This instance should be in @http-media@.
instance Data MediaType where
@@ -323,6 +326,7 @@ instance Data MediaType where
dataTypeOf _ = mediaTypeData
mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
+
mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
instance Hashable MediaType where
@@ -332,59 +336,60 @@ instance Hashable MediaType where
data RequestBody = RequestBody
{ -- | A brief description of the request body. This could contain examples of use.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- _requestBodyDescription :: Maybe Text
-
+ _requestBodyDescription :: Maybe Text,
-- | The content of the request body.
-- The key is a media type or media type range and the value describes it.
-- For requests that match multiple keys, only the most specific key is applicable.
-- e.g. @text/plain@ overrides @text/*@
- , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
-
+ _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject,
-- | Determines if the request body is required in the request.
-- Defaults to 'False'.
- , _requestBodyRequired :: Maybe Bool
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _requestBodyRequired :: Maybe Bool,
+ -- | Specification Extensions
+ _requestBodyExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | Each Media Type Object provides schema and examples for the media type identified by its key.
data MediaTypeObject = MediaTypeObject
- { _mediaTypeObjectSchema :: Maybe (Referenced Schema)
-
+ { _mediaTypeObjectSchema :: Maybe (Referenced Schema),
-- | Example of the media type.
-- The example object SHOULD be in the correct format as specified by the media type.
- , _mediaTypeObjectExample :: Maybe Value
-
+ _mediaTypeObjectExample :: Maybe Value,
-- | Examples of the media type.
-- Each example object SHOULD match the media type and specified schema if present.
- , _mediaTypeObjectExamples :: InsOrdHashMap Text (Referenced Example)
-
+ _mediaTypeObjectExamples :: InsOrdHashMap Text (Referenced Example),
-- | A map between a property name and its encoding information.
-- The key, being the property name, MUST exist in the schema as a property.
-- The encoding object SHALL only apply to 'RequestBody' objects when the media type
-- is @multipart@ or @application/x-www-form-urlencoded@.
- , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding,
+ -- | Specification Extensions
+ _mediaTypeObjectExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | In order to support common ways of serializing simple parameters, a set of style values are defined.
data Style
- = StyleMatrix
- -- ^ Path-style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
- | StyleLabel
- -- ^ Label style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
- | StyleForm
- -- ^ Form style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
+ = -- | Path-style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
+ StyleMatrix
+ | -- | Label style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
+ StyleLabel
+ | -- | Form style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
-- This option replaces @collectionFormat@ with a @csv@ (when @explode@ is false) or @multi@
-- (when explode is true) value from OpenAPI 2.0.
- | StyleSimple
- -- ^ Simple style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
+ StyleForm
+ | -- | Simple style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
-- This option replaces @collectionFormat@ with a @csv@ value from OpenAPI 2.0.
- | StyleSpaceDelimited
- -- ^ Space separated array values.
+ StyleSimple
+ | -- | Space separated array values.
-- This option replaces @collectionFormat@ equal to @ssv@ from OpenAPI 2.0.
- | StylePipeDelimited
- -- ^ Pipe separated array values.
+ StyleSpaceDelimited
+ | -- | Pipe separated array values.
-- This option replaces @collectionFormat@ equal to @pipes@ from OpenAPI 2.0.
- | StyleDeepObject
- -- ^ Provides a simple way of rendering nested objects using form parameters.
+ StylePipeDelimited
+ | -- | Provides a simple way of rendering nested objects using form parameters.
+ StyleDeepObject
deriving (Eq, Show, Generic, Data, Typeable)
data Encoding = Encoding
@@ -395,21 +400,18 @@ data Encoding = Encoding
-- for array – the default is defined based on the inner type.
-- The value can be a specific media type (e.g. @application/json@),
-- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
- _encodingContentType :: Maybe MediaType
-
+ _encodingContentType :: Maybe MediaType,
-- | A map allowing additional information to be provided as headers,
-- for example @Content-Disposition@. @Content-Type@ is described separately
-- and SHALL be ignored in this section.
-- This property SHALL be ignored if the request body media type is not a @multipart@.
- , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
-
+ _encodingHeaders :: InsOrdHashMap Text (Referenced Header),
-- | Describes how a specific property value will be serialized depending on its type.
-- See 'Param' Object for details on the style property.
-- The behavior follows the same values as query parameters, including default values.
-- This property SHALL be ignored if the request body media type
-- is not @application/x-www-form-urlencoded@.
- , _encodingStyle :: Maybe Style
-
+ _encodingStyle :: Maybe Style,
-- | When this is true, property values of type @array@ or @object@ generate
-- separate parameters for each value of the array,
-- or key-value-pair of the map.
@@ -417,17 +419,19 @@ data Encoding = Encoding
-- When style is form, the default value is @true@. For all other styles,
-- the default value is @false@. This property SHALL be ignored
-- if the request body media type is not @application/x-www-form-urlencoded@.
- , _encodingExplode :: Maybe Bool
-
+ _encodingExplode :: Maybe Bool,
-- | Determines whether the parameter value SHOULD allow reserved characters,
-- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)
-- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.
-- The default value is @false@. This property SHALL be ignored if the request body media type
-- is not @application/x-www-form-urlencoded@.
- , _encodingAllowReserved :: Maybe Bool
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _encodingAllowReserved :: Maybe Bool,
+ -- | Specification Extensions
+ _encodingExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-newtype MimeList = MimeList { getMimeList :: [MediaType] }
+newtype MimeList = MimeList {getMimeList :: [MediaType]}
deriving (Eq, Show, Semigroup, Monoid, Typeable)
mimeListConstr :: Constr
@@ -448,52 +452,42 @@ instance Data MimeList where
data Param = Param
{ -- | The name of the parameter.
-- Parameter names are case sensitive.
- _paramName :: Text
-
+ _paramName :: Text,
-- | A brief description of the parameter.
-- This could contain examples of use.
-- CommonMark syntax MAY be used for rich text representation.
- , _paramDescription :: Maybe Text
-
+ _paramDescription :: Maybe Text,
-- | Determines whether this parameter is mandatory.
-- If the parameter is in "path", this property is required and its value MUST be true.
-- Otherwise, the property MAY be included and its default value is @False@.
- , _paramRequired :: Maybe Bool
-
+ _paramRequired :: Maybe Bool,
-- | Specifies that a parameter is deprecated and SHOULD be transitioned out of usage.
-- Default value is @false@.
- , _paramDeprecated :: Maybe Bool
-
+ _paramDeprecated :: Maybe Bool,
-- | The location of the parameter.
- , _paramIn :: ParamLocation
-
+ _paramIn :: ParamLocation,
-- | Sets the ability to pass empty-valued parameters.
-- This is valid only for 'ParamQuery' parameters and allows sending
-- a parameter with an empty value. Default value is @false@.
- , _paramAllowEmptyValue :: Maybe Bool
-
+ _paramAllowEmptyValue :: Maybe Bool,
-- | Determines whether the parameter value SHOULD allow reserved characters,
-- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)
-- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.
-- This property only applies to parameters with an '_paramIn' value of 'ParamQuery'.
-- The default value is 'False'.
- , _paramAllowReserved :: Maybe Bool
-
+ _paramAllowReserved :: Maybe Bool,
-- | Parameter schema.
- , _paramSchema :: Maybe (Referenced Schema)
-
+ _paramSchema :: Maybe (Referenced Schema),
-- | Describes how the parameter value will be serialized depending
-- on the type of the parameter value. Default values (based on value of '_paramIn'):
-- for 'ParamQuery' - 'StyleForm'; for 'ParamPath' - 'StyleSimple'; for 'ParamHeader' - 'StyleSimple';
-- for 'ParamCookie' - 'StyleForm'.
- , _paramStyle :: Maybe Style
-
+ _paramStyle :: Maybe Style,
-- | When this is true, parameter values of type @array@ or @object@
-- generate separate parameters for each value of the array or key-value pair of the map.
-- For other types of parameters this property has no effect.
-- When style is @form@, the default value is true. For all other styles, the default value is false.
- , _paramExplode :: Maybe Bool
-
+ _paramExplode :: Maybe Bool,
-- | Example of the parameter's potential value.
-- The example SHOULD match the specified schema and encoding properties if present.
-- The '_paramExample' field is mutually exclusive of the '_paramExamples' field.
@@ -501,41 +495,40 @@ data Param = Param
-- SHALL override the example provided by the schema. To represent examples of media types
-- that cannot naturally be represented in JSON or YAML, a string value can contain
-- the example with escaping where necessary.
- , _paramExample :: Maybe Value
-
+ _paramExample :: Maybe Value,
-- | Examples of the parameter's potential value.
-- Each example SHOULD contain a value in the correct format as specified
-- in the parameter encoding. The '_paramExamples' field is mutually exclusive of the '_paramExample' field.
-- Furthermore, if referencing a schema that contains an example,
-- the examples value SHALL override the example provided by the schema.
- , _paramExamples :: InsOrdHashMap Text (Referenced Example)
-
+ _paramExamples :: InsOrdHashMap Text (Referenced Example)
-- TODO
-- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
-- should be singleton. mutually exclusive with _paramSchema.
- } deriving (Eq, Show, Generic, Data, Typeable)
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
data Example = Example
{ -- | Short description for the example.
- _exampleSummary :: Maybe Text
-
+ _exampleSummary :: Maybe Text,
-- | Long description for the example.
-- CommonMark syntax MAY be used for rich text representation.
- , _exampleDescription :: Maybe Text
-
+ _exampleDescription :: Maybe Text,
-- | Embedded literal example.
-- The '_exampleValue' field and '_exampleExternalValue' field are mutually exclusive.
--
-- To represent examples of media types that cannot naturally represented in JSON or YAML,
-- use a string value to contain the example, escaping where necessary.
- , _exampleValue :: Maybe Value
-
+ _exampleValue :: Maybe Value,
-- | A URL that points to the literal example.
-- This provides the capability to reference examples that cannot easily be included
-- in JSON or YAML documents. The '_exampleValue' field
-- and '_exampleExternalValue' field are mutually exclusive.
- , _exampleExternalValue :: Maybe URL
- } deriving (Eq, Show, Generic, Typeable, Data)
+ _exampleExternalValue :: Maybe URL,
+ -- | Specification Extensions
+ _exampleExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Typeable, Data)
data ExpressionOrValue
= Expression Text
@@ -550,28 +543,26 @@ data Link = Link
-- This field is mutually exclusive of the '_linkOperationId' field,
-- and MUST point to an 'Operation' Object. Relative '_linkOperationRef'
-- values MAY be used to locate an existing 'Operation' Object in the OpenAPI definition.
- _linkOperationRef :: Maybe Text
-
+ _linkOperationRef :: Maybe Text,
-- | The name of an /existing/, resolvable OAS operation, as defined with a unique
-- '_operationOperationId'. This field is mutually exclusive of the '_linkOperationRef' field.
- , _linkOperationId :: Maybe Text
-
+ _linkOperationId :: Maybe Text,
-- | A map representing parameters to pass to an operation as specified with '_linkOperationId'
-- or identified via '_linkOperationRef'. The key is the parameter name to be used, whereas
-- the value can be a constant or an expression to be evaluated and passed to the linked operation.
-- The parameter name can be qualified using the parameter location @[{in}.]{name}@
-- for operations that use the same parameter name in different locations (e.g. path.id).
- , _linkParameters :: InsOrdHashMap Text ExpressionOrValue
-
+ _linkParameters :: InsOrdHashMap Text ExpressionOrValue,
-- | A literal value or @{expression}@ to use as a request body when calling the target operation.
- , _linkRequestBody :: Maybe ExpressionOrValue
-
+ _linkRequestBody :: Maybe ExpressionOrValue,
-- | A description of the link.
- , _linkDescription :: Maybe Text
-
+ _linkDescription :: Maybe Text,
-- | A server object to be used by the target operation.
- , _linkServer :: Maybe Server
- } deriving (Eq, Show, Generic, Typeable, Data)
+ _linkServer :: Maybe Server,
+ -- | Specification Extensions
+ _linkExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Typeable, Data)
-- | Items for @'OpenApiArray'@ schemas.
--
@@ -582,32 +573,32 @@ data Link = Link
--
-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
data OpenApiItems where
- OpenApiItemsObject :: Referenced Schema -> OpenApiItems
- OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
+ OpenApiItemsObject :: Referenced Schema -> OpenApiItems
+ OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
deriving (Eq, Show, Typeable, Data)
data OpenApiType where
- OpenApiString :: OpenApiType
- OpenApiNumber :: OpenApiType
- OpenApiInteger :: OpenApiType
- OpenApiBoolean :: OpenApiType
- OpenApiArray :: OpenApiType
- OpenApiNull :: OpenApiType
- OpenApiObject :: OpenApiType
+ OpenApiString :: OpenApiType
+ OpenApiNumber :: OpenApiType
+ OpenApiInteger :: OpenApiType
+ OpenApiBoolean :: OpenApiType
+ OpenApiArray :: OpenApiType
+ OpenApiNull :: OpenApiType
+ OpenApiObject :: OpenApiType
deriving (Eq, Show, Typeable, Generic, Data)
data ParamLocation
= -- | Parameters that are appended to the URL.
-- For example, in @/items?id=###@, the query parameter is @id@.
ParamQuery
- -- | Custom headers that are expected as part of the request.
- | ParamHeader
- -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
+ | -- | Custom headers that are expected as part of the request.
+ ParamHeader
+ | -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
-- This does not include the host or base path of the API.
-- For example, in @/items/{itemId}@, the path parameter is @itemId@.
- | ParamPath
- -- | Used to pass a specific cookie value to the API.
- | ParamCookie
+ ParamPath
+ | -- | Used to pass a specific cookie value to the API.
+ ParamCookie
deriving (Eq, Show, Generic, Data, Typeable)
type Format = Text
@@ -615,70 +606,69 @@ type Format = Text
type ParamName = Text
data Schema = Schema
- { _schemaTitle :: Maybe Text
- , _schemaDescription :: Maybe Text
- , _schemaRequired :: [ParamName]
-
- , _schemaNullable :: Maybe Bool
- , _schemaAllOf :: Maybe [Referenced Schema]
- , _schemaOneOf :: Maybe [Referenced Schema]
- , _schemaNot :: Maybe (Referenced Schema)
- , _schemaAnyOf :: Maybe [Referenced Schema]
- , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
- , _schemaAdditionalProperties :: Maybe AdditionalProperties
-
- , _schemaDiscriminator :: Maybe Discriminator
- , _schemaReadOnly :: Maybe Bool
- , _schemaWriteOnly :: Maybe Bool
- , _schemaXml :: Maybe Xml
- , _schemaExternalDocs :: Maybe ExternalDocs
- , _schemaExample :: Maybe Value
- , _schemaDeprecated :: Maybe Bool
-
- , _schemaMaxProperties :: Maybe Integer
- , _schemaMinProperties :: Maybe Integer
-
- , -- | Declares the value of the parameter that the server will use if none is provided,
+ { _schemaTitle :: Maybe Text,
+ _schemaDescription :: Maybe Text,
+ _schemaRequired :: [ParamName],
+ _schemaNullable :: Maybe Bool,
+ _schemaAllOf :: Maybe [Referenced Schema],
+ _schemaOneOf :: Maybe [Referenced Schema],
+ _schemaNot :: Maybe (Referenced Schema),
+ _schemaAnyOf :: Maybe [Referenced Schema],
+ _schemaProperties :: InsOrdHashMap Text (Referenced Schema),
+ _schemaAdditionalProperties :: Maybe AdditionalProperties,
+ _schemaDiscriminator :: Maybe Discriminator,
+ _schemaReadOnly :: Maybe Bool,
+ _schemaWriteOnly :: Maybe Bool,
+ _schemaXml :: Maybe Xml,
+ _schemaExternalDocs :: Maybe ExternalDocs,
+ _schemaExample :: Maybe Value,
+ _schemaDeprecated :: Maybe Bool,
+ _schemaMaxProperties :: Maybe Integer,
+ _schemaMinProperties :: Maybe Integer,
+ -- | Declares the value of the parameter that the server will use if none is provided,
-- for example a @"count"@ to control the number of results per page might default to @100@
-- if not supplied by the client in the request.
-- (Note: "default" has no meaning for required parameters.)
-- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
- _schemaDefault :: Maybe Value
-
- , _schemaType :: Maybe OpenApiType
- , _schemaFormat :: Maybe Format
- , _schemaItems :: Maybe OpenApiItems
- , _schemaMaximum :: Maybe Scientific
- , _schemaExclusiveMaximum :: Maybe Bool
- , _schemaMinimum :: Maybe Scientific
- , _schemaExclusiveMinimum :: Maybe Bool
- , _schemaMaxLength :: Maybe Integer
- , _schemaMinLength :: Maybe Integer
- , _schemaPattern :: Maybe Pattern
- , _schemaMaxItems :: Maybe Integer
- , _schemaMinItems :: Maybe Integer
- , _schemaUniqueItems :: Maybe Bool
- , _schemaEnum :: Maybe [Value]
- , _schemaMultipleOf :: Maybe Scientific
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _schemaDefault :: Maybe Value,
+ _schemaType :: Maybe OpenApiType,
+ _schemaFormat :: Maybe Format,
+ _schemaItems :: Maybe OpenApiItems,
+ _schemaMaximum :: Maybe Scientific,
+ _schemaExclusiveMaximum :: Maybe Bool,
+ _schemaMinimum :: Maybe Scientific,
+ _schemaExclusiveMinimum :: Maybe Bool,
+ _schemaMaxLength :: Maybe Integer,
+ _schemaMinLength :: Maybe Integer,
+ _schemaPattern :: Maybe Pattern,
+ _schemaMaxItems :: Maybe Integer,
+ _schemaMinItems :: Maybe Integer,
+ _schemaUniqueItems :: Maybe Bool,
+ _schemaEnum :: Maybe [Value],
+ _schemaMultipleOf :: Maybe Scientific,
+ -- | Specification Extensions
+ _schemaExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | Regex pattern for @string@ type.
type Pattern = Text
data Discriminator = Discriminator
{ -- | The name of the property in the payload that will hold the discriminator value.
- _discriminatorPropertyName :: Text
-
+ _discriminatorPropertyName :: Text,
-- | An object to hold mappings between payload values and schema names or references.
- , _discriminatorMapping :: InsOrdHashMap Text Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _discriminatorMapping :: InsOrdHashMap Text Text
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | A @'Schema'@ with an optional name.
-- This name can be used in references.
data NamedSchema = NamedSchema
- { _namedSchemaName :: Maybe Text
- , _namedSchemaSchema :: Schema
- } deriving (Eq, Show, Generic, Data, Typeable)
+ { _namedSchemaName :: Maybe Text,
+ _namedSchemaSchema :: Schema
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
data Xml = Xml
{ -- | Replaces the name of the element/attribute used for the described schema property.
@@ -686,27 +676,26 @@ data Xml = Xml
-- When defined alongside type being array (outside the items),
-- it will affect the wrapping element and only if wrapped is true.
-- If wrapped is false, it will be ignored.
- _xmlName :: Maybe Text
-
+ _xmlName :: Maybe Text,
-- | The URL of the namespace definition.
-- Value SHOULD be in the form of a URL.
- , _xmlNamespace :: Maybe Text
-
+ _xmlNamespace :: Maybe Text,
-- | The prefix to be used for the name.
- , _xmlPrefix :: Maybe Text
-
+ _xmlPrefix :: Maybe Text,
-- | Declares whether the property definition translates to an attribute instead of an element.
-- Default value is @False@.
- , _xmlAttribute :: Maybe Bool
-
+ _xmlAttribute :: Maybe Bool,
-- | MAY be used only for an array definition.
-- Signifies whether the array is wrapped
-- (for example, @\\\\@)
-- or unwrapped (@\\@).
-- Default value is @False@.
-- The definition takes effect only when defined alongside type being array (outside the items).
- , _xmlWrapped :: Maybe Bool
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _xmlWrapped :: Maybe Bool,
+ -- | Specification Extensions
+ _xmlExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | A container for the expected responses of an operation.
-- The container maps a HTTP response code to the expected response.
@@ -716,12 +705,14 @@ data Xml = Xml
data Responses = Responses
{ -- | The documentation of responses other than the ones declared for specific HTTP response codes.
-- It can be used to cover undeclared responses.
- _responsesDefault :: Maybe (Referenced Response)
-
+ _responsesDefault :: Maybe (Referenced Response),
-- | Any HTTP status code can be used as the property name (one property per HTTP status code).
-- Describes the expected response for those HTTP status codes.
- , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response),
+ -- | Specification Extensions
+ _responsesExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
type HttpStatusCode = Int
@@ -729,25 +720,25 @@ type HttpStatusCode = Int
data Response = Response
{ -- | A short description of the response.
-- [CommonMark syntax](https://spec.commonmark.org/) can be used for rich text representation.
- _responseDescription :: Text
-
+ _responseDescription :: Text,
-- | A map containing descriptions of potential response payloads.
-- The key is a media type or media type range and the value describes it.
-- For responses that match multiple keys, only the most specific key is applicable.
-- e.g. @text/plain@ overrides @text/*@.
- , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
-
+ _responseContent :: InsOrdHashMap MediaType MediaTypeObject,
-- | Maps a header name to its definition.
- , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
-
+ _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header),
-- | A map of operations links that can be followed from the response.
-- The key of the map is a short name for the link, following the naming
-- constraints of the names for 'Component' Objects.
- , _responseLinks :: InsOrdHashMap Text (Referenced Link)
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _responseLinks :: InsOrdHashMap Text (Referenced Link),
+ -- | Specification Extensions
+ _responseExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
instance IsString Response where
- fromString s = Response (fromString s) mempty mempty mempty
+ fromString s = Response (fromString s) mempty mempty mempty mempty
-- | A map of possible out-of band callbacks related to the parent operation.
-- Each value in the map is a 'PathItem' Object that describes a set of requests that
@@ -764,17 +755,16 @@ type HeaderName = Text
-- Style is always treated as 'StyleSimple', as it is the only value allowed for headers.
data Header = Header
{ -- | A short description of the header.
- _headerDescription :: Maybe HeaderName
-
- , _headerRequired :: Maybe Bool
- , _headerDeprecated :: Maybe Bool
- , _headerAllowEmptyValue :: Maybe Bool
- , _headerExplode :: Maybe Bool
- , _headerExample :: Maybe Value
- , _headerExamples :: InsOrdHashMap Text (Referenced Example)
-
- , _headerSchema :: Maybe (Referenced Schema)
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _headerDescription :: Maybe HeaderName,
+ _headerRequired :: Maybe Bool,
+ _headerDeprecated :: Maybe Bool,
+ _headerAllowEmptyValue :: Maybe Bool,
+ _headerExplode :: Maybe Bool,
+ _headerExample :: Maybe Value,
+ _headerExamples :: InsOrdHashMap Text (Referenced Example),
+ _headerSchema :: Maybe (Referenced Schema)
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | The location of the API key.
data ApiKeyLocation
@@ -785,11 +775,11 @@ data ApiKeyLocation
data ApiKeyParams = ApiKeyParams
{ -- | The name of the header or query parameter to be used.
- _apiKeyName :: Text
-
+ _apiKeyName :: Text,
-- | The location of the API key.
- , _apiKeyIn :: ApiKeyLocation
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _apiKeyIn :: ApiKeyLocation
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
type AuthorizationURL = Text
@@ -797,48 +787,47 @@ type AuthorizationURL = Text
-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
type TokenURL = Text
-newtype OAuth2ImplicitFlow
- = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
+newtype OAuth2ImplicitFlow = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
deriving (Eq, Show, Generic, Data, Typeable)
-newtype OAuth2PasswordFlow
- = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
+newtype OAuth2PasswordFlow = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
deriving (Eq, Show, Generic, Data, Typeable)
-newtype OAuth2ClientCredentialsFlow
- = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
+newtype OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
deriving (Eq, Show, Generic, Data, Typeable)
data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
- { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
- , _oAuth2AuthorizationCodeFlowTokenUrl :: TokenURL
- } deriving (Eq, Show, Generic, Data, Typeable)
+ { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL,
+ _oAuth2AuthorizationCodeFlowTokenUrl :: TokenURL
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
data OAuth2Flow p = OAuth2Flow
- { _oAuth2Params :: p
-
+ { _oAuth2Params :: p,
-- | The URL to be used for obtaining refresh tokens.
- , _oAath2RefreshUrl :: Maybe URL
-
+ _oAath2RefreshUrl :: Maybe URL,
-- | The available scopes for the OAuth2 security scheme.
-- A map between the scope name and a short description for it.
-- The map MAY be empty.
- , _oAuth2Scopes :: InsOrdHashMap Text Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _oAuth2Scopes :: InsOrdHashMap Text Text,
+ -- | Specification Extensions
+ _oAuth2Extensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
data OAuth2Flows = OAuth2Flows
{ -- | Configuration for the OAuth Implicit flow
- _oAuth2FlowsImplicit :: Maybe (OAuth2Flow OAuth2ImplicitFlow)
-
+ _oAuth2FlowsImplicit :: Maybe (OAuth2Flow OAuth2ImplicitFlow),
-- | Configuration for the OAuth Resource Owner Password flow
- , _oAuth2FlowsPassword :: Maybe (OAuth2Flow OAuth2PasswordFlow)
-
+ _oAuth2FlowsPassword :: Maybe (OAuth2Flow OAuth2PasswordFlow),
-- | Configuration for the OAuth Client Credentials flow
- , _oAuth2FlowsClientCredentials :: Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
-
+ _oAuth2FlowsClientCredentials :: Maybe (OAuth2Flow OAuth2ClientCredentialsFlow),
-- | Configuration for the OAuth Authorization Code flow
- , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow),
+ -- | Specification Extensions
+ _oAuth2FlowsExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
type BearerFormat = Text
@@ -881,7 +870,6 @@ data HttpSchemeType
-- "name": "id",
-- "type": "apiKey"
-- }
---
data SecuritySchemeType
= SecuritySchemeHttp HttpSchemeType
| SecuritySchemeApiKey ApiKeyParams
@@ -891,11 +879,13 @@ data SecuritySchemeType
data SecurityScheme = SecurityScheme
{ -- | The type of the security scheme.
- _securitySchemeType :: SecuritySchemeType
-
+ _securitySchemeType :: SecuritySchemeType,
-- | A short description for security scheme.
- , _securitySchemeDescription :: Maybe Text
- } deriving (Eq, Show, Generic, Data, Typeable)
+ _securitySchemeDescription :: Maybe Text,
+ -- | Specification Extensions
+ _securitySchemeExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
newtype SecurityDefinitions
= SecurityDefinitions (Definitions SecurityScheme)
@@ -906,7 +896,8 @@ newtype SecurityDefinitions
-- (that is, there is a logical AND between the schemes).
newtype SecurityRequirement = SecurityRequirement
{ getSecurityRequirement :: InsOrdHashMap Text [Text]
- } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
+ }
+ deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
-- | Tag name.
type TagName = Text
@@ -915,36 +906,39 @@ type TagName = Text
-- It is not mandatory to have a @Tag@ per tag used there.
data Tag = Tag
{ -- | The name of the tag.
- _tagName :: TagName
-
+ _tagName :: TagName,
-- | A short description for the tag.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- , _tagDescription :: Maybe Text
-
+ _tagDescription :: Maybe Text,
-- | Additional external documentation for this tag.
- , _tagExternalDocs :: Maybe ExternalDocs
- } deriving (Eq, Ord, Show, Generic, Data, Typeable)
+ _tagExternalDocs :: Maybe ExternalDocs,
+ -- | Specification Extensions
+ _tagExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
instance Hashable Tag
instance IsString Tag where
- fromString s = Tag (fromString s) Nothing Nothing
+ fromString s = Tag (fromString s) Nothing Nothing mempty
-- | Allows referencing an external resource for extended documentation.
data ExternalDocs = ExternalDocs
{ -- | A short description of the target documentation.
-- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
- _externalDocsDescription :: Maybe Text
-
+ _externalDocsDescription :: Maybe Text,
-- | The URL for the target documentation.
- , _externalDocsUrl :: URL
- } deriving (Eq, Ord, Show, Generic, Data, Typeable)
+ _externalDocsUrl :: URL,
+ -- | Specification Extensions
+ _externalDocsExtensions :: SpecificationExtensions
+ }
+ deriving (Eq, Show, Generic, Data, Typeable)
instance Hashable ExternalDocs
-- | A simple object to allow referencing other definitions in the specification.
-- It can be used to reference parameters and responses that are defined at the top level for reuse.
-newtype Reference = Reference { getReference :: Text }
+newtype Reference = Reference {getReference :: Text}
deriving (Eq, Show, Data, Typeable)
data Referenced a
@@ -955,13 +949,16 @@ data Referenced a
instance IsString a => IsString (Referenced a) where
fromString = Inline . fromString
-newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
+newtype URL = URL {getUrl :: Text} deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable, AesonDefaultValue)
data AdditionalProperties
= AdditionalPropertiesAllowed Bool
| AdditionalPropertiesSchema (Referenced Schema)
deriving (Eq, Show, Data, Typeable)
+newtype SpecificationExtensions = SpecificationExtensions {getSpecificationExtensions :: Definitions Value}
+ deriving (Eq, Show, Hashable, Data, Typeable, Semigroup, Monoid, SwaggerMonoid, AesonDefaultValue)
+
-------------------------------------------------------------------------------
-- Generic instances
-------------------------------------------------------------------------------
@@ -984,6 +981,13 @@ deriveGeneric ''OpenApi
deriveGeneric ''Example
deriveGeneric ''Encoding
deriveGeneric ''Link
+deriveGeneric ''Info
+deriveGeneric ''Contact
+deriveGeneric ''License
+deriveGeneric ''ServerVariable
+deriveGeneric ''Tag
+deriveGeneric ''Xml
+deriveGeneric ''ExternalDocs
-- =======================================================================
-- Monoid instances
@@ -991,115 +995,131 @@ deriveGeneric ''Link
instance Semigroup OpenApi where
(<>) = genericMappend
+
instance Monoid OpenApi where
mempty = genericMempty
mappend = (<>)
instance Semigroup Info where
(<>) = genericMappend
+
instance Monoid Info where
mempty = genericMempty
mappend = (<>)
instance Semigroup Contact where
(<>) = genericMappend
+
instance Monoid Contact where
mempty = genericMempty
mappend = (<>)
instance Semigroup Components where
(<>) = genericMappend
+
instance Monoid Components where
mempty = genericMempty
mappend = (<>)
instance Semigroup PathItem where
(<>) = genericMappend
+
instance Monoid PathItem where
mempty = genericMempty
mappend = (<>)
instance Semigroup Schema where
(<>) = genericMappend
+
instance Monoid Schema where
mempty = genericMempty
mappend = (<>)
instance Semigroup Param where
(<>) = genericMappend
+
instance Monoid Param where
mempty = genericMempty
mappend = (<>)
instance Semigroup Header where
(<>) = genericMappend
+
instance Monoid Header where
mempty = genericMempty
mappend = (<>)
instance Semigroup Responses where
(<>) = genericMappend
+
instance Monoid Responses where
mempty = genericMempty
mappend = (<>)
instance Semigroup Response where
(<>) = genericMappend
+
instance Monoid Response where
mempty = genericMempty
mappend = (<>)
instance Semigroup MediaTypeObject where
(<>) = genericMappend
+
instance Monoid MediaTypeObject where
mempty = genericMempty
mappend = (<>)
instance Semigroup Encoding where
(<>) = genericMappend
+
instance Monoid Encoding where
mempty = genericMempty
mappend = (<>)
instance Semigroup ExternalDocs where
(<>) = genericMappend
+
instance Monoid ExternalDocs where
mempty = genericMempty
mappend = (<>)
instance Semigroup Operation where
(<>) = genericMappend
+
instance Monoid Operation where
mempty = genericMempty
mappend = (<>)
instance Semigroup (OAuth2Flow p) where
- l@OAuth2Flow{ _oAath2RefreshUrl = lUrl, _oAuth2Scopes = lScopes }
- <> OAuth2Flow { _oAath2RefreshUrl = rUrl, _oAuth2Scopes = rScopes } =
- l { _oAath2RefreshUrl = swaggerMappend lUrl rUrl, _oAuth2Scopes = lScopes <> rScopes }
+ l@OAuth2Flow {_oAath2RefreshUrl = lUrl, _oAuth2Scopes = lScopes}
+ <> OAuth2Flow {_oAath2RefreshUrl = rUrl, _oAuth2Scopes = rScopes} =
+ l {_oAath2RefreshUrl = swaggerMappend lUrl rUrl, _oAuth2Scopes = lScopes <> rScopes}
-- swaggerMappend has First-like semantics, and here we need mappend'ing under Maybes.
instance Semigroup OAuth2Flows where
- l <> r = OAuth2Flows
- { _oAuth2FlowsImplicit = _oAuth2FlowsImplicit l <> _oAuth2FlowsImplicit r
- , _oAuth2FlowsPassword = _oAuth2FlowsPassword l <> _oAuth2FlowsPassword r
- , _oAuth2FlowsClientCredentials = _oAuth2FlowsClientCredentials l <> _oAuth2FlowsClientCredentials r
- , _oAuth2FlowsAuthorizationCode = _oAuth2FlowsAuthorizationCode l <> _oAuth2FlowsAuthorizationCode r
- }
+ l <> r =
+ OAuth2Flows
+ { _oAuth2FlowsImplicit = _oAuth2FlowsImplicit l <> _oAuth2FlowsImplicit r,
+ _oAuth2FlowsPassword = _oAuth2FlowsPassword l <> _oAuth2FlowsPassword r,
+ _oAuth2FlowsClientCredentials = _oAuth2FlowsClientCredentials l <> _oAuth2FlowsClientCredentials r,
+ _oAuth2FlowsAuthorizationCode = _oAuth2FlowsAuthorizationCode l <> _oAuth2FlowsAuthorizationCode r,
+ _oAuth2FlowsExtensions = _oAuth2FlowsExtensions l <> _oAuth2FlowsExtensions r
+ }
instance Monoid OAuth2Flows where
mempty = genericMempty
mappend = (<>)
instance Semigroup SecurityScheme where
- SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc
- <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc =
- SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc)
+ SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc lExt
+ <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc rExt =
+ SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc) (lExt <> rExt)
l <> _ = l
instance Semigroup SecurityDefinitions where
(SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
- SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
+ SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
instance Monoid SecurityDefinitions where
mempty = SecurityDefinitions InsOrdHashMap.empty
@@ -1107,6 +1127,7 @@ instance Monoid SecurityDefinitions where
instance Semigroup RequestBody where
(<>) = genericMappend
+
instance Monoid RequestBody where
mempty = genericMempty
mappend = (<>)
@@ -1116,17 +1137,27 @@ instance Monoid RequestBody where
-- =======================================================================
instance SwaggerMonoid Info
+
instance SwaggerMonoid Components
+
instance SwaggerMonoid PathItem
+
instance SwaggerMonoid Schema
+
instance SwaggerMonoid Param
+
instance SwaggerMonoid Responses
+
instance SwaggerMonoid Response
+
instance SwaggerMonoid ExternalDocs
+
instance SwaggerMonoid Operation
+
instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
instance SwaggerMonoid MimeList
+
deriving instance SwaggerMonoid URL
instance SwaggerMonoid OpenApiType where
@@ -1159,33 +1190,12 @@ instance ToJSON OpenApiType where
instance ToJSON ParamLocation where
toJSON = genericToJSON (jsonPrefix "Param")
-instance ToJSON Info where
- toJSON = genericToJSON (jsonPrefix "Info")
-
-instance ToJSON Contact where
- toJSON = genericToJSON (jsonPrefix "Contact")
-
-instance ToJSON License where
- toJSON = genericToJSON (jsonPrefix "License")
-
-instance ToJSON ServerVariable where
- toJSON = genericToJSON (jsonPrefix "ServerVariable")
-
instance ToJSON ApiKeyLocation where
toJSON = genericToJSON (jsonPrefix "ApiKey")
instance ToJSON ApiKeyParams where
toJSON = genericToJSON (jsonPrefix "apiKey")
-instance ToJSON Tag where
- toJSON = genericToJSON (jsonPrefix "Tag")
-
-instance ToJSON ExternalDocs where
- toJSON = genericToJSON (jsonPrefix "ExternalDocs")
-
-instance ToJSON Xml where
- toJSON = genericToJSON (jsonPrefix "Xml")
-
instance ToJSON Discriminator where
toJSON = genericToJSON (jsonPrefix "Discriminator")
@@ -1214,30 +1224,12 @@ instance FromJSON OpenApiType where
instance FromJSON ParamLocation where
parseJSON = genericParseJSON (jsonPrefix "Param")
-instance FromJSON Info where
- parseJSON = genericParseJSON (jsonPrefix "Info")
-
-instance FromJSON Contact where
- parseJSON = genericParseJSON (jsonPrefix "Contact")
-
-instance FromJSON License where
- parseJSON = genericParseJSON (jsonPrefix "License")
-
-instance FromJSON ServerVariable where
- parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
-
instance FromJSON ApiKeyLocation where
parseJSON = genericParseJSON (jsonPrefix "ApiKey")
instance FromJSON ApiKeyParams where
parseJSON = genericParseJSON (jsonPrefix "apiKey")
-instance FromJSON Tag where
- parseJSON = genericParseJSON (jsonPrefix "Tag")
-
-instance FromJSON ExternalDocs where
- parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
-
instance FromJSON Discriminator where
parseJSON = genericParseJSON (jsonPrefix "Discriminator")
@@ -1275,47 +1267,74 @@ instance ToJSON OAuth2Flows where
instance ToJSON SecuritySchemeType where
toJSON (SecuritySchemeHttp ty) = case ty of
HttpSchemeBearer mFmt ->
- object $ [ "type" .= ("http" :: Text)
- , "scheme" .= ("bearer" :: Text)
- ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
+ object $
+ [ "type" .= ("http" :: Text),
+ "scheme" .= ("bearer" :: Text)
+ ]
+ <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
HttpSchemeBasic ->
- object [ "type" .= ("http" :: Text)
- , "scheme" .= ("basic" :: Text)
- ]
+ object
+ [ "type" .= ("http" :: Text),
+ "scheme" .= ("basic" :: Text)
+ ]
HttpSchemeCustom t ->
- object [ "type" .= ("http" :: Text)
- , "scheme" .= t
- ]
- toJSON (SecuritySchemeApiKey params)
- = toJSON params
- <+> object [ "type" .= ("apiKey" :: Text) ]
- toJSON (SecuritySchemeOAuth2 params) = object
- [ "type" .= ("oauth2" :: Text)
- , "flows" .= toJSON params
- ]
- toJSON (SecuritySchemeOpenIdConnect url) = object
- [ "type" .= ("openIdConnect" :: Text)
- , "openIdConnectUrl" .= url
- ]
+ object
+ [ "type" .= ("http" :: Text),
+ "scheme" .= t
+ ]
+ toJSON (SecuritySchemeApiKey params) =
+ toJSON params
+ <+> object ["type" .= ("apiKey" :: Text)]
+ toJSON (SecuritySchemeOAuth2 params) =
+ object
+ [ "type" .= ("oauth2" :: Text),
+ "flows" .= toJSON params
+ ]
+ toJSON (SecuritySchemeOpenIdConnect url) =
+ object
+ [ "type" .= ("openIdConnect" :: Text),
+ "openIdConnectUrl" .= url
+ ]
instance ToJSON OpenApi where
- toJSON a = sopSwaggerGenericToJSON a &
- if InsOrdHashMap.null (_openApiPaths a)
- then (<+> object ["paths" .= object []])
- else id
+ toJSON a =
+ sopSwaggerGenericToJSON a
+ & if InsOrdHashMap.null (_openApiPaths a)
+ then (<+> object ["paths" .= object []])
+ else id
+ toEncoding = sopSwaggerGenericToEncoding
+
+instance ToJSON Info where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
+instance ToJSON Contact where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
+instance ToJSON License where
+ toJSON = sopSwaggerGenericToJSON
toEncoding = sopSwaggerGenericToEncoding
instance ToJSON Server where
toJSON = sopSwaggerGenericToJSON
toEncoding = sopSwaggerGenericToEncoding
+instance ToJSON ServerVariable where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
instance ToJSON SecurityScheme where
toJSON = sopSwaggerGenericToJSON
toEncoding = sopSwaggerGenericToEncoding
instance ToJSON Schema where
- toJSON = sopSwaggerGenericToJSONWithOpts $
- mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
+ toJSON =
+ sopSwaggerGenericToJSONWithOpts $
+ mkSwaggerAesonOptions "schema" & saoSubObject .~ ["items", "extensions"]
+ toEncoding =
+ sopSwaggerGenericToEncodingWithOpts $
+ mkSwaggerAesonOptions "schema" & saoSubObject .~ ["items", "extensions"]
instance ToJSON Header where
toJSON = sopSwaggerGenericToJSON
@@ -1330,15 +1349,15 @@ instance ToJSON Header where
-- "items": {},
-- "maxItems": 0
-- }
---
instance ToJSON OpenApiItems where
- toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
- toJSON (OpenApiItemsArray []) = object
- [ "items" .= object []
- , "maxItems" .= (0 :: Int)
- , "example" .= Array mempty
- ]
- toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
+ toJSON (OpenApiItemsObject x) = object ["items" .= x]
+ toJSON (OpenApiItemsArray []) =
+ object
+ [ "items" .= object [],
+ "maxItems" .= (0 :: Int),
+ "example" .= Array mempty
+ ]
+ toJSON (OpenApiItemsArray x) = object ["items" .= x]
instance ToJSON Components where
toJSON = sopSwaggerGenericToJSON
@@ -1387,23 +1406,51 @@ instance ToJSON Link where
toJSON = sopSwaggerGenericToJSON
toEncoding = sopSwaggerGenericToEncoding
+instance ToJSON Tag where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
+instance ToJSON Xml where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
+instance ToJSON ExternalDocs where
+ toJSON = sopSwaggerGenericToJSON
+ toEncoding = sopSwaggerGenericToEncoding
+
instance ToJSON SecurityDefinitions where
toJSON (SecurityDefinitions sd) = toJSON sd
instance ToJSON Reference where
- toJSON (Reference ref) = object [ "$ref" .= ref ]
+ toJSON (Reference ref) = object ["$ref" .= ref]
+ toEncoding (Reference ref) = pairs ("$ref" .= ref)
referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
-referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
+referencedToJSON prefix (Ref (Reference ref)) = object ["$ref" .= (prefix <> ref)]
referencedToJSON _ (Inline x) = toJSON x
-instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/components/schemas/"
-instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/components/parameters/"
+referencedToEncoding :: ToJSON a => Text -> Referenced a -> JSON.Encoding
+referencedToEncoding prefix (Ref (Reference ref)) = pairs ("$ref" .= (prefix <> ref))
+referencedToEncoding _ (Inline x) = toEncoding x
+
+instance ToJSON (Referenced Schema) where
+ toJSON = referencedToJSON "#/components/schemas/"
+ toEncoding = referencedToEncoding "#/components/schemas/"
+
+instance ToJSON (Referenced RequestBody) where
+ toJSON = referencedToJSON "#/components/requestBodies/"
+ toEncoding = referencedToEncoding "#/components/requestBodies/"
+
+instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/components/parameters/"
+
instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/components/responses/"
-instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
-instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
-instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
-instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
+
+instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
+
+instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
+
+instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
+
instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
instance ToJSON AdditionalProperties where
@@ -1417,6 +1464,11 @@ instance ToJSON ExpressionOrValue where
instance ToJSON Callback where
toJSON (Callback ps) = toJSON ps
+instance ToJSON SpecificationExtensions where
+ toJSON = toJSON . addExtPrefix . getSpecificationExtensions
+ where
+ addExtPrefix = InsOrdHashMap.mapKeys ("x-" <>)
+
-- =======================================================================
-- Manual FromJSON instances
-- =======================================================================
@@ -1438,12 +1490,12 @@ instance FromJSON SecuritySchemeType where
parseJSON js@(Object o) = do
(t :: Text) <- o .: "type"
case t of
- "http" -> do
- scheme <- o .: "scheme"
- SecuritySchemeHttp <$> case scheme of
- "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
- "basic" -> pure HttpSchemeBasic
- t -> pure $ HttpSchemeCustom t
+ "http" -> do
+ scheme <- o .: "scheme"
+ SecuritySchemeHttp <$> case scheme of
+ "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
+ "basic" -> pure HttpSchemeBasic
+ t -> pure $ HttpSchemeCustom t
"apiKey" -> SecuritySchemeApiKey <$> parseJSON js
"oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
"openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
@@ -1453,30 +1505,45 @@ instance FromJSON SecuritySchemeType where
instance FromJSON OpenApi where
parseJSON = sopSwaggerGenericParseJSON
+instance FromJSON Info where
+ parseJSON = sopSwaggerGenericParseJSON
+
+instance FromJSON Contact where
+ parseJSON = sopSwaggerGenericParseJSON
+
+instance FromJSON License where
+ parseJSON = sopSwaggerGenericParseJSON
+
instance FromJSON Server where
parseJSON = sopSwaggerGenericParseJSON
+instance FromJSON ServerVariable where
+ parseJSON = sopSwaggerGenericParseJSON
+
instance FromJSON SecurityScheme where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Schema where
parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
- where nullaryCleanup :: Schema -> Schema
- nullaryCleanup s =
- if _schemaItems s == Just (OpenApiItemsArray [])
- then s { _schemaExample = Nothing
- , _schemaMaxItems = Nothing
- }
- else s
+ where
+ nullaryCleanup :: Schema -> Schema
+ nullaryCleanup s =
+ if _schemaItems s == Just (OpenApiItemsArray [])
+ then
+ s
+ { _schemaExample = Nothing,
+ _schemaMaxItems = Nothing
+ }
+ else s
instance FromJSON Header where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON OpenApiItems where
parseJSON js@(Object obj)
- | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
- | otherwise = OpenApiItemsObject <$> parseJSON js
- parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
+ | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
+ | otherwise = OpenApiItemsObject <$> parseJSON js
+ parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
parseJSON _ = empty
instance FromJSON Components where
@@ -1489,11 +1556,24 @@ instance FromJSON Param where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Responses where
- parseJSON (Object o) = Responses
- <$> o .:? "default"
- <*> parseJSON (Object (HashMap.delete "default" o))
+ parseJSON (Object o) =
+ Responses
+ <$> o .:? "default"
+ <*> parseJSON
+ ( Object
+ ( HashMap.filterWithKey (\k _ -> not $ isExt k) $
+ HashMap.delete "default" o
+ )
+ )
+ <*> case HashMap.filterWithKey (\k _ -> isExt k) o of
+ exts
+ | HashMap.null exts -> pure (SpecificationExtensions mempty)
+ | otherwise -> parseJSON (Object exts)
parseJSON _ = empty
+isExt :: Text -> Bool
+isExt = Text.isPrefixOf "x-"
+
instance FromJSON Example where
parseJSON = sopSwaggerGenericParseJSON
@@ -1521,6 +1601,15 @@ instance FromJSON Encoding where
instance FromJSON Link where
parseJSON = sopSwaggerGenericParseJSON
+instance FromJSON Tag where
+ parseJSON = sopSwaggerGenericParseJSON
+
+instance FromJSON Xml where
+ parseJSON = sopSwaggerGenericParseJSON
+
+instance FromJSON ExternalDocs where
+ parseJSON = sopSwaggerGenericParseJSON
+
instance FromJSON Reference where
parseJSON (Object o) = Reference <$> o .: "$ref"
parseJSON _ = empty
@@ -1530,25 +1619,29 @@ referencedParseJSON prefix js@(Object o) = do
ms <- o .:? "$ref"
case ms of
Nothing -> Inline <$> parseJSON js
- Just s -> Ref <$> parseRef s
+ Just s -> Ref <$> parseRef s
where
parseRef s = do
case Text.stripPrefix prefix s of
- Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
+ Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
Just suffix -> pure (Reference suffix)
referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
-instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/components/schemas/"
-instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/components/parameters/"
+instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/components/schemas/"
+
+instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/components/parameters/"
+
instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/components/responses/"
+
instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
-instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
-instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
-instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"
-instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
-instance FromJSON Xml where
- parseJSON = genericParseJSON (jsonPrefix "xml")
+instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
+
+instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
+
+instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"
+
+instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
instance FromJSON AdditionalProperties where
parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
@@ -1562,55 +1655,113 @@ instance FromJSON ExpressionOrValue where
instance FromJSON Callback where
parseJSON = fmap Callback . parseJSON
+instance FromJSON SpecificationExtensions where
+ parseJSON = withObject "SpecificationExtensions" extFieldsParser
+ where
+ extFieldsParser = pure . SpecificationExtensions . InsOrdHashMap.fromList . catMaybes . filterExtFields
+ filterExtFields = fmap (\(k, v) -> fmap (\k' -> (k', v)) $ Text.stripPrefix "x-" k) . HashMap.toList
+
instance HasSwaggerAesonOptions Server where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "server" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Components where
swaggerAesonOptions _ = mkSwaggerAesonOptions "components"
+
instance HasSwaggerAesonOptions Header where
swaggerAesonOptions _ = mkSwaggerAesonOptions "header"
+
instance AesonDefaultValue p => HasSwaggerAesonOptions (OAuth2Flow p) where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "params"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject .~ ["params", "extensions"]
+
instance HasSwaggerAesonOptions OAuth2Flows where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Operation where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "operation" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Param where
swaggerAesonOptions _ = mkSwaggerAesonOptions "param"
+
instance HasSwaggerAesonOptions PathItem where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Response where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "response" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions RequestBody where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "requestBody"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "requestBody" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions MediaTypeObject where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "mediaTypeObject"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "mediaTypeObject" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Responses where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject .~ ["responses", "extensions"]
+
instance HasSwaggerAesonOptions SecurityScheme where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject .~ ["type", "extensions"]
+
instance HasSwaggerAesonOptions Schema where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject .~ ["paramSchema", "extensions"]
+
instance HasSwaggerAesonOptions OpenApi where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
+ swaggerAesonOptions _ =
+ mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
+ & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Example where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "example" & saoSubObject .~ ["extensions"]
+
instance HasSwaggerAesonOptions Encoding where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding" & saoSubObject .~ ["extensions"]
instance HasSwaggerAesonOptions Link where
- swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "link" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Info where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "info" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Contact where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "contact" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions License where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "license" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions ServerVariable where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "serverVariable" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Tag where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "tag" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Xml where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "xml" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions ExternalDocs where
+ swaggerAesonOptions _ = mkSwaggerAesonOptions "externalDocs" & saoSubObject .~ ["extensions"]
instance AesonDefaultValue Server
+
instance AesonDefaultValue Components
+
instance AesonDefaultValue OAuth2ImplicitFlow
+
instance AesonDefaultValue OAuth2PasswordFlow
+
instance AesonDefaultValue OAuth2ClientCredentialsFlow
+
instance AesonDefaultValue OAuth2AuthorizationCodeFlow
+
instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
+
instance AesonDefaultValue Responses
+
instance AesonDefaultValue SecuritySchemeType
+
instance AesonDefaultValue OpenApiType
+
instance AesonDefaultValue MimeList where defaultValue = Just mempty
+
instance AesonDefaultValue Info
+
instance AesonDefaultValue ParamLocation
+
instance AesonDefaultValue Link
diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs
index 98e1ce06..5ee84b8e 100644
--- a/src/Data/OpenApi/Internal/AesonUtils.hs
+++ b/src/Data/OpenApi/Internal/AesonUtils.hs
@@ -11,6 +11,7 @@ module Data.OpenApi.Internal.AesonUtils (
sopSwaggerGenericToJSON,
sopSwaggerGenericToEncoding,
sopSwaggerGenericToJSONWithOpts,
+ sopSwaggerGenericToEncodingWithOpts,
sopSwaggerGenericParseJSON,
-- * Options
HasSwaggerAesonOptions(..),
@@ -48,13 +49,13 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
data SwaggerAesonOptions = SwaggerAesonOptions
{ _saoPrefix :: String
, _saoAdditionalPairs :: [(Text, Value)]
- , _saoSubObject :: Maybe String
+ , _saoSubObject :: [String]
}
mkSwaggerAesonOptions
:: String -- ^ prefix
-> SwaggerAesonOptions
-mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] Nothing
+mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] []
makeLenses ''SwaggerAesonOptions
@@ -153,7 +154,7 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
go Nil Nil Nil = []
go (I x :* xs) (FieldInfo name :* names) (def :* defs)
- | Just name' == sub = case json of
+ | name' `elem` sub = case json of
Object m -> HM.toList m ++ rest
Null -> rest
_ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
@@ -226,7 +227,7 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
go :: (All FromJSON ys, All Eq ys) => NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
go Nil Nil = pure Nil
go (FieldInfo name :* names) (def :* defs)
- | Just name' == sub =
+ | name' `elem` sub =
-- Note: we might strip fields of outer structure.
cons <$> (withDef $ parseJSON $ Object obj) <*> rest
| otherwise = case def of
@@ -267,6 +268,24 @@ sopSwaggerGenericToEncoding x =
proxy = Proxy :: Proxy a
opts = swaggerAesonOptions proxy
+sopSwaggerGenericToEncodingWithOpts
+ :: forall a xs.
+ ( HasDatatypeInfo a
+ , HasSwaggerAesonOptions a
+ , All2 ToJSON (Code a)
+ , All2 Eq (Code a)
+ , Code a ~ '[xs]
+ )
+ => SwaggerAesonOptions
+ -> a
+ -> Encoding
+sopSwaggerGenericToEncodingWithOpts opts x =
+ let ps = sopSwaggerGenericToEncoding' opts (from x) (datatypeInfo proxy) defs
+ in pairs (pairsToSeries (opts ^. saoAdditionalPairs) <> ps)
+ where
+ proxy = Proxy :: Proxy a
+ defs = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue
+
pairsToSeries :: [Pair] -> Series
pairsToSeries = foldMap (\(k, v) -> (k .= v))
@@ -293,7 +312,7 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
go Nil Nil Nil = mempty
go (I x :* xs) (FieldInfo name :* names) (def :* defs)
- | Just name' == sub = case toJSON x of
+ | name' `elem` sub = case toJSON x of
Object m -> pairsToSeries (HM.toList m) <> rest
Null -> rest
_ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
diff --git a/src/Data/OpenApi/Internal/ParamSchema.hs b/src/Data/OpenApi/Internal/ParamSchema.hs
index 75b637a2..1699a0e4 100644
--- a/src/Data/OpenApi/Internal/ParamSchema.hs
+++ b/src/Data/OpenApi/Internal/ParamSchema.hs
@@ -15,58 +15,59 @@
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- For TypeErrors
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+
module Data.OpenApi.Internal.ParamSchema where
import Control.Lens
import Data.Aeson (ToJSON (..))
-import Data.Proxy
-import GHC.Generics
-
-import Data.Int
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import Data.Fixed (Fixed, HasResolution (..), Pico)
import "unordered-containers" Data.HashSet (HashSet)
+import Data.Int
import Data.Monoid
-import Data.Set (Set)
+import Data.OpenApi.Internal
+import Data.OpenApi.Lens
+import Data.OpenApi.SchemaOptions
+import Data.Proxy
import Data.Scientific
-import Data.Fixed (HasResolution(..), Fixed, Pico)
+import Data.Set (Set)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time
+import Data.UUID.Types (UUID)
import qualified Data.Vector as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Data.Version (Version)
-import Numeric.Natural.Compat (Natural)
import Data.Word
-import Data.UUID.Types (UUID)
+import GHC.Generics
+import GHC.TypeLits (ErrorMessage (..), TypeError)
+import Numeric.Natural.Compat (Natural)
import Web.Cookie (SetCookie)
-import Data.OpenApi.Internal
-import Data.OpenApi.Lens
-import Data.OpenApi.SchemaOptions
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import GHC.TypeLits (TypeError, ErrorMessage(..))
-
-- | Default schema for binary data (any sequence of octets).
binarySchema :: Schema
-binarySchema = mempty
- & type_ ?~ OpenApiString
- & format ?~ "binary"
+binarySchema =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ "binary"
-- | Default schema for binary data (base64 encoded).
byteSchema :: Schema
-byteSchema = mempty
- & type_ ?~ OpenApiString
- & format ?~ "byte"
+byteSchema =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ "byte"
-- | Default schema for password string.
-- @"password"@ format is used to hint UIs the input needs to be obscured.
passwordSchema :: Schema
-passwordSchema = mempty
- & type_ ?~ OpenApiString
- & format ?~ "password"
+passwordSchema =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ "password"
-- | Convert a type into a plain @'Schema'@.
--
@@ -130,14 +131,17 @@ instance ToParamSchema Integer where
toParamSchema _ = mempty & type_ ?~ OpenApiInteger
instance ToParamSchema Natural where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiInteger
- & minimum_ ?~ 0
- & exclusiveMinimum ?~ False
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiInteger
+ & minimum_ ?~ 0
+ & exclusiveMinimum ?~ False
-instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
-instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
-instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
+instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
+
+instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
+
+instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
instance ToParamSchema Int32 where
toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
@@ -145,8 +149,10 @@ instance ToParamSchema Int32 where
instance ToParamSchema Int64 where
toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
-instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
-instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
+instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
+
+instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
+
instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral
instance ToParamSchema Word32 where
@@ -164,39 +170,45 @@ instance ToParamSchema Word64 where
-- "type": "integer"
-- }
toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
-toParamSchemaBoundedIntegral _ = mempty
- & type_ ?~ OpenApiInteger
- & minimum_ ?~ fromInteger (toInteger (minBound :: a))
- & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
+toParamSchemaBoundedIntegral _ =
+ mempty
+ & type_ ?~ OpenApiInteger
+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))
+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
instance ToParamSchema Char where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiString
- & maxLength ?~ 1
- & minLength ?~ 1
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiString
+ & maxLength ?~ 1
+ & minLength ?~ 1
instance ToParamSchema Scientific where
toParamSchema _ = mempty & type_ ?~ OpenApiNumber
instance HasResolution a => ToParamSchema (Fixed a) where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiNumber
- & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiNumber
+ & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
instance ToParamSchema Double where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiNumber
- & format ?~ "double"
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiNumber
+ & format ?~ "double"
instance ToParamSchema Float where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiNumber
- & format ?~ "float"
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiNumber
+ & format ?~ "float"
timeParamSchema :: String -> Schema
-timeParamSchema fmt = mempty
- & type_ ?~ OpenApiString
- & format ?~ T.pack fmt
+timeParamSchema fmt =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ T.pack fmt
-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
instance ToParamSchema Day where
@@ -236,46 +248,62 @@ instance ToParamSchema TL.Text where
toParamSchema _ = toParamSchema (Proxy :: Proxy String)
instance ToParamSchema Version where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiString
- & pattern ?~ "^\\d+(\\.\\d+)*$"
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiString
+ & pattern ?~ "^\\d+(\\.\\d+)*$"
instance ToParamSchema SetCookie where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiString
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiString
type family ToParamSchemaByteStringError bs where
- ToParamSchemaByteStringError bs = TypeError
+ ToParamSchemaByteStringError bs =
+ TypeError
( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
- :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
- :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
+ :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates."
+ )
+
+instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
-instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
+
instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
-instance ToParamSchema a => ToParamSchema (Sum a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
+
+instance ToParamSchema a => ToParamSchema (Sum a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
+
instance ToParamSchema a => ToParamSchema (Product a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
-instance ToParamSchema a => ToParamSchema (First a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
-instance ToParamSchema a => ToParamSchema (Last a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
-instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
+
+instance ToParamSchema a => ToParamSchema (First a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
+
+instance ToParamSchema a => ToParamSchema (Last a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
+
+instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
instance ToParamSchema a => ToParamSchema [a] where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiArray
- & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiArray
+ & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
+
instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
+
instance ToParamSchema a => ToParamSchema (VS.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
+
instance ToParamSchema a => ToParamSchema (VU.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
instance ToParamSchema a => ToParamSchema (Set a) where
- toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
- & uniqueItems ?~ True
+ toParamSchema _ =
+ toParamSchema (Proxy :: Proxy [a])
+ & uniqueItems ?~ True
instance ToParamSchema a => ToParamSchema (HashSet a) where
toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
@@ -289,14 +317,16 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
-- "type": "string"
-- }
instance ToParamSchema () where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiString
- & enum_ ?~ ["_"]
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiString
+ & enum_ ?~ ["_"]
instance ToParamSchema UUID where
- toParamSchema _ = mempty
- & type_ ?~ OpenApiString
- & format ?~ "uuid"
+ toParamSchema _ =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ "uuid"
-- | A configurable generic @'Schema'@ creator.
--
@@ -338,14 +368,15 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
instance Constructor c => GEnumParamSchema (C1 c U1) where
- genumParamSchema opts _ s = s
- & type_ ?~ OpenApiString
- & enum_ %~ addEnumValue tag
+ genumParamSchema opts _ s =
+ s
+ & type_ ?~ OpenApiString
+ & enum_ %~ addEnumValue tag
where
tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
- addEnumValue x Nothing = Just [x]
- addEnumValue x (Just xs) = Just (x:xs)
+ addEnumValue x Nothing = Just [x]
+ addEnumValue x (Just xs) = Just (x : xs)
data Proxy3 a b c = Proxy3
diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index 7bede45b..1964b5fd 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -19,62 +19,65 @@
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- For TypeErrors
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
-module Data.OpenApi.Internal.Schema where
-import Prelude ()
-import Prelude.Compat
+module Data.OpenApi.Internal.Schema where
import Control.Lens hiding (allOf)
-import Data.Data.Lens (template)
-
import Control.Monad
import Control.Monad.Writer
-import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
- ToJSONKeyFunction (..), Value (..))
+import Data.Aeson
+ ( Object (..),
+ SumEncoding (..),
+ ToJSON (..),
+ ToJSONKey (..),
+ ToJSONKeyFunction (..),
+ Value (..),
+ )
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Char
import Data.Data (Data)
+import Data.Data.Lens (template)
+import Data.Fixed (Fixed, HasResolution, Pico)
import Data.Foldable (traverse_)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
-import "unordered-containers" Data.HashSet (HashSet)
-import qualified "unordered-containers" Data.HashSet as HashSet
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
+import "unordered-containers" Data.HashSet (HashSet)
+import qualified "unordered-containers" Data.HashSet as HashSet
import Data.Int
-import Data.IntSet (IntSet)
import Data.IntMap (IntMap)
+import Data.IntSet (IntSet)
import Data.List (sort)
import Data.List.NonEmpty.Compat (NonEmpty)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
+import Data.OpenApi.Declare
+import Data.OpenApi.Internal
+import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
+import Data.OpenApi.Internal.TypeShape
+import Data.OpenApi.Lens hiding (name, schema)
+import qualified Data.OpenApi.Lens as Swagger
+import Data.OpenApi.SchemaOptions
import Data.Proxy
import Data.Scientific (Scientific)
-import Data.Fixed (Fixed, HasResolution, Pico)
import Data.Set (Set)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time
+import qualified Data.UUID.Types as UUID
import qualified Data.Vector as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Data.Version (Version)
-import Numeric.Natural.Compat (Natural)
import Data.Word
import GHC.Generics
-import qualified Data.UUID.Types as UUID
+import GHC.TypeLits (ErrorMessage (..), TypeError)
+import Numeric.Natural.Compat (Natural)
+import Prelude.Compat
import Type.Reflection (Typeable, typeRep)
-
-import Data.OpenApi.Declare
-import Data.OpenApi.Internal
-import Data.OpenApi.Internal.ParamSchema (ToParamSchema(..))
-import Data.OpenApi.Lens hiding (name, schema)
-import qualified Data.OpenApi.Lens as Swagger
-import Data.OpenApi.SchemaOptions
-import Data.OpenApi.Internal.TypeShape
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import GHC.TypeLits (TypeError, ErrorMessage(..))
+import Prelude ()
unnamed :: Schema -> NamedSchema
unnamed schema = NamedSchema Nothing schema
@@ -141,13 +144,18 @@ class Typeable a => ToSchema a where
-- Note that the schema itself is included in definitions
-- only if it is recursive (and thus needs its definition in scope).
declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
- default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
- Proxy a -> Declare (Definitions Schema) NamedSchema
+ default declareNamedSchema ::
+ (Generic a, GToSchema (Rep a)) =>
+ Proxy a ->
+ Declare (Definitions Schema) NamedSchema
declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
instance ToSchema TimeOfDay where
- declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"
- & example ?~ toJSON (TimeOfDay 12 33 15)
+ declareNamedSchema _ =
+ pure $
+ named "TimeOfDay" $
+ timeSchema "hh:MM:ss"
+ & example ?~ toJSON (TimeOfDay 12 33 15)
-- | Convert a type into a schema and declare all used schema definitions.
declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
@@ -255,9 +263,9 @@ inlineSchemasWhen p defs = template %~ deref
where
deref r@(Ref (Reference name))
| p name =
- case InsOrdHashMap.lookup name defs of
- Just schema -> Inline (inlineSchemasWhen p defs schema)
- Nothing -> r
+ case InsOrdHashMap.lookup name defs of
+ Just schema -> Inline (inlineSchemasWhen p defs schema)
+ Nothing -> r
| otherwise = r
deref (Inline schema) = Inline (inlineSchemasWhen p defs schema)
@@ -306,7 +314,7 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
nonRecursive name =
case InsOrdHashMap.lookup name defs of
Just schema -> name `notElem` execDeclare (usedNames schema) mempty
- Nothing -> False
+ Nothing -> False
usedNames schema = traverse_ schemaRefNames (schema ^.. template)
@@ -387,26 +395,28 @@ sketchSchema = sketch . toJSON
sketch js@(Bool _) = go js
sketch js = go js & example ?~ js
- go Null = mempty & type_ ?~ OpenApiNull
- go (Bool _) = mempty & type_ ?~ OpenApiBoolean
+ go Null = mempty & type_ ?~ OpenApiNull
+ go (Bool _) = mempty & type_ ?~ OpenApiBoolean
go (String _) = mempty & type_ ?~ OpenApiString
go (Number _) = mempty & type_ ?~ OpenApiNumber
- go (Array xs) = mempty
- & type_ ?~ OpenApiArray
- & items ?~ case ischema of
+ go (Array xs) =
+ mempty
+ & type_ ?~ OpenApiArray
+ & items ?~ case ischema of
Just s -> OpenApiItemsObject (Inline s)
- _ -> OpenApiItemsArray (map Inline ys)
+ _ -> OpenApiItemsArray (map Inline ys)
where
ys = map go (V.toList xs)
allSame = and ((zipWith (==)) ys (tail ys))
ischema = case ys of
- (z:_) | allSame -> Just z
- _ -> Nothing
- go (Object o) = mempty
- & type_ ?~ OpenApiObject
- & required .~ sort (HashMap.keys o)
- & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
+ (z : _) | allSame -> Just z
+ _ -> Nothing
+ go (Object o) =
+ mempty
+ & type_ ?~ OpenApiObject
+ & required .~ sort (HashMap.keys o)
+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
-- Produced schema uses as much constraints as possible.
@@ -541,39 +551,44 @@ sketchSchema = sketch . toJSON
sketchStrictSchema :: ToJSON a => a -> Schema
sketchStrictSchema = go . toJSON
where
- go Null = mempty & type_ ?~ OpenApiNull
- go js@(Bool _) = mempty
- & type_ ?~ OpenApiBoolean
- & enum_ ?~ [js]
- go js@(String s) = mempty
- & type_ ?~ OpenApiString
- & maxLength ?~ fromIntegral (T.length s)
- & minLength ?~ fromIntegral (T.length s)
- & pattern ?~ s
- & enum_ ?~ [js]
- go js@(Number n) = mempty
- & type_ ?~ OpenApiNumber
- & maximum_ ?~ n
- & minimum_ ?~ n
- & multipleOf ?~ n
- & enum_ ?~ [js]
- go js@(Array xs) = mempty
- & type_ ?~ OpenApiArray
- & maxItems ?~ fromIntegral sz
- & minItems ?~ fromIntegral sz
- & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
- & uniqueItems ?~ allUnique
- & enum_ ?~ [js]
+ go Null = mempty & type_ ?~ OpenApiNull
+ go js@(Bool _) =
+ mempty
+ & type_ ?~ OpenApiBoolean
+ & enum_ ?~ [js]
+ go js@(String s) =
+ mempty
+ & type_ ?~ OpenApiString
+ & maxLength ?~ fromIntegral (T.length s)
+ & minLength ?~ fromIntegral (T.length s)
+ & pattern ?~ s
+ & enum_ ?~ [js]
+ go js@(Number n) =
+ mempty
+ & type_ ?~ OpenApiNumber
+ & maximum_ ?~ n
+ & minimum_ ?~ n
+ & multipleOf ?~ n
+ & enum_ ?~ [js]
+ go js@(Array xs) =
+ mempty
+ & type_ ?~ OpenApiArray
+ & maxItems ?~ fromIntegral sz
+ & minItems ?~ fromIntegral sz
+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
+ & uniqueItems ?~ allUnique
+ & enum_ ?~ [js]
where
sz = length xs
allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
- go js@(Object o) = mempty
- & type_ ?~ OpenApiObject
- & required .~ sort names
- & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
- & maxProperties ?~ fromIntegral (length names)
- & minProperties ?~ fromIntegral (length names)
- & enum_ ?~ [js]
+ go js@(Object o) =
+ mempty
+ & type_ ?~ OpenApiObject
+ & required .~ sort names
+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
+ & maxProperties ?~ fromIntegral (length names)
+ & minProperties ?~ fromIntegral (length names)
+ & enum_ ?~ [js]
where
names = HashMap.keys o
@@ -583,32 +598,50 @@ class GToSchema (f :: * -> *) where
instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
declareNamedSchema _ = do
ref <- declareSchemaRef (Proxy :: Proxy a)
- return $ unnamed $ mempty
- & type_ ?~ OpenApiArray
- & items ?~ OpenApiItemsObject ref
+ return $
+ unnamed $
+ mempty
+ & type_ ?~ OpenApiArray
+ & items ?~ OpenApiItemsObject ref
instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
+
instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
+
instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Int32 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Int64 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Word where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Word8 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Word16 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Word32 where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Word64 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Int32 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Int64 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Word where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Word8 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Word16 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Word32 where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Word64 where declareNamedSchema = plain . paramSchemaToSchema
instance ToSchema Char where
- declareNamedSchema proxy = plain (paramSchemaToSchema proxy)
- & mapped.Swagger.schema.example ?~ toJSON '?'
+ declareNamedSchema proxy =
+ plain (paramSchemaToSchema proxy)
+ & mapped . Swagger.schema . example ?~ toJSON '?'
+
+instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSchema
+
+instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
+instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
@@ -617,50 +650,68 @@ instance ToSchema a => ToSchema (Maybe a) where
instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
-- To match Aeson instance
- declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions {sumEncoding = ObjectWithSingleField}
instance ToSchema () where
declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
-- | For 'ToJSON' instance, see package.
instance ToSchema UUID.UUID where
- declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
- & example ?~ toJSON (UUID.toText UUID.nil)
+ declareNamedSchema p =
+ pure $
+ named "UUID" $
+ paramSchemaToSchema p
+ & example ?~ toJSON (UUID.toText UUID.nil)
instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
+
instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
+
instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
+
instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
+
instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
+
instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
timeSchema :: T.Text -> Schema
-timeSchema fmt = mempty
- & type_ ?~ OpenApiString
- & format ?~ fmt
+timeSchema fmt =
+ mempty
+ & type_ ?~ OpenApiString
+ & format ?~ fmt
-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
instance ToSchema Day where
- declareNamedSchema _ = pure $ named "Day" $ timeSchema "date"
- & example ?~ toJSON (fromGregorian 2016 7 22)
+ declareNamedSchema _ =
+ pure $
+ named "Day" $
+ timeSchema "date"
+ & example ?~ toJSON (fromGregorian 2016 7 22)
-- |
-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ss"
instance ToSchema LocalTime where
- declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
- & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
+ declareNamedSchema _ =
+ pure $
+ named "LocalTime" $
+ timeSchema "yyyy-mm-ddThh:MM:ss"
+ & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
instance ToSchema ZonedTime where
- declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
- & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
+ declareNamedSchema _ =
+ pure $
+ named "ZonedTime" $
+ timeSchema "date-time"
+ & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
instance ToSchema NominalDiffTime where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Pico)
@@ -669,21 +720,28 @@ instance ToSchema NominalDiffTime where
-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
-- Just "yyyy-mm-ddThh:MM:ssZ"
instance ToSchema UTCTime where
- declareNamedSchema _ = pure $ named "UTCTime" $ timeSchema "yyyy-mm-ddThh:MM:ssZ"
- & example ?~ toJSON (UTCTime (fromGregorian 2016 7 22) 0)
+ declareNamedSchema _ =
+ pure $
+ named "UTCTime" $
+ timeSchema "yyyy-mm-ddThh:MM:ssZ"
+ & example ?~ toJSON (UTCTime (fromGregorian 2016 7 22) 0)
instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
+
instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
type family ToSchemaByteStringError bs where
- ToSchemaByteStringError bs = TypeError
+ ToSchemaByteStringError bs =
+ TypeError
( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
- :$$: Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
- :$$: Text "Consider using byteSchema or binarySchema templates." )
+ :$$: Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
+ :$$: Text "Consider using byteSchema or binarySchema templates."
+ )
+
+instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
-instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
@@ -694,34 +752,44 @@ instance (ToSchema a) => ToSchema (IntMap a) where
instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
- ToJSONKeyText _ _ -> declareObjectMapSchema
- ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
+ ToJSONKeyText _ _ -> declareObjectMapSchema
+ ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
where
declareObjectMapSchema = do
schema <- declareSchemaRef (Proxy :: Proxy v)
- return $ unnamed $ mempty
- & type_ ?~ OpenApiObject
- & additionalProperties ?~ AdditionalPropertiesSchema schema
+ return $
+ unnamed $
+ mempty
+ & type_ ?~ OpenApiObject
+ & additionalProperties ?~ AdditionalPropertiesSchema schema
instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
instance {-# OVERLAPPING #-} ToSchema Object where
- declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
- & type_ ?~ OpenApiObject
- & description ?~ "Arbitrary JSON object."
- & additionalProperties ?~ AdditionalPropertiesAllowed True
+ declareNamedSchema _ =
+ pure $
+ NamedSchema (Just "Object") $
+ mempty
+ & type_ ?~ OpenApiObject
+ & description ?~ "Arbitrary JSON object."
+ & additionalProperties ?~ AdditionalPropertiesAllowed True
instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
+
instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
+
instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
+
instance ToSchema a => ToSchema (VP.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
instance ToSchema a => ToSchema (Set a) where
declareNamedSchema _ = do
schema <- declareSchema (Proxy :: Proxy [a])
- return $ unnamed $ schema
- & uniqueItems ?~ True
+ return $
+ unnamed $
+ schema
+ & uniqueItems ?~ True
instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
@@ -729,17 +797,24 @@ instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declare
instance ToSchema a => ToSchema (NonEmpty a) where
declareNamedSchema _ = do
schema <- declareSchema (Proxy :: Proxy [a])
- return $ unnamed $ schema
- & minItems .~ Just 1
+ return $
+ unnamed $
+ schema
+ & minItems .~ Just 1
instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
+
instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
-instance ToSchema a => ToSchema (Sum a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
+instance ToSchema a => ToSchema (Sum a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
+
instance ToSchema a => ToSchema (Product a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
-instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
-instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
-instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
+
+instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
+
+instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
+
+instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -752,26 +827,37 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
-- "type": "integer"
-- }
toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
-toSchemaBoundedIntegral _ = mempty
- & type_ ?~ OpenApiInteger
- & minimum_ ?~ fromInteger (toInteger (minBound :: a))
- & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
+toSchemaBoundedIntegral _ =
+ mempty
+ & type_ ?~ OpenApiInteger
+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))
+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
-genericToNamedSchemaBoundedIntegral :: forall a d f.
- ( Bounded a, Integral a
- , Generic a, Rep a ~ D1 d f, Datatype d)
- => SchemaOptions -> Proxy a -> NamedSchema
-genericToNamedSchemaBoundedIntegral opts proxy
- = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
+genericToNamedSchemaBoundedIntegral ::
+ forall a d f.
+ ( Bounded a,
+ Integral a,
+ Generic a,
+ Rep a ~ D1 d f,
+ Datatype d
+ ) =>
+ SchemaOptions ->
+ Proxy a ->
+ NamedSchema
+genericToNamedSchemaBoundedIntegral opts proxy =
+ genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
-- | Declare a named schema for a @newtype@ wrapper.
-genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
- (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
- => SchemaOptions -- ^ How to derive the name.
- -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.
- -> Proxy a
- -> Declare (Definitions Schema) NamedSchema
+genericDeclareNamedSchemaNewtype ::
+ forall a d c s i inner.
+ (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner)))) =>
+ -- | How to derive the name.
+ SchemaOptions ->
+ -- | How to create a schema for the wrapped type.
+ (Proxy inner -> Declare (Definitions Schema) Schema) ->
+ Proxy a ->
+ Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)
-- | Declare 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -806,20 +892,23 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
--
-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
-declareSchemaBoundedEnumKeyMapping :: forall map key value.
- (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
- => Proxy (map key value) -> Declare (Definitions Schema) Schema
+declareSchemaBoundedEnumKeyMapping ::
+ forall map key value.
+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value) =>
+ Proxy (map key value) ->
+ Declare (Definitions Schema) Schema
declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
ToJSONKeyText keyToText _ -> objectSchema keyToText
ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
where
objectSchema keyToText = do
valueRef <- declareSchemaRef (Proxy :: Proxy value)
- let allKeys = [minBound..maxBound :: key]
- mkPair k = (keyToText k, valueRef)
- return $ mempty
- & type_ ?~ OpenApiObject
- & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
+ let allKeys = [minBound .. maxBound :: key]
+ mkPair k = (keyToText k, valueRef)
+ return $
+ mempty
+ & type_ ?~ OpenApiObject
+ & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
-- This makes a much more useful schema when there aren't many options for key values.
@@ -853,14 +942,19 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
--
-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
-toSchemaBoundedEnumKeyMapping :: forall map key value.
- (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
- => Proxy (map key value) -> Schema
+toSchemaBoundedEnumKeyMapping ::
+ forall map key value.
+ (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value) =>
+ Proxy (map key value) ->
+ Schema
toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
-- | A configurable generic @'Schema'@ creator.
-genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
- SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
+genericDeclareSchema ::
+ (Generic a, GToSchema (Rep a), Typeable a) =>
+ SchemaOptions ->
+ Proxy a ->
+ Declare (Definitions Schema) Schema
genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
-- | A configurable generic @'NamedSchema'@ creator.
@@ -875,8 +969,12 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
--
-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
-- Just "Either_Int_Bool"
-genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
- SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
+genericDeclareNamedSchema ::
+ forall a.
+ (Generic a, GToSchema (Rep a), Typeable a) =>
+ SchemaOptions ->
+ Proxy a ->
+ Declare (Definitions Schema) NamedSchema
genericDeclareNamedSchema opts _ =
rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
where
@@ -885,24 +983,30 @@ genericDeclareNamedSchema opts _ =
orig = fmap unspace $ show $ typeRep @a
name = datatypeNameModifier opts orig
-
-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
-genericNameSchema :: forall a d f.
- (Generic a, Rep a ~ D1 d f, Datatype d)
- => SchemaOptions -> Proxy a -> Schema -> NamedSchema
+genericNameSchema ::
+ forall a d f.
+ (Generic a, Rep a ~ D1 d f, Datatype d) =>
+ SchemaOptions ->
+ Proxy a ->
+ Schema ->
+ NamedSchema
genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text
gdatatypeSchemaName opts _ = case orig of
- (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
+ (c : _) | isAlpha c && isUpper c -> Just (T.pack name)
_ -> Nothing
where
orig = datatypeName (Proxy3 :: Proxy3 d f a)
name = datatypeNameModifier opts orig
-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
-paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
- SchemaOptions -> Proxy a -> NamedSchema
+paramSchemaToNamedSchema ::
+ (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
+ SchemaOptions ->
+ Proxy a ->
+ NamedSchema
paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
-- | Construct 'Schema' usinng 'ToParamSchema'.
@@ -910,9 +1014,10 @@ paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
paramSchemaToSchema = toParamSchema
nullarySchema :: Schema
-nullarySchema = mempty
- & type_ ?~ OpenApiArray
- & items ?~ OpenApiItemsArray []
+nullarySchema =
+ mempty
+ & type_ ?~ OpenApiArray
+ & items ?~ OpenApiItemsArray []
gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -941,15 +1046,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
gdeclareNamedSchema opts _ s
| unwrapUnaryRecords opts = fieldSchema
| otherwise =
- case schema ^. items of
- Just (OpenApiItemsArray [_]) -> fieldSchema
- _ -> do
- declare defs
- return (unnamed schema)
+ case schema ^. items of
+ Just (OpenApiItemsArray [_]) -> fieldSchema
+ _ -> do
+ declare defs
+ return (unnamed schema)
where
(defs, NamedSchema _ schema) = runDeclare recordSchema mempty
recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
- fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
+ fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
gdeclareSchemaRef opts proxy = do
@@ -975,21 +1080,29 @@ appendItem x Nothing = Just (OpenApiItemsArray [x])
appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
-withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
- SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
+withFieldSchema ::
+ forall proxy s f.
+ (Selector s, GToSchema f) =>
+ SchemaOptions ->
+ proxy s f ->
+ Bool ->
+ Schema ->
+ Declare (Definitions Schema) Schema
withFieldSchema opts _ isRequiredField schema = do
ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)
return $
if T.null fname
- then schema
- & type_ ?~ OpenApiArray
- & items %~ appendItem ref
- & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
- & minItems %~ Just . maybe 1 (+1) -- increment minItems
- else schema
- & type_ ?~ OpenApiObject
- & properties . at fname ?~ ref
- & if isRequiredField
+ then
+ schema
+ & type_ ?~ OpenApiArray
+ & items %~ appendItem ref
+ & maxItems %~ Just . maybe 1 (+ 1) -- increment maxItems
+ & minItems %~ Just . maybe 1 (+ 1) -- increment minItems
+ else
+ schema
+ & type_ ?~ OpenApiObject
+ & properties . at fname ?~ ref
+ & if isRequiredField
then required %~ (++ [fname])
else id
where
@@ -1009,32 +1122,37 @@ instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
-instance ( GSumToSchema f
- , GSumToSchema g
- ) => GToSchema (f :+: g)
- where
+instance
+ ( GSumToSchema f,
+ GSumToSchema g
+ ) =>
+ GToSchema (f :+: g)
+ where
-- Aeson does not unwrap unary record in sum types.
- gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
+ gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts {unwrapUnaryRecords = False}) p s
gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
gdeclareNamedSumSchema opts proxy _
| allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchemas)
| otherwise = do
(schemas, _) <- runWriterT declareSumSchema
- return $ unnamed $ mempty
- & type_ ?~ OpenApiObject
- & oneOf ?~ (snd <$> schemas)
+ return $
+ unnamed $
+ mempty
+ & type_ ?~ OpenApiObject
+ & oneOf ?~ (snd <$> schemas)
where
declareSumSchema = gsumToSchema opts proxy
(sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
- toStringTag schemas = mempty
- & type_ ?~ OpenApiString
- & enum_ ?~ map (String . fst) sumSchemas
+ toStringTag schemas =
+ mempty
+ & type_ ?~ OpenApiString
+ & enum_ ?~ map (String . fst) sumSchemas
type AllNullary = All
-class GSumToSchema (f :: * -> *) where
+class GSumToSchema (f :: * -> *) where
gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)]
instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
@@ -1042,8 +1160,13 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
(<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g)
-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
-gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
- Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
+gsumConToSchemaWith ::
+ forall c f.
+ (GToSchema (C1 c f), Constructor c) =>
+ Maybe (Referenced Schema) ->
+ SchemaOptions ->
+ Proxy (C1 c f) ->
+ (T.Text, Referenced Schema)
gsumConToSchemaWith ref opts _ = (tag, schema)
where
schema = case sumEncoding opts of
@@ -1051,35 +1174,46 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
case ref of
-- If subschema is an object and constructor is a record, we add tag directly
-- to the record, as Aeson does it.
- Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
- & required <>~ [T.pack tagField]
- & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
-
+ Just (Inline sub)
+ | sub ^. type_ == Just OpenApiObject && isRecord ->
+ Inline $
+ sub
+ & required <>~ [T.pack tagField]
+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
-- If it is not a record, we need to put subschema into "contents" field.
- _ | not isRecord -> Inline $ mempty
- & type_ ?~ OpenApiObject
- & required .~ [T.pack tagField]
- & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
- -- If constructor is nullary, there is no content.
- & case ref of
- Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
- Nothing -> id
-
+ _
+ | not isRecord ->
+ Inline $
+ mempty
+ & type_ ?~ OpenApiObject
+ & required .~ [T.pack tagField]
+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
+ -- If constructor is nullary, there is no content.
+ & case ref of
+ Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
+ Nothing -> id
-- In the remaining cases we combine "tag" object and "contents" object using allOf.
- _ -> Inline $ mempty
- & type_ ?~ OpenApiObject
- & allOf ?~ [Inline $ mempty
- & type_ ?~ OpenApiObject
- & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
- & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
- & if isRecord
- then allOf . _Just <>~ [refOrNullary]
- else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
+ _ ->
+ Inline $
+ mempty
+ & type_ ?~ OpenApiObject
+ & allOf
+ ?~ [ Inline $
+ mempty
+ & type_ ?~ OpenApiObject
+ & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
+ ]
+ & if isRecord
+ then allOf . _Just <>~ [refOrNullary]
+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
- ObjectWithSingleField -> Inline $ mempty
- & type_ ?~ OpenApiObject
- & required .~ [tag]
- & properties . at tag ?~ refOrNullary
+ ObjectWithSingleField ->
+ Inline $
+ mempty
+ & type_ ?~ OpenApiObject
+ & required .~ [tag]
+ & properties . at tag ?~ refOrNullary
TwoElemArray -> error "unrepresentable in OpenAPI 3"
tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -1087,8 +1221,11 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
refOrNullary = fromMaybe (Inline nullarySchema) ref
refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
-gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
- SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
+gsumConToSchema ::
+ (GToSchema (C1 c f), Constructor c) =>
+ SchemaOptions ->
+ Proxy (C1 c f) ->
+ Declare (Definitions Schema) [(T.Text, Referenced Schema)]
gsumConToSchema opts proxy = do
ref <- gdeclareSchemaRef opts proxy
return [gsumConToSchemaWith (Just ref) opts proxy]
@@ -1104,19 +1241,18 @@ instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)
lift $ gsumConToSchema opts proxy
instance Constructor c => GSumToSchema (C1 c U1) where
- gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
+ gsumToSchema opts proxy = pure $ (: []) $ gsumConToSchemaWith Nothing opts proxy
data Proxy2 a b = Proxy2
data Proxy3 a b c = Proxy3
-{- $setup
->>> import Data.OpenApi
->>> import Data.Aeson (encode)
->>> import Data.Aeson.Types (toJSONKeyText)
->>> import Data.OpenApi.Internal.Utils
->>> :set -XScopedTypeVariables
->>> :set -XDeriveAnyClass
->>> :set -XStandaloneDeriving
->>> :set -XTypeApplications
--}
+-- $setup
+-- >>> import Data.OpenApi
+-- >>> import Data.Aeson (encode)
+-- >>> import Data.Aeson.Types (toJSONKeyText)
+-- >>> import Data.OpenApi.Internal.Utils
+-- >>> :set -XScopedTypeVariables
+-- >>> :set -XDeriveAnyClass
+-- >>> :set -XStandaloneDeriving
+-- >>> :set -XTypeApplications
diff --git a/src/Data/OpenApi/Operation.hs b/src/Data/OpenApi/Operation.hs
index 9a2484b1..18b46c31 100644
--- a/src/Data/OpenApi/Operation.hs
+++ b/src/Data/OpenApi/Operation.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE RankNTypes #-}
+
-- |
-- Module: Data.OpenApi.Operation
-- Maintainer: Nickolay Kudasov
@@ -7,48 +8,47 @@
-- Helper traversals and functions for Swagger operations manipulations.
-- These might be useful when you already have Swagger specification
-- generated by something else.
-module Data.OpenApi.Operation (
- -- * Operation traversals
- allOperations,
- operationsOf,
+module Data.OpenApi.Operation
+ ( -- * Operation traversals
+ allOperations,
+ operationsOf,
- -- * Manipulation
- -- ** Tags
- applyTags,
- applyTagsFor,
+ -- * Manipulation
- -- ** Responses
- setResponse,
- setResponseWith,
- setResponseFor,
- setResponseForWith,
+ -- ** Tags
+ applyTags,
+ applyTagsFor,
- -- ** Paths
- prependPath,
+ -- ** Responses
+ setResponse,
+ setResponseWith,
+ setResponseFor,
+ setResponseForWith,
- -- * Miscellaneous
- declareResponse,
-) where
+ -- ** Paths
+ prependPath,
-import Prelude ()
-import Prelude.Compat
+ -- * Miscellaneous
+ declareResponse,
+ )
+where
import Control.Lens
import Data.Data.Lens
+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
+import qualified Data.HashSet.InsOrd as InsOrdHS
import Data.List.Compat
import Data.Maybe (mapMaybe)
-import Data.Proxy
-import qualified Data.Set as Set
-import Data.Text (Text)
-import Network.HTTP.Media (MediaType)
-
import Data.OpenApi.Declare
import Data.OpenApi.Internal
import Data.OpenApi.Lens
import Data.OpenApi.Schema
-
-import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
-import qualified Data.HashSet.InsOrd as InsOrdHS
+import Data.Proxy
+import qualified Data.Set as Set
+import Data.Text (Text)
+import Network.HTTP.Media (MediaType)
+import Prelude.Compat
+import Prelude ()
-- $setup
-- >>> import Data.Aeson
@@ -76,7 +76,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path )
-- | All operations of a Swagger spec.
allOperations :: Traversal' OpenApi Operation
-allOperations = paths.traverse.template
+allOperations = paths . traverse . template
-- | @'operationsOf' sub@ will traverse only those operations
-- that are present in @sub@. Note that @'Operation'@ is determined
@@ -143,21 +143,17 @@ allOperations = paths.traverse.template
-- }
-- }
operationsOf :: OpenApi -> Traversal' OpenApi Operation
-operationsOf sub = paths.itraversed.withIndex.subops
+operationsOf sub = paths . itraversed . withIndex . subops
where
- -- | Traverse operations that correspond to paths and methods of the sub API.
subops :: Traversal' (FilePath, PathItem) Operation
subops f (path, item) = case InsOrdHashMap.lookup path (sub ^. paths) of
Just subitem -> (,) path <$> methodsOf subitem f item
- Nothing -> pure (path, item)
-
- -- | Traverse operations that exist in a given @'PathItem'@
- -- This is used to traverse only the operations that exist in sub API.
+ Nothing -> pure (path, item)
methodsOf :: PathItem -> Traversal' PathItem Operation
methodsOf pathItem = partsOf template . itraversed . indices (`elem` ns) . _Just
where
ops = pathItem ^.. template :: [Maybe Operation]
- ns = mapMaybe (fmap fst . sequenceA) $ zip [0..] ops
+ ns = mapMaybe (fmap fst . sequenceA) $ zip [0 ..] ops
-- | Apply tags to all operations and update the global list of tags.
--
@@ -170,9 +166,10 @@ applyTags = applyTagsFor allOperations
-- | Apply tags to a part of Swagger spec and update the global
-- list of tags.
applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
-applyTagsFor ops ts swag = swag
- & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
- & tags %~ (<> InsOrdHS.fromList ts)
+applyTagsFor ops ts swag =
+ swag
+ & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
+ & tags %~ (<> InsOrdHS.fromList ts)
-- | Construct a response with @'Schema'@ while declaring all
-- necessary schema definitions.
@@ -202,7 +199,7 @@ applyTagsFor ops ts swag = swag
declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
declareResponse cType proxy = do
s <- declareSchemaRef proxy
- return (mempty & content.at cType ?~ (mempty & schema ?~ s))
+ return (mempty & content . at cType ?~ (mempty & schema ?~ s))
-- | Set response for all operations.
-- This will also update global schema definitions.
@@ -278,9 +275,10 @@ setResponseWith = setResponseForWith allOperations
--
-- See also @'setResponseForWith'@.
setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
-setResponseFor ops code dres swag = swag
- & components.schemas %~ (<> defs)
- & ops . at code ?~ Inline res
+setResponseFor ops code dres swag =
+ swag
+ & components . schemas %~ (<> defs)
+ & ops . at code ?~ Inline res
where
(defs, res) = runDeclare dres mempty
@@ -292,14 +290,15 @@ setResponseFor ops code dres swag = swag
--
-- See also @'setResponseFor'@.
setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
-setResponseForWith ops f code dres swag = swag
- & components.schemas %~ (<> defs)
- & ops . at code %~ Just . Inline . combine
+setResponseForWith ops f code dres swag =
+ swag
+ & components . schemas %~ (<> defs)
+ & ops . at code %~ Just . Inline . combine
where
(defs, new) = runDeclare dres mempty
- combine (Just (Ref (Reference n))) = case swag ^. components.responses.at n of
+ combine (Just (Ref (Reference n))) = case swag ^. components . responses . at n of
Just old -> f old new
- Nothing -> new -- response name can't be dereferenced, replacing with new response
+ Nothing -> new -- response name can't be dereferenced, replacing with new response
combine (Just (Inline old)) = f old new
combine Nothing = new
diff --git a/src/Data/OpenApi/Optics.hs b/src/Data/OpenApi/Optics.hs
index feb125d7..271f3564 100644
--- a/src/Data/OpenApi/Optics.hs
+++ b/src/Data/OpenApi/Optics.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
+
-- |
-- Module: Data.OpenApi.Optics
-- Maintainer: Andrzej Rybczak
@@ -101,9 +102,9 @@
module Data.OpenApi.Optics () where
import Data.Aeson (Value)
-import Data.Scientific (Scientific)
import Data.OpenApi.Internal
import Data.OpenApi.Internal.Utils
+import Data.Scientific (Scientific)
import Data.Text (Text)
import Optics.Core
import Optics.TH
@@ -151,26 +152,32 @@ makePrismLabels ''Referenced
-- OpenApiItems prisms
instance
- ( a ~ [Referenced Schema]
- , b ~ [Referenced Schema]
- ) => LabelOptic "_OpenApiItemsArray"
- A_Review
- OpenApiItems
- OpenApiItems
- a
- b where
+ ( a ~ [Referenced Schema],
+ b ~ [Referenced Schema]
+ ) =>
+ LabelOptic
+ "_OpenApiItemsArray"
+ A_Review
+ OpenApiItems
+ OpenApiItems
+ a
+ b
+ where
labelOptic = unto (\x -> OpenApiItemsArray x)
{-# INLINE labelOptic #-}
instance
- ( a ~ Referenced Schema
- , b ~ Referenced Schema
- ) => LabelOptic "_OpenApiItemsObject"
- A_Review
- OpenApiItems
- OpenApiItems
- a
- b where
+ ( a ~ Referenced Schema,
+ b ~ Referenced Schema
+ ) =>
+ LabelOptic
+ "_OpenApiItemsObject"
+ A_Review
+ OpenApiItems
+ OpenApiItems
+ a
+ b
+ where
labelOptic = unto (\x -> OpenApiItemsObject x)
{-# INLINE labelOptic #-}
@@ -178,151 +185,201 @@ instance
-- More helpful instances for easier access to schema properties
type instance Index Responses = HttpStatusCode
+
type instance Index Operation = HttpStatusCode
type instance IxValue Responses = Referenced Response
+
type instance IxValue Operation = Referenced Response
instance Ixed Responses where
ix n = #responses % ix n
{-# INLINE ix #-}
-instance At Responses where
+
+instance At Responses where
at n = #responses % at n
{-# INLINE at #-}
instance Ixed Operation where
ix n = #responses % ix n
{-# INLINE ix #-}
-instance At Operation where
+
+instance At Operation where
at n = #responses % at n
{-# INLINE at #-}
-- #type
instance
- ( a ~ Maybe OpenApiType
- , b ~ Maybe OpenApiType
- ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe OpenApiType,
+ b ~ Maybe OpenApiType
+ ) =>
+ LabelOptic "type" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #type
{-# INLINE labelOptic #-}
-- #default
instance
- ( a ~ Maybe Value, b ~ Maybe Value
- ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Value,
+ b ~ Maybe Value
+ ) =>
+ LabelOptic "default" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #default
{-# INLINE labelOptic #-}
-- #format
instance
- ( a ~ Maybe Format, b ~ Maybe Format
- ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Format,
+ b ~ Maybe Format
+ ) =>
+ LabelOptic "format" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #format
{-# INLINE labelOptic #-}
-- #items
instance
- ( a ~ Maybe OpenApiItems
- , b ~ Maybe OpenApiItems
- ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe OpenApiItems,
+ b ~ Maybe OpenApiItems
+ ) =>
+ LabelOptic "items" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #items
{-# INLINE labelOptic #-}
-- #maximum
instance
- ( a ~ Maybe Scientific, b ~ Maybe Scientific
- ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Scientific,
+ b ~ Maybe Scientific
+ ) =>
+ LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #maximum
{-# INLINE labelOptic #-}
-- #exclusiveMaximum
instance
- ( a ~ Maybe Bool, b ~ Maybe Bool
- ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Bool,
+ b ~ Maybe Bool
+ ) =>
+ LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #exclusiveMaximum
{-# INLINE labelOptic #-}
-- #minimum
instance
- ( a ~ Maybe Scientific, b ~ Maybe Scientific
- ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Scientific,
+ b ~ Maybe Scientific
+ ) =>
+ LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #minimum
{-# INLINE labelOptic #-}
-- #exclusiveMinimum
instance
- ( a ~ Maybe Bool, b ~ Maybe Bool
- ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Bool,
+ b ~ Maybe Bool
+ ) =>
+ LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #exclusiveMinimum
{-# INLINE labelOptic #-}
-- #maxLength
instance
- ( a ~ Maybe Integer, b ~ Maybe Integer
- ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Integer,
+ b ~ Maybe Integer
+ ) =>
+ LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #maxLength
{-# INLINE labelOptic #-}
-- #minLength
instance
- ( a ~ Maybe Integer, b ~ Maybe Integer
- ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Integer,
+ b ~ Maybe Integer
+ ) =>
+ LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #minLength
{-# INLINE labelOptic #-}
-- #pattern
instance
- ( a ~ Maybe Text, b ~ Maybe Text
- ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Text,
+ b ~ Maybe Text
+ ) =>
+ LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #pattern
{-# INLINE labelOptic #-}
-- #maxItems
instance
- ( a ~ Maybe Integer, b ~ Maybe Integer
- ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Integer,
+ b ~ Maybe Integer
+ ) =>
+ LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #maxItems
{-# INLINE labelOptic #-}
-- #minItems
instance
- ( a ~ Maybe Integer, b ~ Maybe Integer
- ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Integer,
+ b ~ Maybe Integer
+ ) =>
+ LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #minItems
{-# INLINE labelOptic #-}
-- #uniqueItems
instance
- ( a ~ Maybe Bool, b ~ Maybe Bool
- ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Bool,
+ b ~ Maybe Bool
+ ) =>
+ LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #uniqueItems
{-# INLINE labelOptic #-}
-- #enum
instance
- ( a ~ Maybe [Value], b ~ Maybe [Value]
- ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe [Value],
+ b ~ Maybe [Value]
+ ) =>
+ LabelOptic "enum" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #enum
{-# INLINE labelOptic #-}
-- #multipleOf
instance
- ( a ~ Maybe Scientific, b ~ Maybe Scientific
- ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
+ ( a ~ Maybe Scientific,
+ b ~ Maybe Scientific
+ ) =>
+ LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b
+ where
labelOptic = #schema % #multipleOf
{-# INLINE labelOptic #-}
diff --git a/test/Data/OpenApiSpec.hs b/test/Data/OpenApiSpec.hs
index fe724d52..1d409d5d 100644
--- a/test/Data/OpenApiSpec.hs
+++ b/test/Data/OpenApiSpec.hs
@@ -13,6 +13,7 @@ import Data.Aeson
import Data.Aeson.QQ.Simple
import Data.HashMap.Strict (HashMap)
import qualified Data.HashSet.InsOrd as InsOrdHS
+import qualified Data.HashMap.Strict.InsOrd as InsOrdHM
import Data.Text (Text)
import Data.OpenApi
@@ -144,6 +145,7 @@ operationExample = mempty
& at 200 ?~ "Pet updated."
& at 405 ?~ "Invalid input"
& security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
+ & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])
operationExampleJSON :: Value
operationExampleJSON = [aesonQQ|
@@ -198,7 +200,8 @@ operationExampleJSON = [aesonQQ|
"read:pets"
]
}
- ]
+ ],
+ "x-ext1": true
}
|]
@@ -230,6 +233,7 @@ schemaSimpleModelExample = mempty
& minimum_ ?~ 0
& type_ ?~ OpenApiInteger
& format ?~ "int32" ) ]
+ & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])
schemaSimpleModelExampleJSON :: Value
schemaSimpleModelExampleJSON = [aesonQQ|
@@ -247,7 +251,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
"type": "integer"
}
},
- "type": "object"
+ "type": "object",
+ "x-ext1": true
}
|]
@@ -448,15 +453,18 @@ securityDefinitionsExample :: SecurityDefinitions
securityDefinitionsExample = SecurityDefinitions
[ ("api_key", SecurityScheme
{ _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
- , _securitySchemeDescription = Nothing })
+ , _securitySchemeDescription = Nothing
+ , _securitySchemeExtensions = mempty})
, ("petstore_auth", SecurityScheme
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
, _oAath2RefreshUrl = Nothing
+ , _oAuth2Extensions = mempty
, _oAuth2Scopes =
[ ("write:pets", "modify pets in your account")
, ("read:pets", "read your pets") ] } )
- , _securitySchemeDescription = Nothing }) ]
+ , _securitySchemeDescription = Nothing
+ , _securitySchemeExtensions = SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])}) ]
securityDefinitionsExampleJSON :: Value
securityDefinitionsExampleJSON = [aesonQQ|
@@ -476,7 +484,8 @@ securityDefinitionsExampleJSON = [aesonQQ|
},
"authorizationUrl": "http://swagger.io/api/oauth/dialog"
}
- }
+ },
+ "x-ext1": true
}
}
@@ -488,9 +497,11 @@ oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
, _oAath2RefreshUrl = Nothing
+ , _oAuth2Extensions = mempty
, _oAuth2Scopes =
[ ("read:pets", "read your pets") ] } )
- , _securitySchemeDescription = Nothing })
+ , _securitySchemeDescription = Nothing
+ , _securitySchemeExtensions = mempty })
]
oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
@@ -499,9 +510,12 @@ oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
, _oAath2RefreshUrl = Nothing
+ , _oAuth2Extensions = mempty
, _oAuth2Scopes =
[ ("write:pets", "modify pets in your account") ] } )
- , _securitySchemeDescription = Nothing })
+ , _securitySchemeDescription = Nothing
+ , _securitySchemeExtensions = mempty
+ })
]
oAuth2SecurityDefinitionsExample :: SecurityDefinitions