git.iko.soy/typeable/openapi3
on fbc117e help sign in
typeable/openapi3/src/Data/Swagger/Internal.hs
1386 lines 53 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE DeriveGeneric #-}
6{-# LANGUAGE DeriveTraversable #-}
7{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE GADTs #-}
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE RecordWildCards #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE StandaloneDeriving #-}
15{-# LANGUAGE TemplateHaskell #-}
16{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE UndecidableInstances #-}
18#if __GLASGOW_HASKELL__ <710
19{-# LANGUAGE PolyKinds #-}
20#endif
21#include "overlapping-compat.h"
22module Data.Swagger.Internal where
24import Prelude ()
25import Prelude.Compat
27import Control.Lens ((&), (.~), (?~))
28import Control.Applicative
29import Data.Aeson
30import qualified Data.Aeson.Types as JSON
31import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32import qualified Data.HashMap.Strict as HashMap
33import Data.Map (Map)
34import qualified Data.Map as Map
35import Data.Monoid (Monoid (..))
36import Data.Semigroup.Compat (Semigroup (..))
37import Data.Scientific (Scientific)
38import Data.Set (Set)
39import Data.String (IsString(..))
40import Data.Text (Text)
41import qualified Data.Text as Text
42import GHC.Generics (Generic)
43import Network.Socket (HostName, PortNumber)
44import Network.HTTP.Media (MediaType)
45import Text.Read (readMaybe)
47import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
48import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50import Generics.SOP.TH (deriveGeneric)
51import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
52 ,sopSwaggerGenericToJSONWithOpts
53 ,sopSwaggerGenericParseJSON
54 ,HasSwaggerAesonOptions(..)
55 ,AesonDefaultValue(..)
56 ,mkSwaggerAesonOptions
57 ,saoAdditionalPairs
58 ,saoSubObject)
59import Data.Swagger.Internal.Utils
61#if MIN_VERSION_aeson(0,10,0)
62import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
63#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
64#else
65#define DEFINE_TOENCODING
66#endif
68-- $setup
69-- >>> :seti -XDataKinds
70-- >>> import Data.Aeson
72-- | A list of definitions that can be used in references.
73type Definitions = InsOrdHashMap Text
75-- | This is the root document object for the API specification.
76data Swagger = Swagger
77 { -- | Provides metadata about the API.
78 -- The metadata can be used by the clients if needed.
79 _swaggerInfo :: Info
81 -- | The host (name or ip) serving the API. It MAY include a port.
82 -- If the host is not included, the host serving the documentation is to be used (including the port).
83 , _swaggerHost :: Maybe Host
85 -- | The base path on which the API is served, which is relative to the host.
86 -- If it is not included, the API is served directly under the host.
87 -- The value MUST start with a leading slash (/).
88 , _swaggerBasePath :: Maybe FilePath
90 -- | The transfer protocol of the API.
91 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
92 , _swaggerSchemes :: Maybe [Scheme]
94 -- | A list of MIME types the APIs can consume.
95 -- This is global to all APIs but can be overridden on specific API calls.
96 , _swaggerConsumes :: MimeList
98 -- | A list of MIME types the APIs can produce.
99 -- This is global to all APIs but can be overridden on specific API calls.
100 , _swaggerProduces :: MimeList
102 -- | The available paths and operations for the API.
103 -- Holds the relative paths to the individual endpoints.
104 -- The path is appended to the @'basePath'@ in order to construct the full URL.
105 , _swaggerPaths :: InsOrdHashMap FilePath PathItem
107 -- | An object to hold data types produced and consumed by operations.
108 , _swaggerDefinitions :: Definitions Schema
110 -- | An object to hold parameters that can be used across operations.
111 -- This property does not define global parameters for all operations.
112 , _swaggerParameters :: Definitions Param
114 -- | An object to hold responses that can be used across operations.
115 -- This property does not define global responses for all operations.
116 , _swaggerResponses :: Definitions Response
118 -- | Security scheme definitions that can be used across the specification.
119 , _swaggerSecurityDefinitions :: Definitions SecurityScheme
121 -- | A declaration of which security schemes are applied for the API as a whole.
122 -- The list of values describes alternative security schemes that can be used
123 -- (that is, there is a logical OR between the security requirements).
124 -- Individual operations can override this definition.
125 , _swaggerSecurity :: [SecurityRequirement]
127 -- | A list of tags used by the specification with additional metadata.
128 -- The order of the tags can be used to reflect on their order by the parsing tools.
129 -- Not all tags that are used by the Operation Object must be declared.
130 -- The tags that are not declared may be organized randomly or based on the tools' logic.
131 -- Each tag name in the list MUST be unique.
132 , _swaggerTags :: Set Tag
134 -- | Additional external documentation.
135 , _swaggerExternalDocs :: Maybe ExternalDocs
136 } deriving (Eq, Show, Generic, Data, Typeable)
138-- | The object provides metadata about the API.
139-- The metadata can be used by the clients if needed,
140-- and can be presented in the Swagger-UI for convenience.
141data Info = Info
142 { -- | The title of the application.
143 _infoTitle :: Text
145 -- | A short description of the application.
146 -- GFM syntax can be used for rich text representation.
147 , _infoDescription :: Maybe Text
149 -- | The Terms of Service for the API.
150 , _infoTermsOfService :: Maybe Text
152 -- | The contact information for the exposed API.
153 , _infoContact :: Maybe Contact
155 -- | The license information for the exposed API.
156 , _infoLicense :: Maybe License
158 -- | Provides the version of the application API
159 -- (not to be confused with the specification version).
160 , _infoVersion :: Text
161 } deriving (Eq, Show, Generic, Data, Typeable)
163-- | Contact information for the exposed API.
164data Contact = Contact
165 { -- | The identifying name of the contact person/organization.
166 _contactName :: Maybe Text
168 -- | The URL pointing to the contact information.
169 , _contactUrl :: Maybe URL
171 -- | The email address of the contact person/organization.
172 , _contactEmail :: Maybe Text
173 } deriving (Eq, Show, Generic, Data, Typeable)
175-- | License information for the exposed API.
176data License = License
177 { -- | The license name used for the API.
178 _licenseName :: Text
180 -- | A URL to the license used for the API.
181 , _licenseUrl :: Maybe URL
182 } deriving (Eq, Show, Generic, Data, Typeable)
184instance IsString License where
185 fromString s = License (fromString s) Nothing
187-- | The host (name or ip) serving the API. It MAY include a port.
188data Host = Host
189 { _hostName :: HostName -- ^ Host name.
190 , _hostPort :: Maybe PortNumber -- ^ Optional port.
191 } deriving (Eq, Show, Generic, Typeable)
193instance IsString Host where
194 fromString s = Host s Nothing
196hostConstr :: Constr
197hostConstr = mkConstr hostDataType "Host" [] Prefix
199hostDataType :: DataType
200hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
202instance Data Host where
203 gunfold k z c = case constrIndex c of
204 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
205 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
206 toConstr (Host _ _) = hostConstr
207 dataTypeOf _ = hostDataType
209-- | The transfer protocol of the API.
210data Scheme
211 = Http
212 | Https
213 | Ws
214 | Wss
215 deriving (Eq, Show, Generic, Data, Typeable)
217-- | Describes the operations available on a single path.
218-- A @'PathItem'@ may be empty, due to ACL constraints.
219-- The path itself is still exposed to the documentation viewer
220-- but they will not know which operations and parameters are available.
221data PathItem = PathItem
222 { -- | A definition of a GET operation on this path.
223 _pathItemGet :: Maybe Operation
225 -- | A definition of a PUT operation on this path.
226 , _pathItemPut :: Maybe Operation
228 -- | A definition of a POST operation on this path.
229 , _pathItemPost :: Maybe Operation
231 -- | A definition of a DELETE operation on this path.
232 , _pathItemDelete :: Maybe Operation
234 -- | A definition of a OPTIONS operation on this path.
235 , _pathItemOptions :: Maybe Operation
237 -- | A definition of a HEAD operation on this path.
238 , _pathItemHead :: Maybe Operation
240 -- | A definition of a PATCH operation on this path.
241 , _pathItemPatch :: Maybe Operation
243 -- | A list of parameters that are applicable for all the operations described under this path.
244 -- These parameters can be overridden at the operation level, but cannot be removed there.
245 -- The list MUST NOT include duplicated parameters.
246 -- A unique parameter is defined by a combination of a name and location.
247 , _pathItemParameters :: [Referenced Param]
248 } deriving (Eq, Show, Generic, Data, Typeable)
250-- | Describes a single API operation on a path.
251data Operation = Operation
252 { -- | A list of tags for API documentation control.
253 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
254 _operationTags :: Set TagName
256 -- | A short summary of what the operation does.
257 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
258 , _operationSummary :: Maybe Text
260 -- | A verbose explanation of the operation behavior.
261 -- GFM syntax can be used for rich text representation.
262 , _operationDescription :: Maybe Text
264 -- | Additional external documentation for this operation.
265 , _operationExternalDocs :: Maybe ExternalDocs
267 -- | Unique string used to identify the operation.
268 -- The id MUST be unique among all operations described in the API.
269 -- Tools and libraries MAY use the it to uniquely identify an operation,
270 -- therefore, it is recommended to follow common programming naming conventions.
271 , _operationOperationId :: Maybe Text
273 -- | A list of MIME types the operation can consume.
274 -- This overrides the @'consumes'@.
275 -- @Just []@ MAY be used to clear the global definition.
276 , _operationConsumes :: Maybe MimeList
278 -- | A list of MIME types the operation can produce.
279 -- This overrides the @'produces'@.
280 -- @Just []@ MAY be used to clear the global definition.
281 , _operationProduces :: Maybe MimeList
283 -- | A list of parameters that are applicable for this operation.
284 -- If a parameter is already defined at the @'PathItem'@,
285 -- the new definition will override it, but can never remove it.
286 -- The list MUST NOT include duplicated parameters.
287 -- A unique parameter is defined by a combination of a name and location.
288 , _operationParameters :: [Referenced Param]
290 -- | The list of possible responses as they are returned from executing this operation.
291 , _operationResponses :: Responses
293 -- | The transfer protocol for the operation.
294 -- The value overrides @'schemes'@.
295 , _operationSchemes :: Maybe [Scheme]
297 -- | Declares this operation to be deprecated.
298 -- Usage of the declared operation should be refrained.
299 -- Default value is @False@.
300 , _operationDeprecated :: Maybe Bool
302 -- | A declaration of which security schemes are applied for this operation.
303 -- The list of values describes alternative security schemes that can be used
304 -- (that is, there is a logical OR between the security requirements).
305 -- This definition overrides any declared top-level security.
306 -- To remove a top-level security declaration, @Just []@ can be used.
307 , _operationSecurity :: [SecurityRequirement]
308 } deriving (Eq, Show, Generic, Data, Typeable)
310newtype MimeList = MimeList { getMimeList :: [MediaType] }
311 deriving (Eq, Show, Semigroup, Monoid, Typeable)
313mimeListConstr :: Constr
314mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
316mimeListDataType :: DataType
317mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
319instance Data MimeList where
320 gunfold k z c = case constrIndex c of
321 1 -> k (z (\xs -> MimeList (map fromString xs)))
322 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
323 toConstr (MimeList _) = mimeListConstr
324 dataTypeOf _ = mimeListDataType
326-- | Describes a single operation parameter.
327-- A unique parameter is defined by a combination of a name and location.
328data Param = Param
329 { -- | The name of the parameter.
330 -- Parameter names are case sensitive.
331 _paramName :: Text
333 -- | A brief description of the parameter.
334 -- This could contain examples of use.
335 -- GFM syntax can be used for rich text representation.
336 , _paramDescription :: Maybe Text
338 -- | Determines whether this parameter is mandatory.
339 -- If the parameter is in "path", this property is required and its value MUST be true.
340 -- Otherwise, the property MAY be included and its default value is @False@.
341 , _paramRequired :: Maybe Bool
343 -- | Parameter schema.
344 , _paramSchema :: ParamAnySchema
345 } deriving (Eq, Show, Generic, Data, Typeable)
347data ParamAnySchema
348 = ParamBody (Referenced Schema)
349 | ParamOther ParamOtherSchema
350 deriving (Eq, Show, Generic, Data, Typeable)
352data ParamOtherSchema = ParamOtherSchema
353 { -- | The location of the parameter.
354 _paramOtherSchemaIn :: ParamLocation
356 -- | Sets the ability to pass empty-valued parameters.
357 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
358 -- and allows you to send a parameter with a name only or an empty value.
359 -- Default value is @False@.
360 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362 , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
363 } deriving (Eq, Show, Generic, Typeable, Data)
365-- | Items for @'SwaggerArray'@ schemas.
366--
367-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
368-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
369-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
370-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
371--
372-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
373--
374-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
375data SwaggerItems t where
376 SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
377 SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
378 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
379 deriving (Typeable)
381deriving instance Eq (SwaggerItems t)
382deriving instance Show (SwaggerItems t)
383--deriving instance Typeable (SwaggerItems t)
385swaggerItemsPrimitiveConstr :: Constr
386swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388swaggerItemsObjectConstr :: Constr
389swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391swaggerItemsArrayConstr :: Constr
392swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394swaggerItemsDataType :: DataType
395swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397-- Note: unfortunately we have to write these Data instances by hand,
398-- to get better contexts / avoid duplicate name when using standalone deriving
400instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
401 -- TODO: define gfoldl
402 gunfold k z c = case constrIndex c of
403 1 -> k (k (z SwaggerItemsPrimitive))
404 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
405 toConstr _ = swaggerItemsPrimitiveConstr
406 dataTypeOf _ = swaggerItemsDataType
408-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
409instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
410 -- TODO: define gfoldl
411 gunfold k z c = case constrIndex c of
412 1 -> k (k (z SwaggerItemsPrimitive))
413 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
414 toConstr _ = swaggerItemsPrimitiveConstr
415 dataTypeOf _ = swaggerItemsDataType
417instance Data (SwaggerItems 'SwaggerKindSchema) where
418 gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
419 gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
420 gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
422 gunfold k z c = case constrIndex c of
423 2 -> k (z SwaggerItemsObject)
424 3 -> k (z SwaggerItemsArray)
425 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
427 toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
428 toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
429 toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431 dataTypeOf _ = swaggerItemsDataType
433-- | Type used as a kind to avoid overlapping instances.
434data SwaggerKind t
435 = SwaggerKindNormal t
436 | SwaggerKindParamOtherSchema
437 | SwaggerKindSchema
438 deriving (Typeable)
440deriving instance Typeable 'SwaggerKindNormal
441deriving instance Typeable 'SwaggerKindParamOtherSchema
442deriving instance Typeable 'SwaggerKindSchema
444type family SwaggerKindType (k :: SwaggerKind *) :: *
445type instance SwaggerKindType ('SwaggerKindNormal t) = t
446type instance SwaggerKindType 'SwaggerKindSchema = Schema
447type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
449data SwaggerType t where
450 SwaggerString :: SwaggerType t
451 SwaggerNumber :: SwaggerType t
452 SwaggerInteger :: SwaggerType t
453 SwaggerBoolean :: SwaggerType t
454 SwaggerArray :: SwaggerType t
455 SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
456 SwaggerNull :: SwaggerType 'SwaggerKindSchema
457 SwaggerObject :: SwaggerType 'SwaggerKindSchema
458 deriving (Typeable)
460deriving instance Eq (SwaggerType t)
461deriving instance Show (SwaggerType t)
463swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
464swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
467swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469swaggerCommonTypes :: [SwaggerType k]
470swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
473swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
476swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478swaggerTypeConstrs :: [Constr]
479swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
480 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
483 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
484 toConstr = swaggerTypeConstr
485 dataTypeOf = swaggerTypeDataType
487instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
488 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
489 toConstr = swaggerTypeConstr
490 dataTypeOf = swaggerTypeDataType
492instance Data (SwaggerType 'SwaggerKindSchema) where
493 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
494 toConstr = swaggerTypeConstr
495 dataTypeOf = swaggerTypeDataType
497data ParamLocation
498 = -- | Parameters that are appended to the URL.
499 -- For example, in @/items?id=###@, the query parameter is @id@.
500 ParamQuery
501 -- | Custom headers that are expected as part of the request.
502 | ParamHeader
503 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
504 -- This does not include the host or base path of the API.
505 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
506 | ParamPath
507 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
508 -- or @multipart/form-data@ are used as the content type of the request
509 -- (in Swagger's definition, the @consumes@ property of an operation).
510 -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
511 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
512 -- Form parameters have a different format based on the content-type used
513 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
514 | ParamFormData
515 deriving (Eq, Show, Generic, Data, Typeable)
517type Format = Text
519-- | Determines the format of the array.
520data CollectionFormat t where
521 -- Comma separated values: @foo,bar@.
522 CollectionCSV :: CollectionFormat t
523 -- Space separated values: @foo bar@.
524 CollectionSSV :: CollectionFormat t
525 -- Tab separated values: @foo\\tbar@.
526 CollectionTSV :: CollectionFormat t
527 -- Pipe separated values: @foo|bar@.
528 CollectionPipes :: CollectionFormat t
529 -- Corresponds to multiple parameter instances
530 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
531 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
532 CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
533 deriving (Typeable)
535deriving instance Eq (CollectionFormat t)
536deriving instance Show (CollectionFormat t)
538collectionFormatConstr :: CollectionFormat t -> Constr
539collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
541collectionFormatDataType :: DataType
542collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
543 map collectionFormatConstr collectionCommonFormats
545collectionCommonFormats :: [CollectionFormat t]
546collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
549 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
550 toConstr = collectionFormatConstr
551 dataTypeOf _ = collectionFormatDataType
553deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
555type ParamName = Text
557data Schema = Schema
558 { _schemaTitle :: Maybe Text
559 , _schemaDescription :: Maybe Text
560 , _schemaRequired :: [ParamName]
562 , _schemaAllOf :: Maybe [Referenced Schema]
563 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
564 , _schemaAdditionalProperties :: Maybe AdditionalProperties
566 , _schemaDiscriminator :: Maybe Text
567 , _schemaReadOnly :: Maybe Bool
568 , _schemaXml :: Maybe Xml
569 , _schemaExternalDocs :: Maybe ExternalDocs
570 , _schemaExample :: Maybe Value
572 , _schemaMaxProperties :: Maybe Integer
573 , _schemaMinProperties :: Maybe Integer
575 , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
576 } deriving (Eq, Show, Generic, Data, Typeable)
578-- | A @'Schema'@ with an optional name.
579-- This name can be used in references.
580data NamedSchema = NamedSchema
581 { _namedSchemaName :: Maybe Text
582 , _namedSchemaSchema :: Schema
583 } deriving (Eq, Show, Generic, Data, Typeable)
585-- | Regex pattern for @string@ type.
586type Pattern = Text
588data ParamSchema (t :: SwaggerKind *) = ParamSchema
589 { -- | Declares the value of the parameter that the server will use if none is provided,
590 -- for example a @"count"@ to control the number of results per page might default to @100@
591 -- if not supplied by the client in the request.
592 -- (Note: "default" has no meaning for required parameters.)
593 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
594 _paramSchemaDefault :: Maybe Value
596 , _paramSchemaType :: SwaggerType t
597 , _paramSchemaFormat :: Maybe Format
598 , _paramSchemaItems :: Maybe (SwaggerItems t)
599 , _paramSchemaMaximum :: Maybe Scientific
600 , _paramSchemaExclusiveMaximum :: Maybe Bool
601 , _paramSchemaMinimum :: Maybe Scientific
602 , _paramSchemaExclusiveMinimum :: Maybe Bool
603 , _paramSchemaMaxLength :: Maybe Integer
604 , _paramSchemaMinLength :: Maybe Integer
605 , _paramSchemaPattern :: Maybe Pattern
606 , _paramSchemaMaxItems :: Maybe Integer
607 , _paramSchemaMinItems :: Maybe Integer
608 , _paramSchemaUniqueItems :: Maybe Bool
609 , _paramSchemaEnum :: Maybe [Value]
610 , _paramSchemaMultipleOf :: Maybe Scientific
611 } deriving (Eq, Show, Generic, Typeable)
613deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)
615data Xml = Xml
616 { -- | Replaces the name of the element/attribute used for the described schema property.
617 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
618 -- When defined alongside type being array (outside the items),
619 -- it will affect the wrapping element and only if wrapped is true.
620 -- If wrapped is false, it will be ignored.
621 _xmlName :: Maybe Text
623 -- | The URL of the namespace definition.
624 -- Value SHOULD be in the form of a URL.
625 , _xmlNamespace :: Maybe Text
627 -- | The prefix to be used for the name.
628 , _xmlPrefix :: Maybe Text
630 -- | Declares whether the property definition translates to an attribute instead of an element.
631 -- Default value is @False@.
632 , _xmlAttribute :: Maybe Bool
634 -- | MAY be used only for an array definition.
635 -- Signifies whether the array is wrapped
636 -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
637 -- or unwrapped (@\<book/\>\<book/\>@).
638 -- Default value is @False@.
639 -- The definition takes effect only when defined alongside type being array (outside the items).
640 , _xmlWrapped :: Maybe Bool
641 } deriving (Eq, Show, Generic, Data, Typeable)
643-- | A container for the expected responses of an operation.
644-- The container maps a HTTP response code to the expected response.
645-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
646-- since they may not be known in advance.
647-- However, it is expected from the documentation to cover a successful operation response and any known errors.
648data Responses = Responses
649 { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
650 -- It can be used to cover undeclared responses.
651 _responsesDefault :: Maybe (Referenced Response)
653 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
654 -- Describes the expected response for those HTTP status codes.
655 , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
656 } deriving (Eq, Show, Generic, Data, Typeable)
658type HttpStatusCode = Int
660-- | Describes a single response from an API Operation.
661data Response = Response
662 { -- | A short description of the response.
663 -- GFM syntax can be used for rich text representation.
664 _responseDescription :: Text
666 -- | A definition of the response structure.
667 -- It can be a primitive, an array or an object.
668 -- If this field does not exist, it means no content is returned as part of the response.
669 -- As an extension to the Schema Object, its root type value may also be "file".
670 -- This SHOULD be accompanied by a relevant produces mime-type.
671 , _responseSchema :: Maybe (Referenced Schema)
673 -- | A list of headers that are sent with the response.
674 , _responseHeaders :: InsOrdHashMap HeaderName Header
676 -- | An example of the response message.
677 , _responseExamples :: Maybe Example
678 } deriving (Eq, Show, Generic, Data, Typeable)
680instance IsString Response where
681 fromString s = Response (fromString s) Nothing mempty Nothing
683type HeaderName = Text
685data Header = Header
686 { -- | A short description of the header.
687 _headerDescription :: Maybe Text
689 , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
690 } deriving (Eq, Show, Generic, Data, Typeable)
692data Example = Example { getExample :: Map MediaType Value }
693 deriving (Eq, Show, Generic, Typeable)
695exampleConstr :: Constr
696exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
698exampleDataType :: DataType
699exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
701instance Data Example where
702 gunfold k z c = case constrIndex c of
703 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
704 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
705 toConstr (Example _) = exampleConstr
706 dataTypeOf _ = exampleDataType
708-- | The location of the API key.
709data ApiKeyLocation
710 = ApiKeyQuery
711 | ApiKeyHeader
712 deriving (Eq, Show, Generic, Data, Typeable)
714data ApiKeyParams = ApiKeyParams
715 { -- | The name of the header or query parameter to be used.
716 _apiKeyName :: Text
718 -- | The location of the API key.
719 , _apiKeyIn :: ApiKeyLocation
720 } deriving (Eq, Show, Generic, Data, Typeable)
722-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
723type AuthorizationURL = Text
725-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
726type TokenURL = Text
728data OAuth2Flow
729 = OAuth2Implicit AuthorizationURL
730 | OAuth2Password TokenURL
731 | OAuth2Application TokenURL
732 | OAuth2AccessCode AuthorizationURL TokenURL
733 deriving (Eq, Show, Generic, Data, Typeable)
735data OAuth2Params = OAuth2Params
736 { -- | The flow used by the OAuth2 security scheme.
737 _oauth2Flow :: OAuth2Flow
739 -- | The available scopes for the OAuth2 security scheme.
740 , _oauth2Scopes :: InsOrdHashMap Text Text
741 } deriving (Eq, Show, Generic, Data, Typeable)
743data SecuritySchemeType
744 = SecuritySchemeBasic
745 | SecuritySchemeApiKey ApiKeyParams
746 | SecuritySchemeOAuth2 OAuth2Params
747 deriving (Eq, Show, Generic, Data, Typeable)
749data SecurityScheme = SecurityScheme
750 { -- | The type of the security scheme.
751 _securitySchemeType :: SecuritySchemeType
753 -- | A short description for security scheme.
754 , _securitySchemeDescription :: Maybe Text
755 } deriving (Eq, Show, Generic, Data, Typeable)
757-- | Lists the required security schemes to execute this operation.
758-- The object can have multiple security schemes declared in it which are all required
759-- (that is, there is a logical AND between the schemes).
760newtype SecurityRequirement = SecurityRequirement
761 { getSecurityRequirement :: InsOrdHashMap Text [Text]
762 } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
764-- | Tag name.
765type TagName = Text
767-- | Allows adding meta data to a single tag that is used by @Operation@.
768-- It is not mandatory to have a @Tag@ per tag used there.
769data Tag = Tag
770 { -- | The name of the tag.
771 _tagName :: TagName
773 -- | A short description for the tag.
774 -- GFM syntax can be used for rich text representation.
775 , _tagDescription :: Maybe Text
777 -- | Additional external documentation for this tag.
778 , _tagExternalDocs :: Maybe ExternalDocs
779 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
781instance IsString Tag where
782 fromString s = Tag (fromString s) Nothing Nothing
784-- | Allows referencing an external resource for extended documentation.
785data ExternalDocs = ExternalDocs
786 { -- | A short description of the target documentation.
787 -- GFM syntax can be used for rich text representation.
788 _externalDocsDescription :: Maybe Text
790 -- | The URL for the target documentation.
791 , _externalDocsUrl :: URL
792 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
794-- | A simple object to allow referencing other definitions in the specification.
795-- It can be used to reference parameters and responses that are defined at the top level for reuse.
796newtype Reference = Reference { getReference :: Text }
797 deriving (Eq, Show, Data, Typeable)
799data Referenced a
800 = Ref Reference
801 | Inline a
802 deriving (Eq, Show, Functor, Data, Typeable)
804instance IsString a => IsString (Referenced a) where
805 fromString = Inline . fromString
807newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
809data AdditionalProperties
810 = AdditionalPropertiesAllowed Bool
811 | AdditionalPropertiesSchema (Referenced Schema)
812 deriving (Eq, Show, Data, Typeable)
814-- =======================================================================
815-- Monoid instances
816-- =======================================================================
818instance Semigroup Swagger where
819 (<>) = genericMappend
820instance Monoid Swagger where
821 mempty = genericMempty
822 mappend = (<>)
824instance Semigroup Info where
825 (<>) = genericMappend
826instance Monoid Info where
827 mempty = genericMempty
828 mappend = (<>)
830instance Semigroup Contact where
831 (<>) = genericMappend
832instance Monoid Contact where
833 mempty = genericMempty
834 mappend = (<>)
836instance Semigroup PathItem where
837 (<>) = genericMappend
838instance Monoid PathItem where
839 mempty = genericMempty
840 mappend = (<>)
842instance Semigroup Schema where
843 (<>) = genericMappend
844instance Monoid Schema where
845 mempty = genericMempty
846 mappend = (<>)
848instance Semigroup (ParamSchema t) where
849 (<>) = genericMappend
850instance Monoid (ParamSchema t) where
851 mempty = genericMempty
852 mappend = (<>)
854instance Semigroup Param where
855 (<>) = genericMappend
856instance Monoid Param where
857 mempty = genericMempty
858 mappend = (<>)
860instance Semigroup ParamOtherSchema where
861 (<>) = genericMappend
862instance Monoid ParamOtherSchema where
863 mempty = genericMempty
864 mappend = (<>)
866instance Semigroup Header where
867 (<>) = genericMappend
868instance Monoid Header where
869 mempty = genericMempty
870 mappend = (<>)
872instance Semigroup Responses where
873 (<>) = genericMappend
874instance Monoid Responses where
875 mempty = genericMempty
876 mappend = (<>)
878instance Semigroup Response where
879 (<>) = genericMappend
880instance Monoid Response where
881 mempty = genericMempty
882 mappend = (<>)
884instance Semigroup ExternalDocs where
885 (<>) = genericMappend
886instance Monoid ExternalDocs where
887 mempty = genericMempty
888 mappend = (<>)
890instance Semigroup Operation where
891 (<>) = genericMappend
892instance Monoid Operation where
893 mempty = genericMempty
894 mappend = (<>)
896instance Semigroup Example where
897 (<>) = genericMappend
898instance Monoid Example where
899 mempty = genericMempty
900 mappend = (<>)
902-- =======================================================================
903-- SwaggerMonoid helper instances
904-- =======================================================================
906instance SwaggerMonoid Info
907instance SwaggerMonoid PathItem
908instance SwaggerMonoid Schema
909instance SwaggerMonoid (ParamSchema t)
910instance SwaggerMonoid Param
911instance SwaggerMonoid ParamOtherSchema
912instance SwaggerMonoid Responses
913instance SwaggerMonoid Response
914instance SwaggerMonoid ExternalDocs
915instance SwaggerMonoid Operation
917instance SwaggerMonoid MimeList
918deriving instance SwaggerMonoid URL
920instance SwaggerMonoid (SwaggerType t) where
921 swaggerMempty = SwaggerString
922 swaggerMappend _ y = y
924instance SwaggerMonoid ParamLocation where
925 swaggerMempty = ParamQuery
926 swaggerMappend _ y = y
928instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
929 swaggerMempty = InsOrdHashMap.empty
930 swaggerMappend = InsOrdHashMap.unionWith mappend
932instance Monoid a => SwaggerMonoid (Referenced a) where
933 swaggerMempty = Inline mempty
934 swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
935 swaggerMappend _ y = y
937instance SwaggerMonoid ParamAnySchema where
938 swaggerMempty = ParamOther swaggerMempty
939 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
940 swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
941 swaggerMappend _ y = y
943-- =======================================================================
944-- Simple Generic-based ToJSON instances
945-- =======================================================================
947instance ToJSON ParamLocation where
948 toJSON = genericToJSON (jsonPrefix "Param")
950instance ToJSON Info where
951 toJSON = genericToJSON (jsonPrefix "Info")
953instance ToJSON Contact where
954 toJSON = genericToJSON (jsonPrefix "Contact")
956instance ToJSON License where
957 toJSON = genericToJSON (jsonPrefix "License")
959instance ToJSON ApiKeyLocation where
960 toJSON = genericToJSON (jsonPrefix "ApiKey")
962instance ToJSON ApiKeyParams where
963 toJSON = genericToJSON (jsonPrefix "apiKey")
965instance ToJSON Scheme where
966 toJSON = genericToJSON (jsonPrefix "")
968instance ToJSON Tag where
969 toJSON = genericToJSON (jsonPrefix "Tag")
971instance ToJSON ExternalDocs where
972 toJSON = genericToJSON (jsonPrefix "ExternalDocs")
974instance ToJSON Xml where
975 toJSON = genericToJSON (jsonPrefix "Xml")
977-- =======================================================================
978-- Simple Generic-based FromJSON instances
979-- =======================================================================
981instance FromJSON ParamLocation where
982 parseJSON = genericParseJSON (jsonPrefix "Param")
984instance FromJSON Info where
985 parseJSON = genericParseJSON (jsonPrefix "Info")
987instance FromJSON Contact where
988 parseJSON = genericParseJSON (jsonPrefix "Contact")
990instance FromJSON License where
991 parseJSON = genericParseJSON (jsonPrefix "License")
993instance FromJSON ApiKeyLocation where
994 parseJSON = genericParseJSON (jsonPrefix "ApiKey")
996instance FromJSON ApiKeyParams where
997 parseJSON = genericParseJSON (jsonPrefix "apiKey")
999instance FromJSON Scheme where
1000 parseJSON = genericParseJSON (jsonPrefix "")
1002instance FromJSON Tag where
1003 parseJSON = genericParseJSON (jsonPrefix "Tag")
1005instance FromJSON ExternalDocs where
1006 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1008-- =======================================================================
1009-- Manual ToJSON instances
1010-- =======================================================================
1012instance ToJSON OAuth2Flow where
1013 toJSON (OAuth2Implicit authUrl) = object
1014 [ "flow" .= ("implicit" :: Text)
1015 , "authorizationUrl" .= authUrl ]
1016 toJSON (OAuth2Password tokenUrl) = object
1017 [ "flow" .= ("password" :: Text)
1018 , "tokenUrl" .= tokenUrl ]
1019 toJSON (OAuth2Application tokenUrl) = object
1020 [ "flow" .= ("application" :: Text)
1021 , "tokenUrl" .= tokenUrl ]
1022 toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1023 [ "flow" .= ("accessCode" :: Text)
1024 , "authorizationUrl" .= authUrl
1025 , "tokenUrl" .= tokenUrl ]
1027instance ToJSON OAuth2Params where
1028 toJSON = sopSwaggerGenericToJSON
1029 DEFINE_TOENCODING
1031instance ToJSON SecuritySchemeType where
1032 toJSON SecuritySchemeBasic
1033 = object [ "type" .= ("basic" :: Text) ]
1034 toJSON (SecuritySchemeApiKey params)
1035 = toJSON params
1036 <+> object [ "type" .= ("apiKey" :: Text) ]
1037 toJSON (SecuritySchemeOAuth2 params)
1038 = toJSON params
1039 <+> object [ "type" .= ("oauth2" :: Text) ]
1041instance ToJSON Swagger where
1042 toJSON = sopSwaggerGenericToJSON
1043 DEFINE_TOENCODING
1045instance ToJSON SecurityScheme where
1046 toJSON = sopSwaggerGenericToJSON
1047 DEFINE_TOENCODING
1049instance ToJSON Schema where
1050 toJSON = sopSwaggerGenericToJSON
1051 DEFINE_TOENCODING
1053instance ToJSON Header where
1054 toJSON = sopSwaggerGenericToJSON
1055 DEFINE_TOENCODING
1057-- | As for nullary schema for 0-arity type constructors, see
1058-- <https://github.com/GetShopTV/swagger2/issues/167>.
1060-- >>> encode (SwaggerItemsArray [])
1061-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1063instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1064 toJSON (SwaggerItemsPrimitive fmt schema) = object
1065 [ "collectionFormat" .= fmt
1066 , "items" .= schema ]
1067 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1068 toJSON (SwaggerItemsArray []) = object
1069 [ "items" .= object []
1070 , "maxItems" .= (0 :: Int)
1071 , "example" .= Array mempty
1073 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1075instance ToJSON Host where
1076 toJSON (Host host mport) = toJSON $
1077 case mport of
1078 Nothing -> host
1079 Just port -> host ++ ":" ++ show port
1081instance ToJSON MimeList where
1082 toJSON (MimeList xs) = toJSON (map show xs)
1084instance ToJSON Param where
1085 toJSON = sopSwaggerGenericToJSON
1086 DEFINE_TOENCODING
1088instance ToJSON ParamAnySchema where
1089 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1090 toJSON (ParamOther s) = toJSON s
1092instance ToJSON ParamOtherSchema where
1093 toJSON = sopSwaggerGenericToJSON
1094 DEFINE_TOENCODING
1096instance ToJSON Responses where
1097 toJSON = sopSwaggerGenericToJSON
1098 DEFINE_TOENCODING
1100instance ToJSON Response where
1101 toJSON = sopSwaggerGenericToJSON
1102 DEFINE_TOENCODING
1104instance ToJSON Operation where
1105 toJSON = sopSwaggerGenericToJSON
1106 DEFINE_TOENCODING
1108instance ToJSON PathItem where
1109 toJSON = sopSwaggerGenericToJSON
1110 DEFINE_TOENCODING
1112instance ToJSON Example where
1113 toJSON = toJSON . Map.mapKeys show . getExample
1115instance ToJSON Reference where
1116 toJSON (Reference ref) = object [ "$ref" .= ref ]
1118referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1119referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1120referencedToJSON _ (Inline x) = toJSON x
1122instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1123instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1124instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1126instance ToJSON (SwaggerType t) where
1127 toJSON SwaggerArray = "array"
1128 toJSON SwaggerString = "string"
1129 toJSON SwaggerInteger = "integer"
1130 toJSON SwaggerNumber = "number"
1131 toJSON SwaggerBoolean = "boolean"
1132 toJSON SwaggerFile = "file"
1133 toJSON SwaggerNull = "null"
1134 toJSON SwaggerObject = "object"
1136instance ToJSON (CollectionFormat t) where
1137 toJSON CollectionCSV = "csv"
1138 toJSON CollectionSSV = "ssv"
1139 toJSON CollectionTSV = "tsv"
1140 toJSON CollectionPipes = "pipes"
1141 toJSON CollectionMulti = "multi"
1143instance ToJSON (ParamSchema k) where
1144 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1145 toJSON = sopSwaggerGenericToJSONWithOpts $
1146 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1148instance ToJSON AdditionalProperties where
1149 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1150 toJSON (AdditionalPropertiesSchema s) = toJSON s
1152-- =======================================================================
1153-- Manual FromJSON instances
1154-- =======================================================================
1156instance FromJSON OAuth2Flow where
1157 parseJSON (Object o) = do
1158 (flow :: Text) <- o .: "flow"
1159 case flow of
1160 "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1161 "password" -> OAuth2Password <$> o .: "tokenUrl"
1162 "application" -> OAuth2Application <$> o .: "tokenUrl"
1163 "accessCode" -> OAuth2AccessCode
1164 <$> o .: "authorizationUrl"
1165 <*> o .: "tokenUrl"
1166 _ -> empty
1167 parseJSON _ = empty
1169instance FromJSON OAuth2Params where
1170 parseJSON = sopSwaggerGenericParseJSON
1172instance FromJSON SecuritySchemeType where
1173 parseJSON js@(Object o) = do
1174 (t :: Text) <- o .: "type"
1175 case t of
1176 "basic" -> pure SecuritySchemeBasic
1177 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1178 "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1179 _ -> empty
1180 parseJSON _ = empty
1182instance FromJSON Swagger where
1183 parseJSON = sopSwaggerGenericParseJSON
1185instance FromJSON SecurityScheme where
1186 parseJSON = sopSwaggerGenericParseJSON
1188instance FromJSON Schema where
1189 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1190 where nullaryCleanup :: Schema -> Schema
1191 nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1192 if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1193 then s { _schemaExample = Nothing
1194 , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1195 else s
1197instance FromJSON Header where
1198 parseJSON = sopSwaggerGenericParseJSON
1200instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1201 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1202 <$> o .:? "collectionFormat"
1203 <*> (o .: "items" >>= parseJSON)
1205instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1206 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1207 <$> o .:? "collectionFormat"
1208 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1210-- |
1212-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1213-- Just (SwaggerItemsArray [])
1215-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1216-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1218-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1219-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1221instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1222 parseJSON js@(Object obj)
1223 | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1224 | otherwise = SwaggerItemsObject <$> parseJSON js
1225 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1226 parseJSON _ = empty
1228instance FromJSON Host where
1229 parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1230 [host] -> return $ Host host Nothing
1231 [host, port] -> case readMaybe port of
1232 Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1233 Just p -> return $ Host host (Just (fromInteger p))
1234 _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1235 parseJSON _ = empty
1237instance FromJSON MimeList where
1238 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1240instance FromJSON Param where
1241 parseJSON = sopSwaggerGenericParseJSON
1243instance FromJSON ParamAnySchema where
1244 parseJSON js@(Object o) = do
1245 (i :: Text) <- o .: "in"
1246 case i of
1247 "body" -> do
1248 schema <- o .: "schema"
1249 ParamBody <$> parseJSON schema
1250 _ -> ParamOther <$> parseJSON js
1251 parseJSON _ = empty
1253instance FromJSON ParamOtherSchema where
1254 parseJSON = sopSwaggerGenericParseJSON
1256instance FromJSON Responses where
1257 parseJSON (Object o) = Responses
1258 <$> o .:? "default"
1259 <*> (parseJSON (Object (HashMap.delete "default" o)))
1260 parseJSON _ = empty
1262instance FromJSON Example where
1263 parseJSON js = do
1264 m <- parseJSON js
1265 pure $ Example (Map.mapKeys fromString m)
1267instance FromJSON Response where
1268 parseJSON = sopSwaggerGenericParseJSON
1270instance FromJSON Operation where
1271 parseJSON = sopSwaggerGenericParseJSON
1273instance FromJSON PathItem where
1274 parseJSON = sopSwaggerGenericParseJSON
1276instance FromJSON Reference where
1277 parseJSON (Object o) = Reference <$> o .: "$ref"
1278 parseJSON _ = empty
1280referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1281referencedParseJSON prefix js@(Object o) = do
1282 ms <- o .:? "$ref"
1283 case ms of
1284 Nothing -> Inline <$> parseJSON js
1285 Just s -> Ref <$> parseRef s
1286 where
1287 parseRef s = do
1288 case Text.stripPrefix prefix s of
1289 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1290 Just suffix -> pure (Reference suffix)
1291referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1293instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1294instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1295instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1297instance FromJSON Xml where
1298 parseJSON = genericParseJSON (jsonPrefix "xml")
1300instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1301 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1303instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1304 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1306instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1307 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1309instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1310 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1312-- NOTE: There aren't collections of 'Schema'
1313--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1314-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1316instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1317 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1319instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1320 parseJSON = sopSwaggerGenericParseJSON
1321instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1322 parseJSON = sopSwaggerGenericParseJSON
1323instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1324 parseJSON = sopSwaggerGenericParseJSON
1326instance FromJSON AdditionalProperties where
1327 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1328 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1330-------------------------------------------------------------------------------
1331-- TH splices
1332-------------------------------------------------------------------------------
1334deriveGeneric ''Header
1335deriveGeneric ''OAuth2Params
1336deriveGeneric ''Operation
1337deriveGeneric ''Param
1338deriveGeneric ''ParamOtherSchema
1339deriveGeneric ''PathItem
1340deriveGeneric ''Response
1341deriveGeneric ''Responses
1342deriveGeneric ''SecurityScheme
1343deriveGeneric ''Schema
1344deriveGeneric ''ParamSchema
1345deriveGeneric ''Swagger
1347instance HasSwaggerAesonOptions Header where
1348 swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1349instance HasSwaggerAesonOptions OAuth2Params where
1350 swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1351instance HasSwaggerAesonOptions Operation where
1352 swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1353instance HasSwaggerAesonOptions Param where
1354 swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1355instance HasSwaggerAesonOptions ParamOtherSchema where
1356 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1357instance HasSwaggerAesonOptions PathItem where
1358 swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1359instance HasSwaggerAesonOptions Response where
1360 swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1361instance HasSwaggerAesonOptions Responses where
1362 swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1363instance HasSwaggerAesonOptions SecurityScheme where
1364 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1365instance HasSwaggerAesonOptions Schema where
1366 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1367instance HasSwaggerAesonOptions Swagger where
1368 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1370instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1371 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1372instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1373 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1374-- NOTE: Schema doesn't have 'items' sub object!
1375instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1376 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1378instance AesonDefaultValue (ParamSchema s)
1379instance AesonDefaultValue OAuth2Flow
1380instance AesonDefaultValue Responses
1381instance AesonDefaultValue ParamAnySchema
1382instance AesonDefaultValue SecuritySchemeType
1383instance AesonDefaultValue (SwaggerType a)
1384instance AesonDefaultValue MimeList where defaultValue = Just mempty
1385instance AesonDefaultValue Info
1386instance AesonDefaultValue ParamLocation