@@ -1,140 +1,94 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFunctor #-}
51{-# LANGUAGE DeriveGeneric #-}
62{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleContexts #-}
83{-# LANGUAGE FlexibleInstances #-}
9−{-# LANGUAGE GADTs #-}
104{-# LANGUAGE GeneralizedNewtypeDeriving #-}
115{-# LANGUAGE OverloadedStrings #-}
126{-# LANGUAGE RecordWildCards #-}
137{-# LANGUAGE ScopedTypeVariables #-}
148{-# LANGUAGE StandaloneDeriving #-}
159{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
17−{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
20−#endif
21−#include "overlapping-compat.h"
2210module Data.Swagger.Internal where
2311
24−import Prelude ()
25−import Prelude.Compat
26−
27−import Control.Lens ((&), (.~), (?~))
2812import Control.Applicative
13+import Control.Monad
2914import Data.Aeson
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)
15+import Data.Aeson.TH (deriveJSON)
16+import Data.HashMap.Strict (HashMap)
3317import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
3518import Data.Map (Map)
3619import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
38−import Data.Semigroup.Compat (Semigroup (..))
20+import Data.Monoid
3921import Data.Scientific (Scientific)
40−import Data.String (IsString(..))
22+import Data.String (fromString)
4123import Data.Text (Text)
4224import qualified Data.Text as Text
4325import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
26+import Network (HostName, PortNumber)
4527import Network.HTTP.Media (MediaType)
4628import Text.Read (readMaybe)
4729
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)
6030import Data.Swagger.Internal.Utils
6131
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−
7632-- | This is the root document object for the API specification.
7733data Swagger = Swagger
7834 { -- | Provides metadata about the API.
7935 -- The metadata can be used by the clients if needed.
80− _swaggerInfo :: Info
36+ _info :: Info
8137
8238 -- | The host (name or ip) serving the API. It MAY include a port.
8339 -- If the host is not included, the host serving the documentation is to be used (including the port).
84− , _swaggerHost :: Maybe Host
40+ , _host :: Maybe Host
8541
8642 -- | The base path on which the API is served, which is relative to the host.
8743 -- If it is not included, the API is served directly under the host.
8844 -- The value MUST start with a leading slash (/).
89− , _swaggerBasePath :: Maybe FilePath
45+ , _basePath :: Maybe FilePath
9046
9147 -- | The transfer protocol of the API.
9248 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
93− , _swaggerSchemes :: Maybe [Scheme]
49+ , _schemes :: Maybe [Scheme]
9450
9551 -- | A list of MIME types the APIs can consume.
9652 -- This is global to all APIs but can be overridden on specific API calls.
97− , _swaggerConsumes :: MimeList
53+ , _consumes :: MimeList
9854
9955 -- | A list of MIME types the APIs can produce.
100− -- This is global to all APIs but can be overridden on specific API calls.
101− , _swaggerProduces :: MimeList
56+ -- This is global to all APIs but can be overridden on specific API calls.
57+ , _produces :: MimeList
10258
10359 -- | The available paths and operations for the API.
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
60+ , _paths :: Paths
10761
10862 -- | An object to hold data types produced and consumed by operations.
109− , _swaggerDefinitions :: Definitions Schema
63+ , _definitions :: HashMap Text Schema
11064
11165 -- | An object to hold parameters that can be used across operations.
11266 -- This property does not define global parameters for all operations.
113− , _swaggerParameters :: Definitions Param
67+ , _parameters :: HashMap Text Param
11468
11569 -- | An object to hold responses that can be used across operations.
11670 -- This property does not define global responses for all operations.
117− , _swaggerResponses :: Definitions Response
71+ , _responses :: HashMap Text Response
11872
11973 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
74+ , _securityDefinitions :: HashMap Text SecurityScheme
12175
12276 -- | A declaration of which security schemes are applied for the API as a whole.
12377 -- The list of values describes alternative security schemes that can be used
12478 -- (that is, there is a logical OR between the security requirements).
12579 -- Individual operations can override this definition.
126− , _swaggerSecurity :: [SecurityRequirement]
80+ , _security :: [SecurityRequirement]
12781
12882 -- | A list of tags used by the specification with additional metadata.
12983 -- The order of the tags can be used to reflect on their order by the parsing tools.
13084 -- Not all tags that are used by the Operation Object must be declared.
13185 -- The tags that are not declared may be organized randomly or based on the tools' logic.
13286 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
87+ , _tags :: [Tag]
13488
13589 -- | Additional external documentation.
136− , _swaggerExternalDocs :: Maybe ExternalDocs
137− } deriving (Eq, Show, Generic, Data, Typeable)
90+ , _externalDocs :: Maybe ExternalDocs
91+ } deriving (Eq, Show, Generic)
13892
13993-- | The object provides metadata about the API.
14094-- The metadata can be used by the clients if needed,
@@ -159,7 +113,7 @@ data Info = Info
159113 -- | Provides the version of the application API
160114 -- (not to be confused with the specification version).
161115 , _infoVersion :: Text
162− } deriving (Eq, Show, Generic, Data, Typeable)
116+ } deriving (Eq, Show, Generic)
163117
164118-- | Contact information for the exposed API.
165119data Contact = Contact
@@ -171,7 +125,7 @@ data Contact = Contact
171125
172126 -- | The email address of the contact person/organization.
173127 , _contactEmail :: Maybe Text
174− } deriving (Eq, Show, Generic, Data, Typeable)
128+ } deriving (Eq, Show)
175129
176130-- | License information for the exposed API.
177131data License = License
@@ -180,32 +134,13 @@ data License = License
180134
181135 -- | A URL to the license used for the API.
182136 , _licenseUrl :: Maybe URL
183− } deriving (Eq, Show, Generic, Data, Typeable)
184−
185−instance IsString License where
186− fromString s = License (fromString s) Nothing
137+ } deriving (Eq, Show)
187138
188139-- | The host (name or ip) serving the API. It MAY include a port.
189140data Host = Host
190141 { _hostName :: HostName -- ^ Host name.
191142 , _hostPort :: Maybe PortNumber -- ^ Optional port.
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
143+ } deriving (Eq, Show)
209144
210145-- | The transfer protocol of the API.
211146data Scheme
@@ -213,7 +148,14 @@ data Scheme
213148 | Https
214149 | Ws
215150 | Wss
216− deriving (Eq, Show, Generic, Data, Typeable)
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)
217159
218160-- | Describes the operations available on a single path.
219161-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -246,13 +188,13 @@ data PathItem = PathItem
246188 -- The list MUST NOT include duplicated parameters.
247189 -- A unique parameter is defined by a combination of a name and location.
248190 , _pathItemParameters :: [Referenced Param]
249− } deriving (Eq, Show, Generic, Data, Typeable)
191+ } deriving (Eq, Show, Generic)
250192
251193-- | Describes a single API operation on a path.
252194data Operation = Operation
253195 { -- | A list of tags for API documentation control.
254196 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
197+ _operationTags :: [Text]
256198
257199 -- | A short summary of what the operation does.
258200 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -306,23 +248,10 @@ data Operation = Operation
306248 -- This definition overrides any declared top-level security.
307249 -- To remove a top-level security declaration, @Just []@ can be used.
308250 , _operationSecurity :: [SecurityRequirement]
309− } deriving (Eq, Show, Generic, Data, Typeable)
251+ } deriving (Eq, Show, Generic)
310252
311253newtype MimeList = MimeList { getMimeList :: [MediaType] }
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
254+ deriving (Eq, Show, Monoid)
326255
327256-- | Describes a single operation parameter.
328257-- A unique parameter is defined by a combination of a name and location.
@@ -342,13 +271,13 @@ data Param = Param
342271 , _paramRequired :: Maybe Bool
343272
344273 -- | Parameter schema.
345− , _paramSchema :: ParamAnySchema
346− } deriving (Eq, Show, Generic, Data, Typeable)
274+ , _paramSchema :: ParamSchema
275+ } deriving (Eq, Show, Generic)
347276
348−data ParamAnySchema
277+data ParamSchema
349278 = ParamBody (Referenced Schema)
350279 | ParamOther ParamOtherSchema
351− deriving (Eq, Show, Generic, Data, Typeable)
280+ deriving (Eq, Show)
352281
353282data ParamOtherSchema = ParamOtherSchema
354283 { -- | The location of the parameter.
@@ -360,140 +289,25 @@ data ParamOtherSchema = ParamOtherSchema
360289 -- Default value is @False@.
361290 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362291
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
292+ -- | __Required if type is @'ParamArray'@__.
293+ -- Describes the type of items in the array.
294+ , _paramOtherSchemaItems :: Maybe Items
295+
296+ -- | Determines the format of the array if @'ParamArray'@ is used.
297+ -- Default value is csv.
298+ , _paramOtherSchemaCollectionFormat :: Maybe CollectionFormat
299+
300+ , _paramOtherSchemaCommon :: SchemaCommon ParamType
301+ } deriving (Eq, Show, Generic)
302+
303+data ParamType
304+ = ParamString
305+ | ParamNumber
306+ | ParamInteger
307+ | ParamBoolean
308+ | ParamArray
309+ | ParamFile
310+ deriving (Eq, Show)
497311
498312data ParamLocation
499313 = -- | Parameters that are appended to the URL.
@@ -513,45 +327,46 @@ data ParamLocation
513327 -- Form parameters have a different format based on the content-type used
514328 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
515329 | ParamFormData
516− deriving (Eq, Show, Generic, Data, Typeable)
330+ deriving (Eq, Show)
517331
518332type Format = Text
519333
520334-- | Determines the format of the array.
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)
335+data CollectionFormat
336+ = CollectionCSV -- ^ Comma separated values: @foo,bar@.
337+ | CollectionSSV -- ^ Space separated values: @foo bar@.
338+ | CollectionTSV -- ^ Tab separated values: @foo\\tbar@.
339+ | CollectionPipes -- ^ Pipe separated values: @foo|bar@.
340+ | CollectionMulti -- ^ Corresponds to multiple parameter instances
341+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
342+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
343+ deriving (Eq, Show)
344+
345+data ItemsType
346+ = ItemsString
347+ | ItemsNumber
348+ | ItemsInteger
349+ | ItemsBoolean
350+ | ItemsArray
351+ deriving (Eq, Show)
352+
353+data SchemaType
354+ = SchemaArray
355+ | SchemaBoolean
356+ | SchemaInteger
357+ | SchemaNumber
358+ | SchemaNull
359+ | SchemaObject
360+ | SchemaString
361+ deriving (Eq, Show)
362+
363+-- | Determines the format of the nested array.
364+data ItemsCollectionFormat
365+ = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
366+ | ItemsCollectionSSV -- ^ Space separated values: @foo bar@.
367+ | ItemsCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
368+ | ItemsCollectionPipes -- ^ Pipe separated values: @foo|bar@.
369+ deriving (Eq, Show)
555370
556371type ParamName = Text
557372
@@ -560,9 +375,10 @@ data Schema = Schema
560375 , _schemaDescription :: Maybe Text
561376 , _schemaRequired :: [ParamName]
562377
563− , _schemaAllOf :: Maybe [Referenced Schema]
564− , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
378+ , _schemaItems :: Maybe SchemaItems
379+ , _schemaAllOf :: Maybe [Schema]
380+ , _schemaProperties :: HashMap Text (Referenced Schema)
381+ , _schemaAdditionalProperties :: Maybe Schema
566382
567383 , _schemaDiscriminator :: Maybe Text
568384 , _schemaReadOnly :: Maybe Bool
@@ -573,49 +389,41 @@ data Schema = Schema
573389 , _schemaMaxProperties :: Maybe Integer
574390 , _schemaMinProperties :: Maybe Integer
575391
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577− } deriving (Eq, Show, Generic, Data, Typeable)
392+ , _schemaSchemaCommon :: SchemaCommon SchemaType
393+ } deriving (Eq, Show, Generic)
578394
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)
395+data SchemaItems
396+ = SchemaItemsObject (Referenced Schema)
397+ | SchemaItemsArray [Referenced Schema]
398+ deriving (Eq, Show)
585399
586−-- | Regex pattern for @string@ type.
587−type Pattern = Text
588−
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
400+data SchemaCommon typeDomain = SchemaCommon
590401 { -- | Declares the value of the parameter that the server will use if none is provided,
591402 -- for example a @"count"@ to control the number of results per page might default to @100@
592403 -- if not supplied by the client in the request.
593404 -- (Note: "default" has no meaning for required parameters.)
594405 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
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)
406+ _schemaCommonDefault :: Maybe Value
407+
408+ , _schemaCommonType :: typeDomain
409+ , _schemaCommonFormat :: Maybe Format
410+ , _schemaCommonMaximum :: Maybe Scientific
411+ , _schemaCommonExclusiveMaximum :: Maybe Bool
412+ , _schemaCommonMinimum :: Maybe Scientific
413+ , _schemaCommonExclusiveMinimum :: Maybe Bool
414+ , _schemaCommonMaxLength :: Maybe Integer
415+ , _schemaCommonMinLength :: Maybe Integer
416+ , _schemaCommonPattern :: Maybe Text
417+ , _schemaCommonMaxItems :: Maybe Integer
418+ , _schemaCommonMinItems :: Maybe Integer
419+ , _schemaCommonUniqueItems :: Maybe Bool
420+ , _schemaCommonEnum :: Maybe [Value]
421+ , _schemaCommonMultipleOf :: Maybe Scientific
422+ } deriving (Eq, Show, Generic)
615423
616424data Xml = Xml
617425 { -- | Replaces the name of the element/attribute used for the described schema property.
618− -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
426+ -- When defined within the @'Items'@ (items), it will affect the name of the individual XML elements within the list.
619427 -- When defined alongside type being array (outside the items),
620428 -- it will affect the wrapping element and only if wrapped is true.
621429 -- If wrapped is false, it will be ignored.
@@ -639,7 +447,19 @@ data Xml = Xml
639447 -- Default value is @False@.
640448 -- The definition takes effect only when defined alongside type being array (outside the items).
641449 , _xmlWrapped :: Maybe Bool
642− } deriving (Eq, Show, Generic, Data, Typeable)
450+ } deriving (Eq, Show, Generic)
451+
452+data Items = Items
453+ { -- | __Required if type is @'ItemsArray'@.__
454+ -- Describes the type of items in the array.
455+ _itemsItems :: Maybe Items
456+
457+ -- | Determines the format of the array if type array is used.
458+ -- Default value is @'ItemsCollectionCSV'@.
459+ , _itemsCollectionFormat :: Maybe ItemsCollectionFormat
460+
461+ , _itemsCommon :: SchemaCommon ItemsType
462+ } deriving (Eq, Show, Generic)
643463
644464-- | A container for the expected responses of an operation.
645465-- The container maps a HTTP response code to the expected response.
@@ -653,8 +473,8 @@ data Responses = Responses
653473
654474 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
655475 -- Describes the expected response for those HTTP status codes.
656− , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
657− } deriving (Eq, Show, Generic, Data, Typeable)
476+ , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
477+ } deriving (Eq, Show, Generic)
658478
659479type HttpStatusCode = Int
660480
@@ -672,14 +492,11 @@ data Response = Response
672492 , _responseSchema :: Maybe (Referenced Schema)
673493
674494 -- | A list of headers that are sent with the response.
675− , _responseHeaders :: InsOrdHashMap HeaderName Header
495+ , _responseHeaders :: HashMap HeaderName Header
676496
677497 -- | An example of the response message.
678498 , _responseExamples :: Maybe Example
679− } deriving (Eq, Show, Generic, Data, Typeable)
680−
681−instance IsString Response where
682− fromString s = Response (fromString s) Nothing mempty Nothing
499+ } deriving (Eq, Show, Generic)
683500
684501type HeaderName = Text
685502
@@ -687,30 +504,25 @@ data Header = Header
687504 { -- | A short description of the header.
688505 _headerDescription :: Maybe Text
689506
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
691− } deriving (Eq, Show, Generic, Data, Typeable)
507+ -- | __Required if type is @'ItemsArray'@__.
508+ -- Describes the type of items in the array.
509+ , _headerItems :: Maybe Items
692510
693−data Example = Example { getExample :: Map MediaType Value }
694− deriving (Eq, Show, Generic, Typeable)
695−
696−exampleConstr :: Constr
697−exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
511+ -- | Determines the format of the array if type array is used.
512+ -- Default value is @'ItemsCollectionCSV'@.
513+ , _headerCollectionFormat :: Maybe ItemsCollectionFormat
698514
699−exampleDataType :: DataType
700−exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
515+ , _headerCommon :: SchemaCommon ItemsType
516+ } deriving (Eq, Show, Generic)
701517
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
518+data Example = Example { getExample :: Map MediaType Value }
519+ deriving (Eq, Show)
708520
709521-- | The location of the API key.
710522data ApiKeyLocation
711523 = ApiKeyQuery
712524 | ApiKeyHeader
713− deriving (Eq, Show, Generic, Data, Typeable)
525+ deriving (Eq, Show)
714526
715527data ApiKeyParams = ApiKeyParams
716528 { -- | The name of the header or query parameter to be used.
@@ -718,7 +530,7 @@ data ApiKeyParams = ApiKeyParams
718530
719531 -- | The location of the API key.
720532 , _apiKeyIn :: ApiKeyLocation
721− } deriving (Eq, Show, Generic, Data, Typeable)
533+ } deriving (Eq, Show)
722534
723535-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
724536type AuthorizationURL = Text
@@ -731,21 +543,21 @@ data OAuth2Flow
731543 | OAuth2Password TokenURL
732544 | OAuth2Application TokenURL
733545 | OAuth2AccessCode AuthorizationURL TokenURL
734− deriving (Eq, Show, Generic, Data, Typeable)
546+ deriving (Eq, Show)
735547
736548data OAuth2Params = OAuth2Params
737549 { -- | The flow used by the OAuth2 security scheme.
738550 _oauth2Flow :: OAuth2Flow
739551
740552 -- | The available scopes for the OAuth2 security scheme.
741− , _oauth2Scopes :: InsOrdHashMap Text Text
742− } deriving (Eq, Show, Generic, Data, Typeable)
553+ , _oauth2Scopes :: HashMap Text Text
554+ } deriving (Eq, Show, Generic)
743555
744556data SecuritySchemeType
745557 = SecuritySchemeBasic
746558 | SecuritySchemeApiKey ApiKeyParams
747559 | SecuritySchemeOAuth2 OAuth2Params
748− deriving (Eq, Show, Generic, Data, Typeable)
560+ deriving (Eq, Show)
749561
750562data SecurityScheme = SecurityScheme
751563 { -- | The type of the security scheme.
@@ -753,39 +565,20 @@ data SecurityScheme = SecurityScheme
753565
754566 -- | A short description for security scheme.
755567 , _securitySchemeDescription :: Maybe Text
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)
568+ } deriving (Eq, Show, Generic)
773569
774570-- | Lists the required security schemes to execute this operation.
775571-- The object can have multiple security schemes declared in it which are all required
776572-- (that is, there is a logical AND between the schemes).
777573newtype SecurityRequirement = SecurityRequirement
778− { getSecurityRequirement :: InsOrdHashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
780−
781−-- | Tag name.
782−type TagName = Text
574+ { getSecurityRequirement :: HashMap Text [Text]
575+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
783576
784577-- | Allows adding meta data to a single tag that is used by @Operation@.
785578-- It is not mandatory to have a @Tag@ per tag used there.
786579data Tag = Tag
787580 { -- | The name of the tag.
788− _tagName :: TagName
581+ _tagName :: Text
789582
790583 -- | A short description for the tag.
791584 -- GFM syntax can be used for rich text representation.
@@ -793,12 +586,7 @@ data Tag = Tag
793586
794587 -- | Additional external documentation for this tag.
795588 , _tagExternalDocs :: Maybe ExternalDocs
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
589+ } deriving (Eq, Show)
802590
803591-- | Allows referencing an external resource for extended documentation.
804592data ExternalDocs = ExternalDocs
@@ -808,236 +596,170 @@ data ExternalDocs = ExternalDocs
808596
809597 -- | The URL for the target documentation.
810598 , _externalDocsUrl :: URL
811− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812−
813−instance Hashable ExternalDocs
599+ } deriving (Eq, Show, Generic)
814600
815601-- | A simple object to allow referencing other definitions in the specification.
816602-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817603newtype Reference = Reference { getReference :: Text }
818− deriving (Eq, Show, Data, Typeable)
604+ deriving (Eq, Show)
819605
820606data Referenced a
821607 = Ref Reference
822608 | Inline a
823− deriving (Eq, Show, Functor, Data, Typeable)
824−
825−instance IsString a => IsString (Referenced a) where
826− fromString = Inline . fromString
609+ deriving (Eq, Show)
827610
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
829−
830−data AdditionalProperties
831− = AdditionalPropertiesAllowed Bool
832− | AdditionalPropertiesSchema (Referenced Schema)
833− deriving (Eq, Show, Data, Typeable)
611+newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON)
834612
835613-- =======================================================================
836614-- Monoid instances
837615-- =======================================================================
838616
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841617instance Monoid Swagger where
842618 mempty = genericMempty
843− mappend = (<>)
619+ mappend = genericMappend
844620
845−instance Semigroup Info where
846− (<>) = genericMappend
847621instance Monoid Info where
848622 mempty = genericMempty
849− mappend = (<>)
623+ mappend = genericMappend
850624
851−instance Semigroup Contact where
852− (<>) = genericMappend
853−instance Monoid Contact where
625+instance Monoid Paths where
854626 mempty = genericMempty
855− mappend = (<>)
627+ mappend = genericMappend
856628
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859629instance Monoid PathItem where
860630 mempty = genericMempty
861− mappend = (<>)
631+ mappend = genericMappend
862632
863−instance Semigroup Schema where
864− (<>) = genericMappend
865633instance Monoid Schema where
866634 mempty = genericMempty
867− mappend = (<>)
635+ mappend = genericMappend
868636
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871−instance Monoid (ParamSchema t) where
637+instance SwaggerMonoid t => Monoid (SchemaCommon t) where
872638 mempty = genericMempty
873− mappend = (<>)
639+ mappend = genericMappend
874640
875−instance Semigroup Param where
876− (<>) = genericMappend
877641instance Monoid Param where
878642 mempty = genericMempty
879− mappend = (<>)
643+ mappend = genericMappend
880644
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883645instance Monoid ParamOtherSchema where
884646 mempty = genericMempty
885− mappend = (<>)
886−
887−instance Semigroup Header where
888− (<>) = genericMappend
889−instance Monoid Header where
890− mempty = genericMempty
891− mappend = (<>)
647+ mappend = genericMappend
892648
893−instance Semigroup Responses where
894− (<>) = genericMappend
895649instance Monoid Responses where
896650 mempty = genericMempty
897− mappend = (<>)
651+ mappend = genericMappend
898652
899−instance Semigroup Response where
900− (<>) = genericMappend
901653instance Monoid Response where
902654 mempty = genericMempty
903− mappend = (<>)
655+ mappend = genericMappend
904656
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907657instance Monoid ExternalDocs where
908658 mempty = genericMempty
909− mappend = (<>)
659+ mappend = genericMappend
910660
911−instance Semigroup Operation where
912− (<>) = genericMappend
913661instance Monoid Operation where
914662 mempty = genericMempty
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 = (<>)
663+ mappend = genericMappend
933664
934665-- =======================================================================
935666-- SwaggerMonoid helper instances
936667-- =======================================================================
937668
938669instance SwaggerMonoid Info
670+instance SwaggerMonoid Paths
939671instance SwaggerMonoid PathItem
940672instance SwaggerMonoid Schema
941−instance SwaggerMonoid (ParamSchema t)
673+instance SwaggerMonoid t => SwaggerMonoid (SchemaCommon t)
942674instance SwaggerMonoid Param
943675instance SwaggerMonoid ParamOtherSchema
944676instance SwaggerMonoid Responses
945677instance SwaggerMonoid Response
946678instance SwaggerMonoid ExternalDocs
947679instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950680
951681instance SwaggerMonoid MimeList
952682deriving instance SwaggerMonoid URL
953683
954−instance SwaggerMonoid (SwaggerType t) where
955− swaggerMempty = SwaggerString
684+instance SwaggerMonoid SchemaType where
685+ swaggerMempty = SchemaNull
686+ swaggerMappend _ y = y
687+
688+instance SwaggerMonoid ParamType where
689+ swaggerMempty = ParamString
956690 swaggerMappend _ y = y
957691
958692instance SwaggerMonoid ParamLocation where
959693 swaggerMempty = ParamQuery
960694 swaggerMappend _ y = y
961695
962−instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963− swaggerMempty = InsOrdHashMap.empty
964− swaggerMappend = InsOrdHashMap.unionWith mappend
696+instance SwaggerMonoid (HashMap Text Schema) where
697+ swaggerMempty = HashMap.empty
698+ swaggerMappend = HashMap.unionWith mappend
699+
700+instance SwaggerMonoid (HashMap Text (Referenced Schema)) where
701+ swaggerMempty = HashMap.empty
702+ swaggerMappend = HashMap.unionWith swaggerMappend
965703
966704instance Monoid a => SwaggerMonoid (Referenced a) where
967705 swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
706+ swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
969707 swaggerMappend _ y = y
970708
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
976−
977−-- =======================================================================
978−-- Simple Generic-based ToJSON instances
979−-- =======================================================================
709+instance SwaggerMonoid (HashMap Text Param) where
710+ swaggerMempty = HashMap.empty
711+ swaggerMappend = HashMap.unionWith mappend
980712
981−instance ToJSON ParamLocation where
982− toJSON = genericToJSON (jsonPrefix "Param")
713+instance SwaggerMonoid (HashMap Text Response) where
714+ swaggerMempty = HashMap.empty
715+ swaggerMappend = flip HashMap.union
983716
984−instance ToJSON Info where
985− toJSON = genericToJSON (jsonPrefix "Info")
717+instance SwaggerMonoid (HashMap Text SecurityScheme) where
718+ swaggerMempty = HashMap.empty
719+ swaggerMappend = flip HashMap.union
986720
987−instance ToJSON Contact where
988− toJSON = genericToJSON (jsonPrefix "Contact")
721+instance SwaggerMonoid (HashMap FilePath PathItem) where
722+ swaggerMempty = HashMap.empty
723+ swaggerMappend = HashMap.unionWith mappend
989724
990−instance ToJSON License where
991− toJSON = genericToJSON (jsonPrefix "License")
725+instance SwaggerMonoid (HashMap HeaderName Header) where
726+ swaggerMempty = HashMap.empty
727+ swaggerMappend = flip HashMap.union
992728
993−instance ToJSON ApiKeyLocation where
994− toJSON = genericToJSON (jsonPrefix "ApiKey")
729+instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where
730+ swaggerMempty = HashMap.empty
731+ swaggerMappend = flip HashMap.union
995732
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")
733+instance SwaggerMonoid ParamSchema where
734+ swaggerMempty = ParamOther swaggerMempty
735+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
736+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
737+ swaggerMappend _ y = y
1010738
1011739-- =======================================================================
1012−-- Simple Generic-based FromJSON instances
740+-- TH derived ToJSON and FromJSON instances
1013741-- =======================================================================
1014742
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")
743+deriveJSON (jsonPrefix "Param") ''ParamLocation
744+deriveJSON (jsonPrefix "Param") ''ParamType
745+deriveJSON' ''Info
746+deriveJSON' ''Contact
747+deriveJSON' ''License
748+deriveJSON (jsonPrefix "Schema") ''SchemaType
749+deriveJSON (jsonPrefix "Items") ''ItemsType
750+deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
751+deriveJSON (jsonPrefix "Collection") ''CollectionFormat
752+deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
753+deriveJSON (jsonPrefix "apiKey") ''ApiKeyParams
754+deriveJSON' ''SchemaCommon
755+deriveJSONDefault ''Scheme
756+deriveJSON' ''Tag
757+deriveJSON' ''ExternalDocs
758+
759+deriveToJSON' ''Operation
760+deriveToJSON' ''Response
761+deriveToJSON' ''PathItem
762+deriveToJSON' ''Xml
1041763
1042764-- =======================================================================
1043765-- Manual ToJSON instances
@@ -1059,8 +781,7 @@ instance ToJSON OAuth2Flow where
1059781 , "tokenUrl" .= tokenUrl ]
1060782
1061783instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
1063− DEFINE_TOENCODING
784+ toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1064785
1065786instance ToJSON SecuritySchemeType where
1066787 toJSON SecuritySchemeBasic
@@ -1073,38 +794,22 @@ instance ToJSON SecuritySchemeType where
1073794 <+> object [ "type" .= ("oauth2" :: Text) ]
1074795
1075796instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
1077− DEFINE_TOENCODING
797+ toJSON = addVersion . genericToJSON (jsonPrefix "")
798+ where
799+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
800+ addVersion _ = error "impossible"
1078801
1079802instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
1081− DEFINE_TOENCODING
803+ toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1082804
1083805instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
1085− DEFINE_TOENCODING
806+ toJSON = genericToJSONWithSub "schemaCommon" (jsonPrefix "schema")
1086807
1087808instance ToJSON Header where
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 ]
809+ toJSON = genericToJSONWithSub "common" (jsonPrefix "header")
810+
811+instance ToJSON Items where
812+ toJSON = genericToJSONWithSub "common" (jsonPrefix "items")
1108813
1109814instance ToJSON Host where
1110815 toJSON (Host host mport) = toJSON $
@@ -1112,79 +817,38 @@ instance ToJSON Host where
1112817 Nothing -> host
1113818 Just port -> host ++ ":" ++ show port
1114819
820+instance ToJSON Paths where
821+ toJSON (Paths m) = toJSON m
822+
1115823instance ToJSON MimeList where
1116824 toJSON (MimeList xs) = toJSON (map show xs)
1117825
1118826instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
1120− DEFINE_TOENCODING
827+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1121828
1122−instance ToJSON ParamAnySchema where
829+instance ToJSON ParamSchema where
1123830 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124831 toJSON (ParamOther s) = toJSON s
1125832
1126833instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
1128− DEFINE_TOENCODING
1129−
1130−instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
1132− DEFINE_TOENCODING
1133−
1134−instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
1136− DEFINE_TOENCODING
834+ toJSON = genericToJSONWithSub "common" (jsonPrefix "paramOtherSchema")
1137835
1138−instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
1140− DEFINE_TOENCODING
836+instance ToJSON SchemaItems where
837+ toJSON (SchemaItemsObject x) = toJSON x
838+ toJSON (SchemaItemsArray xs) = toJSON xs
1141839
1142−instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
1144− DEFINE_TOENCODING
840+instance ToJSON Responses where
841+ toJSON (Responses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1145842
1146843instance ToJSON Example where
1147844 toJSON = toJSON . Map.mapKeys show . getExample
1148845
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
1152846instance ToJSON Reference where
1153847 toJSON (Reference ref) = object [ "$ref" .= ref ]
1154848
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
849+instance ToJSON a => ToJSON (Referenced a) where
850+ toJSON (Ref ref) = toJSON ref
851+ toJSON (Inline x) = toJSON x
1188852
1189853-- =======================================================================
1190854-- Manual FromJSON instances
@@ -1204,7 +868,7 @@ instance FromJSON OAuth2Flow where
1204868 parseJSON _ = empty
1205869
1206870instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
871+ parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1208872
1209873instance FromJSON SecuritySchemeType where
1210874 parseJSON js@(Object o) = do
@@ -1217,67 +881,55 @@ instance FromJSON SecuritySchemeType where
1217881 parseJSON _ = empty
1218882
1219883instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
884+ parseJSON js@(Object o) = do
885+ (version :: Text) <- o .: "swagger"
886+ when (version /= "2.0") empty
887+ (genericParseJSON (jsonPrefix "")
888+ `withDefaults` [ "consumes" .= (mempty :: MimeList)
889+ , "produces" .= (mempty :: MimeList)
890+ , "security" .= ([] :: [SecurityRequirement])
891+ , "tags" .= ([] :: [Tag])
892+ , "definitions" .= (mempty :: HashMap Text Schema)
893+ , "parameters" .= (mempty :: HashMap Text Param)
894+ , "responses" .= (mempty :: HashMap Text Response)
895+ , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
896+ ] ) js
897+ parseJSON _ = empty
1221898
1222899instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
900+ parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1224901
1225902instance FromJSON Schema where
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
903+ parseJSON = genericParseJSONWithSub "schemaCommon" (jsonPrefix "schema")
904+ `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
905+ , "required" .= ([] :: [ParamName]) ]
1233906
1234907instance FromJSON Header where
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
908+ parseJSON = genericParseJSONWithSub "common" (jsonPrefix "header")
909+
910+instance FromJSON Items where
911+ parseJSON = genericParseJSONWithSub "common" (jsonPrefix "items")
1264912
1265913instance FromJSON Host where
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 ++ "'"
914+ parseJSON (String s) =
915+ case fromInteger <$> readMaybe portStr of
916+ Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
917+ mport -> pure $ Host host mport
918+ where
919+ (hostText, portText) = Text.breakOn ":" s
920+ [host, portStr] = map Text.unpack [hostText, portText]
1272921 parseJSON _ = empty
1273922
923+instance FromJSON Paths where
924+ parseJSON js = Paths <$> parseJSON js
925+
1274926instance FromJSON MimeList where
1275927 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1276928
1277929instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
930+ parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1279931
1280−instance FromJSON ParamAnySchema where
932+instance FromJSON ParamSchema where
1281933 parseJSON js@(Object o) = do
1282934 (i :: Text) <- o .: "in"
1283935 case i of
@@ -1288,12 +940,17 @@ instance FromJSON ParamAnySchema where
1288940 parseJSON _ = empty
1289941
1290942instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
943+ parseJSON = genericParseJSONWithSub "common" (jsonPrefix "paramOtherSchema")
944+
945+instance FromJSON SchemaItems where
946+ parseJSON js@(Object _) = SchemaItemsObject <$> parseJSON js
947+ parseJSON js@(Array _) = SchemaItemsArray <$> parseJSON js
948+ parseJSON _ = empty
1292949
1293950instance FromJSON Responses where
1294951 parseJSON (Object o) = Responses
1295952 <$> o .:? "default"
1296− <*> (parseJSON (Object (HashMap.delete "default" o)))
953+ <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1297954 parseJSON _ = empty
1298955
1299956instance FromJSON Example where
@@ -1302,126 +959,26 @@ instance FromJSON Example where
1302959 pure $ Example (Map.mapKeys fromString m)
1303960
1304961instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
962+ parseJSON = genericParseJSON (jsonPrefix "response")
963+ `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
1306964
1307965instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
966+ parseJSON = genericParseJSON (jsonPrefix "operation")
967+ `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
1309968
1310969instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1312−
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
970+ parseJSON = genericParseJSON (jsonPrefix "pathItem")
971+ `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1315972
1316973instance FromJSON Reference where
1317974 parseJSON (Object o) = Reference <$> o .: "$ref"
1318975 parseJSON _ = empty
1319976
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/"
977+instance FromJSON a => FromJSON (Referenced a) where
978+ parseJSON js
979+ = Ref <$> parseJSON js
980+ <|> Inline <$> parseJSON js
1336981
1337982instance FromJSON Xml where
1338983 parseJSON = genericParseJSON (jsonPrefix "xml")
1339984
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