@@ -1,97 +1,140 @@
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
1{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveTraversable #-}
6{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE OverloadedStrings #-}
11{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE StandaloneDeriving #-}
14{-# LANGUAGE StandaloneDeriving #-}
9{-# LANGUAGE TemplateHaskell #-}
15{-# LANGUAGE TemplateHaskell #-}
16+{-# LANGUAGE TypeFamilies #-}
17+{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ <710
19+{-# LANGUAGE PolyKinds #-}
21+#include "overlapping-compat.h"
10module Data.Swagger.Internal where
22module Data.Swagger.Internal where
27+import Control.Lens ((&), (.~), (?~))
12import Control.Applicative
28import Control.Applicative
14import Data.Aeson
29import Data.Aeson
15−import Data.Aeson.TH (deriveJSON)
30+import qualified Data.Aeson.Types as JSON
16−import Data.Foldable (Foldable)
31+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
17−import Data.HashMap.Strict (HashMap)
32+import Data.Hashable (Hashable)
18import qualified Data.HashMap.Strict as HashMap
33import qualified Data.HashMap.Strict as HashMap
34+import Data.HashSet.InsOrd (InsOrdHashSet)
19import Data.Map (Map)
35import Data.Map (Map)
20import qualified Data.Map as Map
36import qualified Data.Map as Map
21−import Data.Monoid
37+import Data.Monoid (Monoid (..))
38+import Data.Semigroup.Compat (Semigroup (..))
22import Data.Scientific (Scientific)
39import Data.Scientific (Scientific)
23−import Data.String (fromString)
40+import Data.String (IsString(..))
24import Data.Text (Text)
41import Data.Text (Text)
25import qualified Data.Text as Text
42import qualified Data.Text as Text
26−import Data.Traversable (Traversable)
27−import Data.Hashable (Hashable)
28import GHC.Generics (Generic)
43import GHC.Generics (Generic)
29−import Network (HostName, PortNumber)
44+import Network.Socket (HostName, PortNumber)
30import Network.HTTP.Media (MediaType)
45import Network.HTTP.Media (MediaType)
31import Text.Read (readMaybe)
46import Text.Read (readMaybe)
48+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51+import Generics.SOP.TH (deriveGeneric)
52+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53+ ,sopSwaggerGenericToJSONWithOpts
54+ ,sopSwaggerGenericParseJSON
55+ ,HasSwaggerAesonOptions(..)
56+ ,AesonDefaultValue(..)
57+ ,mkSwaggerAesonOptions
33import Data.Swagger.Internal.Utils
60import Data.Swagger.Internal.Utils
62+#if MIN_VERSION_aeson(0,10,0)
63+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64+#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
66+#define DEFINE_TOENCODING
70+-- >>> :seti -XDataKinds
71+-- >>> import Data.Aeson
73+-- | A list of definitions that can be used in references.
74+type Definitions = InsOrdHashMap Text
35-- | This is the root document object for the API specification.
76-- | This is the root document object for the API specification.
36data Swagger = Swagger
77data Swagger = Swagger
37 { -- | Provides metadata about the API.
78 { -- | Provides metadata about the API.
38 -- The metadata can be used by the clients if needed.
79 -- The metadata can be used by the clients if needed.
39− _info :: Info
80+ _swaggerInfo :: Info
41 -- | The host (name or ip) serving the API. It MAY include a port.
82 -- | The host (name or ip) serving the API. It MAY include a port.
42 -- If the host is not included, the host serving the documentation is to be used (including the port).
83 -- If the host is not included, the host serving the documentation is to be used (including the port).
43− , _host :: Maybe Host
84+ , _swaggerHost :: Maybe Host
45 -- | The base path on which the API is served, which is relative to the host.
86 -- | The base path on which the API is served, which is relative to the host.
46 -- If it is not included, the API is served directly under the host.
87 -- If it is not included, the API is served directly under the host.
47 -- The value MUST start with a leading slash (/).
88 -- The value MUST start with a leading slash (/).
48− , _basePath :: Maybe FilePath
89+ , _swaggerBasePath :: Maybe FilePath
50 -- | The transfer protocol of the API.
91 -- | The transfer protocol of the API.
51 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
92 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
52− , _schemes :: Maybe [Scheme]
93+ , _swaggerSchemes :: Maybe [Scheme]
54 -- | A list of MIME types the APIs can consume.
95 -- | A list of MIME types the APIs can consume.
55 -- This is global to all APIs but can be overridden on specific API calls.
96 -- This is global to all APIs but can be overridden on specific API calls.
56− , _consumes :: MimeList
97+ , _swaggerConsumes :: MimeList
58 -- | A list of MIME types the APIs can produce.
99 -- | A list of MIME types the APIs can produce.
59− -- This is global to all APIs but can be overridden on specific API calls.
100+ -- This is global to all APIs but can be overridden on specific API calls.
60− , _produces :: MimeList
101+ , _swaggerProduces :: MimeList
62 -- | The available paths and operations for the API.
103 -- | The available paths and operations for the API.
63− , _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
65 -- | An object to hold data types produced and consumed by operations.
108 -- | An object to hold data types produced and consumed by operations.
66− , _definitions :: HashMap Text Schema
109+ , _swaggerDefinitions :: Definitions Schema
68 -- | An object to hold parameters that can be used across operations.
111 -- | An object to hold parameters that can be used across operations.
69 -- This property does not define global parameters for all operations.
112 -- This property does not define global parameters for all operations.
70− , _parameters :: HashMap Text Parameter
113+ , _swaggerParameters :: Definitions Param
72 -- | An object to hold responses that can be used across operations.
115 -- | An object to hold responses that can be used across operations.
73 -- This property does not define global responses for all operations.
116 -- This property does not define global responses for all operations.
74− , _responses :: HashMap Text Response
117+ , _swaggerResponses :: Definitions Response
76 -- | Security scheme definitions that can be used across the specification.
119 -- | Security scheme definitions that can be used across the specification.
77− , _securityDefinitions :: HashMap Text SecurityScheme
120+ , _swaggerSecurityDefinitions :: SecurityDefinitions
79 -- | A declaration of which security schemes are applied for the API as a whole.
122 -- | A declaration of which security schemes are applied for the API as a whole.
80 -- The list of values describes alternative security schemes that can be used
123 -- The list of values describes alternative security schemes that can be used
81 -- (that is, there is a logical OR between the security requirements).
124 -- (that is, there is a logical OR between the security requirements).
82 -- Individual operations can override this definition.
125 -- Individual operations can override this definition.
83− , _security :: [SecurityRequirement]
126+ , _swaggerSecurity :: [SecurityRequirement]
85 -- | A list of tags used by the specification with additional metadata.
128 -- | A list of tags used by the specification with additional metadata.
86 -- The order of the tags can be used to reflect on their order by the parsing tools.
129 -- The order of the tags can be used to reflect on their order by the parsing tools.
87 -- Not all tags that are used by the Operation Object must be declared.
130 -- Not all tags that are used by the Operation Object must be declared.
88 -- The tags that are not declared may be organized randomly or based on the tools' logic.
131 -- The tags that are not declared may be organized randomly or based on the tools' logic.
89 -- Each tag name in the list MUST be unique.
132 -- Each tag name in the list MUST be unique.
90− , _tags :: [Tag]
133+ , _swaggerTags :: InsOrdHashSet Tag
92 -- | Additional external documentation.
135 -- | Additional external documentation.
93− , _externalDocs :: Maybe ExternalDocs
136+ , _swaggerExternalDocs :: Maybe ExternalDocs
94− } deriving (Eq, Show, Generic)
137+ } deriving (Eq, Show, Generic, Data, Typeable)
96-- | The object provides metadata about the API.
139-- | The object provides metadata about the API.
97-- The metadata can be used by the clients if needed,
140-- The metadata can be used by the clients if needed,
@@ -116,7 +159,7 @@ data Info = Info
116 -- | Provides the version of the application API
159 -- | Provides the version of the application API
117 -- (not to be confused with the specification version).
160 -- (not to be confused with the specification version).
118 , _infoVersion :: Text
161 , _infoVersion :: Text
119− } deriving (Eq, Show, Generic)
162+ } deriving (Eq, Show, Generic, Data, Typeable)
121-- | Contact information for the exposed API.
164-- | Contact information for the exposed API.
122data Contact = Contact
165data Contact = Contact
@@ -128,7 +171,7 @@ data Contact = Contact
129 -- | The email address of the contact person/organization.
172 -- | The email address of the contact person/organization.
130 , _contactEmail :: Maybe Text
173 , _contactEmail :: Maybe Text
131− } deriving (Eq, Show)
174+ } deriving (Eq, Show, Generic, Data, Typeable)
133-- | License information for the exposed API.
176-- | License information for the exposed API.
134data License = License
177data License = License
@@ -137,13 +180,32 @@ data License = License
138 -- | A URL to the license used for the API.
181 -- | A URL to the license used for the API.
139 , _licenseUrl :: Maybe URL
182 , _licenseUrl :: Maybe URL
140− } deriving (Eq, Show)
183+ } deriving (Eq, Show, Generic, Data, Typeable)
185+instance IsString License where
186+ fromString s = License (fromString s) Nothing
142-- | The host (name or ip) serving the API. It MAY include a port.
188-- | The host (name or ip) serving the API. It MAY include a port.
143data Host = Host
189data Host = Host
144 { _hostName :: HostName -- ^ Host name.
190 { _hostName :: HostName -- ^ Host name.
145 , _hostPort :: Maybe PortNumber -- ^ Optional port.
191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
146− } deriving (Eq, Show)
192+ } deriving (Eq, Show, Generic, Typeable)
194+instance IsString Host where
195+ fromString s = Host s Nothing
198+hostConstr = mkConstr hostDataType "Host" [] Prefix
200+hostDataType :: DataType
201+hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
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
148-- | The transfer protocol of the API.
210-- | The transfer protocol of the API.
149data Scheme
211data Scheme
@@ -151,14 +213,7 @@ data Scheme
154− deriving (Eq, Show)
216+ deriving (Eq, Show, Generic, Data, Typeable)
156−-- | The available paths and operations for the API.
158− { -- | Holds the relative paths to the individual endpoints.
159− -- The path is appended to the @'basePath'@ in order to construct the full URL.
160− _pathsMap :: HashMap FilePath PathItem
161− } deriving (Eq, Show, Generic)
163-- | Describes the operations available on a single path.
218-- | Describes the operations available on a single path.
164-- A @'PathItem'@ may be empty, due to ACL constraints.
219-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -190,14 +245,14 @@ data PathItem = PathItem
190 -- These parameters can be overridden at the operation level, but cannot be removed there.
245 -- These parameters can be overridden at the operation level, but cannot be removed there.
191 -- The list MUST NOT include duplicated parameters.
246 -- The list MUST NOT include duplicated parameters.
192 -- A unique parameter is defined by a combination of a name and location.
247 -- A unique parameter is defined by a combination of a name and location.
193− , _pathItemParameters :: [Referenced Parameter]
248+ , _pathItemParameters :: [Referenced Param]
194− } deriving (Eq, Show, Generic)
249+ } deriving (Eq, Show, Generic, Data, Typeable)
196-- | Describes a single API operation on a path.
251-- | Describes a single API operation on a path.
197data Operation = Operation
252data Operation = Operation
198 { -- | A list of tags for API documentation control.
253 { -- | A list of tags for API documentation control.
199 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
200− _operationTags :: [Text]
255+ _operationTags :: InsOrdHashSet TagName
202 -- | A short summary of what the operation does.
257 -- | A short summary of what the operation does.
203 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -231,7 +286,7 @@ data Operation = Operation
231 -- the new definition will override it, but can never remove it.
286 -- the new definition will override it, but can never remove it.
232 -- The list MUST NOT include duplicated parameters.
287 -- The list MUST NOT include duplicated parameters.
233 -- A unique parameter is defined by a combination of a name and location.
288 -- A unique parameter is defined by a combination of a name and location.
234− , _operationParameters :: [Referenced Parameter]
289+ , _operationParameters :: [Referenced Param]
236 -- | The list of possible responses as they are returned from executing this operation.
291 -- | The list of possible responses as they are returned from executing this operation.
237 , _operationResponses :: Responses
292 , _operationResponses :: Responses
@@ -251,88 +306,205 @@ data Operation = Operation
251 -- This definition overrides any declared top-level security.
306 -- This definition overrides any declared top-level security.
252 -- To remove a top-level security declaration, @Just []@ can be used.
307 -- To remove a top-level security declaration, @Just []@ can be used.
253 , _operationSecurity :: [SecurityRequirement]
308 , _operationSecurity :: [SecurityRequirement]
254− } deriving (Eq, Show, Generic)
309+ } deriving (Eq, Show, Generic, Data, Typeable)
256newtype MimeList = MimeList { getMimeList :: [MediaType] }
311newtype MimeList = MimeList { getMimeList :: [MediaType] }
257− deriving (Eq, Show, Monoid)
312+ deriving (Eq, Show, Semigroup, Monoid, Typeable)
314+mimeListConstr :: Constr
315+mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
317+mimeListDataType :: DataType
318+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
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
259-- | Describes a single operation parameter.
327-- | Describes a single operation parameter.
260-- A unique parameter is defined by a combination of a name and location.
328-- A unique parameter is defined by a combination of a name and location.
261−data Parameter = Parameter
329+data Param = Param
262 { -- | The name of the parameter.
330 { -- | The name of the parameter.
263 -- Parameter names are case sensitive.
331 -- Parameter names are case sensitive.
264− _parameterName :: Text
332+ _paramName :: Text
266 -- | A brief description of the parameter.
334 -- | A brief description of the parameter.
267 -- This could contain examples of use.
335 -- This could contain examples of use.
268 -- GFM syntax can be used for rich text representation.
336 -- GFM syntax can be used for rich text representation.
269− , _parameterDescription :: Maybe Text
337+ , _paramDescription :: Maybe Text
271 -- | Determines whether this parameter is mandatory.
339 -- | Determines whether this parameter is mandatory.
272 -- If the parameter is in "path", this property is required and its value MUST be true.
340 -- If the parameter is in "path", this property is required and its value MUST be true.
273 -- Otherwise, the property MAY be included and its default value is @False@.
341 -- Otherwise, the property MAY be included and its default value is @False@.
274− , _parameterRequired :: Maybe Bool
342+ , _paramRequired :: Maybe Bool
276 -- | Parameter schema.
344 -- | Parameter schema.
277− , _parameterSchema :: ParameterSchema
345+ , _paramSchema :: ParamAnySchema
278− } deriving (Eq, Show, Generic)
346+ } deriving (Eq, Show, Generic, Data, Typeable)
280−data ParameterSchema
348+data ParamAnySchema
281− = ParameterBody (Referenced Schema)
349+ = ParamBody (Referenced Schema)
282− | ParameterOther ParameterOtherSchema
350+ | ParamOther ParamOtherSchema
283− deriving (Eq, Show)
351+ deriving (Eq, Show, Generic, Data, Typeable)
285−data ParameterOtherSchema = ParameterOtherSchema
353+data ParamOtherSchema = ParamOtherSchema
286 { -- | The location of the parameter.
354 { -- | The location of the parameter.
287− _parameterOtherSchemaIn :: ParameterLocation
355+ _paramOtherSchemaIn :: ParamLocation
289− -- | The type of the parameter.
290− -- Since the parameter is not located at the request body,
291− -- it is limited to simple types (that is, not an object).
292− -- If type is @'ParamFile'@, the @consumes@ MUST be either
293− -- "multipart/form-data" or " application/x-www-form-urlencoded"
294− -- and the parameter MUST be in @'ParameterFormData'@.
295− , _parameterOtherSchemaType :: ParameterType
297− -- | The extending format for the previously mentioned type.
298− , _parameterOtherSchemaFormat :: Maybe Format
300 -- | Sets the ability to pass empty-valued parameters.
357 -- | Sets the ability to pass empty-valued parameters.
301− -- This is valid only for either @'ParameterQuery'@ or @'ParameterFormData'@
358+ -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
302 -- and allows you to send a parameter with a name only or an empty value.
359 -- and allows you to send a parameter with a name only or an empty value.
303 -- Default value is @False@.
360 -- Default value is @False@.
304− , _parameterOtherSchemaAllowEmptyValue :: Maybe Bool
361+ , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
306− -- | __Required if type is @'ParamArray'@__.
363+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
307− -- Describes the type of items in the array.
364+ } deriving (Eq, Show, Generic, Typeable, Data)
308− , _parameterOtherSchemaItems :: Maybe Items
365+
309−
366+-- | Items for @'SwaggerArray'@ schemas.
310− -- | Determines the format of the array if @'ParamArray'@ is used.
367+--
311− -- Default value is csv.
368+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
312− , _parameterOtherSchemaCollectionFormat :: Maybe CollectionFormat
369+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
313−
370+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
314− , _parameterOtherSchemaCommon :: SchemaCommon
371+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
315− } deriving (Eq, Show, Generic)
372+--
316−
373+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
317−data ParameterType
374+--
318− = ParamString
375+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
319− | ParamNumber
376+data SwaggerItems t where
320− | ParamInteger
377+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
321− | ParamBoolean
378+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
322− | ParamArray
379+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
323− | ParamFile
380+ deriving (Typeable)
324− deriving (Eq, Show)
381+
325−
382+deriving instance Eq (SwaggerItems t)
326−data ParameterLocation
383+deriving instance Show (SwaggerItems t)
384+--deriving instance Typeable (SwaggerItems t)
386+swaggerItemsPrimitiveConstr :: Constr
387+swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
389+swaggerItemsObjectConstr :: Constr
390+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
392+swaggerItemsArrayConstr :: Constr
393+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
395+swaggerItemsDataType :: DataType
396+swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
398+-- Note: unfortunately we have to write these Data instances by hand,
399+-- to get better contexts / avoid duplicate name when using standalone deriving
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
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
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
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)."
428+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
432+ dataTypeOf _ = swaggerItemsDataType
434+-- | Type used as a kind to avoid overlapping instances.
436+ = SwaggerKindNormal t
437+ | SwaggerKindParamOtherSchema
441+deriving instance Typeable 'SwaggerKindNormal
442+deriving instance Typeable 'SwaggerKindParamOtherSchema
443+deriving instance Typeable 'SwaggerKindSchema
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
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
461+deriving instance Eq (SwaggerType t)
462+deriving instance Show (SwaggerType t)
464+swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465+swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
467+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
468+swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
470+swaggerCommonTypes :: [SwaggerType k]
471+swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
473+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
474+swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
476+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
477+swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
479+swaggerTypeConstrs :: [Constr]
480+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
481+ ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
483+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
484+ gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485+ toConstr = swaggerTypeConstr
486+ dataTypeOf = swaggerTypeDataType
488+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
489+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490+ toConstr = swaggerTypeConstr
491+ dataTypeOf = swaggerTypeDataType
493+instance Data (SwaggerType 'SwaggerKindSchema) where
494+ gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495+ toConstr = swaggerTypeConstr
496+ dataTypeOf = swaggerTypeDataType
327 = -- | Parameters that are appended to the URL.
499 = -- | Parameters that are appended to the URL.
328 -- For example, in @/items?id=###@, the query parameter is @id@.
500 -- For example, in @/items?id=###@, the query parameter is @id@.
329− ParameterQuery
501+ ParamQuery
330 -- | Custom headers that are expected as part of the request.
502 -- | Custom headers that are expected as part of the request.
331− | ParameterHeader
503+ | ParamHeader
332 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
504 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
333 -- This does not include the host or base path of the API.
505 -- This does not include the host or base path of the API.
334 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
506 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
335− | ParameterPath
507+ | ParamPath
336 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
508 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
337 -- or @multipart/form-data@ are used as the content type of the request
509 -- or @multipart/form-data@ are used as the content type of the request
338 -- (in Swagger's definition, the @consumes@ property of an operation).
510 -- (in Swagger's definition, the @consumes@ property of an operation).
@@ -340,61 +512,57 @@ data ParameterLocation
340 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
512 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
341 -- Form parameters have a different format based on the content-type used
513 -- Form parameters have a different format based on the content-type used
342 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
514 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
343− | ParameterFormData
515+ | ParamFormData
344− deriving (Eq, Show)
516+ deriving (Eq, Show, Generic, Data, Typeable)
346type Format = Text
518type Format = Text
348-- | Determines the format of the array.
520-- | Determines the format of the array.
349−data CollectionFormat
521+data CollectionFormat t where
350− = CollectionCSV -- ^ Comma separated values: @foo,bar@.
522+ -- Comma separated values: @foo,bar@.
523+ CollectionCSV :: CollectionFormat t
351− | CollectionSSV -- ^ Space separated values: @foo bar@.
524+ -- Space separated values: @foo bar@.
525+ CollectionSSV :: CollectionFormat t
352− | CollectionTSV -- ^ Tab separated values: @foo\\tbar@.
526+ -- Tab separated values: @foo\\tbar@.
527+ CollectionTSV :: CollectionFormat t
353− | CollectionPipes -- ^ Pipe separated values: @foo|bar@.
528+ -- Pipe separated values: @foo|bar@.
529+ CollectionPipes :: CollectionFormat t
354− | CollectionMulti -- ^ Corresponds to multiple parameter instances
530+ -- Corresponds to multiple parameter instances
355− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
531+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
356− -- This is valid only for parameters in @'ParameterQuery'@ or @'ParameterFormData'@.
532+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
357− deriving (Eq, Show)
534+ deriving (Typeable)
359−data ItemsType
536+deriving instance Eq (CollectionFormat t)
360− = ItemsString
537+deriving instance Show (CollectionFormat t)
362− | ItemsInteger
539+collectionFormatConstr :: CollectionFormat t -> Constr
363− | ItemsBoolean
540+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
365− deriving (Eq, Show)
542+collectionFormatDataType :: DataType
366−
543+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
367−data SchemaType
544+ map collectionFormatConstr collectionCommonFormats
369− | SchemaBoolean
546+collectionCommonFormats :: [CollectionFormat t]
370− | SchemaInteger
547+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
372− | SchemaNull
549+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
373− | SchemaObject
550+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
374− | SchemaString
551+ toConstr = collectionFormatConstr
375− deriving (Eq, Show)
552+ dataTypeOf _ = collectionFormatDataType
377−-- | Determines the format of the nested array.
554+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
378−data ItemsCollectionFormat
379− = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
380− | ItemsCollectionSSV -- ^ Space separated values: @foo bar@.
381− | ItemsCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
382− | ItemsCollectionPipes -- ^ Pipe separated values: @foo|bar@.
385type ParamName = Text
556type ParamName = Text
387data Schema = Schema
558data Schema = Schema
388− { _schemaType :: SchemaType
389− , _schemaFormat :: Maybe Format
390− , _schemaTitle :: Maybe Text
559+ { _schemaTitle :: Maybe Text
391 , _schemaDescription :: Maybe Text
560 , _schemaDescription :: Maybe Text
392 , _schemaRequired :: [ParamName]
561 , _schemaRequired :: [ParamName]
394− , _schemaItems :: Maybe SchemaItems
395− , _schemaAllOf :: Maybe [Schema]
563+ , _schemaAllOf :: Maybe [Referenced Schema]
396− , _schemaProperties :: HashMap Text (Referenced Schema)
564+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
397− , _schemaAdditionalProperties :: Maybe Schema
565+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
399 , _schemaDiscriminator :: Maybe Text
567 , _schemaDiscriminator :: Maybe Text
400 , _schemaReadOnly :: Maybe Bool
568 , _schemaReadOnly :: Maybe Bool
@@ -405,39 +573,49 @@ data Schema = Schema
405 , _schemaMaxProperties :: Maybe Integer
573 , _schemaMaxProperties :: Maybe Integer
406 , _schemaMinProperties :: Maybe Integer
574 , _schemaMinProperties :: Maybe Integer
408− , _schemaSchemaCommon :: SchemaCommon
576+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
409− } deriving (Eq, Show, Generic)
577+ } deriving (Eq, Show, Generic, Data, Typeable)
411−data SchemaItems
579+-- | A @'Schema'@ with an optional name.
412− = SchemaItemsObject (Referenced Schema)
580+-- This name can be used in references.
413− | SchemaItemsArray [Referenced Schema]
581+data NamedSchema = NamedSchema
582+ { _namedSchemaName :: Maybe Text
583+ , _namedSchemaSchema :: Schema
414− deriving (Eq, Show)
584+ } deriving (Eq, Show, Generic, Data, Typeable)
416−data SchemaCommon = SchemaCommon
586+-- | Regex pattern for @string@ type.
589+data ParamSchema (t :: SwaggerKind *) = ParamSchema
417 { -- | Declares the value of the parameter that the server will use if none is provided,
590 { -- | Declares the value of the parameter that the server will use if none is provided,
418 -- for example a @"count"@ to control the number of results per page might default to @100@
591 -- for example a @"count"@ to control the number of results per page might default to @100@
419 -- if not supplied by the client in the request.
592 -- if not supplied by the client in the request.
420 -- (Note: "default" has no meaning for required parameters.)
593 -- (Note: "default" has no meaning for required parameters.)
421 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
422− _schemaCommonDefault :: Maybe Value
595+ _paramSchemaDefault :: Maybe Value
424− , _schemaCommonMaximum :: Maybe Scientific
597+ , _paramSchemaType :: Maybe (SwaggerType t)
425− , _schemaCommonExclusiveMaximum :: Maybe Bool
598+ , _paramSchemaFormat :: Maybe Format
599+ , _paramSchemaItems :: Maybe (SwaggerItems t)
600+ , _paramSchemaMaximum :: Maybe Scientific
601+ , _paramSchemaExclusiveMaximum :: Maybe Bool
426− , _schemaCommonMinimum :: Maybe Scientific
602+ , _paramSchemaMinimum :: Maybe Scientific
427− , _schemaCommonExclusiveMinimum :: Maybe Bool
603+ , _paramSchemaExclusiveMinimum :: Maybe Bool
428− , _schemaCommonMaxLength :: Maybe Integer
604+ , _paramSchemaMaxLength :: Maybe Integer
429− , _schemaCommonMinLength :: Maybe Integer
605+ , _paramSchemaMinLength :: Maybe Integer
430− , _schemaCommonPattern :: Maybe Text
606+ , _paramSchemaPattern :: Maybe Pattern
431− , _schemaCommonMaxItems :: Maybe Integer
607+ , _paramSchemaMaxItems :: Maybe Integer
432− , _schemaCommonMinItems :: Maybe Integer
608+ , _paramSchemaMinItems :: Maybe Integer
433− , _schemaCommonUniqueItems :: Maybe Bool
609+ , _paramSchemaUniqueItems :: Maybe Bool
434− , _schemaCommonEnum :: Maybe [Value]
610+ , _paramSchemaEnum :: Maybe [Value]
435− , _schemaCommonMultipleOf :: Maybe Scientific
611+ , _paramSchemaMultipleOf :: Maybe Scientific
436− } deriving (Eq, Show, Generic)
612+ } deriving (Eq, Show, Generic, Typeable)
614+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
438data Xml = Xml
616data Xml = Xml
439 { -- | Replaces the name of the element/attribute used for the described schema property.
617 { -- | Replaces the name of the element/attribute used for the described schema property.
440− -- 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.
441 -- When defined alongside type being array (outside the items),
619 -- When defined alongside type being array (outside the items),
442 -- it will affect the wrapping element and only if wrapped is true.
620 -- it will affect the wrapping element and only if wrapped is true.
443 -- If wrapped is false, it will be ignored.
621 -- If wrapped is false, it will be ignored.
@@ -461,25 +639,7 @@ data Xml = Xml
461 -- Default value is @False@.
639 -- Default value is @False@.
462 -- The definition takes effect only when defined alongside type being array (outside the items).
640 -- The definition takes effect only when defined alongside type being array (outside the items).
463 , _xmlWrapped :: Maybe Bool
641 , _xmlWrapped :: Maybe Bool
464− } deriving (Eq, Show, Generic)
642+ } deriving (Eq, Show, Generic, Data, Typeable)
467− { -- | The internal type of the array.
468− _itemsType :: ItemsType
470− -- | The extending format for the previously mentioned type.
471− , _itemsFormat :: Maybe Format
473− -- | __Required if type is @'ItemsArray'@.__
474− -- Describes the type of items in the array.
475− , _itemsItems :: Maybe Items
477− -- | Determines the format of the array if type array is used.
478− -- Default value is @'ItemsCollectionCSV'@.
479− , _itemsCollectionFormat :: Maybe ItemsCollectionFormat
481− , _itemsCommon :: SchemaCommon
482− } deriving (Eq, Show, Generic)
484-- | A container for the expected responses of an operation.
644-- | A container for the expected responses of an operation.
485-- The container maps a HTTP response code to the expected response.
645-- The container maps a HTTP response code to the expected response.
@@ -493,8 +653,8 @@ data Responses = Responses
494 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
495 -- Describes the expected response for those HTTP status codes.
655 -- Describes the expected response for those HTTP status codes.
496− , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
656+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
497− } deriving (Eq, Show, Generic)
657+ } deriving (Eq, Show, Generic, Data, Typeable)
499type HttpStatusCode = Int
659type HttpStatusCode = Int
@@ -512,11 +672,14 @@ data Response = Response
512 , _responseSchema :: Maybe (Referenced Schema)
672 , _responseSchema :: Maybe (Referenced Schema)
514 -- | A list of headers that are sent with the response.
674 -- | A list of headers that are sent with the response.
515− , _responseHeaders :: HashMap HeaderName Header
675+ , _responseHeaders :: InsOrdHashMap HeaderName Header
517 -- | An example of the response message.
677 -- | An example of the response message.
518 , _responseExamples :: Maybe Example
678 , _responseExamples :: Maybe Example
519− } deriving (Eq, Show, Generic)
679+ } deriving (Eq, Show, Generic, Data, Typeable)
681+instance IsString Response where
682+ fromString s = Response (fromString s) Nothing mempty Nothing
521type HeaderName = Text
684type HeaderName = Text
@@ -524,31 +687,30 @@ data Header = Header
524 { -- | A short description of the header.
687 { -- | A short description of the header.
525 _headerDescription :: Maybe Text
688 _headerDescription :: Maybe Text
527− -- | The type of the object.
690+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
528− , _headerType :: ItemsType
691+ } deriving (Eq, Show, Generic, Data, Typeable)
530− -- | The extending format for the previously mentioned type. See Data Type Formats for further details.
531− , _headerFormat :: Maybe Format
533− -- | __Required if type is @'ItemsArray'@__.
693+data Example = Example { getExample :: Map MediaType Value }
534− -- Describes the type of items in the array.
694+ deriving (Eq, Show, Generic, Typeable)
535− , _headerItems :: Maybe Items
537− -- | Determines the format of the array if type array is used.
696+exampleConstr :: Constr
538− -- Default value is @'ItemsCollectionCSV'@.
697+exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
539− , _headerCollectionFormat :: Maybe ItemsCollectionFormat
541− , _headerCommon :: SchemaCommon
699+exampleDataType :: DataType
542− } deriving (Eq, Show, Generic)
700+exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
544−data Example = Example { getExample :: Map MediaType Value }
702+instance Data Example where
545− deriving (Eq, Show)
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
547-- | The location of the API key.
709-- | The location of the API key.
548data ApiKeyLocation
710data ApiKeyLocation
549 = ApiKeyQuery
711 = ApiKeyQuery
550 | ApiKeyHeader
712 | ApiKeyHeader
551− deriving (Eq, Show)
713+ deriving (Eq, Show, Generic, Data, Typeable)
553data ApiKeyParams = ApiKeyParams
715data ApiKeyParams = ApiKeyParams
554 { -- | The name of the header or query parameter to be used.
716 { -- | The name of the header or query parameter to be used.
@@ -556,7 +718,7 @@ data ApiKeyParams = ApiKeyParams
557 -- | The location of the API key.
719 -- | The location of the API key.
558 , _apiKeyIn :: ApiKeyLocation
720 , _apiKeyIn :: ApiKeyLocation
559− } deriving (Eq, Show)
721+ } deriving (Eq, Show, Generic, Data, Typeable)
561-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
723-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
562type AuthorizationURL = Text
724type AuthorizationURL = Text
@@ -569,21 +731,21 @@ data OAuth2Flow
569 | OAuth2Password TokenURL
731 | OAuth2Password TokenURL
570 | OAuth2Application TokenURL
732 | OAuth2Application TokenURL
571 | OAuth2AccessCode AuthorizationURL TokenURL
733 | OAuth2AccessCode AuthorizationURL TokenURL
572− deriving (Eq, Show)
734+ deriving (Eq, Show, Generic, Data, Typeable)
574data OAuth2Params = OAuth2Params
736data OAuth2Params = OAuth2Params
575 { -- | The flow used by the OAuth2 security scheme.
737 { -- | The flow used by the OAuth2 security scheme.
576 _oauth2Flow :: OAuth2Flow
738 _oauth2Flow :: OAuth2Flow
578 -- | The available scopes for the OAuth2 security scheme.
740 -- | The available scopes for the OAuth2 security scheme.
579− , _oauth2Scopes :: HashMap Text Text
741+ , _oauth2Scopes :: InsOrdHashMap Text Text
580− } deriving (Eq, Show, Generic)
742+ } deriving (Eq, Show, Generic, Data, Typeable)
582data SecuritySchemeType
744data SecuritySchemeType
583 = SecuritySchemeBasic
745 = SecuritySchemeBasic
584 | SecuritySchemeApiKey ApiKeyParams
746 | SecuritySchemeApiKey ApiKeyParams
585 | SecuritySchemeOAuth2 OAuth2Params
747 | SecuritySchemeOAuth2 OAuth2Params
586− deriving (Eq, Show)
748+ deriving (Eq, Show, Generic, Data, Typeable)
588data SecurityScheme = SecurityScheme
750data SecurityScheme = SecurityScheme
589 { -- | The type of the security scheme.
751 { -- | The type of the security scheme.
@@ -591,20 +753,39 @@ data SecurityScheme = SecurityScheme
592 -- | A short description for security scheme.
754 -- | A short description for security scheme.
593 , _securitySchemeDescription :: Maybe Text
755 , _securitySchemeDescription :: Maybe Text
594− } deriving (Eq, Show, Generic)
756+ } deriving (Eq, Show, Generic, Data, Typeable)
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
768+mergeSecurityScheme s1 _ = s1
770+newtype SecurityDefinitions
771+ = SecurityDefinitions (Definitions SecurityScheme)
772+ deriving (Eq, Show, Generic, Data, Typeable)
596-- | Lists the required security schemes to execute this operation.
774-- | Lists the required security schemes to execute this operation.
597-- The object can have multiple security schemes declared in it which are all required
775-- The object can have multiple security schemes declared in it which are all required
598-- (that is, there is a logical AND between the schemes).
776-- (that is, there is a logical AND between the schemes).
599newtype SecurityRequirement = SecurityRequirement
777newtype SecurityRequirement = SecurityRequirement
600− { getSecurityRequirement :: HashMap Text [Text]
778+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
601− } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
779+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
603-- | Allows adding meta data to a single tag that is used by @Operation@.
784-- | Allows adding meta data to a single tag that is used by @Operation@.
604-- It is not mandatory to have a @Tag@ per tag used there.
785-- It is not mandatory to have a @Tag@ per tag used there.
605data Tag = Tag
786data Tag = Tag
606 { -- | The name of the tag.
787 { -- | The name of the tag.
607− _tagName :: Text
788+ _tagName :: TagName
609 -- | A short description for the tag.
790 -- | A short description for the tag.
610 -- GFM syntax can be used for rich text representation.
791 -- GFM syntax can be used for rich text representation.
@@ -612,7 +793,12 @@ data Tag = Tag
613 -- | Additional external documentation for this tag.
794 -- | Additional external documentation for this tag.
614 , _tagExternalDocs :: Maybe ExternalDocs
795 , _tagExternalDocs :: Maybe ExternalDocs
615− } deriving (Eq, Show)
796+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
798+instance Hashable Tag
800+instance IsString Tag where
801+ fromString s = Tag (fromString s) Nothing Nothing
617-- | Allows referencing an external resource for extended documentation.
803-- | Allows referencing an external resource for extended documentation.
618data ExternalDocs = ExternalDocs
804data ExternalDocs = ExternalDocs
@@ -622,170 +808,236 @@ data ExternalDocs = ExternalDocs
623 -- | The URL for the target documentation.
809 -- | The URL for the target documentation.
624 , _externalDocsUrl :: URL
810 , _externalDocsUrl :: URL
625− } deriving (Eq, Show, Generic)
811+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
813+instance Hashable ExternalDocs
627-- | A simple object to allow referencing other definitions in the specification.
815-- | A simple object to allow referencing other definitions in the specification.
628-- It can be used to reference parameters and responses that are defined at the top level for reuse.
816-- It can be used to reference parameters and responses that are defined at the top level for reuse.
629newtype Reference = Reference { getReference :: Text }
817newtype Reference = Reference { getReference :: Text }
630− deriving (Eq, Show)
818+ deriving (Eq, Show, Data, Typeable)
632data Referenced a
820data Referenced a
633 = Ref Reference
821 = Ref Reference
634 | Inline a
822 | Inline a
635− deriving (Eq, Show)
823+ deriving (Eq, Show, Functor, Data, Typeable)
825+instance IsString a => IsString (Referenced a) where
826+ fromString = Inline . fromString
637−newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON)
828+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
830+data AdditionalProperties
831+ = AdditionalPropertiesAllowed Bool
832+ | AdditionalPropertiesSchema (Referenced Schema)
833+ deriving (Eq, Show, Data, Typeable)
639-- =======================================================================
835-- =======================================================================
640-- Monoid instances
836-- Monoid instances
641-- =======================================================================
837-- =======================================================================
839+instance Semigroup Swagger where
840+ (<>) = genericMappend
643instance Monoid Swagger where
841instance Monoid Swagger where
644 mempty = genericMempty
842 mempty = genericMempty
645− mappend = genericMappend
843+ mappend = (<>)
845+instance Semigroup Info where
846+ (<>) = genericMappend
647instance Monoid Info where
847instance Monoid Info where
648 mempty = genericMempty
848 mempty = genericMempty
649− mappend = genericMappend
849+ mappend = (<>)
851+instance Semigroup Contact where
852+ (<>) = genericMappend
651−instance Monoid Paths where
853+instance Monoid Contact where
652 mempty = genericMempty
854 mempty = genericMempty
653− mappend = genericMappend
855+ mappend = (<>)
857+instance Semigroup PathItem where
858+ (<>) = genericMappend
655instance Monoid PathItem where
859instance Monoid PathItem where
656 mempty = genericMempty
860 mempty = genericMempty
657− mappend = genericMappend
861+ mappend = (<>)
863+instance Semigroup Schema where
864+ (<>) = genericMappend
659instance Monoid Schema where
865instance Monoid Schema where
660 mempty = genericMempty
866 mempty = genericMempty
869+instance Semigroup (ParamSchema t) where
661− mappend = genericMappend
870+ (<>) = genericMappend
871+instance Monoid (ParamSchema t) where
872+ mempty = genericMempty
875+instance Semigroup Param where
876+ (<>) = genericMappend
663−instance Monoid SchemaCommon where
877+instance Monoid Param where
664 mempty = genericMempty
878 mempty = genericMempty
665− mappend = genericMappend
879+ mappend = (<>)
667−instance Monoid Parameter where
881+instance Semigroup ParamOtherSchema where
882+ (<>) = genericMappend
883+instance Monoid ParamOtherSchema where
668 mempty = genericMempty
884 mempty = genericMempty
669− mappend = genericMappend
885+ mappend = (<>)
671−instance Monoid ParameterOtherSchema where
887+instance Semigroup Header where
888+ (<>) = genericMappend
889+instance Monoid Header where
672 mempty = genericMempty
890 mempty = genericMempty
673− mappend = genericMappend
891+ mappend = (<>)
893+instance Semigroup Responses where
894+ (<>) = genericMappend
675instance Monoid Responses where
895instance Monoid Responses where
676 mempty = genericMempty
896 mempty = genericMempty
677− mappend = genericMappend
897+ mappend = (<>)
899+instance Semigroup Response where
900+ (<>) = genericMappend
679instance Monoid Response where
901instance Monoid Response where
680 mempty = genericMempty
902 mempty = genericMempty
681− mappend = genericMappend
903+ mappend = (<>)
905+instance Semigroup ExternalDocs where
906+ (<>) = genericMappend
683instance Monoid ExternalDocs where
907instance Monoid ExternalDocs where
684 mempty = genericMempty
908 mempty = genericMempty
685− mappend = genericMappend
909+ mappend = (<>)
911+instance Semigroup Operation where
912+ (<>) = genericMappend
687instance Monoid Operation where
913instance Monoid Operation where
688 mempty = genericMempty
914 mempty = genericMempty
917+instance Semigroup Example where
689− mappend = genericMappend
918+ (<>) = genericMappend
919+instance Monoid Example where
920+ mempty = genericMempty
923+instance Semigroup SecurityScheme where
924+ (<>) = mergeSecurityScheme
926+instance Semigroup SecurityDefinitions where
927+ (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928+ SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
930+instance Monoid SecurityDefinitions where
931+ mempty = SecurityDefinitions $ InsOrdHashMap.empty
691-- =======================================================================
934-- =======================================================================
692-- SwaggerMonoid helper instances
935-- SwaggerMonoid helper instances
693-- =======================================================================
936-- =======================================================================
695instance SwaggerMonoid Info
938instance SwaggerMonoid Info
696−instance SwaggerMonoid Paths
697instance SwaggerMonoid PathItem
939instance SwaggerMonoid PathItem
698instance SwaggerMonoid Schema
940instance SwaggerMonoid Schema
699−instance SwaggerMonoid SchemaCommon
941+instance SwaggerMonoid (ParamSchema t)
700−instance SwaggerMonoid Parameter
942+instance SwaggerMonoid Param
701−instance SwaggerMonoid ParameterOtherSchema
943+instance SwaggerMonoid ParamOtherSchema
702instance SwaggerMonoid Responses
944instance SwaggerMonoid Responses
703instance SwaggerMonoid Response
945instance SwaggerMonoid Response
704instance SwaggerMonoid ExternalDocs
946instance SwaggerMonoid ExternalDocs
705instance SwaggerMonoid Operation
947instance SwaggerMonoid Operation
948+instance SwaggerMonoid SecurityDefinitions
949+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
707instance SwaggerMonoid MimeList
951instance SwaggerMonoid MimeList
708deriving instance SwaggerMonoid URL
952deriving instance SwaggerMonoid URL
710−instance SwaggerMonoid SchemaType where
954+instance SwaggerMonoid (SwaggerType t) where
711− swaggerMempty = SchemaNull
955+ swaggerMempty = SwaggerString
712 swaggerMappend _ y = y
956 swaggerMappend _ y = y
714−instance SwaggerMonoid ParameterType where
958+instance SwaggerMonoid ParamLocation where
715− swaggerMempty = ParamString
959+ swaggerMempty = ParamQuery
716 swaggerMappend _ y = y
960 swaggerMappend _ y = y
718−instance SwaggerMonoid ParameterLocation where
962+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
719− swaggerMempty = ParameterQuery
720− swaggerMappend _ y = y
722−instance SwaggerMonoid (HashMap Text Schema) where
723− swaggerMempty = HashMap.empty
963+ swaggerMempty = InsOrdHashMap.empty
724− swaggerMappend = HashMap.unionWith mappend
964+ swaggerMappend = InsOrdHashMap.unionWith mappend
726−instance SwaggerMonoid (HashMap Text (Referenced Schema)) where
727− swaggerMempty = HashMap.empty
728− swaggerMappend = HashMap.unionWith swaggerMappend
730instance Monoid a => SwaggerMonoid (Referenced a) where
966instance Monoid a => SwaggerMonoid (Referenced a) where
731 swaggerMempty = Inline mempty
967 swaggerMempty = Inline mempty
732− swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
968+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
733 swaggerMappend _ y = y
969 swaggerMappend _ y = y
735−instance SwaggerMonoid (HashMap Text Parameter) where
971+instance SwaggerMonoid ParamAnySchema where
736− swaggerMempty = HashMap.empty
972+ swaggerMempty = ParamOther swaggerMempty
737− swaggerMappend = HashMap.unionWith mappend
973+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
974+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
975+ swaggerMappend _ y = y
739−instance SwaggerMonoid (HashMap Text Response) where
977+-- =======================================================================
740− swaggerMempty = HashMap.empty
978+-- Simple Generic-based ToJSON instances
741− swaggerMappend = flip HashMap.union
979+-- =======================================================================
743−instance SwaggerMonoid (HashMap Text SecurityScheme) where
981+instance ToJSON ParamLocation where
744− swaggerMempty = HashMap.empty
982+ toJSON = genericToJSON (jsonPrefix "Param")
745− swaggerMappend = flip HashMap.union
747−instance SwaggerMonoid (HashMap FilePath PathItem) where
984+instance ToJSON Info where
748− swaggerMempty = HashMap.empty
985+ toJSON = genericToJSON (jsonPrefix "Info")
749− swaggerMappend = HashMap.unionWith mappend
751−instance SwaggerMonoid (HashMap HeaderName Header) where
987+instance ToJSON Contact where
752− swaggerMempty = HashMap.empty
988+ toJSON = genericToJSON (jsonPrefix "Contact")
753− swaggerMappend = flip HashMap.union
755−instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where
990+instance ToJSON License where
756− swaggerMempty = HashMap.empty
991+ toJSON = genericToJSON (jsonPrefix "License")
757− swaggerMappend = flip HashMap.union
759−instance SwaggerMonoid ParameterSchema where
993+instance ToJSON ApiKeyLocation where
760− swaggerMempty = ParameterOther swaggerMempty
994+ toJSON = genericToJSON (jsonPrefix "ApiKey")
761− swaggerMappend (ParameterBody x) (ParameterBody y) = ParameterBody (swaggerMappend x y)
995+
762− swaggerMappend (ParameterOther x) (ParameterOther y) = ParameterOther (swaggerMappend x y)
996+instance ToJSON ApiKeyParams where
763− swaggerMappend _ y = y
997+ toJSON = genericToJSON (jsonPrefix "apiKey")
999+instance ToJSON Scheme where
1000+ toJSON = genericToJSON (jsonPrefix "")
1002+instance ToJSON Tag where
1003+ toJSON = genericToJSON (jsonPrefix "Tag")
1005+instance ToJSON ExternalDocs where
1006+ toJSON = genericToJSON (jsonPrefix "ExternalDocs")
1008+instance ToJSON Xml where
1009+ toJSON = genericToJSON (jsonPrefix "Xml")
765-- =======================================================================
1011-- =======================================================================
766−-- TH derived ToJSON and FromJSON instances
1012+-- Simple Generic-based FromJSON instances
767-- =======================================================================
1013-- =======================================================================
769−deriveJSON (jsonPrefix "Parameter") ''ParameterLocation
1015+instance FromJSON ParamLocation where
770−deriveJSON (jsonPrefix "Param") ''ParameterType
1016+ parseJSON = genericParseJSON (jsonPrefix "Param")
771−deriveJSON' ''Info
1017+
772−deriveJSON' ''Contact
1018+instance FromJSON Info where
773−deriveJSON' ''License
1019+ parseJSON = genericParseJSON (jsonPrefix "Info")
774−deriveJSON (jsonPrefix "Schema") ''SchemaType
1020+
775−deriveJSON (jsonPrefix "Items") ''ItemsType
1021+instance FromJSON Contact where
776−deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
1022+ parseJSON = genericParseJSON (jsonPrefix "Contact")
777−deriveJSON (jsonPrefix "Collection") ''CollectionFormat
1023+
778−deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
1024+instance FromJSON License where
779−deriveJSON (jsonPrefix "apiKey") ''ApiKeyParams
1025+ parseJSON = genericParseJSON (jsonPrefix "License")
780−deriveJSON' ''SchemaCommon
1026+
781−deriveJSONDefault ''Scheme
1027+instance FromJSON ApiKeyLocation where
782−deriveJSON' ''Tag
1028+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
783−deriveJSON' ''ExternalDocs
1029+
784−
1030+instance FromJSON ApiKeyParams where
785−deriveToJSON' ''Operation
1031+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
786−deriveToJSON' ''Response
1032+
787−deriveToJSON' ''PathItem
1033+instance FromJSON Scheme where
788−deriveToJSON' ''Xml
1034+ parseJSON = genericParseJSON (jsonPrefix "")
1036+instance FromJSON Tag where
1037+ parseJSON = genericParseJSON (jsonPrefix "Tag")
1039+instance FromJSON ExternalDocs where
1040+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
790-- =======================================================================
1042-- =======================================================================
791-- Manual ToJSON instances
1043-- Manual ToJSON instances
@@ -807,7 +1059,8 @@ instance ToJSON OAuth2Flow where
807 , "tokenUrl" .= tokenUrl ]
1059 , "tokenUrl" .= tokenUrl ]
809instance ToJSON OAuth2Params where
1061instance ToJSON OAuth2Params where
810− toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1062+ toJSON = sopSwaggerGenericToJSON
812instance ToJSON SecuritySchemeType where
1065instance ToJSON SecuritySchemeType where
813 toJSON SecuritySchemeBasic
1066 toJSON SecuritySchemeBasic
@@ -820,22 +1073,38 @@ instance ToJSON SecuritySchemeType where
820 <+> object [ "type" .= ("oauth2" :: Text) ]
1073 <+> object [ "type" .= ("oauth2" :: Text) ]
822instance ToJSON Swagger where
1075instance ToJSON Swagger where
823− toJSON = addVersion . genericToJSON (jsonPrefix "")
1076+ toJSON = sopSwaggerGenericToJSON
824− where
1077+ DEFINE_TOENCODING
825− addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
826− addVersion _ = error "impossible"
828instance ToJSON SecurityScheme where
1079instance ToJSON SecurityScheme where
829− toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1080+ toJSON = sopSwaggerGenericToJSON
831instance ToJSON Schema where
1083instance ToJSON Schema where
832− toJSON = genericToJSONWithSub "schemaCommon" (jsonPrefix "schema")
1084+ toJSON = sopSwaggerGenericToJSON
834instance ToJSON Header where
1087instance ToJSON Header where
835− toJSON = genericToJSONWithSub "common" (jsonPrefix "header")
1088+ toJSON = sopSwaggerGenericToJSON
836−
1089+ DEFINE_TOENCODING
1091+-- | As for nullary schema for 0-arity type constructors, see
1092+-- <https://github.com/GetShopTV/swagger2/issues/167>.
1094+-- >>> encode (SwaggerItemsArray [])
1095+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
837−instance ToJSON Items where
1097+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
838− toJSON = genericToJSONWithSub "common" (jsonPrefix "items")
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
1107+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
840instance ToJSON Host where
1109instance ToJSON Host where
841 toJSON (Host host mport) = toJSON $
1110 toJSON (Host host mport) = toJSON $
@@ -843,38 +1112,79 @@ instance ToJSON Host where
843 Nothing -> host
1112 Nothing -> host
844 Just port -> host ++ ":" ++ show port
1113 Just port -> host ++ ":" ++ show port
846−instance ToJSON Paths where
847− toJSON (Paths m) = toJSON m
849instance ToJSON MimeList where
1115instance ToJSON MimeList where
850 toJSON (MimeList xs) = toJSON (map show xs)
1116 toJSON (MimeList xs) = toJSON (map show xs)
852−instance ToJSON Parameter where
1118+instance ToJSON Param where
853− toJSON = genericToJSONWithSub "schema" (jsonPrefix "parameter")
1119+ toJSON = sopSwaggerGenericToJSON
855−instance ToJSON ParameterSchema where
1122+instance ToJSON ParamAnySchema where
856− toJSON (ParameterBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1123+ toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
857− toJSON (ParameterOther s) = toJSON s
1124+ toJSON (ParamOther s) = toJSON s
859−instance ToJSON ParameterOtherSchema where
1126+instance ToJSON ParamOtherSchema where
860− toJSON = genericToJSONWithSub "common" (jsonPrefix "parameterOtherSchema")
1127+ toJSON = sopSwaggerGenericToJSON
861−
1128+ DEFINE_TOENCODING
862−instance ToJSON SchemaItems where
863− toJSON (SchemaItemsObject x) = toJSON x
864− toJSON (SchemaItemsArray xs) = toJSON xs
866instance ToJSON Responses where
1130instance ToJSON Responses where
867− toJSON (Responses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1131+ toJSON = sopSwaggerGenericToJSON
1134+instance ToJSON Response where
1135+ toJSON = sopSwaggerGenericToJSON
1138+instance ToJSON Operation where
1139+ toJSON = sopSwaggerGenericToJSON
1142+instance ToJSON PathItem where
1143+ toJSON = sopSwaggerGenericToJSON
869instance ToJSON Example where
1146instance ToJSON Example where
870 toJSON = toJSON . Map.mapKeys show . getExample
1147 toJSON = toJSON . Map.mapKeys show . getExample
1149+instance ToJSON SecurityDefinitions where
1150+ toJSON (SecurityDefinitions sd) = toJSON sd
872instance ToJSON Reference where
1152instance ToJSON Reference where
873 toJSON (Reference ref) = object [ "$ref" .= ref ]
1153 toJSON (Reference ref) = object [ "$ref" .= ref ]
875−instance ToJSON a => ToJSON (Referenced a) where
1155+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
876− toJSON (Ref ref) = toJSON ref
1156+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
877− toJSON (Inline x) = toJSON x
1157+referencedToJSON _ (Inline x) = toJSON x
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/"
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"
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"
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"
1185+instance ToJSON AdditionalProperties where
1186+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187+ toJSON (AdditionalPropertiesSchema s) = toJSON s
879-- =======================================================================
1189-- =======================================================================
880-- Manual FromJSON instances
1190-- Manual FromJSON instances
@@ -894,117 +1204,224 @@ instance FromJSON OAuth2Flow where
894 parseJSON _ = empty
1204 parseJSON _ = empty
896instance FromJSON OAuth2Params where
1206instance FromJSON OAuth2Params where
897− parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1207+ parseJSON = sopSwaggerGenericParseJSON
899instance FromJSON SecuritySchemeType where
1209instance FromJSON SecuritySchemeType where
900− parseJSON json@(Object o) = do
1210+ parseJSON js@(Object o) = do
901 (t :: Text) <- o .: "type"
1211 (t :: Text) <- o .: "type"
902 case t of
1212 case t of
903 "basic" -> pure SecuritySchemeBasic
1213 "basic" -> pure SecuritySchemeBasic
904− "apiKey" -> SecuritySchemeApiKey <$> parseJSON json
1214+ "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
905− "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON json
1215+ "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
906 _ -> empty
1216 _ -> empty
907 parseJSON _ = empty
1217 parseJSON _ = empty
909instance FromJSON Swagger where
1219instance FromJSON Swagger where
910− parseJSON json@(Object o) = do
1220+ parseJSON = sopSwaggerGenericParseJSON
911− (version :: Text) <- o .: "swagger"
912− when (version /= "2.0") empty
913− (genericParseJSON (jsonPrefix "")
914− `withDefaults` [ "consumes" .= (mempty :: MimeList)
915− , "produces" .= (mempty :: MimeList)
916− , "security" .= ([] :: [SecurityRequirement])
917− , "tags" .= ([] :: [Tag])
918− , "definitions" .= (mempty :: HashMap Text Schema)
919− , "parameters" .= (mempty :: HashMap Text Parameter)
920− , "responses" .= (mempty :: HashMap Text Response)
921− , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
925instance FromJSON SecurityScheme where
1222instance FromJSON SecurityScheme where
926− parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1223+ parseJSON = sopSwaggerGenericParseJSON
928instance FromJSON Schema where
1225instance FromJSON Schema where
929− parseJSON = genericParseJSONWithSub "schemaCommon" (jsonPrefix "schema")
1226+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
930− `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1227+ where nullaryCleanup :: Schema -> Schema
931− , "required" .= ([] :: [ParamName]) ]
1228+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230+ then s { _schemaExample = Nothing
1231+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
933instance FromJSON Header where
1234instance FromJSON Header where
934− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "header")
1235+ parseJSON = sopSwaggerGenericParseJSON
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)
936−instance FromJSON Items where
1242+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
937− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "items")
1243+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244+ <$> o .:? "collectionFormat"
1245+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1249+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250+-- Just (SwaggerItemsArray [])
1252+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1255+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
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
939instance FromJSON Host where
1265instance FromJSON Host where
940− parseJSON (String s) =
1266+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
941− case fromInteger <$> readMaybe portStr of
1267+ [host] -> return $ Host host Nothing
942− Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1268+ [host, port] -> case readMaybe port of
943− mport -> pure $ Host host mport
1269+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
944− where
1270+ Just p -> return $ Host host (Just (fromInteger p))
945− (hostText, portText) = Text.breakOn ":" s
1271+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
946− [host, portStr] = map Text.unpack [hostText, portText]
947 parseJSON _ = empty
1272 parseJSON _ = empty
949−instance FromJSON Paths where
950− parseJSON json = Paths <$> parseJSON json
952instance FromJSON MimeList where
1274instance FromJSON MimeList where
953− parseJSON json = (MimeList . map fromString) <$> parseJSON json
1275+ parseJSON js = (MimeList . map fromString) <$> parseJSON js
955−instance FromJSON Parameter where
1277+instance FromJSON Param where
956− parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "parameter")
1278+ parseJSON = sopSwaggerGenericParseJSON
958−instance FromJSON ParameterSchema where
1280+instance FromJSON ParamAnySchema where
959− parseJSON json@(Object o) = do
1281+ parseJSON js@(Object o) = do
960 (i :: Text) <- o .: "in"
1282 (i :: Text) <- o .: "in"
961 case i of
1283 case i of
962 "body" -> do
1284 "body" -> do
963 schema <- o .: "schema"
1285 schema <- o .: "schema"
964− ParameterBody <$> parseJSON schema
1286+ ParamBody <$> parseJSON schema
965− _ -> ParameterOther <$> parseJSON json
1287+ _ -> ParamOther <$> parseJSON js
966 parseJSON _ = empty
1288 parseJSON _ = empty
968−instance FromJSON ParameterOtherSchema where
1290+instance FromJSON ParamOtherSchema where
969− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "parameterOtherSchema")
1291+ parseJSON = sopSwaggerGenericParseJSON
971−instance FromJSON SchemaItems where
972− parseJSON json@(Object _) = SchemaItemsObject <$> parseJSON json
973− parseJSON json@(Array _) = SchemaItemsArray <$> parseJSON json
976instance FromJSON Responses where
1293instance FromJSON Responses where
977 parseJSON (Object o) = Responses
1294 parseJSON (Object o) = Responses
978 <$> o .:? "default"
1295 <$> o .:? "default"
979− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1296+ <*> (parseJSON (Object (HashMap.delete "default" o)))
980 parseJSON _ = empty
1297 parseJSON _ = empty
982instance FromJSON Example where
1299instance FromJSON Example where
983− parseJSON json = do
1300+ parseJSON js = do
984− m <- parseJSON json
1301+ m <- parseJSON js
985 pure $ Example (Map.mapKeys fromString m)
1302 pure $ Example (Map.mapKeys fromString m)
987instance FromJSON Response where
1304instance FromJSON Response where
988− parseJSON = genericParseJSON (jsonPrefix "response")
1305+ parseJSON = sopSwaggerGenericParseJSON
989− `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
991instance FromJSON Operation where
1307instance FromJSON Operation where
992− parseJSON = genericParseJSON (jsonPrefix "operation")
1308+ parseJSON = sopSwaggerGenericParseJSON
993− `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
995instance FromJSON PathItem where
1310instance FromJSON PathItem where
996− parseJSON = genericParseJSON (jsonPrefix "pathItem")
1311+ parseJSON = sopSwaggerGenericParseJSON
997− `withDefaults` [ "parameters" .= ([] :: [Parameter]) ]
1312+
1313+instance FromJSON SecurityDefinitions where
1314+ parseJSON js = SecurityDefinitions <$> parseJSON js
999instance FromJSON Reference where
1316instance FromJSON Reference where
1000 parseJSON (Object o) = Reference <$> o .: "$ref"
1317 parseJSON (Object o) = Reference <$> o .: "$ref"
1001 parseJSON _ = empty
1318 parseJSON _ = empty
1003−instance FromJSON a => FromJSON (Referenced a) where
1320+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1004− parseJSON json
1321+referencedParseJSON prefix js@(Object o) = do
1005− = Ref <$> parseJSON json
1322+ ms <- o .:? "$ref"
1006− <|> Inline <$> parseJSON json
1323+ case ms of
1324+ Nothing -> Inline <$> parseJSON js
1325+ Just s -> Ref <$> parseRef s
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"
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/"
1008instance FromJSON Xml where
1337instance FromJSON Xml where
1009 parseJSON = genericParseJSON (jsonPrefix "xml")
1338 parseJSON = genericParseJSON (jsonPrefix "xml")
1340+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1341+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1343+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1344+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1346+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1347+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1349+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1350+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1352+-- NOTE: There aren't collections of 'Schema'
1353+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1356+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1357+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
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
1366+instance FromJSON AdditionalProperties where
1367+ parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368+ parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1370+-------------------------------------------------------------------------------
1372+-------------------------------------------------------------------------------
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
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")]
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"
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