@@ -1,94 +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.HashMap.Strict (HashMap)
31+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32+import Data.Hashable (Hashable)
17import qualified Data.HashMap.Strict as HashMap
33import qualified Data.HashMap.Strict as HashMap
34+import Data.HashSet.InsOrd (InsOrdHashSet)
18import Data.Map (Map)
35import Data.Map (Map)
19import qualified Data.Map as Map
36import qualified Data.Map as Map
20−import Data.Monoid
37+import Data.Monoid (Monoid (..))
38+import Data.Semigroup.Compat (Semigroup (..))
21import Data.Scientific (Scientific)
39import Data.Scientific (Scientific)
22−import Data.String (fromString)
40+import Data.String (IsString(..))
23import Data.Text (Text)
41import Data.Text (Text)
24import qualified Data.Text as Text
42import qualified Data.Text as Text
25import GHC.Generics (Generic)
43import GHC.Generics (Generic)
26−import Network (HostName, PortNumber)
44+import Network.Socket (HostName, PortNumber)
27import Network.HTTP.Media (MediaType)
45import Network.HTTP.Media (MediaType)
28import 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
30import 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
32-- | This is the root document object for the API specification.
76-- | This is the root document object for the API specification.
33data Swagger = Swagger
77data Swagger = Swagger
34 { -- | Provides metadata about the API.
78 { -- | Provides metadata about the API.
35 -- The metadata can be used by the clients if needed.
79 -- The metadata can be used by the clients if needed.
36− _info :: Info
80+ _swaggerInfo :: Info
38 -- | 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.
39 -- 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).
40− , _host :: Maybe Host
84+ , _swaggerHost :: Maybe Host
42 -- | 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.
43 -- 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.
44 -- The value MUST start with a leading slash (/).
88 -- The value MUST start with a leading slash (/).
45− , _basePath :: Maybe FilePath
89+ , _swaggerBasePath :: Maybe FilePath
47 -- | The transfer protocol of the API.
91 -- | The transfer protocol of the API.
48 -- 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.
49− , _schemes :: Maybe [Scheme]
93+ , _swaggerSchemes :: Maybe [Scheme]
51 -- | A list of MIME types the APIs can consume.
95 -- | A list of MIME types the APIs can consume.
52 -- 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.
53− , _consumes :: MimeList
97+ , _swaggerConsumes :: MimeList
55 -- | A list of MIME types the APIs can produce.
99 -- | A list of MIME types the APIs can produce.
56− -- 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.
57− , _produces :: MimeList
101+ , _swaggerProduces :: MimeList
59 -- | The available paths and operations for the API.
103 -- | The available paths and operations for the API.
60− , _paths :: Paths
104+ -- Holds the relative paths to the individual endpoints.
105+ -- The path is appended to the @'basePath'@ in order to construct the full URL.
106+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem
62 -- | An object to hold data types produced and consumed by operations.
108 -- | An object to hold data types produced and consumed by operations.
63− , _definitions :: HashMap Text Schema
109+ , _swaggerDefinitions :: Definitions Schema
65 -- | An object to hold parameters that can be used across operations.
111 -- | An object to hold parameters that can be used across operations.
66 -- This property does not define global parameters for all operations.
112 -- This property does not define global parameters for all operations.
67− , _parameters :: HashMap Text Param
113+ , _swaggerParameters :: Definitions Param
69 -- | An object to hold responses that can be used across operations.
115 -- | An object to hold responses that can be used across operations.
70 -- This property does not define global responses for all operations.
116 -- This property does not define global responses for all operations.
71− , _responses :: HashMap Text Response
117+ , _swaggerResponses :: Definitions Response
73 -- | Security scheme definitions that can be used across the specification.
119 -- | Security scheme definitions that can be used across the specification.
74− , _securityDefinitions :: HashMap Text SecurityScheme
120+ , _swaggerSecurityDefinitions :: SecurityDefinitions
76 -- | 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.
77 -- 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
78 -- (that is, there is a logical OR between the security requirements).
124 -- (that is, there is a logical OR between the security requirements).
79 -- Individual operations can override this definition.
125 -- Individual operations can override this definition.
80− , _security :: [SecurityRequirement]
126+ , _swaggerSecurity :: [SecurityRequirement]
82 -- | A list of tags used by the specification with additional metadata.
128 -- | A list of tags used by the specification with additional metadata.
83 -- 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.
84 -- 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.
85 -- 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.
86 -- Each tag name in the list MUST be unique.
132 -- Each tag name in the list MUST be unique.
87− , _tags :: [Tag]
133+ , _swaggerTags :: InsOrdHashSet Tag
89 -- | Additional external documentation.
135 -- | Additional external documentation.
90− , _externalDocs :: Maybe ExternalDocs
136+ , _swaggerExternalDocs :: Maybe ExternalDocs
91− } deriving (Eq, Show, Generic)
137+ } deriving (Eq, Show, Generic, Data, Typeable)
93-- | The object provides metadata about the API.
139-- | The object provides metadata about the API.
94-- The metadata can be used by the clients if needed,
140-- The metadata can be used by the clients if needed,
@@ -113,7 +159,7 @@ data Info = Info
113 -- | Provides the version of the application API
159 -- | Provides the version of the application API
114 -- (not to be confused with the specification version).
160 -- (not to be confused with the specification version).
115 , _infoVersion :: Text
161 , _infoVersion :: Text
116− } deriving (Eq, Show, Generic)
162+ } deriving (Eq, Show, Generic, Data, Typeable)
118-- | Contact information for the exposed API.
164-- | Contact information for the exposed API.
119data Contact = Contact
165data Contact = Contact
@@ -125,7 +171,7 @@ data Contact = Contact
126 -- | The email address of the contact person/organization.
172 -- | The email address of the contact person/organization.
127 , _contactEmail :: Maybe Text
173 , _contactEmail :: Maybe Text
128− } deriving (Eq, Show)
174+ } deriving (Eq, Show, Generic, Data, Typeable)
130-- | License information for the exposed API.
176-- | License information for the exposed API.
131data License = License
177data License = License
@@ -134,13 +180,32 @@ data License = License
135 -- | A URL to the license used for the API.
181 -- | A URL to the license used for the API.
136 , _licenseUrl :: Maybe URL
182 , _licenseUrl :: Maybe URL
137− } deriving (Eq, Show)
183+ } deriving (Eq, Show, Generic, Data, Typeable)
185+instance IsString License where
186+ fromString s = License (fromString s) Nothing
139-- | 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.
140data Host = Host
189data Host = Host
141 { _hostName :: HostName -- ^ Host name.
190 { _hostName :: HostName -- ^ Host name.
142 , _hostPort :: Maybe PortNumber -- ^ Optional port.
191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
143− } 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
145-- | The transfer protocol of the API.
210-- | The transfer protocol of the API.
146data Scheme
211data Scheme
@@ -148,14 +213,7 @@ data Scheme
151− deriving (Eq, Show)
216+ deriving (Eq, Show, Generic, Data, Typeable)
153−-- | The available paths and operations for the API.
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)
160-- | Describes the operations available on a single path.
218-- | Describes the operations available on a single path.
161-- A @'PathItem'@ may be empty, due to ACL constraints.
219-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -188,13 +246,13 @@ data PathItem = PathItem
188 -- The list MUST NOT include duplicated parameters.
246 -- The list MUST NOT include duplicated parameters.
189 -- 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.
190 , _pathItemParameters :: [Referenced Param]
248 , _pathItemParameters :: [Referenced Param]
191− } deriving (Eq, Show, Generic)
249+ } deriving (Eq, Show, Generic, Data, Typeable)
193-- | Describes a single API operation on a path.
251-- | Describes a single API operation on a path.
194data Operation = Operation
252data Operation = Operation
195 { -- | A list of tags for API documentation control.
253 { -- | A list of tags for API documentation control.
196 -- 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.
197− _operationTags :: [Text]
255+ _operationTags :: InsOrdHashSet TagName
199 -- | A short summary of what the operation does.
257 -- | A short summary of what the operation does.
200 -- 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.
@@ -248,10 +306,23 @@ data Operation = Operation
248 -- This definition overrides any declared top-level security.
306 -- This definition overrides any declared top-level security.
249 -- To remove a top-level security declaration, @Just []@ can be used.
307 -- To remove a top-level security declaration, @Just []@ can be used.
250 , _operationSecurity :: [SecurityRequirement]
308 , _operationSecurity :: [SecurityRequirement]
251− } deriving (Eq, Show, Generic)
309+ } deriving (Eq, Show, Generic, Data, Typeable)
253newtype MimeList = MimeList { getMimeList :: [MediaType] }
311newtype MimeList = MimeList { getMimeList :: [MediaType] }
254− 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
256-- | Describes a single operation parameter.
327-- | Describes a single operation parameter.
257-- 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.
@@ -271,54 +342,158 @@ data Param = Param
271 , _paramRequired :: Maybe Bool
342 , _paramRequired :: Maybe Bool
273 -- | Parameter schema.
344 -- | Parameter schema.
274− , _paramSchema :: ParamSchema
345+ , _paramSchema :: ParamAnySchema
275− } deriving (Eq, Show, Generic)
346+ } deriving (Eq, Show, Generic, Data, Typeable)
277−data ParamSchema
348+data ParamAnySchema
278 = ParamBody (Referenced Schema)
349 = ParamBody (Referenced Schema)
279 | ParamOther ParamOtherSchema
350 | ParamOther ParamOtherSchema
280− deriving (Eq, Show)
351+ deriving (Eq, Show, Generic, Data, Typeable)
282data ParamOtherSchema = ParamOtherSchema
353data ParamOtherSchema = ParamOtherSchema
283 { -- | The location of the parameter.
354 { -- | The location of the parameter.
284 _paramOtherSchemaIn :: ParamLocation
355 _paramOtherSchemaIn :: ParamLocation
286− -- | The type of the parameter.
287− -- Since the parameter is not located at the request body,
288− -- it is limited to simple types (that is, not an object).
289− -- If type is @'ParamFile'@, the @consumes@ MUST be either
290− -- "multipart/form-data" or " application/x-www-form-urlencoded"
291− -- and the parameter MUST be in @'ParamFormData'@.
292− , _paramOtherSchemaType :: ParamType
294− -- | The extending format for the previously mentioned type.
295− , _paramOtherSchemaFormat :: Maybe Format
297 -- | Sets the ability to pass empty-valued parameters.
357 -- | Sets the ability to pass empty-valued parameters.
298 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
358 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
299 -- 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.
300 -- Default value is @False@.
360 -- Default value is @False@.
301 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
361 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
303− -- | __Required if type is @'ParamArray'@__.
363+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
304− -- Describes the type of items in the array.
364+ } deriving (Eq, Show, Generic, Typeable, Data)
305− , _paramOtherSchemaItems :: Maybe Items
365+
306−
366+-- | Items for @'SwaggerArray'@ schemas.
307− -- | Determines the format of the array if @'ParamArray'@ is used.
367+--
308− -- Default value is csv.
368+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
309− , _paramOtherSchemaCollectionFormat :: Maybe CollectionFormat
369+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
310−
370+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
311− , _paramOtherSchemaCommon :: SchemaCommon
371+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
312− } deriving (Eq, Show, Generic)
372+--
313−
373+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
315− = ParamString
375+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
316− | ParamNumber
376+data SwaggerItems t where
317− | ParamInteger
377+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
318− | ParamBoolean
378+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
319− | ParamArray
379+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
320− | ParamFile
380+ deriving (Typeable)
321− deriving (Eq, Show)
381+
382+deriving instance Eq (SwaggerItems t)
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
323data ParamLocation
498data ParamLocation
324 = -- | Parameters that are appended to the URL.
499 = -- | Parameters that are appended to the URL.
@@ -338,60 +513,56 @@ data ParamLocation
338 -- 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
339 -- (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>).
340 | ParamFormData
515 | ParamFormData
341− deriving (Eq, Show)
516+ deriving (Eq, Show, Generic, Data, Typeable)
343type Format = Text
518type Format = Text
345-- | Determines the format of the array.
520-- | Determines the format of the array.
346−data CollectionFormat
521+data CollectionFormat t where
347− = CollectionCSV -- ^ Comma separated values: @foo,bar@.
522+ -- Comma separated values: @foo,bar@.
523+ CollectionCSV :: CollectionFormat t
348− | CollectionSSV -- ^ Space separated values: @foo bar@.
524+ -- Space separated values: @foo bar@.
525+ CollectionSSV :: CollectionFormat t
349− | CollectionTSV -- ^ Tab separated values: @foo\\tbar@.
526+ -- Tab separated values: @foo\\tbar@.
527+ CollectionTSV :: CollectionFormat t
350− | CollectionPipes -- ^ Pipe separated values: @foo|bar@.
528+ -- Pipe separated values: @foo|bar@.
529+ CollectionPipes :: CollectionFormat t
351− | CollectionMulti -- ^ Corresponds to multiple parameter instances
530+ -- Corresponds to multiple parameter instances
352− -- 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@.
353− -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
532+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
354− deriving (Eq, Show)
533+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
355−
534+ deriving (Typeable)
357− = ItemsString
536+deriving instance Eq (CollectionFormat t)
362− deriving (Eq, Show)
537+deriving instance Show (CollectionFormat t)
364−data SchemaType
539+collectionFormatConstr :: CollectionFormat t -> Constr
365− = SchemaArray
540+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
367− | SchemaInteger
542+collectionFormatDataType :: DataType
368− | SchemaNumber
543+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
369− | SchemaNull
544+ map collectionFormatConstr collectionCommonFormats
371− | SchemaString
546+collectionCommonFormats :: [CollectionFormat t]
372− deriving (Eq, Show)
547+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
374−-- | Determines the format of the nested array.
549+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
375−data ItemsCollectionFormat
550+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
376− = ItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
551+ toConstr = collectionFormatConstr
377− | ItemsCollectionSSV -- ^ Space separated values: @foo bar@.
552+ dataTypeOf _ = collectionFormatDataType
378− | ItemsCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
553+
379− | ItemsCollectionPipes -- ^ Pipe separated values: @foo|bar@.
554+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
382type ParamName = Text
556type ParamName = Text
384data Schema = Schema
558data Schema = Schema
385− { _schemaType :: SchemaType
386− , _schemaFormat :: Maybe Format
387− , _schemaTitle :: Maybe Text
559+ { _schemaTitle :: Maybe Text
388 , _schemaDescription :: Maybe Text
560 , _schemaDescription :: Maybe Text
389 , _schemaRequired :: [ParamName]
561 , _schemaRequired :: [ParamName]
391− , _schemaItems :: Maybe SchemaItems
392− , _schemaAllOf :: Maybe [Schema]
563+ , _schemaAllOf :: Maybe [Referenced Schema]
393− , _schemaProperties :: HashMap Text (Referenced Schema)
564+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
394− , _schemaAdditionalProperties :: Maybe Schema
565+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
396 , _schemaDiscriminator :: Maybe Text
567 , _schemaDiscriminator :: Maybe Text
397 , _schemaReadOnly :: Maybe Bool
568 , _schemaReadOnly :: Maybe Bool
@@ -402,39 +573,49 @@ data Schema = Schema
402 , _schemaMaxProperties :: Maybe Integer
573 , _schemaMaxProperties :: Maybe Integer
403 , _schemaMinProperties :: Maybe Integer
574 , _schemaMinProperties :: Maybe Integer
405− , _schemaSchemaCommon :: SchemaCommon
576+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
406− } deriving (Eq, Show, Generic)
577+ } deriving (Eq, Show, Generic, Data, Typeable)
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)
408−data SchemaItems
586+-- | Regex pattern for @string@ type.
409− = SchemaItemsObject (Referenced Schema)
587+type Pattern = Text
410− | SchemaItemsArray [Referenced Schema]
413−data SchemaCommon = SchemaCommon
589+data ParamSchema (t :: SwaggerKind *) = ParamSchema
414 { -- | 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,
415 -- 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@
416 -- if not supplied by the client in the request.
592 -- if not supplied by the client in the request.
417 -- (Note: "default" has no meaning for required parameters.)
593 -- (Note: "default" has no meaning for required parameters.)
418 -- 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.
419− _schemaCommonDefault :: Maybe Value
595+ _paramSchemaDefault :: Maybe Value
421− , _schemaCommonMaximum :: Maybe Scientific
597+ , _paramSchemaType :: Maybe (SwaggerType t)
422− , _schemaCommonExclusiveMaximum :: Maybe Bool
598+ , _paramSchemaFormat :: Maybe Format
599+ , _paramSchemaItems :: Maybe (SwaggerItems t)
600+ , _paramSchemaMaximum :: Maybe Scientific
601+ , _paramSchemaExclusiveMaximum :: Maybe Bool
423− , _schemaCommonMinimum :: Maybe Scientific
602+ , _paramSchemaMinimum :: Maybe Scientific
424− , _schemaCommonExclusiveMinimum :: Maybe Bool
603+ , _paramSchemaExclusiveMinimum :: Maybe Bool
425− , _schemaCommonMaxLength :: Maybe Integer
604+ , _paramSchemaMaxLength :: Maybe Integer
426− , _schemaCommonMinLength :: Maybe Integer
605+ , _paramSchemaMinLength :: Maybe Integer
427− , _schemaCommonPattern :: Maybe Text
606+ , _paramSchemaPattern :: Maybe Pattern
428− , _schemaCommonMaxItems :: Maybe Integer
607+ , _paramSchemaMaxItems :: Maybe Integer
429− , _schemaCommonMinItems :: Maybe Integer
608+ , _paramSchemaMinItems :: Maybe Integer
430− , _schemaCommonUniqueItems :: Maybe Bool
609+ , _paramSchemaUniqueItems :: Maybe Bool
431− , _schemaCommonEnum :: Maybe [Value]
610+ , _paramSchemaEnum :: Maybe [Value]
432− , _schemaCommonMultipleOf :: Maybe Scientific
611+ , _paramSchemaMultipleOf :: Maybe Scientific
433− } 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)
435data Xml = Xml
616data Xml = Xml
436 { -- | 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.
437− -- 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.
438 -- When defined alongside type being array (outside the items),
619 -- When defined alongside type being array (outside the items),
439 -- 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.
440 -- If wrapped is false, it will be ignored.
621 -- If wrapped is false, it will be ignored.
@@ -458,25 +639,7 @@ data Xml = Xml
458 -- Default value is @False@.
639 -- Default value is @False@.
459 -- 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).
460 , _xmlWrapped :: Maybe Bool
641 , _xmlWrapped :: Maybe Bool
461− } deriving (Eq, Show, Generic)
642+ } deriving (Eq, Show, Generic, Data, Typeable)
464− { -- | The internal type of the array.
465− _itemsType :: ItemsType
467− -- | The extending format for the previously mentioned type.
468− , _itemsFormat :: Maybe Format
470− -- | __Required if type is @'ItemsArray'@.__
471− -- Describes the type of items in the array.
472− , _itemsItems :: Maybe Items
474− -- | Determines the format of the array if type array is used.
475− -- Default value is @'ItemsCollectionCSV'@.
476− , _itemsCollectionFormat :: Maybe ItemsCollectionFormat
478− , _itemsCommon :: SchemaCommon
479− } deriving (Eq, Show, Generic)
481-- | A container for the expected responses of an operation.
644-- | A container for the expected responses of an operation.
482-- The container maps a HTTP response code to the expected response.
645-- The container maps a HTTP response code to the expected response.
@@ -490,8 +653,8 @@ data Responses = Responses
491 -- | 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).
492 -- Describes the expected response for those HTTP status codes.
655 -- Describes the expected response for those HTTP status codes.
493− , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
656+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
494− } deriving (Eq, Show, Generic)
657+ } deriving (Eq, Show, Generic, Data, Typeable)
496type HttpStatusCode = Int
659type HttpStatusCode = Int
@@ -509,11 +672,14 @@ data Response = Response
509 , _responseSchema :: Maybe (Referenced Schema)
672 , _responseSchema :: Maybe (Referenced Schema)
511 -- | A list of headers that are sent with the response.
674 -- | A list of headers that are sent with the response.
512− , _responseHeaders :: HashMap HeaderName Header
675+ , _responseHeaders :: InsOrdHashMap HeaderName Header
514 -- | An example of the response message.
677 -- | An example of the response message.
515 , _responseExamples :: Maybe Example
678 , _responseExamples :: Maybe Example
516− } 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
518type HeaderName = Text
684type HeaderName = Text
@@ -521,31 +687,30 @@ data Header = Header
521 { -- | A short description of the header.
687 { -- | A short description of the header.
522 _headerDescription :: Maybe Text
688 _headerDescription :: Maybe Text
524− -- | The type of the object.
690+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
525− , _headerType :: ItemsType
691+ } deriving (Eq, Show, Generic, Data, Typeable)
527− -- | The extending format for the previously mentioned type. See Data Type Formats for further details.
693+data Example = Example { getExample :: Map MediaType Value }
528− , _headerFormat :: Maybe Format
694+ deriving (Eq, Show, Generic, Typeable)
530− -- | __Required if type is @'ItemsArray'@__.
531− -- Describes the type of items in the array.
532− , _headerItems :: Maybe Items
534− -- | Determines the format of the array if type array is used.
696+exampleConstr :: Constr
535− -- Default value is @'ItemsCollectionCSV'@.
697+exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
536− , _headerCollectionFormat :: Maybe ItemsCollectionFormat
538− , _headerCommon :: SchemaCommon
699+exampleDataType :: DataType
539− } deriving (Eq, Show, Generic)
700+exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
541−data Example = Example { getExample :: Map MediaType Value }
702+instance Data Example where
542− 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
544-- | The location of the API key.
709-- | The location of the API key.
545data ApiKeyLocation
710data ApiKeyLocation
546 = ApiKeyQuery
711 = ApiKeyQuery
547 | ApiKeyHeader
712 | ApiKeyHeader
548− deriving (Eq, Show)
713+ deriving (Eq, Show, Generic, Data, Typeable)
550data ApiKeyParams = ApiKeyParams
715data ApiKeyParams = ApiKeyParams
551 { -- | The name of the header or query parameter to be used.
716 { -- | The name of the header or query parameter to be used.
@@ -553,7 +718,7 @@ data ApiKeyParams = ApiKeyParams
554 -- | The location of the API key.
719 -- | The location of the API key.
555 , _apiKeyIn :: ApiKeyLocation
720 , _apiKeyIn :: ApiKeyLocation
556− } deriving (Eq, Show)
721+ } deriving (Eq, Show, Generic, Data, Typeable)
558-- | 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.
559type AuthorizationURL = Text
724type AuthorizationURL = Text
@@ -566,21 +731,21 @@ data OAuth2Flow
566 | OAuth2Password TokenURL
731 | OAuth2Password TokenURL
567 | OAuth2Application TokenURL
732 | OAuth2Application TokenURL
568 | OAuth2AccessCode AuthorizationURL TokenURL
733 | OAuth2AccessCode AuthorizationURL TokenURL
569− deriving (Eq, Show)
734+ deriving (Eq, Show, Generic, Data, Typeable)
571data OAuth2Params = OAuth2Params
736data OAuth2Params = OAuth2Params
572 { -- | The flow used by the OAuth2 security scheme.
737 { -- | The flow used by the OAuth2 security scheme.
573 _oauth2Flow :: OAuth2Flow
738 _oauth2Flow :: OAuth2Flow
575 -- | The available scopes for the OAuth2 security scheme.
740 -- | The available scopes for the OAuth2 security scheme.
576− , _oauth2Scopes :: HashMap Text Text
741+ , _oauth2Scopes :: InsOrdHashMap Text Text
577− } deriving (Eq, Show, Generic)
742+ } deriving (Eq, Show, Generic, Data, Typeable)
579data SecuritySchemeType
744data SecuritySchemeType
580 = SecuritySchemeBasic
745 = SecuritySchemeBasic
581 | SecuritySchemeApiKey ApiKeyParams
746 | SecuritySchemeApiKey ApiKeyParams
582 | SecuritySchemeOAuth2 OAuth2Params
747 | SecuritySchemeOAuth2 OAuth2Params
583− deriving (Eq, Show)
748+ deriving (Eq, Show, Generic, Data, Typeable)
585data SecurityScheme = SecurityScheme
750data SecurityScheme = SecurityScheme
586 { -- | The type of the security scheme.
751 { -- | The type of the security scheme.
@@ -588,20 +753,39 @@ data SecurityScheme = SecurityScheme
589 -- | A short description for security scheme.
754 -- | A short description for security scheme.
590 , _securitySchemeDescription :: Maybe Text
755 , _securitySchemeDescription :: Maybe Text
591− } 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)
593-- | Lists the required security schemes to execute this operation.
774-- | Lists the required security schemes to execute this operation.
594-- 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
595-- (that is, there is a logical AND between the schemes).
776-- (that is, there is a logical AND between the schemes).
596newtype SecurityRequirement = SecurityRequirement
777newtype SecurityRequirement = SecurityRequirement
597− { getSecurityRequirement :: HashMap Text [Text]
778+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
598− } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
779+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
600-- | 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@.
601-- 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.
602data Tag = Tag
786data Tag = Tag
603 { -- | The name of the tag.
787 { -- | The name of the tag.
604− _tagName :: Text
788+ _tagName :: TagName
606 -- | A short description for the tag.
790 -- | A short description for the tag.
607 -- GFM syntax can be used for rich text representation.
791 -- GFM syntax can be used for rich text representation.
@@ -609,7 +793,12 @@ data Tag = Tag
610 -- | Additional external documentation for this tag.
794 -- | Additional external documentation for this tag.
611 , _tagExternalDocs :: Maybe ExternalDocs
795 , _tagExternalDocs :: Maybe ExternalDocs
612− } 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
614-- | Allows referencing an external resource for extended documentation.
803-- | Allows referencing an external resource for extended documentation.
615data ExternalDocs = ExternalDocs
804data ExternalDocs = ExternalDocs
@@ -619,170 +808,236 @@ data ExternalDocs = ExternalDocs
620 -- | The URL for the target documentation.
809 -- | The URL for the target documentation.
621 , _externalDocsUrl :: URL
810 , _externalDocsUrl :: URL
622− } deriving (Eq, Show, Generic)
811+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
813+instance Hashable ExternalDocs
624-- | A simple object to allow referencing other definitions in the specification.
815-- | A simple object to allow referencing other definitions in the specification.
625-- 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.
626newtype Reference = Reference { getReference :: Text }
817newtype Reference = Reference { getReference :: Text }
627− deriving (Eq, Show)
818+ deriving (Eq, Show, Data, Typeable)
629data Referenced a
820data Referenced a
630 = Ref Reference
821 = Ref Reference
631 | Inline a
822 | Inline a
632− deriving (Eq, Show)
823+ deriving (Eq, Show, Functor, Data, Typeable)
825+instance IsString a => IsString (Referenced a) where
826+ fromString = Inline . fromString
634−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)
636-- =======================================================================
835-- =======================================================================
637-- Monoid instances
836-- Monoid instances
638-- =======================================================================
837-- =======================================================================
839+instance Semigroup Swagger where
840+ (<>) = genericMappend
640instance Monoid Swagger where
841instance Monoid Swagger where
641 mempty = genericMempty
842 mempty = genericMempty
642− mappend = genericMappend
843+ mappend = (<>)
845+instance Semigroup Info where
846+ (<>) = genericMappend
644instance Monoid Info where
847instance Monoid Info where
645 mempty = genericMempty
848 mempty = genericMempty
646− mappend = genericMappend
849+ mappend = (<>)
851+instance Semigroup Contact where
852+ (<>) = genericMappend
648−instance Monoid Paths where
853+instance Monoid Contact where
649 mempty = genericMempty
854 mempty = genericMempty
650− mappend = genericMappend
855+ mappend = (<>)
857+instance Semigroup PathItem where
858+ (<>) = genericMappend
652instance Monoid PathItem where
859instance Monoid PathItem where
653 mempty = genericMempty
860 mempty = genericMempty
654− mappend = genericMappend
861+ mappend = (<>)
863+instance Semigroup Schema where
864+ (<>) = genericMappend
656instance Monoid Schema where
865instance Monoid Schema where
657 mempty = genericMempty
866 mempty = genericMempty
658− mappend = genericMappend
867+ mappend = (<>)
660−instance Monoid SchemaCommon where
869+instance Semigroup (ParamSchema t) where
870+ (<>) = genericMappend
871+instance Monoid (ParamSchema t) where
661 mempty = genericMempty
872 mempty = genericMempty
662− mappend = genericMappend
873+ mappend = (<>)
875+instance Semigroup Param where
876+ (<>) = genericMappend
664instance Monoid Param where
877instance Monoid Param where
665 mempty = genericMempty
878 mempty = genericMempty
666− mappend = genericMappend
879+ mappend = (<>)
881+instance Semigroup ParamOtherSchema where
882+ (<>) = genericMappend
668instance Monoid ParamOtherSchema where
883instance Monoid ParamOtherSchema where
669 mempty = genericMempty
884 mempty = genericMempty
887+instance Semigroup Header where
670− mappend = genericMappend
888+ (<>) = genericMappend
889+instance Monoid Header where
890+ mempty = genericMempty
893+instance Semigroup Responses where
894+ (<>) = genericMappend
672instance Monoid Responses where
895instance Monoid Responses where
673 mempty = genericMempty
896 mempty = genericMempty
674− mappend = genericMappend
897+ mappend = (<>)
899+instance Semigroup Response where
900+ (<>) = genericMappend
676instance Monoid Response where
901instance Monoid Response where
677 mempty = genericMempty
902 mempty = genericMempty
678− mappend = genericMappend
903+ mappend = (<>)
905+instance Semigroup ExternalDocs where
906+ (<>) = genericMappend
680instance Monoid ExternalDocs where
907instance Monoid ExternalDocs where
681 mempty = genericMempty
908 mempty = genericMempty
682− mappend = genericMappend
909+ mappend = (<>)
911+instance Semigroup Operation where
912+ (<>) = genericMappend
684instance Monoid Operation where
913instance Monoid Operation where
685 mempty = genericMempty
914 mempty = genericMempty
917+instance Semigroup Example where
686− 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
688-- =======================================================================
934-- =======================================================================
689-- SwaggerMonoid helper instances
935-- SwaggerMonoid helper instances
690-- =======================================================================
936-- =======================================================================
692instance SwaggerMonoid Info
938instance SwaggerMonoid Info
693−instance SwaggerMonoid Paths
694instance SwaggerMonoid PathItem
939instance SwaggerMonoid PathItem
695instance SwaggerMonoid Schema
940instance SwaggerMonoid Schema
696−instance SwaggerMonoid SchemaCommon
941+instance SwaggerMonoid (ParamSchema t)
697instance SwaggerMonoid Param
942instance SwaggerMonoid Param
698instance SwaggerMonoid ParamOtherSchema
943instance SwaggerMonoid ParamOtherSchema
699instance SwaggerMonoid Responses
944instance SwaggerMonoid Responses
700instance SwaggerMonoid Response
945instance SwaggerMonoid Response
701instance SwaggerMonoid ExternalDocs
946instance SwaggerMonoid ExternalDocs
702instance SwaggerMonoid Operation
947instance SwaggerMonoid Operation
948+instance SwaggerMonoid SecurityDefinitions
949+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
704instance SwaggerMonoid MimeList
951instance SwaggerMonoid MimeList
705deriving instance SwaggerMonoid URL
952deriving instance SwaggerMonoid URL
707−instance SwaggerMonoid SchemaType where
954+instance SwaggerMonoid (SwaggerType t) where
708− swaggerMempty = SchemaNull
709− swaggerMappend _ y = y
711−instance SwaggerMonoid ParamType where
712− swaggerMempty = ParamString
955+ swaggerMempty = SwaggerString
713 swaggerMappend _ y = y
956 swaggerMappend _ y = y
715instance SwaggerMonoid ParamLocation where
958instance SwaggerMonoid ParamLocation where
716 swaggerMempty = ParamQuery
959 swaggerMempty = ParamQuery
717 swaggerMappend _ y = y
960 swaggerMappend _ y = y
719−instance SwaggerMonoid (HashMap Text Schema) where
962+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
720− swaggerMempty = HashMap.empty
963+ swaggerMempty = InsOrdHashMap.empty
721− swaggerMappend = HashMap.unionWith mappend
964+ swaggerMappend = InsOrdHashMap.unionWith mappend
723−instance SwaggerMonoid (HashMap Text (Referenced Schema)) where
724− swaggerMempty = HashMap.empty
725− swaggerMappend = HashMap.unionWith swaggerMappend
727instance Monoid a => SwaggerMonoid (Referenced a) where
966instance Monoid a => SwaggerMonoid (Referenced a) where
728 swaggerMempty = Inline mempty
967 swaggerMempty = Inline mempty
729− swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
968+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
969+ swaggerMappend _ y = y
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)
730 swaggerMappend _ y = y
975 swaggerMappend _ y = y
732−instance SwaggerMonoid (HashMap Text Param) where
977+-- =======================================================================
733− swaggerMempty = HashMap.empty
978+-- Simple Generic-based ToJSON instances
734− swaggerMappend = HashMap.unionWith mappend
979+-- =======================================================================
736−instance SwaggerMonoid (HashMap Text Response) where
981+instance ToJSON ParamLocation where
737− swaggerMempty = HashMap.empty
982+ toJSON = genericToJSON (jsonPrefix "Param")
738− swaggerMappend = flip HashMap.union
740−instance SwaggerMonoid (HashMap Text SecurityScheme) where
984+instance ToJSON Info where
741− swaggerMempty = HashMap.empty
985+ toJSON = genericToJSON (jsonPrefix "Info")
742− swaggerMappend = flip HashMap.union
744−instance SwaggerMonoid (HashMap FilePath PathItem) where
987+instance ToJSON Contact where
745− swaggerMempty = HashMap.empty
988+ toJSON = genericToJSON (jsonPrefix "Contact")
746− swaggerMappend = HashMap.unionWith mappend
748−instance SwaggerMonoid (HashMap HeaderName Header) where
990+instance ToJSON License where
749− swaggerMempty = HashMap.empty
991+ toJSON = genericToJSON (jsonPrefix "License")
750− swaggerMappend = flip HashMap.union
752−instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where
993+instance ToJSON ApiKeyLocation where
753− swaggerMempty = HashMap.empty
994+ toJSON = genericToJSON (jsonPrefix "ApiKey")
754− swaggerMappend = flip HashMap.union
756−instance SwaggerMonoid ParamSchema where
996+instance ToJSON ApiKeyParams where
757− swaggerMempty = ParamOther swaggerMempty
997+ toJSON = genericToJSON (jsonPrefix "apiKey")
758− swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
998+
759− swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
999+instance ToJSON Scheme where
760− swaggerMappend _ y = y
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")
762-- =======================================================================
1011-- =======================================================================
763−-- TH derived ToJSON and FromJSON instances
1012+-- Simple Generic-based FromJSON instances
764-- =======================================================================
1013-- =======================================================================
766−deriveJSON (jsonPrefix "Param") ''ParamLocation
1015+instance FromJSON ParamLocation where
767−deriveJSON (jsonPrefix "Param") ''ParamType
1016+ parseJSON = genericParseJSON (jsonPrefix "Param")
768−deriveJSON' ''Info
1017+
769−deriveJSON' ''Contact
1018+instance FromJSON Info where
770−deriveJSON' ''License
1019+ parseJSON = genericParseJSON (jsonPrefix "Info")
771−deriveJSON (jsonPrefix "Schema") ''SchemaType
1020+
772−deriveJSON (jsonPrefix "Items") ''ItemsType
1021+instance FromJSON Contact where
773−deriveJSON (jsonPrefix "ItemsCollection") ''ItemsCollectionFormat
1022+ parseJSON = genericParseJSON (jsonPrefix "Contact")
774−deriveJSON (jsonPrefix "Collection") ''CollectionFormat
1023+
775−deriveJSON (jsonPrefix "ApiKey") ''ApiKeyLocation
1024+instance FromJSON License where
1025+ parseJSON = genericParseJSON (jsonPrefix "License")
1027+instance FromJSON ApiKeyLocation where
1028+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1030+instance FromJSON ApiKeyParams where
776−deriveJSON (jsonPrefix "apiKey") ''ApiKeyParams
1031+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
777−deriveJSON' ''SchemaCommon
1032+
778−deriveJSONDefault ''Scheme
1033+instance FromJSON Scheme where
779−deriveJSON' ''Tag
1034+ parseJSON = genericParseJSON (jsonPrefix "")
780−deriveJSON' ''ExternalDocs
1035+
781−
1036+instance FromJSON Tag where
782−deriveToJSON' ''Operation
1037+ parseJSON = genericParseJSON (jsonPrefix "Tag")
783−deriveToJSON' ''Response
1038+
784−deriveToJSON' ''PathItem
1039+instance FromJSON ExternalDocs where
785−deriveToJSON' ''Xml
1040+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
787-- =======================================================================
1042-- =======================================================================
788-- Manual ToJSON instances
1043-- Manual ToJSON instances
@@ -804,7 +1059,8 @@ instance ToJSON OAuth2Flow where
804 , "tokenUrl" .= tokenUrl ]
1059 , "tokenUrl" .= tokenUrl ]
806instance ToJSON OAuth2Params where
1061instance ToJSON OAuth2Params where
807− toJSON = genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1062+ toJSON = sopSwaggerGenericToJSON
809instance ToJSON SecuritySchemeType where
1065instance ToJSON SecuritySchemeType where
810 toJSON SecuritySchemeBasic
1066 toJSON SecuritySchemeBasic
@@ -817,22 +1073,38 @@ instance ToJSON SecuritySchemeType where
817 <+> object [ "type" .= ("oauth2" :: Text) ]
1073 <+> object [ "type" .= ("oauth2" :: Text) ]
819instance ToJSON Swagger where
1075instance ToJSON Swagger where
820− toJSON = addVersion . genericToJSON (jsonPrefix "")
1076+ toJSON = sopSwaggerGenericToJSON
821− where
1077+ DEFINE_TOENCODING
822− addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
823− addVersion _ = error "impossible"
825instance ToJSON SecurityScheme where
1079instance ToJSON SecurityScheme where
826− toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1080+ toJSON = sopSwaggerGenericToJSON
828instance ToJSON Schema where
1083instance ToJSON Schema where
829− toJSON = genericToJSONWithSub "schemaCommon" (jsonPrefix "schema")
1084+ toJSON = sopSwaggerGenericToJSON
831instance ToJSON Header where
1087instance ToJSON Header where
832− toJSON = genericToJSONWithSub "common" (jsonPrefix "header")
1088+ toJSON = sopSwaggerGenericToJSON
833−
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}"
834−instance ToJSON Items where
1097+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
835− 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 ]
837instance ToJSON Host where
1109instance ToJSON Host where
838 toJSON (Host host mport) = toJSON $
1110 toJSON (Host host mport) = toJSON $
@@ -840,38 +1112,79 @@ instance ToJSON Host where
840 Nothing -> host
1112 Nothing -> host
841 Just port -> host ++ ":" ++ show port
1113 Just port -> host ++ ":" ++ show port
843−instance ToJSON Paths where
844− toJSON (Paths m) = toJSON m
846instance ToJSON MimeList where
1115instance ToJSON MimeList where
847 toJSON (MimeList xs) = toJSON (map show xs)
1116 toJSON (MimeList xs) = toJSON (map show xs)
849instance ToJSON Param where
1118instance ToJSON Param where
850− toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1119+ toJSON = sopSwaggerGenericToJSON
852−instance ToJSON ParamSchema where
1122+instance ToJSON ParamAnySchema where
853 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1123 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
854 toJSON (ParamOther s) = toJSON s
1124 toJSON (ParamOther s) = toJSON s
856instance ToJSON ParamOtherSchema where
1126instance ToJSON ParamOtherSchema where
857− toJSON = genericToJSONWithSub "common" (jsonPrefix "paramOtherSchema")
1127+ toJSON = sopSwaggerGenericToJSON
858−
1128+ DEFINE_TOENCODING
859−instance ToJSON SchemaItems where
860− toJSON (SchemaItemsObject x) = toJSON x
861− toJSON (SchemaItemsArray xs) = toJSON xs
863instance ToJSON Responses where
1130instance ToJSON Responses where
864− 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
866instance ToJSON Example where
1146instance ToJSON Example where
867 toJSON = toJSON . Map.mapKeys show . getExample
1147 toJSON = toJSON . Map.mapKeys show . getExample
1149+instance ToJSON SecurityDefinitions where
1150+ toJSON (SecurityDefinitions sd) = toJSON sd
869instance ToJSON Reference where
1152instance ToJSON Reference where
870 toJSON (Reference ref) = object [ "$ref" .= ref ]
1153 toJSON (Reference ref) = object [ "$ref" .= ref ]
872−instance ToJSON a => ToJSON (Referenced a) where
1155+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
873− toJSON (Ref ref) = toJSON ref
1156+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
874− 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
876-- =======================================================================
1189-- =======================================================================
877-- Manual FromJSON instances
1190-- Manual FromJSON instances
@@ -891,7 +1204,7 @@ instance FromJSON OAuth2Flow where
891 parseJSON _ = empty
1204 parseJSON _ = empty
893instance FromJSON OAuth2Params where
1206instance FromJSON OAuth2Params where
894− parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1207+ parseJSON = sopSwaggerGenericParseJSON
896instance FromJSON SecuritySchemeType where
1209instance FromJSON SecuritySchemeType where
897 parseJSON js@(Object o) = do
1210 parseJSON js@(Object o) = do
@@ -904,55 +1217,67 @@ instance FromJSON SecuritySchemeType where
904 parseJSON _ = empty
1217 parseJSON _ = empty
906instance FromJSON Swagger where
1219instance FromJSON Swagger where
907− parseJSON js@(Object o) = do
1220+ parseJSON = sopSwaggerGenericParseJSON
908− (version :: Text) <- o .: "swagger"
909− when (version /= "2.0") empty
910− (genericParseJSON (jsonPrefix "")
911− `withDefaults` [ "consumes" .= (mempty :: MimeList)
912− , "produces" .= (mempty :: MimeList)
913− , "security" .= ([] :: [SecurityRequirement])
914− , "tags" .= ([] :: [Tag])
915− , "definitions" .= (mempty :: HashMap Text Schema)
916− , "parameters" .= (mempty :: HashMap Text Param)
917− , "responses" .= (mempty :: HashMap Text Response)
918− , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
922instance FromJSON SecurityScheme where
1222instance FromJSON SecurityScheme where
923− parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1223+ parseJSON = sopSwaggerGenericParseJSON
925instance FromJSON Schema where
1225instance FromJSON Schema where
926− parseJSON = genericParseJSONWithSub "schemaCommon" (jsonPrefix "schema")
1226+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
927− `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1227+ where nullaryCleanup :: Schema -> Schema
928− , "required" .= ([] :: [ParamName]) ]
1228+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230+ then s { _schemaExample = Nothing
1231+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
930instance FromJSON Header where
1234instance FromJSON Header where
931− 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)
933−instance FromJSON Items where
1242+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
934− 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
936instance FromJSON Host where
1265instance FromJSON Host where
937− parseJSON (String s) =
1266+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
938− case fromInteger <$> readMaybe portStr of
1267+ [host] -> return $ Host host Nothing
939− Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1268+ [host, port] -> case readMaybe port of
940− mport -> pure $ Host host mport
1269+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
941− where
1270+ Just p -> return $ Host host (Just (fromInteger p))
942− (hostText, portText) = Text.breakOn ":" s
1271+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
943− [host, portStr] = map Text.unpack [hostText, portText]
944 parseJSON _ = empty
1272 parseJSON _ = empty
946−instance FromJSON Paths where
947− parseJSON js = Paths <$> parseJSON js
949instance FromJSON MimeList where
1274instance FromJSON MimeList where
950 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1275 parseJSON js = (MimeList . map fromString) <$> parseJSON js
952instance FromJSON Param where
1277instance FromJSON Param where
953− parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1278+ parseJSON = sopSwaggerGenericParseJSON
955−instance FromJSON ParamSchema where
1280+instance FromJSON ParamAnySchema where
956 parseJSON js@(Object o) = do
1281 parseJSON js@(Object o) = do
957 (i :: Text) <- o .: "in"
1282 (i :: Text) <- o .: "in"
958 case i of
1283 case i of
@@ -963,17 +1288,12 @@ instance FromJSON ParamSchema where
963 parseJSON _ = empty
1288 parseJSON _ = empty
965instance FromJSON ParamOtherSchema where
1290instance FromJSON ParamOtherSchema where
966− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "paramOtherSchema")
1291+ parseJSON = sopSwaggerGenericParseJSON
968−instance FromJSON SchemaItems where
969− parseJSON js@(Object _) = SchemaItemsObject <$> parseJSON js
970− parseJSON js@(Array _) = SchemaItemsArray <$> parseJSON js
973instance FromJSON Responses where
1293instance FromJSON Responses where
974 parseJSON (Object o) = Responses
1294 parseJSON (Object o) = Responses
975 <$> o .:? "default"
1295 <$> o .:? "default"
976− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1296+ <*> (parseJSON (Object (HashMap.delete "default" o)))
977 parseJSON _ = empty
1297 parseJSON _ = empty
979instance FromJSON Example where
1299instance FromJSON Example where
@@ -982,26 +1302,126 @@ instance FromJSON Example where
982 pure $ Example (Map.mapKeys fromString m)
1302 pure $ Example (Map.mapKeys fromString m)
984instance FromJSON Response where
1304instance FromJSON Response where
985− parseJSON = genericParseJSON (jsonPrefix "response")
1305+ parseJSON = sopSwaggerGenericParseJSON
986− `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
988instance FromJSON Operation where
1307instance FromJSON Operation where
989− parseJSON = genericParseJSON (jsonPrefix "operation")
1308+ parseJSON = sopSwaggerGenericParseJSON
990− `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
992instance FromJSON PathItem where
1310instance FromJSON PathItem where
993− parseJSON = genericParseJSON (jsonPrefix "pathItem")
1311+ parseJSON = sopSwaggerGenericParseJSON
994− `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1312+
1313+instance FromJSON SecurityDefinitions where
1314+ parseJSON js = SecurityDefinitions <$> parseJSON js
996instance FromJSON Reference where
1316instance FromJSON Reference where
997 parseJSON (Object o) = Reference <$> o .: "$ref"
1317 parseJSON (Object o) = Reference <$> o .: "$ref"
998 parseJSON _ = empty
1318 parseJSON _ = empty
1000−instance FromJSON a => FromJSON (Referenced a) where
1320+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1001− parseJSON js
1321+referencedParseJSON prefix js@(Object o) = do
1002− = Ref <$> parseJSON js
1322+ ms <- o .:? "$ref"
1003− <|> Inline <$> parseJSON js
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/"
1005instance FromJSON Xml where
1337instance FromJSON Xml where
1006 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