@@ -1,6 +1,6 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
44{-# LANGUAGE DeriveGeneric #-}
55{-# LANGUAGE DeriveTraversable #-}
66{-# LANGUAGE FlexibleContexts #-}
@@ -14,91 +14,87 @@
1414{-# LANGUAGE TemplateHaskell #-}
1515{-# LANGUAGE TypeFamilies #-}
1616{-# LANGUAGE UndecidableInstances #-}
17−module Data.OpenApi.Internal where
17+module Data.Swagger.Internal where
1818
1919import Prelude ()
2020import Prelude.Compat
2121
22+import Control.Lens ((&), (.~), (?~))
2223import Control.Applicative
23−import Control.Lens ((&), (.~), (?~))
24−import Data.Aeson hiding (Encoding)
25−#if MIN_VERSION_aeson(2,0,0)
26−import qualified Data.Aeson.KeyMap as KeyMap
27−#endif
28−import qualified Data.Aeson.Types as JSON
29−import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
30− constrIndex, mkConstr, mkDataType)
31−import Data.Hashable (Hashable (..))
32−import qualified Data.HashMap.Strict as HashMap
33−import Data.HashSet.InsOrd (InsOrdHashSet)
34−import Data.Map (Map)
35−import qualified Data.Map as Map
36−import Data.Monoid (Monoid (..))
37−import Data.Scientific (Scientific)
38−import Data.Semigroup.Compat (Semigroup (..))
39−import Data.String (IsString (..))
40−import Data.Text (Text)
41−import qualified Data.Text as Text
42−import Data.Text.Encoding (encodeUtf8)
43−import GHC.Generics (Generic)
44−import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
45− (/:))
46−import Network.Socket (HostName, PortNumber)
47−import Text.Read (readMaybe)
24+import Data.Aeson hiding (Encoding)
25+import qualified Data.Aeson.Types as JSON
26+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
27+import Data.Hashable (Hashable)
28+import qualified Data.HashMap.Strict as HashMap
29+import Data.HashSet.InsOrd (InsOrdHashSet)
30+import Data.Map (Map)
31+import qualified Data.Map as Map
32+import Data.Monoid (Monoid (..))
33+import Data.Semigroup.Compat (Semigroup (..))
34+import Data.Scientific (Scientific)
35+import Data.String (IsString(..))
36+import Data.Text (Text)
37+import qualified Data.Text as Text
38+import GHC.Generics (Generic)
39+import Network.Socket (HostName, PortNumber)
40+import Network.HTTP.Media (MediaType)
41+import Text.Read (readMaybe)
4842
4943import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
5044import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5145
52−import Data.OpenApi.Aeson.Compat (deleteKey)
53−import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
54− mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
55− sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
56− sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
57−import Data.OpenApi.Internal.Utils
5846import Generics.SOP.TH (deriveGeneric)
47+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
48+ ,sopSwaggerGenericToJSONWithOpts
49+ ,sopSwaggerGenericParseJSON
50+ ,HasSwaggerAesonOptions(..)
51+ ,AesonDefaultValue(..)
52+ ,mkSwaggerAesonOptions
53+ ,saoAdditionalPairs
54+ ,saoSubObject)
55+import Data.Swagger.Internal.Utils
56+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
5957
6058-- $setup
6159-- >>> :seti -XDataKinds
6260-- >>> import Data.Aeson
63−-- >>> import Data.ByteString.Lazy.Char8 as BSL
64−-- >>> import Data.OpenApi.Internal.Utils
6561
6662-- | A list of definitions that can be used in references.
6763type Definitions = InsOrdHashMap Text
6864
6965-- | This is the root document object for the API specification.
70−data OpenApi = OpenApi
66+data Swagger = Swagger
7167 { -- | Provides metadata about the API.
7268 -- The metadata can be used by the clients if needed.
73− _openApiInfo :: Info
69+ _swaggerInfo :: Info
7470
7571 -- | An array of Server Objects, which provide connectivity information
7672 -- to a target server. If the servers property is not provided, or is an empty array,
7773 -- the default value would be a 'Server' object with a url value of @/@.
78− , _openApiServers :: [Server]
74+ , _swaggerServers :: [Server]
7975
8076 -- | The available paths and operations for the API.
81− , _openApiPaths :: InsOrdHashMap FilePath PathItem
77+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem
8278
8379 -- | An element to hold various schemas for the specification.
84− , _openApiComponents :: Components
80+ , _swaggerComponents :: Components
8581
8682 -- | A declaration of which security mechanisms can be used across the API.
8783 -- The list of values includes alternative security requirement objects that can be used.
8884 -- Only one of the security requirement objects need to be satisfied to authorize a request.
8985 -- Individual operations can override this definition.
9086 -- To make security optional, an empty security requirement can be included in the array.
91− , _openApiSecurity :: [SecurityRequirement]
87+ , _swaggerSecurity :: [SecurityRequirement]
9288
9389 -- | A list of tags used by the specification with additional metadata.
9490 -- The order of the tags can be used to reflect on their order by the parsing tools.
9591 -- Not all tags that are used by the 'Operation' Object must be declared.
9692 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
9793 -- Each tag name in the list MUST be unique.
98− , _openApiTags :: InsOrdHashSet Tag
94+ , _swaggerTags :: InsOrdHashSet Tag
9995
10096 -- | Additional external documentation.
101− , _openApiExternalDocs :: Maybe ExternalDocs
97+ , _swaggerExternalDocs :: Maybe ExternalDocs
10298 } deriving (Eq, Show, Generic, Data, Typeable)
10399
104100-- | The object provides metadata about the API.
@@ -183,9 +179,6 @@ data ServerVariable = ServerVariable
183179 , _serverVariableDescription :: Maybe Text
184180 } deriving (Eq, Show, Generic, Data, Typeable)
185181
186−instance IsString Server where
187− fromString s = Server (fromString s) Nothing mempty
188−
189182-- | Holds a set of reusable objects for different aspects of the OAS.
190183-- All objects defined within the components object will have no effect on the API
191184-- unless they are explicitly referenced from properties outside the components object.
@@ -195,12 +188,42 @@ data Components = Components
195188 , _componentsParameters :: Definitions Param
196189 , _componentsExamples :: Definitions Example
197190 , _componentsRequestBodies :: Definitions RequestBody
198− , _componentsHeaders :: Definitions Header
199− , _componentsSecuritySchemes :: SecurityDefinitions
200− , _componentsLinks :: Definitions Link
201− , _componentsCallbacks :: Definitions Callback
191+ , _componentsHeader :: Definitions Header
192+ , _componentsSecuritySchemes :: Definitions SecurityScheme
193+-- , _componentsLinks
194+-- , _componentsCallbacks
202195 } deriving (Eq, Show, Generic, Data, Typeable)
203196
197+-- | The host (name or ip) serving the API. It MAY include a port.
198+data Host = Host
199+ { _hostName :: HostName -- ^ Host name.
200+ , _hostPort :: Maybe PortNumber -- ^ Optional port.
201+ } deriving (Eq, Show, Generic, Typeable)
202+
203+instance IsString Host where
204+ fromString s = Host s Nothing
205+
206+hostConstr :: Constr
207+hostConstr = mkConstr hostDataType "Host" [] Prefix
208+
209+hostDataType :: DataType
210+hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
211+
212+instance Data Host where
213+ gunfold k z c = case constrIndex c of
214+ 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
215+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
216+ toConstr (Host _ _) = hostConstr
217+ dataTypeOf _ = hostDataType
218+
219+-- | The transfer protocol of the API.
220+data Scheme
221+ = Http
222+ | Https
223+ | Ws
224+ | Wss
225+ deriving (Eq, Show, Generic, Data, Typeable)
226+
204227-- | Describes the operations available on a single path.
205228-- A @'PathItem'@ may be empty, due to ACL constraints.
206229-- The path itself is still exposed to the documentation viewer
@@ -288,11 +311,7 @@ data Operation = Operation
288311 -- | The list of possible responses as they are returned from executing this operation.
289312 , _operationResponses :: Responses
290313
291− -- | A map of possible out-of band callbacks related to the parent operation.
292− -- The key is a unique identifier for the 'Callback' Object.
293− -- Each value in the map is a 'Callback' Object that describes a request
294− -- that may be initiated by the API provider and the expected responses.
295− , _operationCallbacks :: InsOrdHashMap Text (Referenced Callback)
314+ -- TODO callbacks
296315
297316 -- | Declares this operation to be deprecated.
298317 -- Usage of the declared operation should be refrained.
@@ -312,22 +331,6 @@ data Operation = Operation
312331 , _operationServers :: [Server]
313332 } deriving (Eq, Show, Generic, Data, Typeable)
314333
315−-- This instance should be in @http-media@.
316−instance Data MediaType where
317− gunfold k z c = case constrIndex c of
318− 1 -> k (k (k (z (\main sub params -> foldl (/:) (main // sub) (Map.toList params)))))
319− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MediaType."
320−
321− toConstr _ = mediaTypeConstr
322−
323− dataTypeOf _ = mediaTypeData
324−
325−mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
326−mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
327−
328−instance Hashable MediaType where
329− hashWithSalt salt mt = salt `hashWithSalt` show mt
330−
331334-- | Describes a single request body.
332335data RequestBody = RequestBody
333336 { -- | A brief description of the request body. This could contain examples of use.
@@ -337,11 +340,9 @@ data RequestBody = RequestBody
337340 -- | The content of the request body.
338341 -- The key is a media type or media type range and the value describes it.
339342 -- For requests that match multiple keys, only the most specific key is applicable.
340− -- e.g. @text/plain@ overrides @text/\*@
341− , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
343+ -- e.g. @text/plain@ overrides @text/*@
344+ , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
342345
343− -- | Determines if the request body is required in the request.
344− -- Defaults to 'False'.
345346 , _requestBodyRequired :: Maybe Bool
346347 } deriving (Eq, Show, Generic, Data, Typeable)
347348
@@ -364,29 +365,6 @@ data MediaTypeObject = MediaTypeObject
364365 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
365366 } deriving (Eq, Show, Generic, Data, Typeable)
366367
367−-- | In order to support common ways of serializing simple parameters, a set of style values are defined.
368−data Style
369− = StyleMatrix
370− -- ^ Path-style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
371− | StyleLabel
372− -- ^ Label style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
373− | StyleForm
374− -- ^ Form style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
375− -- This option replaces @collectionFormat@ with a @csv@ (when @explode@ is false) or @multi@
376− -- (when explode is true) value from OpenAPI 2.0.
377− | StyleSimple
378− -- ^ Simple style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
379− -- This option replaces @collectionFormat@ with a @csv@ value from OpenAPI 2.0.
380− | StyleSpaceDelimited
381− -- ^ Space separated array values.
382− -- This option replaces @collectionFormat@ equal to @ssv@ from OpenAPI 2.0.
383− | StylePipeDelimited
384− -- ^ Pipe separated array values.
385− -- This option replaces @collectionFormat@ equal to @pipes@ from OpenAPI 2.0.
386− | StyleDeepObject
387− -- ^ Provides a simple way of rendering nested objects using form parameters.
388− deriving (Eq, Show, Generic, Data, Typeable)
389−
390368data Encoding = Encoding
391369 { -- | The Content-Type for encoding a specific property.
392370 -- Default value depends on the property type: for @string@
@@ -394,8 +372,8 @@ data Encoding = Encoding
394372 -- for other primitive types – @text/plain@; for object - @application/json@;
395373 -- for array – the default is defined based on the inner type.
396374 -- The value can be a specific media type (e.g. @application/json@),
397− -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
398− _encodingContentType :: Maybe MediaType
375+ -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
376+ _encodingContentType :: Maybe Text
399377
400378 -- | A map allowing additional information to be provided as headers,
401379 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -404,11 +382,11 @@ data Encoding = Encoding
404382 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
405383
406384 -- | Describes how a specific property value will be serialized depending on its type.
407− -- See 'Param' Object for details on the style property.
385+ -- See Parameter Object for details on the style property.
408386 -- The behavior follows the same values as query parameters, including default values.
409387 -- This property SHALL be ignored if the request body media type
410388 -- is not @application/x-www-form-urlencoded@.
411− , _encodingStyle :: Maybe Style
389+ , _encodingStyle :: Maybe Text -- TODO enum
412390
413391 -- | When this is true, property values of type @array@ or @object@ generate
414392 -- separate parameters for each value of the array,
@@ -434,11 +412,11 @@ mimeListConstr :: Constr
434412mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
435413
436414mimeListDataType :: DataType
437−mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
415+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
438416
439417instance Data MimeList where
440418 gunfold k z c = case constrIndex c of
441− 1 -> k (z (MimeList . map fromString))
419+ 1 -> k (z (\xs -> MimeList (map fromString xs)))
442420 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
443421 toConstr (MimeList _) = mimeListConstr
444422 dataTypeOf _ = mimeListDataType
@@ -452,7 +430,7 @@ data Param = Param
452430
453431 -- | A brief description of the parameter.
454432 -- This could contain examples of use.
455− -- CommonMark syntax MAY be used for rich text representation.
433+ -- GFM syntax can be used for rich text representation.
456434 , _paramDescription :: Maybe Text
457435
458436 -- | Determines whether this parameter is mandatory.
@@ -460,60 +438,27 @@ data Param = Param
460438 -- Otherwise, the property MAY be included and its default value is @False@.
461439 , _paramRequired :: Maybe Bool
462440
463− -- | Specifies that a parameter is deprecated and SHOULD be transitioned out of usage.
464− -- Default value is @false@.
465− , _paramDeprecated :: Maybe Bool
441+ -- | Parameter schema.
442+ , _paramSchema :: ParamAnySchema
443+ } deriving (Eq, Show, Generic, Data, Typeable)
444+
445+data ParamAnySchema
446+ = ParamBody (Referenced Schema)
447+ | ParamOther ParamOtherSchema
448+ deriving (Eq, Show, Generic, Data, Typeable)
466449
467− -- | The location of the parameter.
468− , _paramIn :: ParamLocation
450+data ParamOtherSchema = ParamOtherSchema
451+ { -- | The location of the parameter.
452+ _paramOtherSchemaIn :: ParamLocation
469453
470454 -- | Sets the ability to pass empty-valued parameters.
471− -- This is valid only for 'ParamQuery' parameters and allows sending
472− -- a parameter with an empty value. Default value is @false@.
473− , _paramAllowEmptyValue :: Maybe Bool
474−
475− -- | Determines whether the parameter value SHOULD allow reserved characters,
476− -- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)
477− -- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.
478− -- This property only applies to parameters with an '_paramIn' value of 'ParamQuery'.
479− -- The default value is 'False'.
480− , _paramAllowReserved :: Maybe Bool
455+ -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
456+ -- and allows you to send a parameter with a name only or an empty value.
457+ -- Default value is @False@.
458+ , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
481459
482− -- | Parameter schema.
483− , _paramSchema :: Maybe (Referenced Schema)
484−
485− -- | Describes how the parameter value will be serialized depending
486− -- on the type of the parameter value. Default values (based on value of '_paramIn'):
487− -- for 'ParamQuery' - 'StyleForm'; for 'ParamPath' - 'StyleSimple'; for 'ParamHeader' - 'StyleSimple';
488− -- for 'ParamCookie' - 'StyleForm'.
489− , _paramStyle :: Maybe Style
490−
491− -- | When this is true, parameter values of type @array@ or @object@
492− -- generate separate parameters for each value of the array or key-value pair of the map.
493− -- For other types of parameters this property has no effect.
494− -- When style is @form@, the default value is true. For all other styles, the default value is false.
495− , _paramExplode :: Maybe Bool
496−
497− -- | Example of the parameter's potential value.
498− -- The example SHOULD match the specified schema and encoding properties if present.
499− -- The '_paramExample' field is mutually exclusive of the '_paramExamples' field.
500− -- Furthermore, if referencing a schema that contains an example, the example value
501− -- SHALL override the example provided by the schema. To represent examples of media types
502− -- that cannot naturally be represented in JSON or YAML, a string value can contain
503− -- the example with escaping where necessary.
504− , _paramExample :: Maybe Value
505−
506− -- | Examples of the parameter's potential value.
507− -- Each example SHOULD contain a value in the correct format as specified
508− -- in the parameter encoding. The '_paramExamples' field is mutually exclusive of the '_paramExample' field.
509− -- Furthermore, if referencing a schema that contains an example,
510− -- the examples value SHALL override the example provided by the schema.
511− , _paramExamples :: InsOrdHashMap Text (Referenced Example)
512−
513− -- TODO
514− -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
515− -- should be singleton. mutually exclusive with _paramSchema.
516− } deriving (Eq, Show, Generic, Data, Typeable)
460+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
461+ } deriving (Eq, Show, Generic, Typeable, Data)
517462
518463data Example = Example
519464 { -- | Short description for the example.
@@ -537,64 +482,137 @@ data Example = Example
537482 , _exampleExternalValue :: Maybe URL
538483 } deriving (Eq, Show, Generic, Typeable, Data)
539484
540−data ExpressionOrValue
541− = Expression Text
542− | Value Value
543− deriving (Eq, Show, Generic, Typeable, Data)
544−
545−-- | The Link object represents a possible design-time link for a response.
546−-- The presence of a link does not guarantee the caller's ability to successfully invoke it,
547−-- rather it provides a known relationship and traversal mechanism between responses and other operations.
548−data Link = Link
549− { -- | A relative or absolute URI reference to an OAS operation.
550− -- This field is mutually exclusive of the '_linkOperationId' field,
551− -- and MUST point to an 'Operation' Object. Relative '_linkOperationRef'
552− -- values MAY be used to locate an existing 'Operation' Object in the OpenAPI definition.
553− _linkOperationRef :: Maybe Text
554−
555− -- | The name of an /existing/, resolvable OAS operation, as defined with a unique
556− -- '_operationOperationId'. This field is mutually exclusive of the '_linkOperationRef' field.
557− , _linkOperationId :: Maybe Text
558−
559− -- | A map representing parameters to pass to an operation as specified with '_linkOperationId'
560− -- or identified via '_linkOperationRef'. The key is the parameter name to be used, whereas
561− -- the value can be a constant or an expression to be evaluated and passed to the linked operation.
562− -- The parameter name can be qualified using the parameter location @[{in}.]{name}@
563− -- for operations that use the same parameter name in different locations (e.g. path.id).
564− , _linkParameters :: InsOrdHashMap Text ExpressionOrValue
565−
566− -- | A literal value or @{expression}@ to use as a request body when calling the target operation.
567− , _linkRequestBody :: Maybe ExpressionOrValue
568−
569− -- | A description of the link.
570− , _linkDescription :: Maybe Text
571−
572− -- | A server object to be used by the target operation.
573− , _linkServer :: Maybe Server
574− } deriving (Eq, Show, Generic, Typeable, Data)
575−
576−-- | Items for @'OpenApiArray'@ schemas.
485+-- | Items for @'SwaggerArray'@ schemas.
577486--
578−-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
579−-- it will incorporate Json Schema mostly verbatim.
487+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
488+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
489+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
490+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
580491--
581−-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
492+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
582493--
583−-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
584−data OpenApiItems where
585− OpenApiItemsObject :: Referenced Schema -> OpenApiItems
586− OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
587− deriving (Eq, Show, Typeable, Data)
588−
589−data OpenApiType where
590− OpenApiString :: OpenApiType
591− OpenApiNumber :: OpenApiType
592− OpenApiInteger :: OpenApiType
593− OpenApiBoolean :: OpenApiType
594− OpenApiArray :: OpenApiType
595− OpenApiNull :: OpenApiType
596− OpenApiObject :: OpenApiType
597− deriving (Eq, Show, Typeable, Generic, Data)
494+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
495+data SwaggerItems t where
496+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
497+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
498+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
499+ deriving (Typeable)
500+
501+deriving instance Eq (SwaggerItems t)
502+deriving instance Show (SwaggerItems t)
503+--deriving instance Typeable (SwaggerItems t)
504+
505+swaggerItemsPrimitiveConstr :: Constr
506+swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
507+
508+swaggerItemsObjectConstr :: Constr
509+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
510+
511+swaggerItemsArrayConstr :: Constr
512+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
513+
514+swaggerItemsDataType :: DataType
515+swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
516+
517+-- Note: unfortunately we have to write these Data instances by hand,
518+-- to get better contexts / avoid duplicate name when using standalone deriving
519+
520+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
521+ -- TODO: define gfoldl
522+ gunfold k z c = case constrIndex c of
523+ 1 -> k (k (z SwaggerItemsPrimitive))
524+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
525+ toConstr _ = swaggerItemsPrimitiveConstr
526+ dataTypeOf _ = swaggerItemsDataType
527+
528+-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
529+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
530+ -- TODO: define gfoldl
531+ gunfold k z c = case constrIndex c of
532+ 1 -> k (k (z SwaggerItemsPrimitive))
533+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
534+ toConstr _ = swaggerItemsPrimitiveConstr
535+ dataTypeOf _ = swaggerItemsDataType
536+
537+instance Data (SwaggerItems 'SwaggerKindSchema) where
538+ gfoldl _ _ (SwaggerItemsPrimitive _ _) = error " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
539+ gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
540+ gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
541+
542+ gunfold k z c = case constrIndex c of
543+ 2 -> k (z SwaggerItemsObject)
544+ 3 -> k (z SwaggerItemsArray)
545+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
546+
547+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
548+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
549+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
550+
551+ dataTypeOf _ = swaggerItemsDataType
552+
553+-- | Type used as a kind to avoid overlapping instances.
554+data SwaggerKind t
555+ = SwaggerKindNormal t
556+ | SwaggerKindParamOtherSchema
557+ | SwaggerKindSchema
558+ deriving (Typeable)
559+
560+deriving instance Typeable 'SwaggerKindNormal
561+deriving instance Typeable 'SwaggerKindParamOtherSchema
562+deriving instance Typeable 'SwaggerKindSchema
563+
564+type family SwaggerKindType (k :: SwaggerKind *) :: *
565+type instance SwaggerKindType ('SwaggerKindNormal t) = t
566+type instance SwaggerKindType 'SwaggerKindSchema = Schema
567+type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
568+
569+data SwaggerType t where
570+ SwaggerString :: SwaggerType t
571+ SwaggerNumber :: SwaggerType t
572+ SwaggerInteger :: SwaggerType t
573+ SwaggerBoolean :: SwaggerType t
574+ SwaggerArray :: SwaggerType t
575+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
576+ SwaggerNull :: SwaggerType 'SwaggerKindSchema
577+ SwaggerObject :: SwaggerType 'SwaggerKindSchema
578+ deriving (Typeable)
579+
580+deriving instance Eq (SwaggerType t)
581+deriving instance Show (SwaggerType t)
582+
583+swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
584+swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
585+
586+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
587+swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
588+
589+swaggerCommonTypes :: [SwaggerType k]
590+swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
591+
592+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
593+swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
594+
595+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
596+swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
597+
598+swaggerTypeConstrs :: [Constr]
599+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
600+ ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
601+
602+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
603+ gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
604+ toConstr = swaggerTypeConstr
605+ dataTypeOf = swaggerTypeDataType
606+
607+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
608+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
609+ toConstr = swaggerTypeConstr
610+ dataTypeOf = swaggerTypeDataType
611+
612+instance Data (SwaggerType 'SwaggerKindSchema) where
613+ gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
614+ toConstr = swaggerTypeConstr
615+ dataTypeOf = swaggerTypeDataType
598616
599617data ParamLocation
600618 = -- | Parameters that are appended to the URL.
@@ -612,6 +630,42 @@ data ParamLocation
612630
613631type Format = Text
614632
633+-- | Determines the format of the array.
634+data CollectionFormat t where
635+ -- Comma separated values: @foo,bar@.
636+ CollectionCSV :: CollectionFormat t
637+ -- Space separated values: @foo bar@.
638+ CollectionSSV :: CollectionFormat t
639+ -- Tab separated values: @foo\\tbar@.
640+ CollectionTSV :: CollectionFormat t
641+ -- Pipe separated values: @foo|bar@.
642+ CollectionPipes :: CollectionFormat t
643+ -- Corresponds to multiple parameter instances
644+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
645+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
646+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
647+ deriving (Typeable)
648+
649+deriving instance Eq (CollectionFormat t)
650+deriving instance Show (CollectionFormat t)
651+
652+collectionFormatConstr :: CollectionFormat t -> Constr
653+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
654+
655+collectionFormatDataType :: DataType
656+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
657+ map collectionFormatConstr collectionCommonFormats
658+
659+collectionCommonFormats :: [CollectionFormat t]
660+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
661+
662+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
663+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
664+ toConstr = collectionFormatConstr
665+ dataTypeOf _ = collectionFormatDataType
666+
667+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
668+
615669type ParamName = Text
616670
617671data Schema = Schema
@@ -638,33 +692,9 @@ data Schema = Schema
638692 , _schemaMaxProperties :: Maybe Integer
639693 , _schemaMinProperties :: Maybe Integer
640694
641− , -- | Declares the value of the parameter that the server will use if none is provided,
642− -- for example a @"count"@ to control the number of results per page might default to @100@
643− -- if not supplied by the client in the request.
644− -- (Note: "default" has no meaning for required parameters.)
645− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
646− _schemaDefault :: Maybe Value
647−
648− , _schemaType :: Maybe OpenApiType
649− , _schemaFormat :: Maybe Format
650− , _schemaItems :: Maybe OpenApiItems
651− , _schemaMaximum :: Maybe Scientific
652− , _schemaExclusiveMaximum :: Maybe Bool
653− , _schemaMinimum :: Maybe Scientific
654− , _schemaExclusiveMinimum :: Maybe Bool
655− , _schemaMaxLength :: Maybe Integer
656− , _schemaMinLength :: Maybe Integer
657− , _schemaPattern :: Maybe Pattern
658− , _schemaMaxItems :: Maybe Integer
659− , _schemaMinItems :: Maybe Integer
660− , _schemaUniqueItems :: Maybe Bool
661− , _schemaEnum :: Maybe [Value]
662− , _schemaMultipleOf :: Maybe Scientific
695+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
663696 } deriving (Eq, Show, Generic, Data, Typeable)
664697
665−-- | Regex pattern for @string@ type.
666−type Pattern = Text
667−
668698data Discriminator = Discriminator
669699 { -- | The name of the property in the payload that will hold the discriminator value.
670700 _discriminatorPropertyName :: Text
@@ -680,9 +710,41 @@ data NamedSchema = NamedSchema
680710 , _namedSchemaSchema :: Schema
681711 } deriving (Eq, Show, Generic, Data, Typeable)
682712
713+-- | Regex pattern for @string@ type.
714+type Pattern = Text
715+
716+-- TODO examples for params
717+
718+data ParamSchema (t :: SwaggerKind *) = ParamSchema
719+ { -- | Declares the value of the parameter that the server will use if none is provided,
720+ -- for example a @"count"@ to control the number of results per page might default to @100@
721+ -- if not supplied by the client in the request.
722+ -- (Note: "default" has no meaning for required parameters.)
723+ -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
724+ _paramSchemaDefault :: Maybe Value
725+
726+ , _paramSchemaType :: Maybe (SwaggerType t)
727+ , _paramSchemaFormat :: Maybe Format
728+ , _paramSchemaItems :: Maybe (SwaggerItems t)
729+ , _paramSchemaMaximum :: Maybe Scientific
730+ , _paramSchemaExclusiveMaximum :: Maybe Bool
731+ , _paramSchemaMinimum :: Maybe Scientific
732+ , _paramSchemaExclusiveMinimum :: Maybe Bool
733+ , _paramSchemaMaxLength :: Maybe Integer
734+ , _paramSchemaMinLength :: Maybe Integer
735+ , _paramSchemaPattern :: Maybe Pattern
736+ , _paramSchemaMaxItems :: Maybe Integer
737+ , _paramSchemaMinItems :: Maybe Integer
738+ , _paramSchemaUniqueItems :: Maybe Bool
739+ , _paramSchemaEnum :: Maybe [Value]
740+ , _paramSchemaMultipleOf :: Maybe Scientific
741+ } deriving (Eq, Show, Generic, Typeable)
742+
743+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
744+
683745data Xml = Xml
684746 { -- | Replaces the name of the element/attribute used for the described schema property.
685− -- When defined within the @'OpenApiItems'@ (items), it will affect the name of the individual XML elements within the list.
747+ -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
686748 -- When defined alongside type being array (outside the items),
687749 -- it will affect the wrapping element and only if wrapped is true.
688750 -- If wrapped is false, it will be ignored.
@@ -734,46 +796,25 @@ data Response = Response
734796 -- | A map containing descriptions of potential response payloads.
735797 -- The key is a media type or media type range and the value describes it.
736798 -- For responses that match multiple keys, only the most specific key is applicable.
737− -- e.g. @text/plain@ overrides @text/\*@.
738− , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
799+ -- e.g. @text/plain@ overrides @text/*@.
800+ , _responseContent :: InsOrdHashMap Text MediaTypeObject
739801
740802 -- | Maps a header name to its definition.
741803 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
742804
743− -- | A map of operations links that can be followed from the response.
744− -- The key of the map is a short name for the link, following the naming
745− -- constraints of the names for 'Component' Objects.
746− , _responseLinks :: InsOrdHashMap Text (Referenced Link)
805+ -- TODO links
747806 } deriving (Eq, Show, Generic, Data, Typeable)
748807
749808instance IsString Response where
750− fromString s = Response (fromString s) mempty mempty mempty
751−
752−-- | A map of possible out-of band callbacks related to the parent operation.
753−-- Each value in the map is a 'PathItem' Object that describes a set of requests that
754−-- may be initiated by the API provider and the expected responses.
755−-- The key value used to identify the path item object is an expression, evaluated at runtime,
756−-- that identifies a URL to use for the callback operation.
757−newtype Callback = Callback (InsOrdHashMap Text PathItem)
758− deriving (Eq, Show, Generic, Data, Typeable)
809+ fromString s = Response (fromString s) mempty mempty
759810
760811type HeaderName = Text
761812
762−-- | Header fields have the same meaning as for 'Param'.
763−--
764−-- Style is always treated as 'StyleSimple', as it is the only value allowed for headers.
765813data Header = Header
766814 { -- | A short description of the header.
767− _headerDescription :: Maybe HeaderName
768−
769− , _headerRequired :: Maybe Bool
770− , _headerDeprecated :: Maybe Bool
771− , _headerAllowEmptyValue :: Maybe Bool
772− , _headerExplode :: Maybe Bool
773− , _headerExample :: Maybe Value
774− , _headerExamples :: InsOrdHashMap Text (Referenced Example)
815+ _headerDescription :: Maybe Text
775816
776− , _headerSchema :: Maybe (Referenced Schema)
817+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
777818 } deriving (Eq, Show, Generic, Data, Typeable)
778819
779820-- | The location of the API key.
@@ -797,96 +838,26 @@ type AuthorizationURL = Text
797838-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
798839type TokenURL = Text
799840
800−newtype OAuth2ImplicitFlow
801− = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
802− deriving (Eq, Show, Generic, Data, Typeable)
803−
804−newtype OAuth2PasswordFlow
805− = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
806− deriving (Eq, Show, Generic, Data, Typeable)
807−
808−newtype OAuth2ClientCredentialsFlow
809− = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
841+data OAuth2Flow
842+ = OAuth2Implicit AuthorizationURL
843+ | OAuth2Password TokenURL
844+ | OAuth2Application TokenURL
845+ | OAuth2AccessCode AuthorizationURL TokenURL
810846 deriving (Eq, Show, Generic, Data, Typeable)
811847
812−data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
813− { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
814− , _oAuth2AuthorizationCodeFlowTokenUrl :: TokenURL
815− } deriving (Eq, Show, Generic, Data, Typeable)
816−
817−data OAuth2Flow p = OAuth2Flow
818− { _oAuth2Params :: p
819−
820− -- | The URL to be used for obtaining refresh tokens.
821− , _oAath2RefreshUrl :: Maybe URL
848+data OAuth2Params = OAuth2Params
849+ { -- | The flow used by the OAuth2 security scheme.
850+ _oauth2Flow :: OAuth2Flow
822851
823852 -- | The available scopes for the OAuth2 security scheme.
824− -- A map between the scope name and a short description for it.
825− -- The map MAY be empty.
826− , _oAuth2Scopes :: InsOrdHashMap Text Text
827− } deriving (Eq, Show, Generic, Data, Typeable)
828−
829−data OAuth2Flows = OAuth2Flows
830− { -- | Configuration for the OAuth Implicit flow
831− _oAuth2FlowsImplicit :: Maybe (OAuth2Flow OAuth2ImplicitFlow)
832−
833− -- | Configuration for the OAuth Resource Owner Password flow
834− , _oAuth2FlowsPassword :: Maybe (OAuth2Flow OAuth2PasswordFlow)
835−
836− -- | Configuration for the OAuth Client Credentials flow
837− , _oAuth2FlowsClientCredentials :: Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
838−
839− -- | Configuration for the OAuth Authorization Code flow
840− , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
853+ , _oauth2Scopes :: InsOrdHashMap Text Text
841854 } deriving (Eq, Show, Generic, Data, Typeable)
842855
843−type BearerFormat = Text
844−
845−data HttpSchemeType
846− = HttpSchemeBearer (Maybe BearerFormat)
847− | HttpSchemeBasic
848− | HttpSchemeCustom Text
849− deriving (Eq, Show, Generic, Data, Typeable)
850−
851−-- |
852−--
853−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer Nothing))
854−-- {
855−-- "scheme": "bearer",
856−-- "type": "http"
857−-- }
858−--
859−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer (Just "jwt")))
860−-- {
861−-- "bearerFormat": "jwt",
862−-- "scheme": "bearer",
863−-- "type": "http"
864−-- }
865−--
866−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp HttpSchemeBasic)
867−-- {
868−-- "scheme": "basic",
869−-- "type": "http"
870−-- }
871−--
872−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeCustom "CANARY"))
873−-- {
874−-- "scheme": "CANARY",
875−-- "type": "http"
876−-- }
877−--
878−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeApiKey (ApiKeyParams "id" ApiKeyCookie))
879−-- {
880−-- "in": "cookie",
881−-- "name": "id",
882−-- "type": "apiKey"
883−-- }
884−--
885856data SecuritySchemeType
886− = SecuritySchemeHttp HttpSchemeType
857+ = SecuritySchemeHttp
887858 | SecuritySchemeApiKey ApiKeyParams
888− | SecuritySchemeOAuth2 OAuth2Flows
889− | SecuritySchemeOpenIdConnect URL
859+ | SecuritySchemeOAuth2 OAuth2Params
860+-- | SecuritySchemeOpenIdConnect -- FIXME
890861 deriving (Eq, Show, Generic, Data, Typeable)
891862
892863data SecurityScheme = SecurityScheme
@@ -897,6 +868,18 @@ data SecurityScheme = SecurityScheme
897868 , _securitySchemeDescription :: Maybe Text
898869 } deriving (Eq, Show, Generic, Data, Typeable)
899870
871+
872+-- | merge scopes of two OAuth2 security schemes when their flows are identical.
873+-- In other case returns first security scheme
874+mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
875+mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
876+ s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
877+ = if flow1 == flow2 then
878+ SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
879+ else
880+ s1
881+mergeSecurityScheme s1 _ = s1
882+
900883newtype SecurityDefinitions
901884 = SecurityDefinitions (Definitions SecurityScheme)
902885 deriving (Eq, Show, Generic, Data, Typeable)
@@ -918,7 +901,7 @@ data Tag = Tag
918901 _tagName :: TagName
919902
920903 -- | A short description for the tag.
921− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
904+ -- GFM syntax can be used for rich text representation.
922905 , _tagDescription :: Maybe Text
923906
924907 -- | Additional external documentation for this tag.
@@ -933,7 +916,7 @@ instance IsString Tag where
933916-- | Allows referencing an external resource for extended documentation.
934917data ExternalDocs = ExternalDocs
935918 { -- | A short description of the target documentation.
936− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
919+ -- GFM syntax can be used for rich text representation.
937920 _externalDocsDescription :: Maybe Text
938921
939922 -- | The URL for the target documentation.
@@ -966,13 +949,12 @@ data AdditionalProperties
966949-- Generic instances
967950-------------------------------------------------------------------------------
968951
969−deriveGeneric ''Server
970952deriveGeneric ''Components
971953deriveGeneric ''Header
972−deriveGeneric ''OAuth2Flow
973−deriveGeneric ''OAuth2Flows
954+deriveGeneric ''OAuth2Params
974955deriveGeneric ''Operation
975956deriveGeneric ''Param
957+deriveGeneric ''ParamOtherSchema
976958deriveGeneric ''PathItem
977959deriveGeneric ''Response
978960deriveGeneric ''RequestBody
@@ -980,18 +962,18 @@ deriveGeneric ''MediaTypeObject
980962deriveGeneric ''Responses
981963deriveGeneric ''SecurityScheme
982964deriveGeneric ''Schema
983−deriveGeneric ''OpenApi
965+deriveGeneric ''ParamSchema
966+deriveGeneric ''Swagger
984967deriveGeneric ''Example
985968deriveGeneric ''Encoding
986−deriveGeneric ''Link
987969
988970-- =======================================================================
989971-- Monoid instances
990972-- =======================================================================
991973
992−instance Semigroup OpenApi where
974+instance Semigroup Swagger where
993975 (<>) = genericMappend
994−instance Monoid OpenApi where
976+instance Monoid Swagger where
995977 mempty = genericMempty
996978 mappend = (<>)
997979
@@ -1025,12 +1007,24 @@ instance Monoid Schema where
10251007 mempty = genericMempty
10261008 mappend = (<>)
10271009
1010+instance Semigroup (ParamSchema t) where
1011+ (<>) = genericMappend
1012+instance Monoid (ParamSchema t) where
1013+ mempty = genericMempty
1014+ mappend = (<>)
1015+
10281016instance Semigroup Param where
10291017 (<>) = genericMappend
10301018instance Monoid Param where
10311019 mempty = genericMempty
10321020 mappend = (<>)
10331021
1022+instance Semigroup ParamOtherSchema where
1023+ (<>) = genericMappend
1024+instance Monoid ParamOtherSchema where
1025+ mempty = genericMempty
1026+ mappend = (<>)
1027+
10341028instance Semigroup Header where
10351029 (<>) = genericMappend
10361030instance Monoid Header where
@@ -1073,29 +1067,8 @@ instance Monoid Operation where
10731067 mempty = genericMempty
10741068 mappend = (<>)
10751069
1076−instance Semigroup (OAuth2Flow p) where
1077− l@OAuth2Flow{ _oAath2RefreshUrl = lUrl, _oAuth2Scopes = lScopes }
1078− <> OAuth2Flow { _oAath2RefreshUrl = rUrl, _oAuth2Scopes = rScopes } =
1079− l { _oAath2RefreshUrl = swaggerMappend lUrl rUrl, _oAuth2Scopes = lScopes <> rScopes }
1080−
1081−-- swaggerMappend has First-like semantics, and here we need mappend'ing under Maybes.
1082−instance Semigroup OAuth2Flows where
1083− l <> r = OAuth2Flows
1084− { _oAuth2FlowsImplicit = _oAuth2FlowsImplicit l <> _oAuth2FlowsImplicit r
1085− , _oAuth2FlowsPassword = _oAuth2FlowsPassword l <> _oAuth2FlowsPassword r
1086− , _oAuth2FlowsClientCredentials = _oAuth2FlowsClientCredentials l <> _oAuth2FlowsClientCredentials r
1087− , _oAuth2FlowsAuthorizationCode = _oAuth2FlowsAuthorizationCode l <> _oAuth2FlowsAuthorizationCode r
1088− }
1089−
1090−instance Monoid OAuth2Flows where
1091− mempty = genericMempty
1092− mappend = (<>)
1093−
10941070instance Semigroup SecurityScheme where
1095− SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc
1096− <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc =
1097− SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc)
1098− l <> _ = l
1071+ (<>) = mergeSecurityScheme
10991072
11001073instance Semigroup SecurityDefinitions where
11011074 (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
@@ -1105,12 +1078,6 @@ instance Monoid SecurityDefinitions where
11051078 mempty = SecurityDefinitions InsOrdHashMap.empty
11061079 mappend = (<>)
11071080
1108−instance Semigroup RequestBody where
1109− (<>) = genericMappend
1110−instance Monoid RequestBody where
1111− mempty = genericMempty
1112− mappend = (<>)
1113−
11141081-- =======================================================================
11151082-- SwaggerMonoid helper instances
11161083-- =======================================================================
@@ -1119,19 +1086,21 @@ instance SwaggerMonoid Info
11191086instance SwaggerMonoid Components
11201087instance SwaggerMonoid PathItem
11211088instance SwaggerMonoid Schema
1089+instance SwaggerMonoid (ParamSchema t)
11221090instance SwaggerMonoid Param
1091+instance SwaggerMonoid ParamOtherSchema
11231092instance SwaggerMonoid Responses
11241093instance SwaggerMonoid Response
11251094instance SwaggerMonoid ExternalDocs
11261095instance SwaggerMonoid Operation
1127−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
11281096instance SwaggerMonoid SecurityDefinitions
1097+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
11291098
11301099instance SwaggerMonoid MimeList
11311100deriving instance SwaggerMonoid URL
11321101
1133−instance SwaggerMonoid OpenApiType where
1134− swaggerMempty = OpenApiString
1102+instance SwaggerMonoid (SwaggerType t) where
1103+ swaggerMempty = SwaggerString
11351104 swaggerMappend _ y = y
11361105
11371106instance SwaggerMonoid ParamLocation where
@@ -1147,16 +1116,16 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
11471116 swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
11481117 swaggerMappend _ y = y
11491118
1119+instance SwaggerMonoid ParamAnySchema where
1120+ swaggerMempty = ParamOther swaggerMempty
1121+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
1122+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
1123+ swaggerMappend _ y = y
1124+
11501125-- =======================================================================
11511126-- Simple Generic-based ToJSON instances
11521127-- =======================================================================
11531128
1154−instance ToJSON Style where
1155− toJSON = genericToJSON (jsonPrefix "Style")
1156−
1157−instance ToJSON OpenApiType where
1158− toJSON = genericToJSON (jsonPrefix "Swagger")
1159−
11601129instance ToJSON ParamLocation where
11611130 toJSON = genericToJSON (jsonPrefix "Param")
11621131
@@ -1169,6 +1138,9 @@ instance ToJSON Contact where
11691138instance ToJSON License where
11701139 toJSON = genericToJSON (jsonPrefix "License")
11711140
1141+instance ToJSON Server where
1142+ toJSON = genericToJSON (jsonPrefix "Server")
1143+
11721144instance ToJSON ServerVariable where
11731145 toJSON = genericToJSON (jsonPrefix "ServerVariable")
11741146
@@ -1178,6 +1150,9 @@ instance ToJSON ApiKeyLocation where
11781150instance ToJSON ApiKeyParams where
11791151 toJSON = genericToJSON (jsonPrefix "apiKey")
11801152
1153+instance ToJSON Scheme where
1154+ toJSON = genericToJSON (jsonPrefix "")
1155+
11811156instance ToJSON Tag where
11821157 toJSON = genericToJSON (jsonPrefix "Tag")
11831158
@@ -1190,28 +1165,10 @@ instance ToJSON Xml where
11901165instance ToJSON Discriminator where
11911166 toJSON = genericToJSON (jsonPrefix "Discriminator")
11921167
1193−instance ToJSON OAuth2ImplicitFlow where
1194− toJSON = genericToJSON (jsonPrefix "OAuth2ImplicitFlow")
1195−
1196−instance ToJSON OAuth2PasswordFlow where
1197− toJSON = genericToJSON (jsonPrefix "OAuth2PasswordFlow")
1198−
1199−instance ToJSON OAuth2ClientCredentialsFlow where
1200− toJSON = genericToJSON (jsonPrefix "OAuth2ClientCredentialsFlow")
1201−
1202−instance ToJSON OAuth2AuthorizationCodeFlow where
1203− toJSON = genericToJSON (jsonPrefix "OAuth2AuthorizationCodeFlow")
1204−
12051168-- =======================================================================
12061169-- Simple Generic-based FromJSON instances
12071170-- =======================================================================
12081171
1209−instance FromJSON Style where
1210− parseJSON = genericParseJSON (jsonPrefix "Style")
1211−
1212−instance FromJSON OpenApiType where
1213− parseJSON = genericParseJSON (jsonPrefix "Swagger")
1214−
12151172instance FromJSON ParamLocation where
12161173 parseJSON = genericParseJSON (jsonPrefix "Param")
12171174
@@ -1224,6 +1181,9 @@ instance FromJSON Contact where
12241181instance FromJSON License where
12251182 parseJSON = genericParseJSON (jsonPrefix "License")
12261183
1184+instance FromJSON Server where
1185+ parseJSON = genericParseJSON (jsonPrefix "Server")
1186+
12271187instance FromJSON ServerVariable where
12281188 parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
12291189
@@ -1233,6 +1193,9 @@ instance FromJSON ApiKeyLocation where
12331193instance FromJSON ApiKeyParams where
12341194 parseJSON = genericParseJSON (jsonPrefix "apiKey")
12351195
1196+instance FromJSON Scheme where
1197+ parseJSON = genericParseJSON (jsonPrefix "")
1198+
12361199instance FromJSON Tag where
12371200 parseJSON = genericParseJSON (jsonPrefix "Tag")
12381201
@@ -1242,81 +1205,53 @@ instance FromJSON ExternalDocs where
12421205instance FromJSON Discriminator where
12431206 parseJSON = genericParseJSON (jsonPrefix "Discriminator")
12441207
1245−instance FromJSON OAuth2ImplicitFlow where
1246− parseJSON = genericParseJSON (jsonPrefix "OAuth2ImplicitFlow")
1247−
1248−instance FromJSON OAuth2PasswordFlow where
1249− parseJSON = genericParseJSON (jsonPrefix "OAuth2PasswordFlow")
1250−
1251−instance FromJSON OAuth2ClientCredentialsFlow where
1252− parseJSON = genericParseJSON (jsonPrefix "OAuth2ClientCredentialsFlow")
1253−
1254−instance FromJSON OAuth2AuthorizationCodeFlow where
1255− parseJSON = genericParseJSON (jsonPrefix "OAuth2AuthorizationCodeFlow")
1256−
12571208-- =======================================================================
12581209-- Manual ToJSON instances
12591210-- =======================================================================
12601211
1261−instance ToJSON MediaType where
1262− toJSON = toJSON . show
1263− toEncoding = toEncoding . show
1264−
1265−instance ToJSONKey MediaType where
1266− toJSONKey = JSON.toJSONKeyText (Text.pack . show)
1267−
1268−instance (Eq p, ToJSON p, AesonDefaultValue p) => ToJSON (OAuth2Flow p) where
1269− toJSON = sopSwaggerGenericToJSON
1270− toEncoding = sopSwaggerGenericToEncoding
1271−
1272−instance ToJSON OAuth2Flows where
1212+instance ToJSON OAuth2Flow where
1213+ toJSON (OAuth2Implicit authUrl) = object
1214+ [ "flow" .= ("implicit" :: Text)
1215+ , "authorizationUrl" .= authUrl ]
1216+ toJSON (OAuth2Password tokenUrl) = object
1217+ [ "flow" .= ("password" :: Text)
1218+ , "tokenUrl" .= tokenUrl ]
1219+ toJSON (OAuth2Application tokenUrl) = object
1220+ [ "flow" .= ("application" :: Text)
1221+ , "tokenUrl" .= tokenUrl ]
1222+ toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1223+ [ "flow" .= ("accessCode" :: Text)
1224+ , "authorizationUrl" .= authUrl
1225+ , "tokenUrl" .= tokenUrl ]
1226+
1227+instance ToJSON OAuth2Params where
12731228 toJSON = sopSwaggerGenericToJSON
12741229 toEncoding = sopSwaggerGenericToEncoding
12751230
12761231instance ToJSON SecuritySchemeType where
1277− toJSON (SecuritySchemeHttp ty) = case ty of
1278− HttpSchemeBearer mFmt ->
1279− object $ [ "type" .= ("http" :: Text)
1280− , "scheme" .= ("bearer" :: Text)
1281− ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
1282− HttpSchemeBasic ->
1283− object [ "type" .= ("http" :: Text)
1284− , "scheme" .= ("basic" :: Text)
1285− ]
1286− HttpSchemeCustom t ->
1287− object [ "type" .= ("http" :: Text)
1288− , "scheme" .= t
1289− ]
1232+ toJSON SecuritySchemeHttp
1233+ = object [ "type" .= ("http" :: Text) ]
12901234 toJSON (SecuritySchemeApiKey params)
12911235 = toJSON params
12921236 <+> object [ "type" .= ("apiKey" :: Text) ]
1293− toJSON (SecuritySchemeOAuth2 params) = object
1294− [ "type" .= ("oauth2" :: Text)
1295− , "flows" .= toJSON params
1296− ]
1297− toJSON (SecuritySchemeOpenIdConnect url) = object
1298− [ "type" .= ("openIdConnect" :: Text)
1299− , "openIdConnectUrl" .= url
1300− ]
1237+ toJSON (SecuritySchemeOAuth2 params)
1238+ = toJSON params
1239+ <+> object [ "type" .= ("oauth2" :: Text) ]
13011240
1302−instance ToJSON OpenApi where
1241+instance ToJSON Swagger where
13031242 toJSON a = sopSwaggerGenericToJSON a &
1304− if InsOrdHashMap.null (_openApiPaths a)
1243+ if InsOrdHashMap.null (_swaggerPaths a)
13051244 then (<+> object ["paths" .= object []])
13061245 else id
13071246 toEncoding = sopSwaggerGenericToEncoding
13081247
1309−instance ToJSON Server where
1310− toJSON = sopSwaggerGenericToJSON
1311− toEncoding = sopSwaggerGenericToEncoding
1312−
13131248instance ToJSON SecurityScheme where
13141249 toJSON = sopSwaggerGenericToJSON
13151250 toEncoding = sopSwaggerGenericToEncoding
13161251
13171252instance ToJSON Schema where
1318− toJSON = sopSwaggerGenericToJSONWithOpts $
1319− mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
1253+ toJSON = sopSwaggerGenericToJSON
1254+ toEncoding = sopSwaggerGenericToEncoding
13201255
13211256instance ToJSON Header where
13221257 toJSON = sopSwaggerGenericToJSON
@@ -1325,26 +1260,31 @@ instance ToJSON Header where
13251260-- | As for nullary schema for 0-arity type constructors, see
13261261-- <https://github.com/GetShopTV/swagger2/issues/167>.
13271262--
1328−-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1329−-- {
1330−-- "example": [],
1331−-- "items": {},
1332−-- "maxItems": 0
1333−-- }
1263+-- >>> encode (SwaggerItemsArray [])
1264+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
13341265--
1335−instance ToJSON OpenApiItems where
1336− toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1337− toJSON (OpenApiItemsArray []) = object
1266+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1267+ toJSON (SwaggerItemsPrimitive fmt schema) = object
1268+ [ "collectionFormat" .= fmt
1269+ , "items" .= schema ]
1270+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1271+ toJSON (SwaggerItemsArray []) = object
13381272 [ "items" .= object []
13391273 , "maxItems" .= (0 :: Int)
13401274 , "example" .= Array mempty
13411275 ]
1342− toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
1276+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
13431277
13441278instance ToJSON Components where
13451279 toJSON = sopSwaggerGenericToJSON
13461280 toEncoding = sopSwaggerGenericToEncoding
13471281
1282+instance ToJSON Host where
1283+ toJSON (Host host mport) = toJSON $
1284+ case mport of
1285+ Nothing -> host
1286+ Just port -> host ++ ":" ++ show port
1287+
13481288instance ToJSON MimeList where
13491289 toJSON (MimeList xs) = toJSON (map show xs)
13501290
@@ -1352,6 +1292,14 @@ instance ToJSON Param where
13521292 toJSON = sopSwaggerGenericToJSON
13531293 toEncoding = sopSwaggerGenericToEncoding
13541294
1295+instance ToJSON ParamAnySchema where
1296+ toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1297+ toJSON (ParamOther s) = toJSON s
1298+
1299+instance ToJSON ParamOtherSchema where
1300+ toJSON = sopSwaggerGenericToJSON
1301+ toEncoding = sopSwaggerGenericToEncoding
1302+
13551303instance ToJSON Responses where
13561304 toJSON = sopSwaggerGenericToJSON
13571305 toEncoding = sopSwaggerGenericToEncoding
@@ -1384,10 +1332,6 @@ instance ToJSON Encoding where
13841332 toJSON = sopSwaggerGenericToJSON
13851333 toEncoding = sopSwaggerGenericToEncoding
13861334
1387−instance ToJSON Link where
1388− toJSON = sopSwaggerGenericToJSON
1389− toEncoding = sopSwaggerGenericToEncoding
1390−
13911335instance ToJSON SecurityDefinitions where
13921336 toJSON (SecurityDefinitions sd) = toJSON sd
13931337
@@ -1404,57 +1348,64 @@ instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/compone
14041348instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
14051349instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
14061350instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1407−instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
1408−instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
1351+
1352+instance ToJSON (SwaggerType t) where
1353+ toJSON SwaggerArray = "array"
1354+ toJSON SwaggerString = "string"
1355+ toJSON SwaggerInteger = "integer"
1356+ toJSON SwaggerNumber = "number"
1357+ toJSON SwaggerBoolean = "boolean"
1358+ toJSON SwaggerFile = "file"
1359+ toJSON SwaggerNull = "null"
1360+ toJSON SwaggerObject = "object"
1361+
1362+instance ToJSON (CollectionFormat t) where
1363+ toJSON CollectionCSV = "csv"
1364+ toJSON CollectionSSV = "ssv"
1365+ toJSON CollectionTSV = "tsv"
1366+ toJSON CollectionPipes = "pipes"
1367+ toJSON CollectionMulti = "multi"
1368+
1369+instance ToJSON (ParamSchema k) where
1370+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1371+ toJSON = sopSwaggerGenericToJSONWithOpts $
1372+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
14091373
14101374instance ToJSON AdditionalProperties where
14111375 toJSON (AdditionalPropertiesAllowed b) = toJSON b
14121376 toJSON (AdditionalPropertiesSchema s) = toJSON s
14131377
1414−instance ToJSON ExpressionOrValue where
1415− toJSON (Expression expr) = toJSON expr
1416− toJSON (Value val) = toJSON val
1417−
1418−instance ToJSON Callback where
1419− toJSON (Callback ps) = toJSON ps
1420−
14211378-- =======================================================================
14221379-- Manual FromJSON instances
14231380-- =======================================================================
14241381
1425−instance FromJSON MediaType where
1426− parseJSON = withText "MediaType" $ \str ->
1427− maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
1428−
1429−instance FromJSONKey MediaType where
1430− fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
1431−
1432−instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1433− parseJSON = sopSwaggerGenericParseJSON
1382+instance FromJSON OAuth2Flow where
1383+ parseJSON (Object o) = do
1384+ (flow :: Text) <- o .: "flow"
1385+ case flow of
1386+ "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1387+ "password" -> OAuth2Password <$> o .: "tokenUrl"
1388+ "application" -> OAuth2Application <$> o .: "tokenUrl"
1389+ "accessCode" -> OAuth2AccessCode
1390+ <$> o .: "authorizationUrl"
1391+ <*> o .: "tokenUrl"
1392+ _ -> empty
1393+ parseJSON _ = empty
14341394
1435−instance FromJSON OAuth2Flows where
1395+instance FromJSON OAuth2Params where
14361396 parseJSON = sopSwaggerGenericParseJSON
14371397
14381398instance FromJSON SecuritySchemeType where
14391399 parseJSON js@(Object o) = do
14401400 (t :: Text) <- o .: "type"
14411401 case t of
1442− "http" -> do
1443− scheme <- o .: "scheme"
1444− SecuritySchemeHttp <$> case scheme of
1445− "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
1446− "basic" -> pure HttpSchemeBasic
1447− t -> pure $ HttpSchemeCustom t
1402+ "http" -> pure SecuritySchemeHttp
14481403 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1449− "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1450− "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1404+ "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
14511405 _ -> empty
14521406 parseJSON _ = empty
14531407
1454−instance FromJSON OpenApi where
1455− parseJSON = sopSwaggerGenericParseJSON
1456−
1457−instance FromJSON Server where
1408+instance FromJSON Swagger where
14581409 parseJSON = sopSwaggerGenericParseJSON
14591410
14601411instance FromJSON SecurityScheme where
@@ -1463,36 +1414,78 @@ instance FromJSON SecurityScheme where
14631414instance FromJSON Schema where
14641415 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
14651416 where nullaryCleanup :: Schema -> Schema
1466− nullaryCleanup s =
1467− if _schemaItems s == Just (OpenApiItemsArray [])
1417+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1418+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
14681419 then s { _schemaExample = Nothing
1469− , _schemaMaxItems = Nothing
1470− }
1420+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
14711421 else s
14721422
14731423instance FromJSON Header where
14741424 parseJSON = sopSwaggerGenericParseJSON
14751425
1476−instance FromJSON OpenApiItems where
1426+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1427+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1428+ <$> o .:? "collectionFormat"
1429+ <*> (o .: "items" >>= parseJSON)
1430+
1431+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1432+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1433+ <$> o .:? "collectionFormat"
1434+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1435+
1436+-- |
1437+--
1438+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1439+-- Just (SwaggerItemsArray [])
1440+--
1441+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1442+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1443+--
1444+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1445+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1446+--
1447+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
14771448 parseJSON js@(Object obj)
1478− | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
1479− | otherwise = OpenApiItemsObject <$> parseJSON js
1480− parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
1449+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1450+ | otherwise = SwaggerItemsObject <$> parseJSON js
1451+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
14811452 parseJSON _ = empty
14821453
14831454instance FromJSON Components where
14841455 parseJSON = sopSwaggerGenericParseJSON
14851456
1457+instance FromJSON Host where
1458+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1459+ [host] -> return $ Host host Nothing
1460+ [host, port] -> case readMaybe port of
1461+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1462+ Just p -> return $ Host host (Just (fromInteger p))
1463+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1464+ parseJSON _ = empty
1465+
14861466instance FromJSON MimeList where
1487− parseJSON js = MimeList . map fromString <$> parseJSON js
1467+ parseJSON js = (MimeList . map fromString) <$> parseJSON js
14881468
14891469instance FromJSON Param where
14901470 parseJSON = sopSwaggerGenericParseJSON
14911471
1472+instance FromJSON ParamAnySchema where
1473+ parseJSON js@(Object o) = do
1474+ (i :: Text) <- o .: "in"
1475+ case i of
1476+ "body" -> do
1477+ schema <- o .: "schema"
1478+ ParamBody <$> parseJSON schema
1479+ _ -> ParamOther <$> parseJSON js
1480+ parseJSON _ = empty
1481+
1482+instance FromJSON ParamOtherSchema where
1483+ parseJSON = sopSwaggerGenericParseJSON
1484+
14921485instance FromJSON Responses where
14931486 parseJSON (Object o) = Responses
14941487 <$> o .:? "default"
1495− <*> parseJSON (Object (deleteKey "default" o))
1488+ <*> (parseJSON (Object (HashMap.delete "default" o)))
14961489 parseJSON _ = empty
14971490
14981491instance FromJSON Example where
@@ -1507,9 +1500,6 @@ instance FromJSON Operation where
15071500instance FromJSON PathItem where
15081501 parseJSON = sopSwaggerGenericParseJSON
15091502
1510−instance FromJSON SecurityDefinitions where
1511− parseJSON js = SecurityDefinitions <$> parseJSON js
1512−
15131503instance FromJSON RequestBody where
15141504 parseJSON = sopSwaggerGenericParseJSON
15151505
@@ -1519,8 +1509,8 @@ instance FromJSON MediaTypeObject where
15191509instance FromJSON Encoding where
15201510 parseJSON = sopSwaggerGenericParseJSON
15211511
1522−instance FromJSON Link where
1523− parseJSON = sopSwaggerGenericParseJSON
1512+instance FromJSON SecurityDefinitions where
1513+ parseJSON js = SecurityDefinitions <$> parseJSON js
15241514
15251515instance FromJSON Reference where
15261516 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1545,38 +1535,52 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
15451535instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
15461536instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
15471537instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
1548−instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"
1549−instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
15501538
15511539instance FromJSON Xml where
15521540 parseJSON = genericParseJSON (jsonPrefix "xml")
15531541
1542+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1543+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1544+
1545+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1546+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1547+
1548+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1549+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1550+
1551+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1552+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1553+
1554+-- NOTE: There aren't collections of 'Schema'
1555+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1556+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1557+
1558+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1559+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1560+
1561+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1562+ parseJSON = sopSwaggerGenericParseJSON
1563+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1564+ parseJSON = sopSwaggerGenericParseJSON
1565+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1566+ parseJSON = sopSwaggerGenericParseJSON
1567+
15541568instance FromJSON AdditionalProperties where
15551569 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
15561570 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
15571571
1558−-- | All strings are parsed as expressions
1559−instance FromJSON ExpressionOrValue where
1560− parseJSON (String expr) = pure $ Expression expr
1561− parseJSON v = pure $ Value v
1562−
1563−instance FromJSON Callback where
1564− parseJSON = fmap Callback . parseJSON
1565−
1566−instance HasSwaggerAesonOptions Server where
1567− swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
15681572instance HasSwaggerAesonOptions Components where
15691573 swaggerAesonOptions _ = mkSwaggerAesonOptions "components"
15701574instance HasSwaggerAesonOptions Header where
1571− swaggerAesonOptions _ = mkSwaggerAesonOptions "header"
1572−instance AesonDefaultValue p => HasSwaggerAesonOptions (OAuth2Flow p) where
1573− swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "params"
1574−instance HasSwaggerAesonOptions OAuth2Flows where
1575− swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows"
1575+ swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1576+instance HasSwaggerAesonOptions OAuth2Params where
1577+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
15761578instance HasSwaggerAesonOptions Operation where
15771579 swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
15781580instance HasSwaggerAesonOptions Param where
1579− swaggerAesonOptions _ = mkSwaggerAesonOptions "param"
1581+ swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1582+instance HasSwaggerAesonOptions ParamOtherSchema where
1583+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
15801584instance HasSwaggerAesonOptions PathItem where
15811585 swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
15821586instance HasSwaggerAesonOptions Response where
@@ -1591,29 +1595,29 @@ instance HasSwaggerAesonOptions SecurityScheme where
15911595 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
15921596instance HasSwaggerAesonOptions Schema where
15931597 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1594−instance HasSwaggerAesonOptions OpenApi where
1595− swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1598+instance HasSwaggerAesonOptions Swagger where
1599+ swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.3")]
15961600instance HasSwaggerAesonOptions Example where
15971601 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
15981602instance HasSwaggerAesonOptions Encoding where
15991603 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
16001604
1601−instance HasSwaggerAesonOptions Link where
1602− swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
1605+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1606+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1607+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1608+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1609+-- NOTE: Schema doesn't have 'items' sub object!
1610+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1611+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
16031612
1604−instance AesonDefaultValue Server
16051613instance AesonDefaultValue Components
1606−instance AesonDefaultValue OAuth2ImplicitFlow
1607−instance AesonDefaultValue OAuth2PasswordFlow
1608−instance AesonDefaultValue OAuth2ClientCredentialsFlow
1609−instance AesonDefaultValue OAuth2AuthorizationCodeFlow
1610−instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1614+instance AesonDefaultValue (ParamSchema s)
1615+instance AesonDefaultValue OAuth2Flow
16111616instance AesonDefaultValue Responses
1617+instance AesonDefaultValue ParamAnySchema
16121618instance AesonDefaultValue SecuritySchemeType
1613−instance AesonDefaultValue OpenApiType
1619+instance AesonDefaultValue (SwaggerType a)
16141620instance AesonDefaultValue MimeList where defaultValue = Just mempty
16151621instance AesonDefaultValue Info
16161622instance AesonDefaultValue ParamLocation
1617−instance AesonDefaultValue Link
1618−instance AesonDefaultValue SecurityDefinitions where
1619− defaultValue = Just mempty
1623+instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty