@@ -1,94 +1,140 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
15{-# LANGUAGE DeriveGeneric #-}
26{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE FlexibleContexts #-}
38{-# LANGUAGE FlexibleInstances #-}
9+{-# LANGUAGE GADTs #-}
410{-# LANGUAGE GeneralizedNewtypeDeriving #-}
511{-# LANGUAGE OverloadedStrings #-}
612{-# LANGUAGE RecordWildCards #-}
713{-# LANGUAGE ScopedTypeVariables #-}
814{-# LANGUAGE StandaloneDeriving #-}
915{-# LANGUAGE TemplateHaskell #-}
16+{-# LANGUAGE TypeFamilies #-}
17+{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ <710
19+{-# LANGUAGE PolyKinds #-}
20+#endif
21+#include "overlapping-compat.h"
1022module Data.Swagger.Internal where
1123
24+import Prelude ()
25+import Prelude.Compat
26+
27+import Control.Lens ((&), (.~), (?~))
1228import Control.Applicative
13−import Control.Monad
1429import Data.Aeson
15−import Data.Aeson.TH (deriveJSON)
16−import Data.HashMap.Strict (HashMap)
30+import qualified Data.Aeson.Types as JSON
31+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32+import Data.Hashable (Hashable)
1733import qualified Data.HashMap.Strict as HashMap
34+import Data.HashSet.InsOrd (InsOrdHashSet)
1835import Data.Map (Map)
1936import qualified Data.Map as Map
20−import Data.Monoid
37+import Data.Monoid (Monoid (..))
38+import Data.Semigroup.Compat (Semigroup (..))
2139import Data.Scientific (Scientific)
22−import Data.String (fromString)
40+import Data.String (IsString(..))
2341import Data.Text (Text)
2442import qualified Data.Text as Text
2543import GHC.Generics (Generic)
26−import Network (HostName, PortNumber)
44+import Network.Socket (HostName, PortNumber)
2745import Network.HTTP.Media (MediaType)
2846import Text.Read (readMaybe)
2947
48+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50+
51+import Generics.SOP.TH (deriveGeneric)
52+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53+ ,sopSwaggerGenericToJSONWithOpts
54+ ,sopSwaggerGenericParseJSON
55+ ,HasSwaggerAesonOptions(..)
56+ ,AesonDefaultValue(..)
57+ ,mkSwaggerAesonOptions
58+ ,saoAdditionalPairs
59+ ,saoSubObject)
3060import Data.Swagger.Internal.Utils
3161
62+#if MIN_VERSION_aeson(0,10,0)
63+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64+#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65+#else
66+#define DEFINE_TOENCODING
67+#endif
68+
69+-- $setup
70+-- >>> :seti -XDataKinds
71+-- >>> import Data.Aeson
72+
73+-- | A list of definitions that can be used in references.
74+type Definitions = InsOrdHashMap Text
75+
3276-- | This is the root document object for the API specification.
3377data Swagger = Swagger
3478 { -- | Provides metadata about the API.
3579 -- The metadata can be used by the clients if needed.
36− _info :: Info
80+ _swaggerInfo :: Info
3781
3882 -- | The host (name or ip) serving the API. It MAY include a port.
3983 -- If the host is not included, the host serving the documentation is to be used (including the port).
40− , _host :: Maybe Host
84+ , _swaggerHost :: Maybe Host
4185
4286 -- | The base path on which the API is served, which is relative to the host.
4387 -- If it is not included, the API is served directly under the host.
4488 -- The value MUST start with a leading slash (/).
45− , _basePath :: Maybe FilePath
89+ , _swaggerBasePath :: Maybe FilePath
4690
4791 -- | The transfer protocol of the API.
4892 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
49− , _schemes :: Maybe [Scheme]
93+ , _swaggerSchemes :: Maybe [Scheme]
5094
5195 -- | A list of MIME types the APIs can consume.
5296 -- This is global to all APIs but can be overridden on specific API calls.
53− , _consumes :: MimeList
97+ , _swaggerConsumes :: MimeList
5498
5599 -- | A list of MIME types the APIs can produce.
56− -- This is global to all APIs but can be overridden on specific API calls.
57− , _produces :: MimeList
100+ -- This is global to all APIs but can be overridden on specific API calls.
101+ , _swaggerProduces :: MimeList
58102
59103 -- | The available paths and operations for the API.
60− , _paths :: Paths
104+ -- Holds the relative paths to the individual endpoints.
105+ -- The path is appended to the @'basePath'@ in order to construct the full URL.
106+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem
61107
62108 -- | An object to hold data types produced and consumed by operations.
63− , _definitions :: HashMap Text Schema
109+ , _swaggerDefinitions :: Definitions Schema
64110
65111 -- | An object to hold parameters that can be used across operations.
66112 -- This property does not define global parameters for all operations.
67− , _parameters :: HashMap Text Param
113+ , _swaggerParameters :: Definitions Param
68114
69115 -- | An object to hold responses that can be used across operations.
70116 -- This property does not define global responses for all operations.
71− , _responses :: HashMap Text Response
117+ , _swaggerResponses :: Definitions Response
72118
73119 -- | Security scheme definitions that can be used across the specification.
74− , _securityDefinitions :: HashMap Text SecurityScheme
120+ , _swaggerSecurityDefinitions :: SecurityDefinitions
75121
76122 -- | A declaration of which security schemes are applied for the API as a whole.
77123 -- The list of values describes alternative security schemes that can be used
78124 -- (that is, there is a logical OR between the security requirements).
79125 -- Individual operations can override this definition.
80− , _security :: [SecurityRequirement]
126+ , _swaggerSecurity :: [SecurityRequirement]
81127
82128 -- | A list of tags used by the specification with additional metadata.
83129 -- The order of the tags can be used to reflect on their order by the parsing tools.
84130 -- Not all tags that are used by the Operation Object must be declared.
85131 -- The tags that are not declared may be organized randomly or based on the tools' logic.
86132 -- Each tag name in the list MUST be unique.
87− , _tags :: [Tag]
133+ , _swaggerTags :: InsOrdHashSet Tag
88134
89135 -- | Additional external documentation.
90− , _externalDocs :: Maybe ExternalDocs
91− } deriving (Eq, Show, Generic)
136+ , _swaggerExternalDocs :: Maybe ExternalDocs
137+ } deriving (Eq, Show, Generic, Data, Typeable)
92138
93139-- | The object provides metadata about the API.
94140-- The metadata can be used by the clients if needed,
@@ -113,7 +159,7 @@ data Info = Info
113159 -- | Provides the version of the application API
114160 -- (not to be confused with the specification version).
115161 , _infoVersion :: Text
116− } deriving (Eq, Show, Generic)
162+ } deriving (Eq, Show, Generic, Data, Typeable)
117163
118164-- | Contact information for the exposed API.
119165data Contact = Contact
@@ -125,7 +171,7 @@ data Contact = Contact
125171
126172 -- | The email address of the contact person/organization.
127173 , _contactEmail :: Maybe Text
128− } deriving (Eq, Show)
174+ } deriving (Eq, Show, Generic, Data, Typeable)
129175
130176-- | License information for the exposed API.
131177data License = License
@@ -134,13 +180,32 @@ data License = License
134180
135181 -- | A URL to the license used for the API.
136182 , _licenseUrl :: Maybe URL
137− } deriving (Eq, Show)
183+ } deriving (Eq, Show, Generic, Data, Typeable)
184+
185+instance IsString License where
186+ fromString s = License (fromString s) Nothing
138187
139188-- | The host (name or ip) serving the API. It MAY include a port.
140189data Host = Host
141190 { _hostName :: HostName -- ^ Host name.
142191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
143− } deriving (Eq, Show)
192+ } deriving (Eq, Show, Generic, Typeable)
193+
194+instance IsString Host where
195+ fromString s = Host s Nothing
196+
197+hostConstr :: Constr
198+hostConstr = mkConstr hostDataType "Host" [] Prefix
199+
200+hostDataType :: DataType
201+hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
202+
203+instance Data Host where
204+ gunfold k z c = case constrIndex c of
205+ 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
206+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
207+ toConstr (Host _ _) = hostConstr
208+ dataTypeOf _ = hostDataType
144209
145210-- | The transfer protocol of the API.
146211data Scheme
@@ -148,14 +213,7 @@ data Scheme
148213 | Https
149214 | Ws
150215 | Wss
151− deriving (Eq, Show)
152−
153−-- | The available paths and operations for the API.
154−data Paths = Paths
155− { -- | Holds the relative paths to the individual endpoints.
156− -- The path is appended to the @'basePath'@ in order to construct the full URL.
157− _pathsMap :: HashMap FilePath PathItem
158− } deriving (Eq, Show, Generic)
216+ deriving (Eq, Show, Generic, Data, Typeable)
159217
160218-- | Describes the operations available on a single path.
161219-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -188,13 +246,13 @@ data PathItem = PathItem
188246 -- The list MUST NOT include duplicated parameters.
189247 -- A unique parameter is defined by a combination of a name and location.
190248 , _pathItemParameters :: [Referenced Param]
191− } deriving (Eq, Show, Generic)
249+ } deriving (Eq, Show, Generic, Data, Typeable)
192250
193251-- | Describes a single API operation on a path.
194252data Operation = Operation
195253 { -- | A list of tags for API documentation control.
196254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
197− _operationTags :: [Text]
255+ _operationTags :: InsOrdHashSet TagName
198256
199257 -- | A short summary of what the operation does.
200258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -248,10 +306,23 @@ data Operation = Operation
248306 -- This definition overrides any declared top-level security.
249307 -- To remove a top-level security declaration, @Just []@ can be used.
250308 , _operationSecurity :: [SecurityRequirement]
251− } deriving (Eq, Show, Generic)
309+ } deriving (Eq, Show, Generic, Data, Typeable)
252310
253311newtype MimeList = MimeList { getMimeList :: [MediaType] }
254− deriving (Eq, Show, Monoid)
312+ deriving (Eq, Show, Semigroup, Monoid, Typeable)
313+
314+mimeListConstr :: Constr
315+mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
316+
317+mimeListDataType :: DataType
318+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
319+
320+instance Data MimeList where
321+ gunfold k z c = case constrIndex c of
322+ 1 -> k (z (\xs -> MimeList (map fromString xs)))
323+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
324+ toConstr (MimeList _) = mimeListConstr
325+ dataTypeOf _ = mimeListDataType
255326
256327-- | Describes a single operation parameter.
257328-- A unique parameter is defined by a combination of a name and location.
@@ -271,13 +342,13 @@ data Param = Param
271342 , _paramRequired :: Maybe Bool
272343
273344 -- | Parameter schema.
274− , _paramSchema :: ParamSchema
275− } deriving (Eq, Show, Generic)
345+ , _paramSchema :: ParamAnySchema
346+ } deriving (Eq, Show, Generic, Data, Typeable)
276347
277−data ParamSchema
348+data ParamAnySchema
278349 = ParamBody (Referenced Schema)
279350 | ParamOther ParamOtherSchema
280− deriving (Eq, Show)
351+ deriving (Eq, Show, Generic, Data, Typeable)
281352
282353data ParamOtherSchema = ParamOtherSchema
283354 { -- | The location of the parameter.
@@ -289,21 +360,140 @@ data ParamOtherSchema = ParamOtherSchema
289360 -- Default value is @False@.
290361 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
291362
292− -- | Determines the format of the array if @'ParamArray'@ is used.
293− -- Default value is csv.
294− , _paramOtherSchemaCollectionFormat :: Maybe CollectionFormat
295−
296− , _paramOtherSchemaCommon :: SchemaCommon ParamType Items
297− } deriving (Eq, Show, Generic)
298−
299−data ParamType
300− = ParamString
301− | ParamNumber
302− | ParamInteger
303− | ParamBoolean
304− | ParamArray
305− | ParamFile
306− deriving (Eq, Show)
363+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364+ } deriving (Eq, Show, Generic, Typeable, Data)
365+
366+-- | Items for @'SwaggerArray'@ schemas.
367+--
368+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
369+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
370+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
371+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
372+--
373+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
374+--
375+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376+data SwaggerItems t where
377+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
380+ deriving (Typeable)
381+
382+deriving instance Eq (SwaggerItems t)
383+deriving instance Show (SwaggerItems t)
384+--deriving instance Typeable (SwaggerItems t)
385+
386+swaggerItemsPrimitiveConstr :: Constr
387+swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388+
389+swaggerItemsObjectConstr :: Constr
390+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391+
392+swaggerItemsArrayConstr :: Constr
393+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394+
395+swaggerItemsDataType :: DataType
396+swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397+
398+-- Note: unfortunately we have to write these Data instances by hand,
399+-- to get better contexts / avoid duplicate name when using standalone deriving
400+
401+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402+ -- TODO: define gfoldl
403+ gunfold k z c = case constrIndex c of
404+ 1 -> k (k (z SwaggerItemsPrimitive))
405+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406+ toConstr _ = swaggerItemsPrimitiveConstr
407+ dataTypeOf _ = swaggerItemsDataType
408+
409+-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411+ -- TODO: define gfoldl
412+ gunfold k z c = case constrIndex c of
413+ 1 -> k (k (z SwaggerItemsPrimitive))
414+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415+ toConstr _ = swaggerItemsPrimitiveConstr
416+ dataTypeOf _ = swaggerItemsDataType
417+
418+instance Data (SwaggerItems 'SwaggerKindSchema) where
419+ gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420+ gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421+ gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
422+
423+ gunfold k z c = case constrIndex c of
424+ 2 -> k (z SwaggerItemsObject)
425+ 3 -> k (z SwaggerItemsArray)
426+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
427+
428+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431+
432+ dataTypeOf _ = swaggerItemsDataType
433+
434+-- | Type used as a kind to avoid overlapping instances.
435+data SwaggerKind t
436+ = SwaggerKindNormal t
437+ | SwaggerKindParamOtherSchema
438+ | SwaggerKindSchema
439+ deriving (Typeable)
440+
441+deriving instance Typeable 'SwaggerKindNormal
442+deriving instance Typeable 'SwaggerKindParamOtherSchema
443+deriving instance Typeable 'SwaggerKindSchema
444+
445+type family SwaggerKindType (k :: SwaggerKind *) :: *
446+type instance SwaggerKindType ('SwaggerKindNormal t) = t
447+type instance SwaggerKindType 'SwaggerKindSchema = Schema
448+type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
449+
450+data SwaggerType t where
451+ SwaggerString :: SwaggerType t
452+ SwaggerNumber :: SwaggerType t
453+ SwaggerInteger :: SwaggerType t
454+ SwaggerBoolean :: SwaggerType t
455+ SwaggerArray :: SwaggerType t
456+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457+ SwaggerNull :: SwaggerType 'SwaggerKindSchema
458+ SwaggerObject :: SwaggerType 'SwaggerKindSchema
459+ deriving (Typeable)
460+
461+deriving instance Eq (SwaggerType t)
462+deriving instance Show (SwaggerType t)
463+
464+swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465+swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466+
467+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
468+swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469+
470+swaggerCommonTypes :: [SwaggerType k]
471+swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472+
473+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
474+swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475+
476+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
477+swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478+
479+swaggerTypeConstrs :: [Constr]
480+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
481+ ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482+
483+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
484+ gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485+ toConstr = swaggerTypeConstr
486+ dataTypeOf = swaggerTypeDataType
487+
488+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
489+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490+ toConstr = swaggerTypeConstr
491+ dataTypeOf = swaggerTypeDataType
492+
493+instance Data (SwaggerType 'SwaggerKindSchema) where
494+ gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495+ toConstr = swaggerTypeConstr
496+ dataTypeOf = swaggerTypeDataType
307497
308498data ParamLocation
309499 = -- | Parameters that are appended to the URL.
@@ -323,46 +513,45 @@ data ParamLocation
323513 -- Form parameters have a different format based on the content-type used
324514 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
325515 | ParamFormData
326− deriving (Eq, Show)
516+ deriving (Eq, Show, Generic, Data, Typeable)
327517
328518type Format = Text
329519
330520-- | Determines the format of the array.
331−data CollectionFormat
332− = CollectionCSV -- ^ Comma separated values: @foo,bar@.
333− | CollectionSSV -- ^ Space separated values: @foo bar@.
334− | CollectionTSV -- ^ Tab separated values: @foo\\tbar@.
335− | CollectionPipes -- ^ Pipe separated values: @foo|bar@.
336− | CollectionMulti -- ^ Corresponds to multiple parameter instances
337− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
338− -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
339− deriving (Eq, Show)
340−
341−data ItemsType
342− = ItemsString
343− | ItemsNumber
344− | ItemsInteger
345− | ItemsBoolean
346− | ItemsArray
347− deriving (Eq, Show)
348−
349−data SchemaType
350− = SchemaArray
351− | SchemaBoolean
352− | SchemaInteger
353− | SchemaNumber
354− | SchemaNull
355− | SchemaObject
356− | SchemaString
357− deriving (Eq, Show)
358−
359−-- | Determines the format of the nested array.
360−data ItemsCollectionFormat
361− = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
362− | ItemsCollectionSSV -- ^ Space separated values: @foo bar@.
363− | ItemsCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
364− | ItemsCollectionPipes -- ^ Pipe separated values: @foo|bar@.
365− deriving (Eq, Show)
521+data CollectionFormat t where
522+ -- Comma separated values: @foo,bar@.
523+ CollectionCSV :: CollectionFormat t
524+ -- Space separated values: @foo bar@.
525+ CollectionSSV :: CollectionFormat t
526+ -- Tab separated values: @foo\\tbar@.
527+ CollectionTSV :: CollectionFormat t
528+ -- Pipe separated values: @foo|bar@.
529+ CollectionPipes :: CollectionFormat t
530+ -- Corresponds to multiple parameter instances
531+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
534+ deriving (Typeable)
535+
536+deriving instance Eq (CollectionFormat t)
537+deriving instance Show (CollectionFormat t)
538+
539+collectionFormatConstr :: CollectionFormat t -> Constr
540+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
541+
542+collectionFormatDataType :: DataType
543+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
544+ map collectionFormatConstr collectionCommonFormats
545+
546+collectionCommonFormats :: [CollectionFormat t]
547+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548+
549+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
550+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551+ toConstr = collectionFormatConstr
552+ dataTypeOf _ = collectionFormatDataType
553+
554+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
366555
367556type ParamName = Text
368557
@@ -371,9 +560,9 @@ data Schema = Schema
371560 , _schemaDescription :: Maybe Text
372561 , _schemaRequired :: [ParamName]
373562
374− , _schemaAllOf :: Maybe [Schema]
375− , _schemaProperties :: HashMap Text (Referenced Schema)
376− , _schemaAdditionalProperties :: Maybe Schema
563+ , _schemaAllOf :: Maybe [Referenced Schema]
564+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
377566
378567 , _schemaDiscriminator :: Maybe Text
379568 , _schemaReadOnly :: Maybe Bool
@@ -384,42 +573,49 @@ data Schema = Schema
384573 , _schemaMaxProperties :: Maybe Integer
385574 , _schemaMinProperties :: Maybe Integer
386575
387− , _schemaSchemaCommon :: SchemaCommon SchemaType SchemaItems
388− } deriving (Eq, Show, Generic)
576+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577+ } deriving (Eq, Show, Generic, Data, Typeable)
578+
579+-- | A @'Schema'@ with an optional name.
580+-- This name can be used in references.
581+data NamedSchema = NamedSchema
582+ { _namedSchemaName :: Maybe Text
583+ , _namedSchemaSchema :: Schema
584+ } deriving (Eq, Show, Generic, Data, Typeable)
389585
390−data SchemaItems
391− = SchemaItemsObject (Referenced Schema)
392− | SchemaItemsArray [Referenced Schema]
393− deriving (Eq, Show)
586+-- | Regex pattern for @string@ type.
587+type Pattern = Text
394588
395−data SchemaCommon typeDomain items = SchemaCommon
589+data ParamSchema (t :: SwaggerKind *) = ParamSchema
396590 { -- | Declares the value of the parameter that the server will use if none is provided,
397591 -- for example a @"count"@ to control the number of results per page might default to @100@
398592 -- if not supplied by the client in the request.
399593 -- (Note: "default" has no meaning for required parameters.)
400594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
401− _schemaCommonDefault :: Maybe Value
402−
403− , _schemaCommonType :: typeDomain
404− , _schemaCommonFormat :: Maybe Format
405− , _schemaCommonItems :: Maybe items
406− , _schemaCommonMaximum :: Maybe Scientific
407− , _schemaCommonExclusiveMaximum :: Maybe Bool
408− , _schemaCommonMinimum :: Maybe Scientific
409− , _schemaCommonExclusiveMinimum :: Maybe Bool
410− , _schemaCommonMaxLength :: Maybe Integer
411− , _schemaCommonMinLength :: Maybe Integer
412− , _schemaCommonPattern :: Maybe Text
413− , _schemaCommonMaxItems :: Maybe Integer
414− , _schemaCommonMinItems :: Maybe Integer
415− , _schemaCommonUniqueItems :: Maybe Bool
416− , _schemaCommonEnum :: Maybe [Value]
417− , _schemaCommonMultipleOf :: Maybe Scientific
418− } deriving (Eq, Show, Generic)
595+ _paramSchemaDefault :: Maybe Value
596+
597+ , _paramSchemaType :: Maybe (SwaggerType t)
598+ , _paramSchemaFormat :: Maybe Format
599+ , _paramSchemaItems :: Maybe (SwaggerItems t)
600+ , _paramSchemaMaximum :: Maybe Scientific
601+ , _paramSchemaExclusiveMaximum :: Maybe Bool
602+ , _paramSchemaMinimum :: Maybe Scientific
603+ , _paramSchemaExclusiveMinimum :: Maybe Bool
604+ , _paramSchemaMaxLength :: Maybe Integer
605+ , _paramSchemaMinLength :: Maybe Integer
606+ , _paramSchemaPattern :: Maybe Pattern
607+ , _paramSchemaMaxItems :: Maybe Integer
608+ , _paramSchemaMinItems :: Maybe Integer
609+ , _paramSchemaUniqueItems :: Maybe Bool
610+ , _paramSchemaEnum :: Maybe [Value]
611+ , _paramSchemaMultipleOf :: Maybe Scientific
612+ } deriving (Eq, Show, Generic, Typeable)
613+
614+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
419615
420616data Xml = Xml
421617 { -- | Replaces the name of the element/attribute used for the described schema property.
422− -- When defined within the @'Items'@ (items), it will affect the name of the individual XML elements within the list.
618+ -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
423619 -- When defined alongside type being array (outside the items),
424620 -- it will affect the wrapping element and only if wrapped is true.
425621 -- If wrapped is false, it will be ignored.
@@ -443,15 +639,7 @@ data Xml = Xml
443639 -- Default value is @False@.
444640 -- The definition takes effect only when defined alongside type being array (outside the items).
445641 , _xmlWrapped :: Maybe Bool
446− } deriving (Eq, Show, Generic)
447−
448−data Items = Items
449− { -- | Determines the format of the array if type array is used.
450− -- Default value is @'ItemsCollectionCSV'@.
451− _itemsCollectionFormat :: Maybe ItemsCollectionFormat
452−
453− , _itemsCommon :: SchemaCommon ItemsType Items
454− } deriving (Eq, Show, Generic)
642+ } deriving (Eq, Show, Generic, Data, Typeable)
455643
456644-- | A container for the expected responses of an operation.
457645-- The container maps a HTTP response code to the expected response.
@@ -465,8 +653,8 @@ data Responses = Responses
465653
466654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
467655 -- Describes the expected response for those HTTP status codes.
468− , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
469− } deriving (Eq, Show, Generic)
656+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
657+ } deriving (Eq, Show, Generic, Data, Typeable)
470658
471659type HttpStatusCode = Int
472660
@@ -484,11 +672,14 @@ data Response = Response
484672 , _responseSchema :: Maybe (Referenced Schema)
485673
486674 -- | A list of headers that are sent with the response.
487− , _responseHeaders :: HashMap HeaderName Header
675+ , _responseHeaders :: InsOrdHashMap HeaderName Header
488676
489677 -- | An example of the response message.
490678 , _responseExamples :: Maybe Example
491− } deriving (Eq, Show, Generic)
679+ } deriving (Eq, Show, Generic, Data, Typeable)
680+
681+instance IsString Response where
682+ fromString s = Response (fromString s) Nothing mempty Nothing
492683
493684type HeaderName = Text
494685
@@ -496,21 +687,30 @@ data Header = Header
496687 { -- | A short description of the header.
497688 _headerDescription :: Maybe Text
498689
499− -- | Determines the format of the array if type array is used.
500− -- Default value is @'ItemsCollectionCSV'@.
501− , _headerCollectionFormat :: Maybe ItemsCollectionFormat
502−
503− , _headerCommon :: SchemaCommon ItemsType Items
504− } deriving (Eq, Show, Generic)
690+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
691+ } deriving (Eq, Show, Generic, Data, Typeable)
505692
506693data Example = Example { getExample :: Map MediaType Value }
507− deriving (Eq, Show)
694+ deriving (Eq, Show, Generic, Typeable)
695+
696+exampleConstr :: Constr
697+exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
698+
699+exampleDataType :: DataType
700+exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
701+
702+instance Data Example where
703+ gunfold k z c = case constrIndex c of
704+ 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
705+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
706+ toConstr (Example _) = exampleConstr
707+ dataTypeOf _ = exampleDataType
508708
509709-- | The location of the API key.
510710data ApiKeyLocation
511711 = ApiKeyQuery
512712 | ApiKeyHeader
513− deriving (Eq, Show)
713+ deriving (Eq, Show, Generic, Data, Typeable)
514714
515715data ApiKeyParams = ApiKeyParams
516716 { -- | The name of the header or query parameter to be used.
@@ -518,7 +718,7 @@ data ApiKeyParams = ApiKeyParams
518718
519719 -- | The location of the API key.
520720 , _apiKeyIn :: ApiKeyLocation
521− } deriving (Eq, Show)
721+ } deriving (Eq, Show, Generic, Data, Typeable)
522722
523723-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
524724type AuthorizationURL = Text
@@ -531,21 +731,21 @@ data OAuth2Flow
531731 | OAuth2Password TokenURL
532732 | OAuth2Application TokenURL
533733 | OAuth2AccessCode AuthorizationURL TokenURL
534− deriving (Eq, Show)
734+ deriving (Eq, Show, Generic, Data, Typeable)
535735
536736data OAuth2Params = OAuth2Params
537737 { -- | The flow used by the OAuth2 security scheme.
538738 _oauth2Flow :: OAuth2Flow
539739
540740 -- | The available scopes for the OAuth2 security scheme.
541− , _oauth2Scopes :: HashMap Text Text
542− } deriving (Eq, Show, Generic)
741+ , _oauth2Scopes :: InsOrdHashMap Text Text
742+ } deriving (Eq, Show, Generic, Data, Typeable)
543743
544744data SecuritySchemeType
545745 = SecuritySchemeBasic
546746 | SecuritySchemeApiKey ApiKeyParams
547747 | SecuritySchemeOAuth2 OAuth2Params
548− deriving (Eq, Show)
748+ deriving (Eq, Show, Generic, Data, Typeable)
549749
550750data SecurityScheme = SecurityScheme
551751 { -- | The type of the security scheme.
@@ -553,20 +753,39 @@ data SecurityScheme = SecurityScheme
553753
554754 -- | A short description for security scheme.
555755 , _securitySchemeDescription :: Maybe Text
556− } deriving (Eq, Show, Generic)
756+ } deriving (Eq, Show, Generic, Data, Typeable)
757+
758+
759+-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760+-- In other case returns first security scheme
761+mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762+mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763+ s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764+ = if flow1 == flow2 then
765+ SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
766+ else
767+ s1
768+mergeSecurityScheme s1 _ = s1
769+
770+newtype SecurityDefinitions
771+ = SecurityDefinitions (Definitions SecurityScheme)
772+ deriving (Eq, Show, Generic, Data, Typeable)
557773
558774-- | Lists the required security schemes to execute this operation.
559775-- The object can have multiple security schemes declared in it which are all required
560776-- (that is, there is a logical AND between the schemes).
561777newtype SecurityRequirement = SecurityRequirement
562− { getSecurityRequirement :: HashMap Text [Text]
563− } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
778+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
779+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
780+
781+-- | Tag name.
782+type TagName = Text
564783
565784-- | Allows adding meta data to a single tag that is used by @Operation@.
566785-- It is not mandatory to have a @Tag@ per tag used there.
567786data Tag = Tag
568787 { -- | The name of the tag.
569− _tagName :: Text
788+ _tagName :: TagName
570789
571790 -- | A short description for the tag.
572791 -- GFM syntax can be used for rich text representation.
@@ -574,7 +793,12 @@ data Tag = Tag
574793
575794 -- | Additional external documentation for this tag.
576795 , _tagExternalDocs :: Maybe ExternalDocs
577− } deriving (Eq, Show)
796+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797+
798+instance Hashable Tag
799+
800+instance IsString Tag where
801+ fromString s = Tag (fromString s) Nothing Nothing
578802
579803-- | Allows referencing an external resource for extended documentation.
580804data ExternalDocs = ExternalDocs
@@ -584,170 +808,236 @@ data ExternalDocs = ExternalDocs
584808
585809 -- | The URL for the target documentation.
586810 , _externalDocsUrl :: URL
587− } deriving (Eq, Show, Generic)
811+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812+
813+instance Hashable ExternalDocs
588814
589815-- | A simple object to allow referencing other definitions in the specification.
590816-- It can be used to reference parameters and responses that are defined at the top level for reuse.
591817newtype Reference = Reference { getReference :: Text }
592− deriving (Eq, Show)
818+ deriving (Eq, Show, Data, Typeable)
593819
594820data Referenced a
595821 = Ref Reference
596822 | Inline a
597− deriving (Eq, Show)
823+ deriving (Eq, Show, Functor, Data, Typeable)
824+
825+instance IsString a => IsString (Referenced a) where
826+ fromString = Inline . fromString
827+
828+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
598829
599−newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON)
830+data AdditionalProperties
831+ = AdditionalPropertiesAllowed Bool
832+ | AdditionalPropertiesSchema (Referenced Schema)
833+ deriving (Eq, Show, Data, Typeable)
600834
601835-- =======================================================================
602836-- Monoid instances
603837-- =======================================================================
604838
839+instance Semigroup Swagger where
840+ (<>) = genericMappend
605841instance Monoid Swagger where
606842 mempty = genericMempty
607− mappend = genericMappend
843+ mappend = (<>)
608844
845+instance Semigroup Info where
846+ (<>) = genericMappend
609847instance Monoid Info where
610848 mempty = genericMempty
611− mappend = genericMappend
849+ mappend = (<>)
612850
613−instance Monoid Paths where
851+instance Semigroup Contact where
852+ (<>) = genericMappend
853+instance Monoid Contact where
614854 mempty = genericMempty
615− mappend = genericMappend
855+ mappend = (<>)
616856
857+instance Semigroup PathItem where
858+ (<>) = genericMappend
617859instance Monoid PathItem where
618860 mempty = genericMempty
619− mappend = genericMappend
861+ mappend = (<>)
620862
863+instance Semigroup Schema where
864+ (<>) = genericMappend
621865instance Monoid Schema where
622866 mempty = genericMempty
623− mappend = genericMappend
867+ mappend = (<>)
624868
625−instance SwaggerMonoid t => Monoid (SchemaCommon t i) where
869+instance Semigroup (ParamSchema t) where
870+ (<>) = genericMappend
871+instance Monoid (ParamSchema t) where
626872 mempty = genericMempty
627− mappend = genericMappend
873+ mappend = (<>)
628874
875+instance Semigroup Param where
876+ (<>) = genericMappend
629877instance Monoid Param where
630878 mempty = genericMempty
631− mappend = genericMappend
879+ mappend = (<>)
632880
881+instance Semigroup ParamOtherSchema where
882+ (<>) = genericMappend
633883instance Monoid ParamOtherSchema where
634884 mempty = genericMempty
635− mappend = genericMappend
885+ mappend = (<>)
886+
887+instance Semigroup Header where
888+ (<>) = genericMappend
889+instance Monoid Header where
890+ mempty = genericMempty
891+ mappend = (<>)
636892
893+instance Semigroup Responses where
894+ (<>) = genericMappend
637895instance Monoid Responses where
638896 mempty = genericMempty
639− mappend = genericMappend
897+ mappend = (<>)
640898
899+instance Semigroup Response where
900+ (<>) = genericMappend
641901instance Monoid Response where
642902 mempty = genericMempty
643− mappend = genericMappend
903+ mappend = (<>)
644904
905+instance Semigroup ExternalDocs where
906+ (<>) = genericMappend
645907instance Monoid ExternalDocs where
646908 mempty = genericMempty
647− mappend = genericMappend
909+ mappend = (<>)
648910
911+instance Semigroup Operation where
912+ (<>) = genericMappend
649913instance Monoid Operation where
650914 mempty = genericMempty
651− mappend = genericMappend
915+ mappend = (<>)
916+
917+instance Semigroup Example where
918+ (<>) = genericMappend
919+instance Monoid Example where
920+ mempty = genericMempty
921+ mappend = (<>)
922+
923+instance Semigroup SecurityScheme where
924+ (<>) = mergeSecurityScheme
925+
926+instance Semigroup SecurityDefinitions where
927+ (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928+ SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929+
930+instance Monoid SecurityDefinitions where
931+ mempty = SecurityDefinitions $ InsOrdHashMap.empty
932+ mappend = (<>)
652933
653934-- =======================================================================
654935-- SwaggerMonoid helper instances
655936-- =======================================================================
656937
657938instance SwaggerMonoid Info
658−instance SwaggerMonoid Paths
659939instance SwaggerMonoid PathItem
660940instance SwaggerMonoid Schema
661−instance SwaggerMonoid t => SwaggerMonoid (SchemaCommon t i)
941+instance SwaggerMonoid (ParamSchema t)
662942instance SwaggerMonoid Param
663943instance SwaggerMonoid ParamOtherSchema
664944instance SwaggerMonoid Responses
665945instance SwaggerMonoid Response
666946instance SwaggerMonoid ExternalDocs
667947instance SwaggerMonoid Operation
948+instance SwaggerMonoid SecurityDefinitions
949+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
668950
669951instance SwaggerMonoid MimeList
670952deriving instance SwaggerMonoid URL
671953
672−instance SwaggerMonoid SchemaType where
673− swaggerMempty = SchemaNull
674− swaggerMappend _ y = y
675−
676−instance SwaggerMonoid ParamType where
677− swaggerMempty = ParamString
954+instance SwaggerMonoid (SwaggerType t) where
955+ swaggerMempty = SwaggerString
678956 swaggerMappend _ y = y
679957
680958instance SwaggerMonoid ParamLocation where
681959 swaggerMempty = ParamQuery
682960 swaggerMappend _ y = y
683961
684−instance SwaggerMonoid (HashMap Text Schema) where
685− swaggerMempty = HashMap.empty
686− swaggerMappend = HashMap.unionWith mappend
687−
688−instance SwaggerMonoid (HashMap Text (Referenced Schema)) where
689− swaggerMempty = HashMap.empty
690− swaggerMappend = HashMap.unionWith swaggerMappend
962+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963+ swaggerMempty = InsOrdHashMap.empty
964+ swaggerMappend = InsOrdHashMap.unionWith mappend
691965
692966instance Monoid a => SwaggerMonoid (Referenced a) where
693967 swaggerMempty = Inline mempty
694− swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
968+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
695969 swaggerMappend _ y = y
696970
697−instance SwaggerMonoid (HashMap Text Param) where
698− swaggerMempty = HashMap.empty
699− swaggerMappend = HashMap.unionWith mappend
971+instance SwaggerMonoid ParamAnySchema where
972+ swaggerMempty = ParamOther swaggerMempty
973+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
974+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
975+ swaggerMappend _ y = y
700976
701−instance SwaggerMonoid (HashMap Text Response) where
702− swaggerMempty = HashMap.empty
703− swaggerMappend = flip HashMap.union
977+-- =======================================================================
978+-- Simple Generic-based ToJSON instances
979+-- =======================================================================
704980
705−instance SwaggerMonoid (HashMap Text SecurityScheme) where
706− swaggerMempty = HashMap.empty
707− swaggerMappend = flip HashMap.union
981+instance ToJSON ParamLocation where
982+ toJSON = genericToJSON (jsonPrefix "Param")
708983
709−instance SwaggerMonoid (HashMap FilePath PathItem) where
710− swaggerMempty = HashMap.empty
711− swaggerMappend = HashMap.unionWith mappend
984+instance ToJSON Info where
985+ toJSON = genericToJSON (jsonPrefix "Info")
712986
713−instance SwaggerMonoid (HashMap HeaderName Header) where
714− swaggerMempty = HashMap.empty
715− swaggerMappend = flip HashMap.union
987+instance ToJSON Contact where
988+ toJSON = genericToJSON (jsonPrefix "Contact")
716989
717−instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where
718− swaggerMempty = HashMap.empty
719− swaggerMappend = flip HashMap.union
990+instance ToJSON License where
991+ toJSON = genericToJSON (jsonPrefix "License")
720992
721−instance SwaggerMonoid ParamSchema where
722− swaggerMempty = ParamOther swaggerMempty
723− swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
724− swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
725− swaggerMappend _ y = y
993+instance ToJSON ApiKeyLocation where
994+ toJSON = genericToJSON (jsonPrefix "ApiKey")
995+
996+instance ToJSON ApiKeyParams where
997+ toJSON = genericToJSON (jsonPrefix "apiKey")
998+
999+instance ToJSON Scheme where
1000+ toJSON = genericToJSON (jsonPrefix "")
1001+
1002+instance ToJSON Tag where
1003+ toJSON = genericToJSON (jsonPrefix "Tag")
1004+
1005+instance ToJSON ExternalDocs where
1006+ toJSON = genericToJSON (jsonPrefix "ExternalDocs")
1007+
1008+instance ToJSON Xml where
1009+ toJSON = genericToJSON (jsonPrefix "Xml")
7261010
7271011-- =======================================================================
728−-- TH derived ToJSON and FromJSON instances
1012+-- Simple Generic-based FromJSON instances
7291013-- =======================================================================
7301014
731−deriveJSON (jsonPrefix "Param") ''ParamLocation
732−deriveJSON (jsonPrefix "Param") ''ParamType
733−deriveJSON' ''Info
734−deriveJSON' ''Contact
735−deriveJSON' ''License
736−deriveJSON (jsonPrefix "Schema") ''SchemaType
737−deriveJSON (jsonPrefix "Items") ''ItemsType
738−deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
739−deriveJSON (jsonPrefix "Collection") ''CollectionFormat
740−deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
741−deriveJSON (jsonPrefix "apiKey") ''ApiKeyParams
742−deriveJSON' ''SchemaCommon
743−deriveJSONDefault ''Scheme
744−deriveJSON' ''Tag
745−deriveJSON' ''ExternalDocs
746−
747−deriveToJSON' ''Operation
748−deriveToJSON' ''Response
749−deriveToJSON' ''PathItem
750−deriveToJSON' ''Xml
1015+instance FromJSON ParamLocation where
1016+ parseJSON = genericParseJSON (jsonPrefix "Param")
1017+
1018+instance FromJSON Info where
1019+ parseJSON = genericParseJSON (jsonPrefix "Info")
1020+
1021+instance FromJSON Contact where
1022+ parseJSON = genericParseJSON (jsonPrefix "Contact")
1023+
1024+instance FromJSON License where
1025+ parseJSON = genericParseJSON (jsonPrefix "License")
1026+
1027+instance FromJSON ApiKeyLocation where
1028+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1029+
1030+instance FromJSON ApiKeyParams where
1031+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
1032+
1033+instance FromJSON Scheme where
1034+ parseJSON = genericParseJSON (jsonPrefix "")
1035+
1036+instance FromJSON Tag where
1037+ parseJSON = genericParseJSON (jsonPrefix "Tag")
1038+
1039+instance FromJSON ExternalDocs where
1040+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
7511041
7521042-- =======================================================================
7531043-- Manual ToJSON instances
@@ -769,7 +1059,8 @@ instance ToJSON OAuth2Flow where
7691059 , "tokenUrl" .= tokenUrl ]
7701060
7711061instance ToJSON OAuth2Params where
772− toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1062+ toJSON = sopSwaggerGenericToJSON
1063+ DEFINE_TOENCODING
7731064
7741065instance ToJSON SecuritySchemeType where
7751066 toJSON SecuritySchemeBasic
@@ -782,22 +1073,38 @@ instance ToJSON SecuritySchemeType where
7821073 <+> object [ "type" .= ("oauth2" :: Text) ]
7831074
7841075instance ToJSON Swagger where
785− toJSON = addVersion . genericToJSON (jsonPrefix "")
786− where
787− addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
788− addVersion _ = error "impossible"
1076+ toJSON = sopSwaggerGenericToJSON
1077+ DEFINE_TOENCODING
7891078
7901079instance ToJSON SecurityScheme where
791− toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1080+ toJSON = sopSwaggerGenericToJSON
1081+ DEFINE_TOENCODING
7921082
7931083instance ToJSON Schema where
794− toJSON = genericToJSONWithSub "schemaCommon" (jsonPrefix "schema")
1084+ toJSON = sopSwaggerGenericToJSON
1085+ DEFINE_TOENCODING
7951086
7961087instance ToJSON Header where
797− toJSON = genericToJSONWithSub "common" (jsonPrefix "header")
798−
799−instance ToJSON Items where
800− toJSON = genericToJSONWithSub "common" (jsonPrefix "items")
1088+ toJSON = sopSwaggerGenericToJSON
1089+ DEFINE_TOENCODING
1090+
1091+-- | As for nullary schema for 0-arity type constructors, see
1092+-- <https://github.com/GetShopTV/swagger2/issues/167>.
1093+--
1094+-- >>> encode (SwaggerItemsArray [])
1095+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1096+--
1097+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1098+ toJSON (SwaggerItemsPrimitive fmt schema) = object
1099+ [ "collectionFormat" .= fmt
1100+ , "items" .= schema ]
1101+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102+ toJSON (SwaggerItemsArray []) = object
1103+ [ "items" .= object []
1104+ , "maxItems" .= (0 :: Int)
1105+ , "example" .= Array mempty
1106+ ]
1107+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
8011108
8021109instance ToJSON Host where
8031110 toJSON (Host host mport) = toJSON $
@@ -805,38 +1112,79 @@ instance ToJSON Host where
8051112 Nothing -> host
8061113 Just port -> host ++ ":" ++ show port
8071114
808−instance ToJSON Paths where
809− toJSON (Paths m) = toJSON m
810−
8111115instance ToJSON MimeList where
8121116 toJSON (MimeList xs) = toJSON (map show xs)
8131117
8141118instance ToJSON Param where
815− toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1119+ toJSON = sopSwaggerGenericToJSON
1120+ DEFINE_TOENCODING
8161121
817−instance ToJSON ParamSchema where
1122+instance ToJSON ParamAnySchema where
8181123 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
8191124 toJSON (ParamOther s) = toJSON s
8201125
8211126instance ToJSON ParamOtherSchema where
822− toJSON = genericToJSONWithSub "common" (jsonPrefix "paramOtherSchema")
823−
824−instance ToJSON SchemaItems where
825− toJSON (SchemaItemsObject x) = toJSON x
826− toJSON (SchemaItemsArray xs) = toJSON xs
1127+ toJSON = sopSwaggerGenericToJSON
1128+ DEFINE_TOENCODING
8271129
8281130instance ToJSON Responses where
829− toJSON (Responses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1131+ toJSON = sopSwaggerGenericToJSON
1132+ DEFINE_TOENCODING
1133+
1134+instance ToJSON Response where
1135+ toJSON = sopSwaggerGenericToJSON
1136+ DEFINE_TOENCODING
1137+
1138+instance ToJSON Operation where
1139+ toJSON = sopSwaggerGenericToJSON
1140+ DEFINE_TOENCODING
1141+
1142+instance ToJSON PathItem where
1143+ toJSON = sopSwaggerGenericToJSON
1144+ DEFINE_TOENCODING
8301145
8311146instance ToJSON Example where
8321147 toJSON = toJSON . Map.mapKeys show . getExample
8331148
1149+instance ToJSON SecurityDefinitions where
1150+ toJSON (SecurityDefinitions sd) = toJSON sd
1151+
8341152instance ToJSON Reference where
8351153 toJSON (Reference ref) = object [ "$ref" .= ref ]
8361154
837−instance ToJSON a => ToJSON (Referenced a) where
838− toJSON (Ref ref) = toJSON ref
839− toJSON (Inline x) = toJSON x
1155+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1156+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1157+referencedToJSON _ (Inline x) = toJSON x
1158+
1159+instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1160+instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1161+instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1162+
1163+instance ToJSON (SwaggerType t) where
1164+ toJSON SwaggerArray = "array"
1165+ toJSON SwaggerString = "string"
1166+ toJSON SwaggerInteger = "integer"
1167+ toJSON SwaggerNumber = "number"
1168+ toJSON SwaggerBoolean = "boolean"
1169+ toJSON SwaggerFile = "file"
1170+ toJSON SwaggerNull = "null"
1171+ toJSON SwaggerObject = "object"
1172+
1173+instance ToJSON (CollectionFormat t) where
1174+ toJSON CollectionCSV = "csv"
1175+ toJSON CollectionSSV = "ssv"
1176+ toJSON CollectionTSV = "tsv"
1177+ toJSON CollectionPipes = "pipes"
1178+ toJSON CollectionMulti = "multi"
1179+
1180+instance ToJSON (ParamSchema k) where
1181+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1182+ toJSON = sopSwaggerGenericToJSONWithOpts $
1183+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1184+
1185+instance ToJSON AdditionalProperties where
1186+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187+ toJSON (AdditionalPropertiesSchema s) = toJSON s
8401188
8411189-- =======================================================================
8421190-- Manual FromJSON instances
@@ -856,7 +1204,7 @@ instance FromJSON OAuth2Flow where
8561204 parseJSON _ = empty
8571205
8581206instance FromJSON OAuth2Params where
859− parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1207+ parseJSON = sopSwaggerGenericParseJSON
8601208
8611209instance FromJSON SecuritySchemeType where
8621210 parseJSON js@(Object o) = do
@@ -869,55 +1217,67 @@ instance FromJSON SecuritySchemeType where
8691217 parseJSON _ = empty
8701218
8711219instance FromJSON Swagger where
872− parseJSON js@(Object o) = do
873− (version :: Text) <- o .: "swagger"
874− when (version /= "2.0") empty
875− (genericParseJSON (jsonPrefix "")
876− `withDefaults` [ "consumes" .= (mempty :: MimeList)
877− , "produces" .= (mempty :: MimeList)
878− , "security" .= ([] :: [SecurityRequirement])
879− , "tags" .= ([] :: [Tag])
880− , "definitions" .= (mempty :: HashMap Text Schema)
881− , "parameters" .= (mempty :: HashMap Text Param)
882− , "responses" .= (mempty :: HashMap Text Response)
883− , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
884− ] ) js
885− parseJSON _ = empty
1220+ parseJSON = sopSwaggerGenericParseJSON
8861221
8871222instance FromJSON SecurityScheme where
888− parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1223+ parseJSON = sopSwaggerGenericParseJSON
8891224
8901225instance FromJSON Schema where
891− parseJSON = genericParseJSONWithSub "schemaCommon" (jsonPrefix "schema")
892− `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
893− , "required" .= ([] :: [ParamName]) ]
1226+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1227+ where nullaryCleanup :: Schema -> Schema
1228+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230+ then s { _schemaExample = Nothing
1231+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1232+ else s
8941233
8951234instance FromJSON Header where
896− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "header")
897−
898−instance FromJSON Items where
899− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "items")
1235+ parseJSON = sopSwaggerGenericParseJSON
1236+
1237+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1238+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1239+ <$> o .:? "collectionFormat"
1240+ <*> (o .: "items" >>= parseJSON)
1241+
1242+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244+ <$> o .:? "collectionFormat"
1245+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1246+
1247+-- |
1248+--
1249+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250+-- Just (SwaggerItemsArray [])
1251+--
1252+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1254+--
1255+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1257+--
1258+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259+ parseJSON js@(Object obj)
1260+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261+ | otherwise = SwaggerItemsObject <$> parseJSON js
1262+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1263+ parseJSON _ = empty
9001264
9011265instance FromJSON Host where
902− parseJSON (String s) =
903− case fromInteger <$> readMaybe portStr of
904− Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
905− mport -> pure $ Host host mport
906− where
907− (hostText, portText) = Text.breakOn ":" s
908− [host, portStr] = map Text.unpack [hostText, portText]
1266+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1267+ [host] -> return $ Host host Nothing
1268+ [host, port] -> case readMaybe port of
1269+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1270+ Just p -> return $ Host host (Just (fromInteger p))
1271+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
9091272 parseJSON _ = empty
9101273
911−instance FromJSON Paths where
912− parseJSON js = Paths <$> parseJSON js
913−
9141274instance FromJSON MimeList where
9151275 parseJSON js = (MimeList . map fromString) <$> parseJSON js
9161276
9171277instance FromJSON Param where
918− parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1278+ parseJSON = sopSwaggerGenericParseJSON
9191279
920−instance FromJSON ParamSchema where
1280+instance FromJSON ParamAnySchema where
9211281 parseJSON js@(Object o) = do
9221282 (i :: Text) <- o .: "in"
9231283 case i of
@@ -928,17 +1288,12 @@ instance FromJSON ParamSchema where
9281288 parseJSON _ = empty
9291289
9301290instance FromJSON ParamOtherSchema where
931− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "paramOtherSchema")
932−
933−instance FromJSON SchemaItems where
934− parseJSON js@(Object _) = SchemaItemsObject <$> parseJSON js
935− parseJSON js@(Array _) = SchemaItemsArray <$> parseJSON js
936− parseJSON _ = empty
1291+ parseJSON = sopSwaggerGenericParseJSON
9371292
9381293instance FromJSON Responses where
9391294 parseJSON (Object o) = Responses
9401295 <$> o .:? "default"
941− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1296+ <*> (parseJSON (Object (HashMap.delete "default" o)))
9421297 parseJSON _ = empty
9431298
9441299instance FromJSON Example where
@@ -947,26 +1302,126 @@ instance FromJSON Example where
9471302 pure $ Example (Map.mapKeys fromString m)
9481303
9491304instance FromJSON Response where
950− parseJSON = genericParseJSON (jsonPrefix "response")
951− `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
1305+ parseJSON = sopSwaggerGenericParseJSON
9521306
9531307instance FromJSON Operation where
954− parseJSON = genericParseJSON (jsonPrefix "operation")
955− `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
1308+ parseJSON = sopSwaggerGenericParseJSON
9561309
9571310instance FromJSON PathItem where
958− parseJSON = genericParseJSON (jsonPrefix "pathItem")
959− `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1311+ parseJSON = sopSwaggerGenericParseJSON
1312+
1313+instance FromJSON SecurityDefinitions where
1314+ parseJSON js = SecurityDefinitions <$> parseJSON js
9601315
9611316instance FromJSON Reference where
9621317 parseJSON (Object o) = Reference <$> o .: "$ref"
9631318 parseJSON _ = empty
9641319
965−instance FromJSON a => FromJSON (Referenced a) where
966− parseJSON js
967− = Ref <$> parseJSON js
968− <|> Inline <$> parseJSON js
1320+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1321+referencedParseJSON prefix js@(Object o) = do
1322+ ms <- o .:? "$ref"
1323+ case ms of
1324+ Nothing -> Inline <$> parseJSON js
1325+ Just s -> Ref <$> parseRef s
1326+ where
1327+ parseRef s = do
1328+ case Text.stripPrefix prefix s of
1329+ Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1330+ Just suffix -> pure (Reference suffix)
1331+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1332+
1333+instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1334+instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1335+instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
9691336
9701337instance FromJSON Xml where
9711338 parseJSON = genericParseJSON (jsonPrefix "xml")
9721339
1340+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1341+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1342+
1343+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1344+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1345+
1346+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1347+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1348+
1349+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1350+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1351+
1352+-- NOTE: There aren't collections of 'Schema'
1353+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1355+
1356+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1357+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1358+
1359+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1360+ parseJSON = sopSwaggerGenericParseJSON
1361+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1362+ parseJSON = sopSwaggerGenericParseJSON
1363+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1364+ parseJSON = sopSwaggerGenericParseJSON
1365+
1366+instance FromJSON AdditionalProperties where
1367+ parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368+ parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1369+
1370+-------------------------------------------------------------------------------
1371+-- TH splices
1372+-------------------------------------------------------------------------------
1373+
1374+deriveGeneric ''Header
1375+deriveGeneric ''OAuth2Params
1376+deriveGeneric ''Operation
1377+deriveGeneric ''Param
1378+deriveGeneric ''ParamOtherSchema
1379+deriveGeneric ''PathItem
1380+deriveGeneric ''Response
1381+deriveGeneric ''Responses
1382+deriveGeneric ''SecurityScheme
1383+deriveGeneric ''Schema
1384+deriveGeneric ''ParamSchema
1385+deriveGeneric ''Swagger
1386+
1387+instance HasSwaggerAesonOptions Header where
1388+ swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1389+instance HasSwaggerAesonOptions OAuth2Params where
1390+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1391+instance HasSwaggerAesonOptions Operation where
1392+ swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1393+instance HasSwaggerAesonOptions Param where
1394+ swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1395+instance HasSwaggerAesonOptions ParamOtherSchema where
1396+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1397+instance HasSwaggerAesonOptions PathItem where
1398+ swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1399+instance HasSwaggerAesonOptions Response where
1400+ swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1401+instance HasSwaggerAesonOptions Responses where
1402+ swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1403+instance HasSwaggerAesonOptions SecurityScheme where
1404+ swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1405+instance HasSwaggerAesonOptions Schema where
1406+ swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1407+instance HasSwaggerAesonOptions Swagger where
1408+ swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1409+
1410+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1411+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1412+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1413+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1414+-- NOTE: Schema doesn't have 'items' sub object!
1415+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1416+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1417+
1418+instance AesonDefaultValue (ParamSchema s)
1419+instance AesonDefaultValue OAuth2Flow
1420+instance AesonDefaultValue Responses
1421+instance AesonDefaultValue ParamAnySchema
1422+instance AesonDefaultValue SecuritySchemeType
1423+instance AesonDefaultValue (SwaggerType a)
1424+instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425+instance AesonDefaultValue Info
1426+instance AesonDefaultValue ParamLocation
1427+instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty