@@ -1,452 +1,636 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
15{-# LANGUAGE DeriveGeneric #-}
26{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE FlexibleContexts #-}
8+{-# LANGUAGE FlexibleInstances #-}
9+{-# LANGUAGE GADTs #-}
310{-# LANGUAGE GeneralizedNewtypeDeriving #-}
411{-# LANGUAGE OverloadedStrings #-}
512{-# LANGUAGE RecordWildCards #-}
613{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE StandaloneDeriving #-}
715{-# LANGUAGE TemplateHaskell #-}
16+{-# LANGUAGE TypeFamilies #-}
17+{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ <710
19+{-# LANGUAGE PolyKinds #-}
20+#endif
21+#include "overlapping-compat.h"
822module Data.Swagger.Internal where
923
24+import Prelude ()
25+import Prelude.Compat
26+
27+import Control.Lens ((&), (.~), (?~))
1028import Control.Applicative
11−import Control.Monad
1229import Data.Aeson
13−import Data.Aeson.TH (deriveJSON)
14−import Data.Foldable (Foldable)
15−import Data.HashMap.Strict (HashMap)
30+import qualified Data.Aeson.Types as JSON
31+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32+import Data.Hashable (Hashable)
1633import qualified Data.HashMap.Strict as HashMap
34+import Data.HashSet.InsOrd (InsOrdHashSet)
1735import Data.Map (Map)
1836import qualified Data.Map as Map
19−import Data.String (fromString)
37+import Data.Monoid (Monoid (..))
38+import Data.Semigroup.Compat (Semigroup (..))
39+import Data.Scientific (Scientific)
40+import Data.String (IsString(..))
2041import Data.Text (Text)
2142import qualified Data.Text as Text
22−import Data.Traversable (Traversable)
23−import Data.Hashable (Hashable)
2443import GHC.Generics (Generic)
25−import Network (HostName, PortNumber)
44+import Network.Socket (HostName, PortNumber)
2645import Network.HTTP.Media (MediaType)
2746import Text.Read (readMaybe)
2847
48+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50+
51+import Generics.SOP.TH (deriveGeneric)
52+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53+ ,sopSwaggerGenericToJSONWithOpts
54+ ,sopSwaggerGenericParseJSON
55+ ,HasSwaggerAesonOptions(..)
56+ ,AesonDefaultValue(..)
57+ ,mkSwaggerAesonOptions
58+ ,saoAdditionalPairs
59+ ,saoSubObject)
2960import Data.Swagger.Internal.Utils
3061
62+#if MIN_VERSION_aeson(0,10,0)
63+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64+#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65+#else
66+#define DEFINE_TOENCODING
67+#endif
68+
69+-- $setup
70+-- >>> :seti -XDataKinds
71+-- >>> import Data.Aeson
72+
73+-- | A list of definitions that can be used in references.
74+type Definitions = InsOrdHashMap Text
75+
3176-- | This is the root document object for the API specification.
3277data Swagger = Swagger
3378 { -- | Provides metadata about the API.
3479 -- The metadata can be used by the clients if needed.
35− swaggerInfo :: SwaggerInfo
80+ _swaggerInfo :: Info
3681
3782 -- | The host (name or ip) serving the API. It MAY include a port.
3883 -- If the host is not included, the host serving the documentation is to be used (including the port).
39− , swaggerHost :: Maybe SwaggerHost
84+ , _swaggerHost :: Maybe Host
4085
4186 -- | The base path on which the API is served, which is relative to the host.
4287 -- If it is not included, the API is served directly under the host.
4388 -- The value MUST start with a leading slash (/).
44− , swaggerBasePath :: Maybe FilePath
89+ , _swaggerBasePath :: Maybe FilePath
4590
4691 -- | The transfer protocol of the API.
4792 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
48− , swaggerSchemes :: Maybe [SwaggerScheme]
93+ , _swaggerSchemes :: Maybe [Scheme]
4994
5095 -- | A list of MIME types the APIs can consume.
5196 -- This is global to all APIs but can be overridden on specific API calls.
52− , swaggerConsumes :: SwaggerMimeList
97+ , _swaggerConsumes :: MimeList
5398
5499 -- | A list of MIME types the APIs can produce.
55− -- This is global to all APIs but can be overridden on specific API calls.
56− , swaggerProduces :: SwaggerMimeList
100+ -- This is global to all APIs but can be overridden on specific API calls.
101+ , _swaggerProduces :: MimeList
57102
58103 -- | The available paths and operations for the API.
59− , swaggerPaths :: SwaggerPaths
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
60107
61108 -- | An object to hold data types produced and consumed by operations.
62− , swaggerDefinitions :: HashMap Text SwaggerSchema
109+ , _swaggerDefinitions :: Definitions Schema
63110
64111 -- | An object to hold parameters that can be used across operations.
65112 -- This property does not define global parameters for all operations.
66− , swaggerParameters :: HashMap Text SwaggerParameter
113+ , _swaggerParameters :: Definitions Param
67114
68115 -- | An object to hold responses that can be used across operations.
69116 -- This property does not define global responses for all operations.
70− , swaggerResponses :: HashMap Text SwaggerResponse
117+ , _swaggerResponses :: Definitions Response
71118
72119 -- | Security scheme definitions that can be used across the specification.
73− , swaggerSecurityDefinitions :: HashMap Text SwaggerSecurityScheme
120+ , _swaggerSecurityDefinitions :: SecurityDefinitions
74121
75122 -- | A declaration of which security schemes are applied for the API as a whole.
76123 -- The list of values describes alternative security schemes that can be used
77124 -- (that is, there is a logical OR between the security requirements).
78125 -- Individual operations can override this definition.
79− , swaggerSecurity :: [SwaggerSecurityRequirement]
126+ , _swaggerSecurity :: [SecurityRequirement]
80127
81128 -- | A list of tags used by the specification with additional metadata.
82129 -- The order of the tags can be used to reflect on their order by the parsing tools.
83130 -- Not all tags that are used by the Operation Object must be declared.
84131 -- The tags that are not declared may be organized randomly or based on the tools' logic.
85132 -- Each tag name in the list MUST be unique.
86− , swaggerTags :: [SwaggerTag]
133+ , _swaggerTags :: InsOrdHashSet Tag
87134
88135 -- | Additional external documentation.
89− , swaggerExternalDocs :: SwaggerExternalDocs
90− } deriving (Show, Generic)
136+ , _swaggerExternalDocs :: Maybe ExternalDocs
137+ } deriving (Eq, Show, Generic, Data, Typeable)
91138
92139-- | The object provides metadata about the API.
93140-- The metadata can be used by the clients if needed,
94141-- and can be presented in the Swagger-UI for convenience.
95−data SwaggerInfo = SwaggerInfo
142+data Info = Info
96143 { -- | The title of the application.
97− swaggerInfoTitle :: Text
144+ _infoTitle :: Text
98145
99146 -- | A short description of the application.
100147 -- GFM syntax can be used for rich text representation.
101− , swaggerInfoDescription :: Maybe Text
148+ , _infoDescription :: Maybe Text
102149
103150 -- | The Terms of Service for the API.
104− , swaggerInfoTermsOfService :: Maybe Text
151+ , _infoTermsOfService :: Maybe Text
105152
106153 -- | The contact information for the exposed API.
107− , swaggerInfoContact :: Maybe SwaggerContact
154+ , _infoContact :: Maybe Contact
108155
109156 -- | The license information for the exposed API.
110− , swaggerInfoLicense :: Maybe SwaggerLicense
157+ , _infoLicense :: Maybe License
111158
112159 -- | Provides the version of the application API
113160 -- (not to be confused with the specification version).
114− , swaggerInfoVersion :: Text
115− } deriving (Show)
161+ , _infoVersion :: Text
162+ } deriving (Eq, Show, Generic, Data, Typeable)
116163
117164-- | Contact information for the exposed API.
118−data SwaggerContact = SwaggerContact
165+data Contact = Contact
119166 { -- | The identifying name of the contact person/organization.
120− swaggerContactName :: Maybe Text
167+ _contactName :: Maybe Text
121168
122169 -- | The URL pointing to the contact information.
123− , swaggerContactUrl :: Maybe URL
170+ , _contactUrl :: Maybe URL
124171
125172 -- | The email address of the contact person/organization.
126− , swaggerContactEmail :: Maybe Text
127− } deriving (Show)
173+ , _contactEmail :: Maybe Text
174+ } deriving (Eq, Show, Generic, Data, Typeable)
128175
129176-- | License information for the exposed API.
130−data SwaggerLicense = SwaggerLicense
177+data License = License
131178 { -- | The license name used for the API.
132− swaggerLicenseName :: Text
179+ _licenseName :: Text
133180
134181 -- | A URL to the license used for the API.
135− , swaggerLicenseUrl :: Maybe URL
136− } deriving (Show)
182+ , _licenseUrl :: Maybe URL
183+ } deriving (Eq, Show, Generic, Data, Typeable)
184+
185+instance IsString License where
186+ fromString s = License (fromString s) Nothing
137187
138188-- | The host (name or ip) serving the API. It MAY include a port.
139−data SwaggerHost = SwaggerHost
140− { swaggerHostName :: HostName -- ^ Host name.
141− , swaggerHostPort :: Maybe PortNumber -- ^ Optional port.
142− } deriving (Show)
189+data Host = Host
190+ { _hostName :: HostName -- ^ Host name.
191+ , _hostPort :: Maybe PortNumber -- ^ Optional port.
192+ } deriving (Eq, Show, Generic, Typeable)
193+
194+instance IsString Host where
195+ fromString s = Host s Nothing
196+
197+hostConstr :: Constr
198+hostConstr = mkConstr hostDataType "Host" [] Prefix
199+
200+hostDataType :: DataType
201+hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
202+
203+instance Data Host where
204+ gunfold k z c = case constrIndex c of
205+ 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
206+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
207+ toConstr (Host _ _) = hostConstr
208+ dataTypeOf _ = hostDataType
143209
144210-- | The transfer protocol of the API.
145−data SwaggerScheme
211+data Scheme
146212 = Http
147213 | Https
148214 | Ws
149215 | Wss
150− deriving (Show)
151−
152−-- | The available paths and operations for the API.
153−data SwaggerPaths = SwaggerPaths
154− { -- | Holds the relative paths to the individual endpoints.
155− -- The path is appended to the @'swaggerBasePath'@ in order to construct the full URL.
156− swaggerPathsMap :: HashMap FilePath SwaggerPathItem
157− } deriving (Show)
216+ deriving (Eq, Show, Generic, Data, Typeable)
158217
159218-- | Describes the operations available on a single path.
160−-- A @'SwaggerPathItem'@ may be empty, due to ACL constraints.
219+-- A @'PathItem'@ may be empty, due to ACL constraints.
161220-- The path itself is still exposed to the documentation viewer
162221-- but they will not know which operations and parameters are available.
163−data SwaggerPathItem = SwaggerPathItem
222+data PathItem = PathItem
164223 { -- | A definition of a GET operation on this path.
165− swaggerPathItemGet :: Maybe SwaggerOperation
224+ _pathItemGet :: Maybe Operation
166225
167226 -- | A definition of a PUT operation on this path.
168− , swaggerPathItemPut :: Maybe SwaggerOperation
227+ , _pathItemPut :: Maybe Operation
169228
170229 -- | A definition of a POST operation on this path.
171− , swaggerPathItemPost :: Maybe SwaggerOperation
230+ , _pathItemPost :: Maybe Operation
172231
173232 -- | A definition of a DELETE operation on this path.
174− , swaggerPathItemDelete :: Maybe SwaggerOperation
233+ , _pathItemDelete :: Maybe Operation
175234
176235 -- | A definition of a OPTIONS operation on this path.
177− , swaggerPathItemOptions :: Maybe SwaggerOperation
236+ , _pathItemOptions :: Maybe Operation
178237
179238 -- | A definition of a HEAD operation on this path.
180− , swaggerPathItemHead :: Maybe SwaggerOperation
239+ , _pathItemHead :: Maybe Operation
181240
182241 -- | A definition of a PATCH operation on this path.
183− , swaggerPathItemPatch :: Maybe SwaggerOperation
242+ , _pathItemPatch :: Maybe Operation
184243
185244 -- | A list of parameters that are applicable for all the operations described under this path.
186245 -- These parameters can be overridden at the operation level, but cannot be removed there.
187246 -- The list MUST NOT include duplicated parameters.
188247 -- A unique parameter is defined by a combination of a name and location.
189− , swaggerPathItemParameters :: [SwaggerParameter]
190− } deriving (Show)
248+ , _pathItemParameters :: [Referenced Param]
249+ } deriving (Eq, Show, Generic, Data, Typeable)
191250
192251-- | Describes a single API operation on a path.
193−data SwaggerOperation = SwaggerOperation
252+data Operation = Operation
194253 { -- | A list of tags for API documentation control.
195254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
196− swaggerOperationTags :: [Text]
255+ _operationTags :: InsOrdHashSet TagName
197256
198257 -- | A short summary of what the operation does.
199258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
200− , swaggerOperationSummary :: Maybe Text
259+ , _operationSummary :: Maybe Text
201260
202261 -- | A verbose explanation of the operation behavior.
203262 -- GFM syntax can be used for rich text representation.
204− , swaggerOperationDescription :: Maybe Text
263+ , _operationDescription :: Maybe Text
205264
206265 -- | Additional external documentation for this operation.
207− , swaggerOperationExternalDocs :: Maybe SwaggerExternalDocs
266+ , _operationExternalDocs :: Maybe ExternalDocs
208267
209268 -- | Unique string used to identify the operation.
210269 -- The id MUST be unique among all operations described in the API.
211270 -- Tools and libraries MAY use the it to uniquely identify an operation,
212271 -- therefore, it is recommended to follow common programming naming conventions.
213− , swaggerOperationOperationId :: Maybe Text
272+ , _operationOperationId :: Maybe Text
214273
215274 -- | A list of MIME types the operation can consume.
216− -- This overrides the @'swaggerConsumes'@.
275+ -- This overrides the @'consumes'@.
217276 -- @Just []@ MAY be used to clear the global definition.
218− , swaggerOperationConsumes :: Maybe SwaggerMimeList
277+ , _operationConsumes :: Maybe MimeList
219278
220279 -- | A list of MIME types the operation can produce.
221− -- This overrides the @'swaggerProduces'@.
280+ -- This overrides the @'produces'@.
222281 -- @Just []@ MAY be used to clear the global definition.
223− , swaggerOperationProduces :: Maybe SwaggerMimeList
282+ , _operationProduces :: Maybe MimeList
224283
225284 -- | A list of parameters that are applicable for this operation.
226− -- If a parameter is already defined at the @'SwaggerPathItem'@,
285+ -- If a parameter is already defined at the @'PathItem'@,
227286 -- the new definition will override it, but can never remove it.
228287 -- The list MUST NOT include duplicated parameters.
229288 -- A unique parameter is defined by a combination of a name and location.
230− , swaggerOperationParameters :: [SwaggerParameter]
289+ , _operationParameters :: [Referenced Param]
231290
232291 -- | The list of possible responses as they are returned from executing this operation.
233− , swaggerOperationResponses :: SwaggerResponses
292+ , _operationResponses :: Responses
234293
235294 -- | The transfer protocol for the operation.
236− -- The value overrides @'swaggerSchemes'@.
237− , swaggerOperationSchemes :: Maybe [SwaggerScheme]
295+ -- The value overrides @'schemes'@.
296+ , _operationSchemes :: Maybe [Scheme]
238297
239298 -- | Declares this operation to be deprecated.
240299 -- Usage of the declared operation should be refrained.
241300 -- Default value is @False@.
242− , swaggerOperationDeprecated :: Bool
301+ , _operationDeprecated :: Maybe Bool
243302
244303 -- | A declaration of which security schemes are applied for this operation.
245304 -- The list of values describes alternative security schemes that can be used
246305 -- (that is, there is a logical OR between the security requirements).
247306 -- This definition overrides any declared top-level security.
248307 -- To remove a top-level security declaration, @Just []@ can be used.
249− , swaggerOperationSecurity :: [SwaggerSecurityRequirement]
250− } deriving (Show)
308+ , _operationSecurity :: [SecurityRequirement]
309+ } deriving (Eq, Show, Generic, Data, Typeable)
310+
311+newtype MimeList = MimeList { getMimeList :: [MediaType] }
312+ deriving (Eq, Show, Semigroup, Monoid, Typeable)
313+
314+mimeListConstr :: Constr
315+mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
251316
252−newtype SwaggerMimeList = SwaggerMimeList { getSwaggerMimeList :: [MediaType] }
253− deriving (Show)
317+mimeListDataType :: DataType
318+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
319+
320+instance Data MimeList where
321+ gunfold k z c = case constrIndex c of
322+ 1 -> k (z (\xs -> MimeList (map fromString xs)))
323+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
324+ toConstr (MimeList _) = mimeListConstr
325+ dataTypeOf _ = mimeListDataType
254326
255327-- | Describes a single operation parameter.
256328-- A unique parameter is defined by a combination of a name and location.
257−data SwaggerParameter = SwaggerParameter
329+data Param = Param
258330 { -- | The name of the parameter.
259331 -- Parameter names are case sensitive.
260− swaggerParameterName :: Text
332+ _paramName :: Text
261333
262334 -- | A brief description of the parameter.
263335 -- This could contain examples of use.
264336 -- GFM syntax can be used for rich text representation.
265− , swaggerParameterDescription :: Maybe Text
337+ , _paramDescription :: Maybe Text
266338
267339 -- | Determines whether this parameter is mandatory.
268340 -- If the parameter is in "path", this property is required and its value MUST be true.
269341 -- Otherwise, the property MAY be included and its default value is @False@.
270− , swaggerParameterRequired :: Bool
342+ , _paramRequired :: Maybe Bool
271343
272344 -- | Parameter schema.
273− , swaggerParameterSchema :: SwaggerParameterSchema
274− } deriving (Show, Generic)
345+ , _paramSchema :: ParamAnySchema
346+ } deriving (Eq, Show, Generic, Data, Typeable)
275347
276−data SwaggerParameterSchema
277− = SwaggerParameterBody SwaggerSchema
278− | SwaggerParameterOther SwaggerParameterOtherSchema
279− deriving (Show)
348+data ParamAnySchema
349+ = ParamBody (Referenced Schema)
350+ | ParamOther ParamOtherSchema
351+ deriving (Eq, Show, Generic, Data, Typeable)
280352
281−data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema
353+data ParamOtherSchema = ParamOtherSchema
282354 { -- | The location of the parameter.
283− swaggerParameterOtherSchemaIn :: SwaggerParameterLocation
284−
285− -- | The type of the parameter.
286− -- Since the parameter is not located at the request body,
287− -- it is limited to simple types (that is, not an object).
288− -- If type is @'SwaggerParamFile'@, the @consumes@ MUST be either
289− -- "multipart/form-data" or " application/x-www-form-urlencoded"
290− -- and the parameter MUST be in @'SwaggerParameterFormData'@.
291− , swaggerParameterOtherSchemaType :: SwaggerParameterType
292−
293− -- | The extending format for the previously mentioned type.
294− , swaggerParameterOtherSchemaFormat :: Maybe SwaggerFormat
355+ _paramOtherSchemaIn :: ParamLocation
295356
296357 -- | Sets the ability to pass empty-valued parameters.
297− -- This is valid only for either @'SwaggerParameterQuery'@ or @'SwaggerParameterFormData'@
358+ -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
298359 -- and allows you to send a parameter with a name only or an empty value.
299360 -- Default value is @False@.
300− , swaggerParameterOtherSchemaAllowEmptyValue :: Bool
301−
302− -- | __Required if type is @'SwaggerParamArray'@__.
303− -- Describes the type of items in the array.
304− , swaggerParameterOtherSchemaItems :: Maybe SwaggerItems
305−
306− -- | Determines the format of the array if @'SwaggerParamArray'@ is used.
307− -- Default value is csv.
308− , swaggerParameterOtherSchemaCollectionFormat :: Maybe SwaggerCollectionFormat
309−
310− , swaggerParameterOtherSchemaCommon :: SwaggerSchemaCommon
311− } deriving (Show, Generic)
312−
313−data SwaggerParameterType
314− = SwaggerParamString
315− | SwaggerParamNumber
316− | SwaggerParamInteger
317− | SwaggerParamBoolean
318− | SwaggerParamArray
319− | SwaggerParamFile
320− deriving (Show)
321−
322−data SwaggerParameterLocation
361+ , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362+
363+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364+ } deriving (Eq, Show, Generic, Typeable, Data)
365+
366+-- | Items for @'SwaggerArray'@ schemas.
367+--
368+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
369+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
370+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
371+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
372+--
373+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
374+--
375+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376+data SwaggerItems t where
377+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
380+ deriving (Typeable)
381+
382+deriving instance Eq (SwaggerItems t)
383+deriving instance Show (SwaggerItems t)
384+--deriving instance Typeable (SwaggerItems t)
385+
386+swaggerItemsPrimitiveConstr :: Constr
387+swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388+
389+swaggerItemsObjectConstr :: Constr
390+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391+
392+swaggerItemsArrayConstr :: Constr
393+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394+
395+swaggerItemsDataType :: DataType
396+swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397+
398+-- Note: unfortunately we have to write these Data instances by hand,
399+-- to get better contexts / avoid duplicate name when using standalone deriving
400+
401+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402+ -- TODO: define gfoldl
403+ gunfold k z c = case constrIndex c of
404+ 1 -> k (k (z SwaggerItemsPrimitive))
405+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406+ toConstr _ = swaggerItemsPrimitiveConstr
407+ dataTypeOf _ = swaggerItemsDataType
408+
409+-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411+ -- TODO: define gfoldl
412+ gunfold k z c = case constrIndex c of
413+ 1 -> k (k (z SwaggerItemsPrimitive))
414+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415+ toConstr _ = swaggerItemsPrimitiveConstr
416+ dataTypeOf _ = swaggerItemsDataType
417+
418+instance Data (SwaggerItems 'SwaggerKindSchema) where
419+ gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420+ gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421+ gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
422+
423+ gunfold k z c = case constrIndex c of
424+ 2 -> k (z SwaggerItemsObject)
425+ 3 -> k (z SwaggerItemsArray)
426+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
427+
428+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431+
432+ dataTypeOf _ = swaggerItemsDataType
433+
434+-- | Type used as a kind to avoid overlapping instances.
435+data SwaggerKind t
436+ = SwaggerKindNormal t
437+ | SwaggerKindParamOtherSchema
438+ | SwaggerKindSchema
439+ deriving (Typeable)
440+
441+deriving instance Typeable 'SwaggerKindNormal
442+deriving instance Typeable 'SwaggerKindParamOtherSchema
443+deriving instance Typeable 'SwaggerKindSchema
444+
445+type family SwaggerKindType (k :: SwaggerKind *) :: *
446+type instance SwaggerKindType ('SwaggerKindNormal t) = t
447+type instance SwaggerKindType 'SwaggerKindSchema = Schema
448+type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
449+
450+data SwaggerType t where
451+ SwaggerString :: SwaggerType t
452+ SwaggerNumber :: SwaggerType t
453+ SwaggerInteger :: SwaggerType t
454+ SwaggerBoolean :: SwaggerType t
455+ SwaggerArray :: SwaggerType t
456+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457+ SwaggerNull :: SwaggerType 'SwaggerKindSchema
458+ SwaggerObject :: SwaggerType 'SwaggerKindSchema
459+ deriving (Typeable)
460+
461+deriving instance Eq (SwaggerType t)
462+deriving instance Show (SwaggerType t)
463+
464+swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465+swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466+
467+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
468+swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469+
470+swaggerCommonTypes :: [SwaggerType k]
471+swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472+
473+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
474+swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475+
476+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
477+swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478+
479+swaggerTypeConstrs :: [Constr]
480+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
481+ ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482+
483+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
484+ gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485+ toConstr = swaggerTypeConstr
486+ dataTypeOf = swaggerTypeDataType
487+
488+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
489+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490+ toConstr = swaggerTypeConstr
491+ dataTypeOf = swaggerTypeDataType
492+
493+instance Data (SwaggerType 'SwaggerKindSchema) where
494+ gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495+ toConstr = swaggerTypeConstr
496+ dataTypeOf = swaggerTypeDataType
497+
498+data ParamLocation
323499 = -- | Parameters that are appended to the URL.
324500 -- For example, in @/items?id=###@, the query parameter is @id@.
325− SwaggerParameterQuery
501+ ParamQuery
326502 -- | Custom headers that are expected as part of the request.
327− | SwaggerParameterHeader
503+ | ParamHeader
328504 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
329505 -- This does not include the host or base path of the API.
330506 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
331− | SwaggerParameterPath
507+ | ParamPath
332508 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
333509 -- or @multipart/form-data@ are used as the content type of the request
334510 -- (in Swagger's definition, the @consumes@ property of an operation).
335− -- This is the only parameter type that can be used to send files, thus supporting the @'SwaggerParamFile'@ type.
511+ -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
336512 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
337513 -- Form parameters have a different format based on the content-type used
338514 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
339− | SwaggerParameterFormData
340− deriving (Show)
515+ | ParamFormData
516+ deriving (Eq, Show, Generic, Data, Typeable)
341517
342−type SwaggerFormat = Text
518+type Format = Text
343519
344520-- | Determines the format of the array.
345−data SwaggerCollectionFormat
346− = SwaggerCollectionCSV -- ^ Comma separated values: @foo,bar@.
347− | SwaggerCollectionSSV -- ^ Space separated values: @foo bar@.
348− | SwaggerCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
349− | SwaggerCollectionPipes -- ^ Pipe separated values: @foo|bar@.
350− | SwaggerCollectionMulti -- ^ Corresponds to multiple parameter instances
351− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
352− -- This is valid only for parameters in @'SwaggerParameterQuery'@ or @'SwaggerParameterFormData'@.
353− deriving (Show)
354−
355−data SwaggerItemsType
356− = SwaggerItemsString
357− | SwaggerItemsNumber
358− | SwaggerItemsInteger
359− | SwaggerItemsBoolean
360− | SwaggerItemsArray
361− deriving (Show)
362−
363−data SwaggerSchemaType
364− = SwaggerSchemaArray
365− | SwaggerSchemaBoolean
366− | SwaggerSchemaInteger
367− | SwaggerSchemaNumber
368− | SwaggerSchemaNull
369− | SwaggerSchemaObject
370− | SwaggerSchemaString
371− deriving (Show)
372−
373−-- | Determines the format of the nested array.
374−data SwaggerItemsCollectionFormat
375− = SwaggerItemsCollectionCSV -- ^ Comma separated values: @foo,bar@.
376− | SwaggerItemsCollectionSSV -- ^ Space separated values: @foo bar@.
377− | SwaggerItemsCollectionTSV -- ^ Tab separated values: @foo\\tbar@.
378− | SwaggerItemsCollectionPipes -- ^ Pipe separated values: @foo|bar@.
379− deriving (Show)
380−
381−data SwaggerSchema = SwaggerSchema
382− { swaggerSchemaType :: SwaggerSchemaType
383− , swaggerSchemaFormat :: SwaggerFormat
384− , swaggerSchemaTitle :: Maybe Text
385− , swaggerSchemaDescription :: Maybe Text
386− , swaggerSchemaRequired :: Maybe Bool
387−
388− , swaggerSchemaItems :: SwaggerSchemaItems
389− , swaggerSchemaAllOf :: [SwaggerSchema]
390− , swaggerSchemaProperties :: HashMap Text SwaggerSchema
391− , swaggerSchemaAdditionalProperties :: Maybe SwaggerSchema
392−
393− , swaggerSchemaDiscriminator :: Maybe Text
394− , swaggerSchemaReadOnly :: Maybe Bool
395− , swaggerSchemaXml :: Maybe SwaggerXml
396− , swaggerSchemaExternalDocs :: Maybe SwaggerExternalDocs
397− , swaggerSchemaExample :: Maybe Value
398−
399− , swaggerSchemaMaxProperties :: Maybe Integer
400− , swaggerSchemaMinProperties :: Maybe Integer
401−
402− , swaggerSchemaCommon :: SwaggerSchemaCommon
403− } deriving (Show, Generic)
404−
405−data SwaggerSchemaItems
406− = SwaggerSchemaItemsObject SwaggerSchema
407− | SwaggerSchemaItemsArray [SwaggerSchema]
408− deriving (Show)
409−
410−data SwaggerSchemaCommon = SwaggerSchemaCommon
521+data CollectionFormat t where
522+ -- Comma separated values: @foo,bar@.
523+ CollectionCSV :: CollectionFormat t
524+ -- Space separated values: @foo bar@.
525+ CollectionSSV :: CollectionFormat t
526+ -- Tab separated values: @foo\\tbar@.
527+ CollectionTSV :: CollectionFormat t
528+ -- Pipe separated values: @foo|bar@.
529+ CollectionPipes :: CollectionFormat t
530+ -- Corresponds to multiple parameter instances
531+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
534+ deriving (Typeable)
535+
536+deriving instance Eq (CollectionFormat t)
537+deriving instance Show (CollectionFormat t)
538+
539+collectionFormatConstr :: CollectionFormat t -> Constr
540+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
541+
542+collectionFormatDataType :: DataType
543+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
544+ map collectionFormatConstr collectionCommonFormats
545+
546+collectionCommonFormats :: [CollectionFormat t]
547+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548+
549+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
550+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551+ toConstr = collectionFormatConstr
552+ dataTypeOf _ = collectionFormatDataType
553+
554+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
555+
556+type ParamName = Text
557+
558+data Schema = Schema
559+ { _schemaTitle :: Maybe Text
560+ , _schemaDescription :: Maybe Text
561+ , _schemaRequired :: [ParamName]
562+
563+ , _schemaAllOf :: Maybe [Referenced Schema]
564+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
566+
567+ , _schemaDiscriminator :: Maybe Text
568+ , _schemaReadOnly :: Maybe Bool
569+ , _schemaXml :: Maybe Xml
570+ , _schemaExternalDocs :: Maybe ExternalDocs
571+ , _schemaExample :: Maybe Value
572+
573+ , _schemaMaxProperties :: Maybe Integer
574+ , _schemaMinProperties :: Maybe Integer
575+
576+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577+ } deriving (Eq, Show, Generic, Data, Typeable)
578+
579+-- | A @'Schema'@ with an optional name.
580+-- This name can be used in references.
581+data NamedSchema = NamedSchema
582+ { _namedSchemaName :: Maybe Text
583+ , _namedSchemaSchema :: Schema
584+ } deriving (Eq, Show, Generic, Data, Typeable)
585+
586+-- | Regex pattern for @string@ type.
587+type Pattern = Text
588+
589+data ParamSchema (t :: SwaggerKind *) = ParamSchema
411590 { -- | Declares the value of the parameter that the server will use if none is provided,
412591 -- for example a @"count"@ to control the number of results per page might default to @100@
413592 -- if not supplied by the client in the request.
414593 -- (Note: "default" has no meaning for required parameters.)
415594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
416− swaggerSchemaDefault :: Maybe Value
417−
418− , swaggerSchemaMaximum :: Maybe Integer
419− , swaggerSchemaExclusiveMaximum :: Maybe Bool
420− , swaggerSchemaMinimum :: Maybe Integer
421− , swaggerSchemaExclusiveMinimum :: Maybe Bool
422− , swaggerSchemaMaxLength :: Maybe Integer
423− , swaggerSchemaMinLength :: Maybe Integer
424− , swaggerSchemaPattern :: Maybe Text
425− , swaggerSchemaMaxItems :: Maybe Integer
426− , swaggerSchemaMinItems :: Maybe Integer
427− , swaggerSchemaUniqueItems :: Maybe Bool
428− , swaggerSchemaEnum :: Maybe [Value]
429− , swaggerSchemaMultipleOf :: Maybe Integer
430− } deriving (Show, Generic)
431−
432−data SwaggerXml = SwaggerXml
595+ _paramSchemaDefault :: Maybe Value
596+
597+ , _paramSchemaType :: Maybe (SwaggerType t)
598+ , _paramSchemaFormat :: Maybe Format
599+ , _paramSchemaItems :: Maybe (SwaggerItems t)
600+ , _paramSchemaMaximum :: Maybe Scientific
601+ , _paramSchemaExclusiveMaximum :: Maybe Bool
602+ , _paramSchemaMinimum :: Maybe Scientific
603+ , _paramSchemaExclusiveMinimum :: Maybe Bool
604+ , _paramSchemaMaxLength :: Maybe Integer
605+ , _paramSchemaMinLength :: Maybe Integer
606+ , _paramSchemaPattern :: Maybe Pattern
607+ , _paramSchemaMaxItems :: Maybe Integer
608+ , _paramSchemaMinItems :: Maybe Integer
609+ , _paramSchemaUniqueItems :: Maybe Bool
610+ , _paramSchemaEnum :: Maybe [Value]
611+ , _paramSchemaMultipleOf :: Maybe Scientific
612+ } deriving (Eq, Show, Generic, Typeable)
613+
614+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
615+
616+data Xml = Xml
433617 { -- | Replaces the name of the element/attribute used for the described schema property.
434618 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
435619 -- When defined alongside type being array (outside the items),
436620 -- it will affect the wrapping element and only if wrapped is true.
437621 -- If wrapped is false, it will be ignored.
438− swaggerXmlName :: Maybe Text
622+ _xmlName :: Maybe Text
439623
440624 -- | The URL of the namespace definition.
441625 -- Value SHOULD be in the form of a URL.
442− , swaggerXmlNamespace :: Maybe Text
626+ , _xmlNamespace :: Maybe Text
443627
444628 -- | The prefix to be used for the name.
445− , swaggerXmlPrefix :: Maybe Text
629+ , _xmlPrefix :: Maybe Text
446630
447631 -- | Declares whether the property definition translates to an attribute instead of an element.
448632 -- Default value is @False@.
449− , swaggerXmlAttribute :: Bool
633+ , _xmlAttribute :: Maybe Bool
450634
451635 -- | MAY be used only for an array definition.
452636 -- Signifies whether the array is wrapped
@@ -454,103 +638,87 @@ data SwaggerXml = SwaggerXml
454638 -- or unwrapped (@\<book/\>\<book/\>@).
455639 -- Default value is @False@.
456640 -- The definition takes effect only when defined alongside type being array (outside the items).
457− , swaggerXmlWrapped :: Bool
458− } deriving (Show)
459−
460−data SwaggerItems = SwaggerItems
461− { -- | The internal type of the array.
462− swaggerItemsType :: SwaggerItemsType
463−
464− -- | The extending format for the previously mentioned type.
465− , swaggerItemsFormat :: SwaggerFormat
466−
467− -- | __Required if type is @'SwaggerItemsArray'@.__
468− -- Describes the type of items in the array.
469− , swaggerItemsItems :: SwaggerItems
470−
471− -- | Determines the format of the array if type array is used.
472− -- Default value is @'SwaggerItemsCollectionCSV'@.
473− , swaggerItemsCollectionFormat :: SwaggerItemsCollectionFormat
474−
475− , swaggerItemsCommon :: SwaggerSchemaCommon
476− } deriving (Show, Generic)
641+ , _xmlWrapped :: Maybe Bool
642+ } deriving (Eq, Show, Generic, Data, Typeable)
477643
478644-- | A container for the expected responses of an operation.
479645-- The container maps a HTTP response code to the expected response.
480646-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
481647-- since they may not be known in advance.
482648-- However, it is expected from the documentation to cover a successful operation response and any known errors.
483−data SwaggerResponses = SwaggerResponses
649+data Responses = Responses
484650 { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
485651 -- It can be used to cover undeclared responses.
486− swaggerResponsesDefault :: Maybe SwaggerResponse
652+ _responsesDefault :: Maybe (Referenced Response)
487653
488654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
489655 -- Describes the expected response for those HTTP status codes.
490− , swaggerResponsesResponses :: HashMap HttpStatusCode SwaggerResponse
491− } deriving (Show)
656+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
657+ } deriving (Eq, Show, Generic, Data, Typeable)
492658
493659type HttpStatusCode = Int
494660
495661-- | Describes a single response from an API Operation.
496−data SwaggerResponse = SwaggerResponse
662+data Response = Response
497663 { -- | A short description of the response.
498664 -- GFM syntax can be used for rich text representation.
499− swaggerResponseDescription :: Text
665+ _responseDescription :: Text
500666
501667 -- | A definition of the response structure.
502668 -- It can be a primitive, an array or an object.
503669 -- If this field does not exist, it means no content is returned as part of the response.
504670 -- As an extension to the Schema Object, its root type value may also be "file".
505671 -- This SHOULD be accompanied by a relevant produces mime-type.
506− , swaggerResponseSchema :: Maybe SwaggerSchema
672+ , _responseSchema :: Maybe (Referenced Schema)
507673
508674 -- | A list of headers that are sent with the response.
509− , swaggerResponseHeaders :: HashMap HeaderName SwaggerHeader
675+ , _responseHeaders :: InsOrdHashMap HeaderName Header
510676
511677 -- | An example of the response message.
512− , swaggerResponseExamples :: Maybe SwaggerExample
513− } deriving (Show)
678+ , _responseExamples :: Maybe Example
679+ } deriving (Eq, Show, Generic, Data, Typeable)
680+
681+instance IsString Response where
682+ fromString s = Response (fromString s) Nothing mempty Nothing
514683
515684type HeaderName = Text
516685
517−data SwaggerHeader = SwaggerHeader
686+data Header = Header
518687 { -- | A short description of the header.
519− swaggerHeaderDescription :: Maybe String
688+ _headerDescription :: Maybe Text
520689
521− -- | The type of the object.
522− , swaggerHeaderType :: SwaggerItemsType
690+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
691+ } deriving (Eq, Show, Generic, Data, Typeable)
523692
524− -- | The extending format for the previously mentioned type. See Data Type Formats for further details.
525− , swaggerHeaderFormat :: Maybe SwaggerFormat
693+data Example = Example { getExample :: Map MediaType Value }
694+ deriving (Eq, Show, Generic, Typeable)
526695
527− -- | __Required if type is @'SwaggerItemsArray'@__.
528− -- Describes the type of items in the array.
529− , swaggerHeaderItems :: SwaggerItems
696+exampleConstr :: Constr
697+exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
530698
531− -- | Determines the format of the array if type array is used.
532− -- Default value is @'SwaggerItemsCollectionCSV'@.
533− , swaggerHeaderCollectionFormat :: SwaggerItemsCollectionFormat
699+exampleDataType :: DataType
700+exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
534701
535− , swaggerHeaderCommon :: SwaggerSchemaCommon
536− } deriving (Show, Generic)
537−
538−data SwaggerExample = SwaggerExample { getSwaggerExample :: Map MediaType Value }
539− deriving (Show)
702+instance Data Example where
703+ gunfold k z c = case constrIndex c of
704+ 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
705+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
706+ toConstr (Example _) = exampleConstr
707+ dataTypeOf _ = exampleDataType
540708
541709-- | The location of the API key.
542−data SwaggerApiKeyLocation
543− = SwaggerApiKeyQuery
544− | SwaggerApiKeyHeader
545− deriving (Show)
710+data ApiKeyLocation
711+ = ApiKeyQuery
712+ | ApiKeyHeader
713+ deriving (Eq, Show, Generic, Data, Typeable)
546714
547−data SwaggerApiKeyParams = SwaggerApiKeyParams
715+data ApiKeyParams = ApiKeyParams
548716 { -- | The name of the header or query parameter to be used.
549− swaggerApiKeyName :: Text
717+ _apiKeyName :: Text
550718
551719 -- | The location of the API key.
552− , swaggerApiKeyIn :: SwaggerApiKeyLocation
553− } deriving (Show)
720+ , _apiKeyIn :: ApiKeyLocation
721+ } deriving (Eq, Show, Generic, Data, Typeable)
554722
555723-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
556724type AuthorizationURL = Text
@@ -558,295 +726,702 @@ type AuthorizationURL = Text
558726-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
559727type TokenURL = Text
560728
561−data SwaggerOAuth2Flow
562− = SwaggerOAuth2Implicit AuthorizationURL
563− | SwaggerOAuth2Password TokenURL
564− | SwaggerOAuth2Application TokenURL
565− | SwaggerOAuth2AccessCode AuthorizationURL TokenURL
566− deriving (Show)
729+data OAuth2Flow
730+ = OAuth2Implicit AuthorizationURL
731+ | OAuth2Password TokenURL
732+ | OAuth2Application TokenURL
733+ | OAuth2AccessCode AuthorizationURL TokenURL
734+ deriving (Eq, Show, Generic, Data, Typeable)
567735
568−data SwaggerOAuth2Params = SwaggerOAuth2Params
736+data OAuth2Params = OAuth2Params
569737 { -- | The flow used by the OAuth2 security scheme.
570− swaggerOAuth2Flow :: SwaggerOAuth2Flow
738+ _oauth2Flow :: OAuth2Flow
571739
572740 -- | The available scopes for the OAuth2 security scheme.
573− , swaggerOAuth2Scopes :: HashMap Text Text
574− } deriving (Show, Generic)
575−
576−data SwaggerSecuritySchemeType
577− = SwaggerSecuritySchemeBasic
578− | SwaggerSecuritySchemeApiKey SwaggerApiKeyParams
579− | SwaggerSecuritySchemeOAuth2 SwaggerOAuth2Params
580− deriving (Show)
581−
582−data SwaggerSecuritySchemeTypeName
583− = SwaggerSecuritySchemeTypeBasic
584− | SwaggerSecuritySchemeTypeApiKey
585− | SwaggerSecuritySchemeTypeOAuth2
586− deriving (Eq, Read, Show, Generic)
587−
588−swaggerSecuritySchemeTypeNameToText :: SwaggerSecuritySchemeTypeName -> Text
589−swaggerSecuritySchemeTypeNameToText SwaggerSecuritySchemeTypeBasic = "basic"
590−swaggerSecuritySchemeTypeNameToText SwaggerSecuritySchemeTypeApiKey = "apiKey"
591−swaggerSecuritySchemeTypeNameToText SwaggerSecuritySchemeTypeOAuth2 = "oauth2"
592−
593−swaggerSecuritySchemeTypeNameFromText :: Alternative f => Text -> f SwaggerSecuritySchemeTypeName
594−swaggerSecuritySchemeTypeNameFromText "basic" = pure SwaggerSecuritySchemeTypeBasic
595−swaggerSecuritySchemeTypeNameFromText "apiKey" = pure SwaggerSecuritySchemeTypeApiKey
596−swaggerSecuritySchemeTypeNameFromText "oauth2" = pure SwaggerSecuritySchemeTypeOAuth2
597−swaggerSecuritySchemeTypeNameFromText _ = empty
598−
599−instance Hashable SwaggerSecuritySchemeTypeName
600−
601−data SwaggerSecurityScheme = SwaggerSecurityScheme
741+ , _oauth2Scopes :: InsOrdHashMap Text Text
742+ } deriving (Eq, Show, Generic, Data, Typeable)
743+
744+data SecuritySchemeType
745+ = SecuritySchemeBasic
746+ | SecuritySchemeApiKey ApiKeyParams
747+ | SecuritySchemeOAuth2 OAuth2Params
748+ deriving (Eq, Show, Generic, Data, Typeable)
749+
750+data SecurityScheme = SecurityScheme
602751 { -- | The type of the security scheme.
603− swaggerSecuritySchemeType :: SwaggerSecuritySchemeType
752+ _securitySchemeType :: SecuritySchemeType
604753
605754 -- | A short description for security scheme.
606− , swaggerSecuritySchemeDescription :: Maybe Text
607− } deriving (Show, Generic)
755+ , _securitySchemeDescription :: Maybe Text
756+ } deriving (Eq, Show, Generic, Data, Typeable)
757+
758+
759+-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760+-- In other case returns first security scheme
761+mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762+mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763+ s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764+ = if flow1 == flow2 then
765+ SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
766+ else
767+ s1
768+mergeSecurityScheme s1 _ = s1
769+
770+newtype SecurityDefinitions
771+ = SecurityDefinitions (Definitions SecurityScheme)
772+ deriving (Eq, Show, Generic, Data, Typeable)
608773
609774-- | Lists the required security schemes to execute this operation.
610775-- The object can have multiple security schemes declared in it which are all required
611776-- (that is, there is a logical AND between the schemes).
612−newtype SwaggerSecurityRequirement = SwaggerSecurityRequirement
613− { getSwaggerSecurityRequirement :: HashMap SwaggerSecuritySchemeTypeName Text
614− } deriving (Eq, Read, Show, Monoid)
777+newtype SecurityRequirement = SecurityRequirement
778+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
779+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
615780
616−-- | Allows adding meta data to a single tag that is used by @SwaggerOperation@.
617−-- It is not mandatory to have a @SwaggerTag@ per tag used there.
618−data SwaggerTag = SwaggerTag
781+-- | Tag name.
782+type TagName = Text
783+
784+-- | Allows adding meta data to a single tag that is used by @Operation@.
785+-- It is not mandatory to have a @Tag@ per tag used there.
786+data Tag = Tag
619787 { -- | The name of the tag.
620− swaggerTagName :: Text
788+ _tagName :: TagName
621789
622790 -- | A short description for the tag.
623791 -- GFM syntax can be used for rich text representation.
624− , swaggerTagDescription :: Maybe Text
792+ , _tagDescription :: Maybe Text
625793
626794 -- | Additional external documentation for this tag.
627− , swaggerTagExternalDocs :: Maybe SwaggerExternalDocs
628− } deriving (Show)
795+ , _tagExternalDocs :: Maybe ExternalDocs
796+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797+
798+instance Hashable Tag
799+
800+instance IsString Tag where
801+ fromString s = Tag (fromString s) Nothing Nothing
629802
630803-- | Allows referencing an external resource for extended documentation.
631−data SwaggerExternalDocs = SwaggerExternalDocs
804+data ExternalDocs = ExternalDocs
632805 { -- | A short description of the target documentation.
633806 -- GFM syntax can be used for rich text representation.
634− swaggerExternalDocsDescription :: Maybe Text
807+ _externalDocsDescription :: Maybe Text
635808
636809 -- | The URL for the target documentation.
637− , swaggerExternalDocsUrl :: URL
638− } deriving (Show)
810+ , _externalDocsUrl :: URL
811+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812+
813+instance Hashable ExternalDocs
814+
815+-- | A simple object to allow referencing other definitions in the specification.
816+-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817+newtype Reference = Reference { getReference :: Text }
818+ deriving (Eq, Show, Data, Typeable)
819+
820+data Referenced a
821+ = Ref Reference
822+ | Inline a
823+ deriving (Eq, Show, Functor, Data, Typeable)
824+
825+instance IsString a => IsString (Referenced a) where
826+ fromString = Inline . fromString
827+
828+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
829+
830+data AdditionalProperties
831+ = AdditionalPropertiesAllowed Bool
832+ | AdditionalPropertiesSchema (Referenced Schema)
833+ deriving (Eq, Show, Data, Typeable)
834+
835+-- =======================================================================
836+-- Monoid instances
837+-- =======================================================================
838+
839+instance Semigroup Swagger where
840+ (<>) = genericMappend
841+instance Monoid Swagger where
842+ mempty = genericMempty
843+ mappend = (<>)
844+
845+instance Semigroup Info where
846+ (<>) = genericMappend
847+instance Monoid Info where
848+ mempty = genericMempty
849+ mappend = (<>)
850+
851+instance Semigroup Contact where
852+ (<>) = genericMappend
853+instance Monoid Contact where
854+ mempty = genericMempty
855+ mappend = (<>)
856+
857+instance Semigroup PathItem where
858+ (<>) = genericMappend
859+instance Monoid PathItem where
860+ mempty = genericMempty
861+ mappend = (<>)
862+
863+instance Semigroup Schema where
864+ (<>) = genericMappend
865+instance Monoid Schema where
866+ mempty = genericMempty
867+ mappend = (<>)
868+
869+instance Semigroup (ParamSchema t) where
870+ (<>) = genericMappend
871+instance Monoid (ParamSchema t) where
872+ mempty = genericMempty
873+ mappend = (<>)
874+
875+instance Semigroup Param where
876+ (<>) = genericMappend
877+instance Monoid Param where
878+ mempty = genericMempty
879+ mappend = (<>)
880+
881+instance Semigroup ParamOtherSchema where
882+ (<>) = genericMappend
883+instance Monoid ParamOtherSchema where
884+ mempty = genericMempty
885+ mappend = (<>)
886+
887+instance Semigroup Header where
888+ (<>) = genericMappend
889+instance Monoid Header where
890+ mempty = genericMempty
891+ mappend = (<>)
892+
893+instance Semigroup Responses where
894+ (<>) = genericMappend
895+instance Monoid Responses where
896+ mempty = genericMempty
897+ mappend = (<>)
898+
899+instance Semigroup Response where
900+ (<>) = genericMappend
901+instance Monoid Response where
902+ mempty = genericMempty
903+ mappend = (<>)
904+
905+instance Semigroup ExternalDocs where
906+ (<>) = genericMappend
907+instance Monoid ExternalDocs where
908+ mempty = genericMempty
909+ mappend = (<>)
910+
911+instance Semigroup Operation where
912+ (<>) = genericMappend
913+instance Monoid Operation where
914+ mempty = genericMempty
915+ mappend = (<>)
916+
917+instance Semigroup Example where
918+ (<>) = genericMappend
919+instance Monoid Example where
920+ mempty = genericMempty
921+ mappend = (<>)
922+
923+instance Semigroup SecurityScheme where
924+ (<>) = mergeSecurityScheme
925+
926+instance Semigroup SecurityDefinitions where
927+ (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928+ SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929+
930+instance Monoid SecurityDefinitions where
931+ mempty = SecurityDefinitions $ InsOrdHashMap.empty
932+ mappend = (<>)
933+
934+-- =======================================================================
935+-- SwaggerMonoid helper instances
936+-- =======================================================================
639937
640−newtype URL = URL { getUrl :: Text } deriving (Show, ToJSON, FromJSON)
938+instance SwaggerMonoid Info
939+instance SwaggerMonoid PathItem
940+instance SwaggerMonoid Schema
941+instance SwaggerMonoid (ParamSchema t)
942+instance SwaggerMonoid Param
943+instance SwaggerMonoid ParamOtherSchema
944+instance SwaggerMonoid Responses
945+instance SwaggerMonoid Response
946+instance SwaggerMonoid ExternalDocs
947+instance SwaggerMonoid Operation
948+instance SwaggerMonoid SecurityDefinitions
949+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950+
951+instance SwaggerMonoid MimeList
952+deriving instance SwaggerMonoid URL
953+
954+instance SwaggerMonoid (SwaggerType t) where
955+ swaggerMempty = SwaggerString
956+ swaggerMappend _ y = y
957+
958+instance SwaggerMonoid ParamLocation where
959+ swaggerMempty = ParamQuery
960+ swaggerMappend _ y = y
961+
962+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963+ swaggerMempty = InsOrdHashMap.empty
964+ swaggerMappend = InsOrdHashMap.unionWith mappend
965+
966+instance Monoid a => SwaggerMonoid (Referenced a) where
967+ swaggerMempty = Inline mempty
968+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
969+ swaggerMappend _ y = y
970+
971+instance SwaggerMonoid ParamAnySchema where
972+ swaggerMempty = ParamOther swaggerMempty
973+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
974+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
975+ swaggerMappend _ y = y
641976
642977-- =======================================================================
643−-- TH derived ToJSON and FromJSON instances
978+-- Simple Generic-based ToJSON instances
644979-- =======================================================================
645980
646−deriveJSON' ''SwaggerOperation
647−deriveJSON (jsonPrefix "SwaggerParameter") ''SwaggerParameterLocation
648−deriveJSON (jsonPrefix "SwaggerParam") ''SwaggerParameterType
649−deriveJSON' ''SwaggerPathItem
650−deriveJSON' ''SwaggerInfo
651−deriveJSON' ''SwaggerContact
652−deriveJSON' ''SwaggerLicense
653−deriveJSON (jsonPrefix "SwaggerSchema") ''SwaggerSchemaType
654−deriveJSON (jsonPrefix "SwaggerItems") ''SwaggerItemsType
655−deriveJSON (jsonPrefix "SwaggerItemsCollection") ''SwaggerItemsCollectionFormat
656−deriveJSON (jsonPrefix "SwaggerCollection") ''SwaggerCollectionFormat
657−deriveJSON (jsonPrefix "SwaggerSecuritySchemeType") ''SwaggerSecuritySchemeTypeName
658−deriveJSON (jsonPrefix "SwaggerApiKey") ''SwaggerApiKeyLocation
659−deriveJSON (jsonPrefix "swaggerApiKey") ''SwaggerApiKeyParams
660−deriveJSON' ''SwaggerResponse
661−deriveJSON' ''SwaggerSchemaCommon
662−deriveJSONDefault ''SwaggerScheme
663−deriveJSON' ''SwaggerTag
664−deriveJSON' ''SwaggerExternalDocs
665−deriveJSON' ''SwaggerXml
981+instance ToJSON ParamLocation where
982+ toJSON = genericToJSON (jsonPrefix "Param")
983+
984+instance ToJSON Info where
985+ toJSON = genericToJSON (jsonPrefix "Info")
986+
987+instance ToJSON Contact where
988+ toJSON = genericToJSON (jsonPrefix "Contact")
989+
990+instance ToJSON License where
991+ toJSON = genericToJSON (jsonPrefix "License")
992+
993+instance ToJSON ApiKeyLocation where
994+ toJSON = genericToJSON (jsonPrefix "ApiKey")
995+
996+instance ToJSON ApiKeyParams where
997+ toJSON = genericToJSON (jsonPrefix "apiKey")
998+
999+instance ToJSON Scheme where
1000+ toJSON = genericToJSON (jsonPrefix "")
1001+
1002+instance ToJSON Tag where
1003+ toJSON = genericToJSON (jsonPrefix "Tag")
1004+
1005+instance ToJSON ExternalDocs where
1006+ toJSON = genericToJSON (jsonPrefix "ExternalDocs")
1007+
1008+instance ToJSON Xml where
1009+ toJSON = genericToJSON (jsonPrefix "Xml")
1010+
1011+-- =======================================================================
1012+-- Simple Generic-based FromJSON instances
1013+-- =======================================================================
1014+
1015+instance FromJSON ParamLocation where
1016+ parseJSON = genericParseJSON (jsonPrefix "Param")
1017+
1018+instance FromJSON Info where
1019+ parseJSON = genericParseJSON (jsonPrefix "Info")
1020+
1021+instance FromJSON Contact where
1022+ parseJSON = genericParseJSON (jsonPrefix "Contact")
1023+
1024+instance FromJSON License where
1025+ parseJSON = genericParseJSON (jsonPrefix "License")
1026+
1027+instance FromJSON ApiKeyLocation where
1028+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1029+
1030+instance FromJSON ApiKeyParams where
1031+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
1032+
1033+instance FromJSON Scheme where
1034+ parseJSON = genericParseJSON (jsonPrefix "")
1035+
1036+instance FromJSON Tag where
1037+ parseJSON = genericParseJSON (jsonPrefix "Tag")
1038+
1039+instance FromJSON ExternalDocs where
1040+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
6661041
6671042-- =======================================================================
6681043-- Manual ToJSON instances
6691044-- =======================================================================
6701045
671−instance ToJSON SwaggerOAuth2Flow where
672− toJSON (SwaggerOAuth2Implicit authUrl) = object
1046+instance ToJSON OAuth2Flow where
1047+ toJSON (OAuth2Implicit authUrl) = object
6731048 [ "flow" .= ("implicit" :: Text)
6741049 , "authorizationUrl" .= authUrl ]
675− toJSON (SwaggerOAuth2Password tokenUrl) = object
1050+ toJSON (OAuth2Password tokenUrl) = object
6761051 [ "flow" .= ("password" :: Text)
6771052 , "tokenUrl" .= tokenUrl ]
678− toJSON (SwaggerOAuth2Application tokenUrl) = object
1053+ toJSON (OAuth2Application tokenUrl) = object
6791054 [ "flow" .= ("application" :: Text)
6801055 , "tokenUrl" .= tokenUrl ]
681− toJSON (SwaggerOAuth2AccessCode authUrl tokenUrl) = object
1056+ toJSON (OAuth2AccessCode authUrl tokenUrl) = object
6821057 [ "flow" .= ("accessCode" :: Text)
6831058 , "authorizationUrl" .= authUrl
6841059 , "tokenUrl" .= tokenUrl ]
6851060
686−instance ToJSON SwaggerOAuth2Params where
687− toJSON = genericToJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")
1061+instance ToJSON OAuth2Params where
1062+ toJSON = sopSwaggerGenericToJSON
1063+ DEFINE_TOENCODING
6881064
689−instance ToJSON SwaggerSecuritySchemeType where
690− toJSON SwaggerSecuritySchemeBasic
691− = object [ "type" .= SwaggerSecuritySchemeTypeBasic ]
692− toJSON (SwaggerSecuritySchemeApiKey params)
1065+instance ToJSON SecuritySchemeType where
1066+ toJSON SecuritySchemeBasic
1067+ = object [ "type" .= ("basic" :: Text) ]
1068+ toJSON (SecuritySchemeApiKey params)
6931069 = toJSON params
694− <+> object [ "type" .= SwaggerSecuritySchemeTypeApiKey ]
695− toJSON (SwaggerSecuritySchemeOAuth2 params)
1070+ <+> object [ "type" .= ("apiKey" :: Text) ]
1071+ toJSON (SecuritySchemeOAuth2 params)
6961072 = toJSON params
697− <+> object [ "type" .= SwaggerSecuritySchemeTypeOAuth2 ]
1073+ <+> object [ "type" .= ("oauth2" :: Text) ]
6981074
6991075instance ToJSON Swagger where
700− toJSON = addVersion . genericToJSON (jsonPrefix "swagger")
701− where
702− addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
703− addVersion _ = error "impossible"
1076+ toJSON = sopSwaggerGenericToJSON
1077+ DEFINE_TOENCODING
1078+
1079+instance ToJSON SecurityScheme where
1080+ toJSON = sopSwaggerGenericToJSON
1081+ DEFINE_TOENCODING
1082+
1083+instance ToJSON Schema where
1084+ toJSON = sopSwaggerGenericToJSON
1085+ DEFINE_TOENCODING
1086+
1087+instance ToJSON Header where
1088+ toJSON = sopSwaggerGenericToJSON
1089+ DEFINE_TOENCODING
1090+
1091+-- | As for nullary schema for 0-arity type constructors, see
1092+-- <https://github.com/GetShopTV/swagger2/issues/167>.
1093+--
1094+-- >>> encode (SwaggerItemsArray [])
1095+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1096+--
1097+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1098+ toJSON (SwaggerItemsPrimitive fmt schema) = object
1099+ [ "collectionFormat" .= fmt
1100+ , "items" .= schema ]
1101+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102+ toJSON (SwaggerItemsArray []) = object
1103+ [ "items" .= object []
1104+ , "maxItems" .= (0 :: Int)
1105+ , "example" .= Array mempty
1106+ ]
1107+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1108+
1109+instance ToJSON Host where
1110+ toJSON (Host host mport) = toJSON $
1111+ case mport of
1112+ Nothing -> host
1113+ Just port -> host ++ ":" ++ show port
7041114
705−instance ToJSON SwaggerSecurityScheme where
706− toJSON = genericToJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")
1115+instance ToJSON MimeList where
1116+ toJSON (MimeList xs) = toJSON (map show xs)
7071117
708−instance ToJSON SwaggerSchema where
709− toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerSchema")
1118+instance ToJSON Param where
1119+ toJSON = sopSwaggerGenericToJSON
1120+ DEFINE_TOENCODING
7101121
711−instance ToJSON SwaggerHeader where
712− toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerHeader")
1122+instance ToJSON ParamAnySchema where
1123+ toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124+ toJSON (ParamOther s) = toJSON s
7131125
714−instance ToJSON SwaggerItems where
715− toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerItems")
1126+instance ToJSON ParamOtherSchema where
1127+ toJSON = sopSwaggerGenericToJSON
1128+ DEFINE_TOENCODING
7161129
717−instance ToJSON SwaggerHost where
718− toJSON (SwaggerHost host mport) = toJSON $
719− case mport of
720− Nothing -> host
721− Just port -> host ++ ":" ++ show port
1130+instance ToJSON Responses where
1131+ toJSON = sopSwaggerGenericToJSON
1132+ DEFINE_TOENCODING
1133+
1134+instance ToJSON Response where
1135+ toJSON = sopSwaggerGenericToJSON
1136+ DEFINE_TOENCODING
1137+
1138+instance ToJSON Operation where
1139+ toJSON = sopSwaggerGenericToJSON
1140+ DEFINE_TOENCODING
1141+
1142+instance ToJSON PathItem where
1143+ toJSON = sopSwaggerGenericToJSON
1144+ DEFINE_TOENCODING
7221145
723−instance ToJSON SwaggerPaths where
724− toJSON (SwaggerPaths m) = toJSON m
1146+instance ToJSON Example where
1147+ toJSON = toJSON . Map.mapKeys show . getExample
7251148
726−instance ToJSON SwaggerMimeList where
727− toJSON (SwaggerMimeList xs) = toJSON (map show xs)
1149+instance ToJSON SecurityDefinitions where
1150+ toJSON (SecurityDefinitions sd) = toJSON sd
7281151
729−instance ToJSON SwaggerParameter where
730− toJSON = genericToJSONWithSub "schema" (jsonPrefix "swaggerParameter")
1152+instance ToJSON Reference where
1153+ toJSON (Reference ref) = object [ "$ref" .= ref ]
7311154
732−instance ToJSON SwaggerParameterSchema where
733− toJSON (SwaggerParameterBody s) = toJSON s <+> object [ "in" .= ("body" :: Text) ]
734− toJSON (SwaggerParameterOther s) = toJSON s
1155+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1156+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1157+referencedToJSON _ (Inline x) = toJSON x
7351158
736−instance ToJSON SwaggerParameterOtherSchema where
737− toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
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/"
7381162
739−instance ToJSON SwaggerSchemaItems where
740− toJSON (SwaggerSchemaItemsObject x) = toJSON x
741− toJSON (SwaggerSchemaItemsArray xs) = toJSON xs
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"
7421172
743−instance ToJSON SwaggerResponses where
744− toJSON (SwaggerResponses def rs) = object
745− [ "default" .= def
746− , "responses" .= hashMapMapKeys show rs ]
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"
7471179
748−instance ToJSON SwaggerExample where
749− toJSON = toJSON . Map.mapKeys show . getSwaggerExample
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"
7501184
751−instance ToJSON SwaggerSecurityRequirement where
752− toJSON (SwaggerSecurityRequirement m) = toJSON (hashMapMapKeys swaggerSecuritySchemeTypeNameToText m)
1185+instance ToJSON AdditionalProperties where
1186+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187+ toJSON (AdditionalPropertiesSchema s) = toJSON s
7531188
7541189-- =======================================================================
7551190-- Manual FromJSON instances
7561191-- =======================================================================
7571192
758−instance FromJSON SwaggerOAuth2Flow where
1193+instance FromJSON OAuth2Flow where
7591194 parseJSON (Object o) = do
7601195 (flow :: Text) <- o .: "flow"
7611196 case flow of
762− "implicit" -> SwaggerOAuth2Implicit <$> o .: "authorizationUrl"
763− "password" -> SwaggerOAuth2Password <$> o .: "tokenUrl"
764− "application" -> SwaggerOAuth2Application <$> o .: "tokenUrl"
765− "accessCode" -> SwaggerOAuth2AccessCode
1197+ "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1198+ "password" -> OAuth2Password <$> o .: "tokenUrl"
1199+ "application" -> OAuth2Application <$> o .: "tokenUrl"
1200+ "accessCode" -> OAuth2AccessCode
7661201 <$> o .: "authorizationUrl"
7671202 <*> o .: "tokenUrl"
7681203 _ -> empty
7691204 parseJSON _ = empty
7701205
771−instance FromJSON SwaggerOAuth2Params where
772− parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")
1206+instance FromJSON OAuth2Params where
1207+ parseJSON = sopSwaggerGenericParseJSON
7731208
774−instance FromJSON SwaggerSecuritySchemeType where
775− parseJSON json@(Object o) = do
776− t <- o .: "type"
1209+instance FromJSON SecuritySchemeType where
1210+ parseJSON js@(Object o) = do
1211+ (t :: Text) <- o .: "type"
7771212 case t of
778− SwaggerSecuritySchemeTypeBasic -> pure SwaggerSecuritySchemeBasic
779− SwaggerSecuritySchemeTypeApiKey -> SwaggerSecuritySchemeApiKey <$> parseJSON json
780− SwaggerSecuritySchemeTypeOAuth2 -> SwaggerSecuritySchemeOAuth2 <$> parseJSON json
1213+ "basic" -> pure SecuritySchemeBasic
1214+ "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1215+ "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1216+ _ -> empty
7811217 parseJSON _ = empty
7821218
7831219instance FromJSON Swagger where
784− parseJSON json@(Object o) = do
785− (version :: Text) <- o .: "swagger"
786− when (version /= "2.0") empty
787− genericParseJSON (jsonPrefix "swagger") json
1220+ parseJSON = sopSwaggerGenericParseJSON
1221+
1222+instance FromJSON SecurityScheme where
1223+ parseJSON = sopSwaggerGenericParseJSON
1224+
1225+instance FromJSON Schema where
1226+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1227+ where nullaryCleanup :: Schema -> Schema
1228+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230+ then s { _schemaExample = Nothing
1231+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1232+ else s
1233+
1234+instance FromJSON Header where
1235+ parseJSON = sopSwaggerGenericParseJSON
1236+
1237+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1238+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1239+ <$> o .:? "collectionFormat"
1240+ <*> (o .: "items" >>= parseJSON)
1241+
1242+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244+ <$> o .:? "collectionFormat"
1245+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1246+
1247+-- |
1248+--
1249+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250+-- Just (SwaggerItemsArray [])
1251+--
1252+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1254+--
1255+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1257+--
1258+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259+ parseJSON js@(Object obj)
1260+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261+ | otherwise = SwaggerItemsObject <$> parseJSON js
1262+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
7881263 parseJSON _ = empty
7891264
790−instance FromJSON SwaggerSecurityScheme where
791− parseJSON = genericParseJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")
792−
793−instance FromJSON SwaggerSchema where
794− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerSchema")
795−
796−instance FromJSON SwaggerHeader where
797− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerHeader")
798−
799−instance FromJSON SwaggerItems where
800− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerItems")
801−
802−instance FromJSON SwaggerHost where
803− parseJSON (String s) =
804− case fromInteger <$> readMaybe portStr of
805− Nothing | not (null portStr) -> empty
806− mport -> pure $ SwaggerHost host mport
807− where
808− (hostText, portText) = Text.breakOnEnd ":" s
809− [host, portStr] = map Text.unpack [hostText, portText]
1265+instance FromJSON Host where
1266+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1267+ [host] -> return $ Host host Nothing
1268+ [host, port] -> case readMaybe port of
1269+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1270+ Just p -> return $ Host host (Just (fromInteger p))
1271+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
8101272 parseJSON _ = empty
8111273
812−instance FromJSON SwaggerPaths where
813− parseJSON json = SwaggerPaths <$> parseJSON json
814−
815−instance FromJSON SwaggerMimeList where
816− parseJSON json = (SwaggerMimeList . map fromString) <$> parseJSON json
1274+instance FromJSON MimeList where
1275+ parseJSON js = (MimeList . map fromString) <$> parseJSON js
8171276
818−instance FromJSON SwaggerParameter where
819− parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "swaggerParameter")
1277+instance FromJSON Param where
1278+ parseJSON = sopSwaggerGenericParseJSON
8201279
821−instance FromJSON SwaggerParameterSchema where
822− parseJSON json@(Object o) = do
1280+instance FromJSON ParamAnySchema where
1281+ parseJSON js@(Object o) = do
8231282 (i :: Text) <- o .: "in"
8241283 case i of
825− "body" -> SwaggerParameterBody <$> parseJSON json
826− _ -> SwaggerParameterOther <$> parseJSON json
1284+ "body" -> do
1285+ schema <- o .: "schema"
1286+ ParamBody <$> parseJSON schema
1287+ _ -> ParamOther <$> parseJSON js
8271288 parseJSON _ = empty
8281289
829−instance FromJSON SwaggerParameterOtherSchema where
830− parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
1290+instance FromJSON ParamOtherSchema where
1291+ parseJSON = sopSwaggerGenericParseJSON
8311292
832−instance FromJSON SwaggerSchemaItems where
833− parseJSON json@(Object _) = SwaggerSchemaItemsObject <$> parseJSON json
834− parseJSON json@(Array _) = SwaggerSchemaItemsArray <$> parseJSON json
1293+instance FromJSON Responses where
1294+ parseJSON (Object o) = Responses
1295+ <$> o .:? "default"
1296+ <*> (parseJSON (Object (HashMap.delete "default" o)))
8351297 parseJSON _ = empty
8361298
837−instance FromJSON SwaggerResponses where
838− parseJSON (Object o) = SwaggerResponses
839− <$> o .: "default"
840− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
841− parseJSON _ = empty
1299+instance FromJSON Example where
1300+ parseJSON js = do
1301+ m <- parseJSON js
1302+ pure $ Example (Map.mapKeys fromString m)
1303+
1304+instance FromJSON Response where
1305+ parseJSON = sopSwaggerGenericParseJSON
1306+
1307+instance FromJSON Operation where
1308+ parseJSON = sopSwaggerGenericParseJSON
8421309
843−instance FromJSON SwaggerExample where
844− parseJSON json = do
845− m <- parseJSON json
846− pure $ SwaggerExample (Map.mapKeys fromString m)
1310+instance FromJSON PathItem where
1311+ parseJSON = sopSwaggerGenericParseJSON
8471312
848−instance FromJSON SwaggerSecurityRequirement where
849− parseJSON json = do
850− m <- parseJSON json
851− SwaggerSecurityRequirement <$> hashMapTraverseKeys swaggerSecuritySchemeTypeNameFromText m
1313+instance FromJSON SecurityDefinitions where
1314+ parseJSON js = SecurityDefinitions <$> parseJSON js
1315+
1316+instance FromJSON Reference where
1317+ parseJSON (Object o) = Reference <$> o .: "$ref"
1318+ parseJSON _ = empty
8521319
1320+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1321+referencedParseJSON prefix js@(Object o) = do
1322+ ms <- o .:? "$ref"
1323+ case ms of
1324+ Nothing -> Inline <$> parseJSON js
1325+ Just s -> Ref <$> parseRef s
1326+ where
1327+ parseRef s = do
1328+ case Text.stripPrefix prefix s of
1329+ Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1330+ Just suffix -> pure (Reference suffix)
1331+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1332+
1333+instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1334+instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1335+instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1336+
1337+instance FromJSON Xml where
1338+ parseJSON = genericParseJSON (jsonPrefix "xml")
1339+
1340+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1341+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1342+
1343+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1344+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1345+
1346+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1347+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1348+
1349+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1350+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1351+
1352+-- NOTE: There aren't collections of 'Schema'
1353+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1355+
1356+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1357+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1358+
1359+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1360+ parseJSON = sopSwaggerGenericParseJSON
1361+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1362+ parseJSON = sopSwaggerGenericParseJSON
1363+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1364+ parseJSON = sopSwaggerGenericParseJSON
1365+
1366+instance FromJSON AdditionalProperties where
1367+ parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368+ parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1369+
1370+-------------------------------------------------------------------------------
1371+-- TH splices
1372+-------------------------------------------------------------------------------
1373+
1374+deriveGeneric ''Header
1375+deriveGeneric ''OAuth2Params
1376+deriveGeneric ''Operation
1377+deriveGeneric ''Param
1378+deriveGeneric ''ParamOtherSchema
1379+deriveGeneric ''PathItem
1380+deriveGeneric ''Response
1381+deriveGeneric ''Responses
1382+deriveGeneric ''SecurityScheme
1383+deriveGeneric ''Schema
1384+deriveGeneric ''ParamSchema
1385+deriveGeneric ''Swagger
1386+
1387+instance HasSwaggerAesonOptions Header where
1388+ swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1389+instance HasSwaggerAesonOptions OAuth2Params where
1390+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1391+instance HasSwaggerAesonOptions Operation where
1392+ swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1393+instance HasSwaggerAesonOptions Param where
1394+ swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1395+instance HasSwaggerAesonOptions ParamOtherSchema where
1396+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1397+instance HasSwaggerAesonOptions PathItem where
1398+ swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1399+instance HasSwaggerAesonOptions Response where
1400+ swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1401+instance HasSwaggerAesonOptions Responses where
1402+ swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1403+instance HasSwaggerAesonOptions SecurityScheme where
1404+ swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1405+instance HasSwaggerAesonOptions Schema where
1406+ swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1407+instance HasSwaggerAesonOptions Swagger where
1408+ swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1409+
1410+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1411+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1412+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1413+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1414+-- NOTE: Schema doesn't have 'items' sub object!
1415+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1416+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1417+
1418+instance AesonDefaultValue (ParamSchema s)
1419+instance AesonDefaultValue OAuth2Flow
1420+instance AesonDefaultValue Responses
1421+instance AesonDefaultValue ParamAnySchema
1422+instance AesonDefaultValue SecuritySchemeType
1423+instance AesonDefaultValue (SwaggerType a)
1424+instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425+instance AesonDefaultValue Info
1426+instance AesonDefaultValue ParamLocation
1427+instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty