git.iko.soy/typeable/openapi3
on 022e345 help sign in
typeable/openapi3/src/Data/Swagger/Internal.hs
1352 lines 52 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 (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-- | A list of definitions that can be used in references.
69type Definitions = InsOrdHashMap Text
71-- | This is the root document object for the API specification.
72data Swagger = Swagger
73 { -- | Provides metadata about the API.
74 -- The metadata can be used by the clients if needed.
75 _swaggerInfo :: Info
77 -- | The host (name or ip) serving the API. It MAY include a port.
78 -- If the host is not included, the host serving the documentation is to be used (including the port).
79 , _swaggerHost :: Maybe Host
81 -- | The base path on which the API is served, which is relative to the host.
82 -- If it is not included, the API is served directly under the host.
83 -- The value MUST start with a leading slash (/).
84 , _swaggerBasePath :: Maybe FilePath
86 -- | The transfer protocol of the API.
87 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
88 , _swaggerSchemes :: Maybe [Scheme]
90 -- | A list of MIME types the APIs can consume.
91 -- This is global to all APIs but can be overridden on specific API calls.
92 , _swaggerConsumes :: MimeList
94 -- | A list of MIME types the APIs can produce.
95 -- This is global to all APIs but can be overridden on specific API calls.
96 , _swaggerProduces :: MimeList
98 -- | The available paths and operations for the API.
99 -- Holds the relative paths to the individual endpoints.
100 -- The path is appended to the @'basePath'@ in order to construct the full URL.
101 , _swaggerPaths :: InsOrdHashMap FilePath PathItem
103 -- | An object to hold data types produced and consumed by operations.
104 , _swaggerDefinitions :: Definitions Schema
106 -- | An object to hold parameters that can be used across operations.
107 -- This property does not define global parameters for all operations.
108 , _swaggerParameters :: Definitions Param
110 -- | An object to hold responses that can be used across operations.
111 -- This property does not define global responses for all operations.
112 , _swaggerResponses :: Definitions Response
114 -- | Security scheme definitions that can be used across the specification.
115 , _swaggerSecurityDefinitions :: Definitions SecurityScheme
117 -- | A declaration of which security schemes are applied for the API as a whole.
118 -- The list of values describes alternative security schemes that can be used
119 -- (that is, there is a logical OR between the security requirements).
120 -- Individual operations can override this definition.
121 , _swaggerSecurity :: [SecurityRequirement]
123 -- | A list of tags used by the specification with additional metadata.
124 -- The order of the tags can be used to reflect on their order by the parsing tools.
125 -- Not all tags that are used by the Operation Object must be declared.
126 -- The tags that are not declared may be organized randomly or based on the tools' logic.
127 -- Each tag name in the list MUST be unique.
128 , _swaggerTags :: Set Tag
130 -- | Additional external documentation.
131 , _swaggerExternalDocs :: Maybe ExternalDocs
132 } deriving (Eq, Show, Generic, Data, Typeable)
134-- | The object provides metadata about the API.
135-- The metadata can be used by the clients if needed,
136-- and can be presented in the Swagger-UI for convenience.
137data Info = Info
138 { -- | The title of the application.
139 _infoTitle :: Text
141 -- | A short description of the application.
142 -- GFM syntax can be used for rich text representation.
143 , _infoDescription :: Maybe Text
145 -- | The Terms of Service for the API.
146 , _infoTermsOfService :: Maybe Text
148 -- | The contact information for the exposed API.
149 , _infoContact :: Maybe Contact
151 -- | The license information for the exposed API.
152 , _infoLicense :: Maybe License
154 -- | Provides the version of the application API
155 -- (not to be confused with the specification version).
156 , _infoVersion :: Text
157 } deriving (Eq, Show, Generic, Data, Typeable)
159-- | Contact information for the exposed API.
160data Contact = Contact
161 { -- | The identifying name of the contact person/organization.
162 _contactName :: Maybe Text
164 -- | The URL pointing to the contact information.
165 , _contactUrl :: Maybe URL
167 -- | The email address of the contact person/organization.
168 , _contactEmail :: Maybe Text
169 } deriving (Eq, Show, Generic, Data, Typeable)
171-- | License information for the exposed API.
172data License = License
173 { -- | The license name used for the API.
174 _licenseName :: Text
176 -- | A URL to the license used for the API.
177 , _licenseUrl :: Maybe URL
178 } deriving (Eq, Show, Generic, Data, Typeable)
180instance IsString License where
181 fromString s = License (fromString s) Nothing
183-- | The host (name or ip) serving the API. It MAY include a port.
184data Host = Host
185 { _hostName :: HostName -- ^ Host name.
186 , _hostPort :: Maybe PortNumber -- ^ Optional port.
187 } deriving (Eq, Show, Generic, Typeable)
189instance IsString Host where
190 fromString s = Host s Nothing
192hostConstr :: Constr
193hostConstr = mkConstr hostDataType "Host" [] Prefix
195hostDataType :: DataType
196hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
198instance Data Host where
199 gunfold k z c = case constrIndex c of
200 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
201 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
202 toConstr (Host _ _) = hostConstr
203 dataTypeOf _ = hostDataType
205-- | The transfer protocol of the API.
206data Scheme
207 = Http
208 | Https
209 | Ws
210 | Wss
211 deriving (Eq, Show, Generic, Data, Typeable)
213-- | Describes the operations available on a single path.
214-- A @'PathItem'@ may be empty, due to ACL constraints.
215-- The path itself is still exposed to the documentation viewer
216-- but they will not know which operations and parameters are available.
217data PathItem = PathItem
218 { -- | A definition of a GET operation on this path.
219 _pathItemGet :: Maybe Operation
221 -- | A definition of a PUT operation on this path.
222 , _pathItemPut :: Maybe Operation
224 -- | A definition of a POST operation on this path.
225 , _pathItemPost :: Maybe Operation
227 -- | A definition of a DELETE operation on this path.
228 , _pathItemDelete :: Maybe Operation
230 -- | A definition of a OPTIONS operation on this path.
231 , _pathItemOptions :: Maybe Operation
233 -- | A definition of a HEAD operation on this path.
234 , _pathItemHead :: Maybe Operation
236 -- | A definition of a PATCH operation on this path.
237 , _pathItemPatch :: Maybe Operation
239 -- | A list of parameters that are applicable for all the operations described under this path.
240 -- These parameters can be overridden at the operation level, but cannot be removed there.
241 -- The list MUST NOT include duplicated parameters.
242 -- A unique parameter is defined by a combination of a name and location.
243 , _pathItemParameters :: [Referenced Param]
244 } deriving (Eq, Show, Generic, Data, Typeable)
246-- | Describes a single API operation on a path.
247data Operation = Operation
248 { -- | A list of tags for API documentation control.
249 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
250 _operationTags :: Set TagName
252 -- | A short summary of what the operation does.
253 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
254 , _operationSummary :: Maybe Text
256 -- | A verbose explanation of the operation behavior.
257 -- GFM syntax can be used for rich text representation.
258 , _operationDescription :: Maybe Text
260 -- | Additional external documentation for this operation.
261 , _operationExternalDocs :: Maybe ExternalDocs
263 -- | Unique string used to identify the operation.
264 -- The id MUST be unique among all operations described in the API.
265 -- Tools and libraries MAY use the it to uniquely identify an operation,
266 -- therefore, it is recommended to follow common programming naming conventions.
267 , _operationOperationId :: Maybe Text
269 -- | A list of MIME types the operation can consume.
270 -- This overrides the @'consumes'@.
271 -- @Just []@ MAY be used to clear the global definition.
272 , _operationConsumes :: Maybe MimeList
274 -- | A list of MIME types the operation can produce.
275 -- This overrides the @'produces'@.
276 -- @Just []@ MAY be used to clear the global definition.
277 , _operationProduces :: Maybe MimeList
279 -- | A list of parameters that are applicable for this operation.
280 -- If a parameter is already defined at the @'PathItem'@,
281 -- the new definition will override it, but can never remove it.
282 -- The list MUST NOT include duplicated parameters.
283 -- A unique parameter is defined by a combination of a name and location.
284 , _operationParameters :: [Referenced Param]
286 -- | The list of possible responses as they are returned from executing this operation.
287 , _operationResponses :: Responses
289 -- | The transfer protocol for the operation.
290 -- The value overrides @'schemes'@.
291 , _operationSchemes :: Maybe [Scheme]
293 -- | Declares this operation to be deprecated.
294 -- Usage of the declared operation should be refrained.
295 -- Default value is @False@.
296 , _operationDeprecated :: Maybe Bool
298 -- | A declaration of which security schemes are applied for this operation.
299 -- The list of values describes alternative security schemes that can be used
300 -- (that is, there is a logical OR between the security requirements).
301 -- This definition overrides any declared top-level security.
302 -- To remove a top-level security declaration, @Just []@ can be used.
303 , _operationSecurity :: [SecurityRequirement]
304 } deriving (Eq, Show, Generic, Data, Typeable)
306newtype MimeList = MimeList { getMimeList :: [MediaType] }
307 deriving (Eq, Show, Semigroup, Monoid, Typeable)
309mimeListConstr :: Constr
310mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
312mimeListDataType :: DataType
313mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
315instance Data MimeList where
316 gunfold k z c = case constrIndex c of
317 1 -> k (z (\xs -> MimeList (map fromString xs)))
318 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
319 toConstr (MimeList _) = mimeListConstr
320 dataTypeOf _ = mimeListDataType
322-- | Describes a single operation parameter.
323-- A unique parameter is defined by a combination of a name and location.
324data Param = Param
325 { -- | The name of the parameter.
326 -- Parameter names are case sensitive.
327 _paramName :: Text
329 -- | A brief description of the parameter.
330 -- This could contain examples of use.
331 -- GFM syntax can be used for rich text representation.
332 , _paramDescription :: Maybe Text
334 -- | Determines whether this parameter is mandatory.
335 -- If the parameter is in "path", this property is required and its value MUST be true.
336 -- Otherwise, the property MAY be included and its default value is @False@.
337 , _paramRequired :: Maybe Bool
339 -- | Parameter schema.
340 , _paramSchema :: ParamAnySchema
341 } deriving (Eq, Show, Generic, Data, Typeable)
343data ParamAnySchema
344 = ParamBody (Referenced Schema)
345 | ParamOther ParamOtherSchema
346 deriving (Eq, Show, Generic, Data, Typeable)
348data ParamOtherSchema = ParamOtherSchema
349 { -- | The location of the parameter.
350 _paramOtherSchemaIn :: ParamLocation
352 -- | Sets the ability to pass empty-valued parameters.
353 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
354 -- and allows you to send a parameter with a name only or an empty value.
355 -- Default value is @False@.
356 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
358 , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
359 } deriving (Eq, Show, Generic, Typeable, Data)
361-- | Items for @'SwaggerArray'@ schemas.
362--
363-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
364-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
365-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
366-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
367--
368-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
369--
370-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
371data SwaggerItems t where
372 SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
373 SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
374 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
375 deriving (Typeable)
377deriving instance Eq (SwaggerItems t)
378deriving instance Show (SwaggerItems t)
379--deriving instance Typeable (SwaggerItems t)
381swaggerItemsPrimitiveConstr :: Constr
382swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
384swaggerItemsObjectConstr :: Constr
385swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
387swaggerItemsArrayConstr :: Constr
388swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
390swaggerItemsDataType :: DataType
391swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
393-- Note: unfortunately we have to write these Data instances by hand,
394-- to get better contexts / avoid duplicate name when using standalone deriving
396instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
397 -- TODO: define gfoldl
398 gunfold k z c = case constrIndex c of
399 1 -> k (k (z SwaggerItemsPrimitive))
400 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
401 toConstr _ = swaggerItemsPrimitiveConstr
402 dataTypeOf _ = swaggerItemsDataType
404-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
405instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
406 -- TODO: define gfoldl
407 gunfold k z c = case constrIndex c of
408 1 -> k (k (z SwaggerItemsPrimitive))
409 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
410 toConstr _ = swaggerItemsPrimitiveConstr
411 dataTypeOf _ = swaggerItemsDataType
413instance Data (SwaggerItems 'SwaggerKindSchema) where
414 gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
415 gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
416 gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
418 gunfold k z c = case constrIndex c of
419 2 -> k (z SwaggerItemsObject)
420 3 -> k (z SwaggerItemsArray)
421 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
423 toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
424 toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
425 toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
427 dataTypeOf _ = swaggerItemsDataType
429-- | Type used as a kind to avoid overlapping instances.
430data SwaggerKind t
431 = SwaggerKindNormal t
432 | SwaggerKindParamOtherSchema
433 | SwaggerKindSchema
434 deriving (Typeable)
436deriving instance Typeable 'SwaggerKindNormal
437deriving instance Typeable 'SwaggerKindParamOtherSchema
438deriving instance Typeable 'SwaggerKindSchema
440type family SwaggerKindType (k :: SwaggerKind *) :: *
441type instance SwaggerKindType ('SwaggerKindNormal t) = t
442type instance SwaggerKindType 'SwaggerKindSchema = Schema
443type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
445data SwaggerType t where
446 SwaggerString :: SwaggerType t
447 SwaggerNumber :: SwaggerType t
448 SwaggerInteger :: SwaggerType t
449 SwaggerBoolean :: SwaggerType t
450 SwaggerArray :: SwaggerType t
451 SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
452 SwaggerNull :: SwaggerType 'SwaggerKindSchema
453 SwaggerObject :: SwaggerType 'SwaggerKindSchema
454 deriving (Typeable)
456deriving instance Eq (SwaggerType t)
457deriving instance Show (SwaggerType t)
459swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
460swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
462swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
463swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
465swaggerCommonTypes :: [SwaggerType k]
466swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
468swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
469swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
471swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
472swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
474swaggerTypeConstrs :: [Constr]
475swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
476 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
478instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
479 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
480 toConstr = swaggerTypeConstr
481 dataTypeOf = swaggerTypeDataType
483instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
484 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
485 toConstr = swaggerTypeConstr
486 dataTypeOf = swaggerTypeDataType
488instance Data (SwaggerType 'SwaggerKindSchema) where
489 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
490 toConstr = swaggerTypeConstr
491 dataTypeOf = swaggerTypeDataType
493data ParamLocation
494 = -- | Parameters that are appended to the URL.
495 -- For example, in @/items?id=###@, the query parameter is @id@.
496 ParamQuery
497 -- | Custom headers that are expected as part of the request.
498 | ParamHeader
499 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
500 -- This does not include the host or base path of the API.
501 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
502 | ParamPath
503 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
504 -- or @multipart/form-data@ are used as the content type of the request
505 -- (in Swagger's definition, the @consumes@ property of an operation).
506 -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
507 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
508 -- Form parameters have a different format based on the content-type used
509 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
510 | ParamFormData
511 deriving (Eq, Show, Generic, Data, Typeable)
513type Format = Text
515-- | Determines the format of the array.
516data CollectionFormat t where
517 -- Comma separated values: @foo,bar@.
518 CollectionCSV :: CollectionFormat t
519 -- Space separated values: @foo bar@.
520 CollectionSSV :: CollectionFormat t
521 -- Tab separated values: @foo\\tbar@.
522 CollectionTSV :: CollectionFormat t
523 -- Pipe separated values: @foo|bar@.
524 CollectionPipes :: CollectionFormat t
525 -- Corresponds to multiple parameter instances
526 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
527 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
528 CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
529 deriving (Typeable)
531deriving instance Eq (CollectionFormat t)
532deriving instance Show (CollectionFormat t)
534collectionFormatConstr :: CollectionFormat t -> Constr
535collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
537collectionFormatDataType :: DataType
538collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
539 map collectionFormatConstr collectionCommonFormats
541collectionCommonFormats :: [CollectionFormat t]
542collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
544instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
545 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
546 toConstr = collectionFormatConstr
547 dataTypeOf _ = collectionFormatDataType
549deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
551type ParamName = Text
553data Schema = Schema
554 { _schemaTitle :: Maybe Text
555 , _schemaDescription :: Maybe Text
556 , _schemaRequired :: [ParamName]
558 , _schemaAllOf :: Maybe [Referenced Schema]
559 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
560 , _schemaAdditionalProperties :: Maybe AdditionalProperties
562 , _schemaDiscriminator :: Maybe Text
563 , _schemaReadOnly :: Maybe Bool
564 , _schemaXml :: Maybe Xml
565 , _schemaExternalDocs :: Maybe ExternalDocs
566 , _schemaExample :: Maybe Value
568 , _schemaMaxProperties :: Maybe Integer
569 , _schemaMinProperties :: Maybe Integer
571 , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
572 } deriving (Eq, Show, Generic, Data, Typeable)
574-- | A @'Schema'@ with an optional name.
575-- This name can be used in references.
576data NamedSchema = NamedSchema
577 { _namedSchemaName :: Maybe Text
578 , _namedSchemaSchema :: Schema
579 } deriving (Eq, Show, Generic, Data, Typeable)
581-- | Regex pattern for @string@ type.
582type Pattern = Text
584data ParamSchema (t :: SwaggerKind *) = ParamSchema
585 { -- | Declares the value of the parameter that the server will use if none is provided,
586 -- for example a @"count"@ to control the number of results per page might default to @100@
587 -- if not supplied by the client in the request.
588 -- (Note: "default" has no meaning for required parameters.)
589 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
590 _paramSchemaDefault :: Maybe Value
592 , _paramSchemaType :: SwaggerType t
593 , _paramSchemaFormat :: Maybe Format
594 , _paramSchemaItems :: Maybe (SwaggerItems t)
595 , _paramSchemaMaximum :: Maybe Scientific
596 , _paramSchemaExclusiveMaximum :: Maybe Bool
597 , _paramSchemaMinimum :: Maybe Scientific
598 , _paramSchemaExclusiveMinimum :: Maybe Bool
599 , _paramSchemaMaxLength :: Maybe Integer
600 , _paramSchemaMinLength :: Maybe Integer
601 , _paramSchemaPattern :: Maybe Pattern
602 , _paramSchemaMaxItems :: Maybe Integer
603 , _paramSchemaMinItems :: Maybe Integer
604 , _paramSchemaUniqueItems :: Maybe Bool
605 , _paramSchemaEnum :: Maybe [Value]
606 , _paramSchemaMultipleOf :: Maybe Scientific
607 } deriving (Eq, Show, Generic, Typeable)
609deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)
611data Xml = Xml
612 { -- | Replaces the name of the element/attribute used for the described schema property.
613 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
614 -- When defined alongside type being array (outside the items),
615 -- it will affect the wrapping element and only if wrapped is true.
616 -- If wrapped is false, it will be ignored.
617 _xmlName :: Maybe Text
619 -- | The URL of the namespace definition.
620 -- Value SHOULD be in the form of a URL.
621 , _xmlNamespace :: Maybe Text
623 -- | The prefix to be used for the name.
624 , _xmlPrefix :: Maybe Text
626 -- | Declares whether the property definition translates to an attribute instead of an element.
627 -- Default value is @False@.
628 , _xmlAttribute :: Maybe Bool
630 -- | MAY be used only for an array definition.
631 -- Signifies whether the array is wrapped
632 -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
633 -- or unwrapped (@\<book/\>\<book/\>@).
634 -- Default value is @False@.
635 -- The definition takes effect only when defined alongside type being array (outside the items).
636 , _xmlWrapped :: Maybe Bool
637 } deriving (Eq, Show, Generic, Data, Typeable)
639-- | A container for the expected responses of an operation.
640-- The container maps a HTTP response code to the expected response.
641-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
642-- since they may not be known in advance.
643-- However, it is expected from the documentation to cover a successful operation response and any known errors.
644data Responses = Responses
645 { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
646 -- It can be used to cover undeclared responses.
647 _responsesDefault :: Maybe (Referenced Response)
649 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
650 -- Describes the expected response for those HTTP status codes.
651 , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
652 } deriving (Eq, Show, Generic, Data, Typeable)
654type HttpStatusCode = Int
656-- | Describes a single response from an API Operation.
657data Response = Response
658 { -- | A short description of the response.
659 -- GFM syntax can be used for rich text representation.
660 _responseDescription :: Text
662 -- | A definition of the response structure.
663 -- It can be a primitive, an array or an object.
664 -- If this field does not exist, it means no content is returned as part of the response.
665 -- As an extension to the Schema Object, its root type value may also be "file".
666 -- This SHOULD be accompanied by a relevant produces mime-type.
667 , _responseSchema :: Maybe (Referenced Schema)
669 -- | A list of headers that are sent with the response.
670 , _responseHeaders :: InsOrdHashMap HeaderName Header
672 -- | An example of the response message.
673 , _responseExamples :: Maybe Example
674 } deriving (Eq, Show, Generic, Data, Typeable)
676instance IsString Response where
677 fromString s = Response (fromString s) Nothing mempty Nothing
679type HeaderName = Text
681data Header = Header
682 { -- | A short description of the header.
683 _headerDescription :: Maybe Text
685 , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
686 } deriving (Eq, Show, Generic, Data, Typeable)
688data Example = Example { getExample :: Map MediaType Value }
689 deriving (Eq, Show, Generic, Typeable)
691exampleConstr :: Constr
692exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
694exampleDataType :: DataType
695exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
697instance Data Example where
698 gunfold k z c = case constrIndex c of
699 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
700 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
701 toConstr (Example _) = exampleConstr
702 dataTypeOf _ = exampleDataType
704-- | The location of the API key.
705data ApiKeyLocation
706 = ApiKeyQuery
707 | ApiKeyHeader
708 deriving (Eq, Show, Generic, Data, Typeable)
710data ApiKeyParams = ApiKeyParams
711 { -- | The name of the header or query parameter to be used.
712 _apiKeyName :: Text
714 -- | The location of the API key.
715 , _apiKeyIn :: ApiKeyLocation
716 } deriving (Eq, Show, Generic, Data, Typeable)
718-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
719type AuthorizationURL = Text
721-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
722type TokenURL = Text
724data OAuth2Flow
725 = OAuth2Implicit AuthorizationURL
726 | OAuth2Password TokenURL
727 | OAuth2Application TokenURL
728 | OAuth2AccessCode AuthorizationURL TokenURL
729 deriving (Eq, Show, Generic, Data, Typeable)
731data OAuth2Params = OAuth2Params
732 { -- | The flow used by the OAuth2 security scheme.
733 _oauth2Flow :: OAuth2Flow
735 -- | The available scopes for the OAuth2 security scheme.
736 , _oauth2Scopes :: InsOrdHashMap Text Text
737 } deriving (Eq, Show, Generic, Data, Typeable)
739data SecuritySchemeType
740 = SecuritySchemeBasic
741 | SecuritySchemeApiKey ApiKeyParams
742 | SecuritySchemeOAuth2 OAuth2Params
743 deriving (Eq, Show, Generic, Data, Typeable)
745data SecurityScheme = SecurityScheme
746 { -- | The type of the security scheme.
747 _securitySchemeType :: SecuritySchemeType
749 -- | A short description for security scheme.
750 , _securitySchemeDescription :: Maybe Text
751 } deriving (Eq, Show, Generic, Data, Typeable)
753-- | Lists the required security schemes to execute this operation.
754-- The object can have multiple security schemes declared in it which are all required
755-- (that is, there is a logical AND between the schemes).
756newtype SecurityRequirement = SecurityRequirement
757 { getSecurityRequirement :: InsOrdHashMap Text [Text]
758 } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
760-- | Tag name.
761type TagName = Text
763-- | Allows adding meta data to a single tag that is used by @Operation@.
764-- It is not mandatory to have a @Tag@ per tag used there.
765data Tag = Tag
766 { -- | The name of the tag.
767 _tagName :: TagName
769 -- | A short description for the tag.
770 -- GFM syntax can be used for rich text representation.
771 , _tagDescription :: Maybe Text
773 -- | Additional external documentation for this tag.
774 , _tagExternalDocs :: Maybe ExternalDocs
775 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
777instance IsString Tag where
778 fromString s = Tag (fromString s) Nothing Nothing
780-- | Allows referencing an external resource for extended documentation.
781data ExternalDocs = ExternalDocs
782 { -- | A short description of the target documentation.
783 -- GFM syntax can be used for rich text representation.
784 _externalDocsDescription :: Maybe Text
786 -- | The URL for the target documentation.
787 , _externalDocsUrl :: URL
788 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
790-- | A simple object to allow referencing other definitions in the specification.
791-- It can be used to reference parameters and responses that are defined at the top level for reuse.
792newtype Reference = Reference { getReference :: Text }
793 deriving (Eq, Show, Data, Typeable)
795data Referenced a
796 = Ref Reference
797 | Inline a
798 deriving (Eq, Show, Functor, Data, Typeable)
800instance IsString a => IsString (Referenced a) where
801 fromString = Inline . fromString
803newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
805data AdditionalProperties
806 = AdditionalPropertiesAllowed Bool
807 | AdditionalPropertiesSchema (Referenced Schema)
808 deriving (Eq, Show, Data, Typeable)
810-- =======================================================================
811-- Monoid instances
812-- =======================================================================
814instance Semigroup Swagger where
815 (<>) = genericMappend
816instance Monoid Swagger where
817 mempty = genericMempty
818 mappend = (<>)
820instance Semigroup Info where
821 (<>) = genericMappend
822instance Monoid Info where
823 mempty = genericMempty
824 mappend = (<>)
826instance Semigroup Contact where
827 (<>) = genericMappend
828instance Monoid Contact where
829 mempty = genericMempty
830 mappend = (<>)
832instance Semigroup PathItem where
833 (<>) = genericMappend
834instance Monoid PathItem where
835 mempty = genericMempty
836 mappend = (<>)
838instance Semigroup Schema where
839 (<>) = genericMappend
840instance Monoid Schema where
841 mempty = genericMempty
842 mappend = (<>)
844instance Semigroup (ParamSchema t) where
845 (<>) = genericMappend
846instance Monoid (ParamSchema t) where
847 mempty = genericMempty
848 mappend = (<>)
850instance Semigroup Param where
851 (<>) = genericMappend
852instance Monoid Param where
853 mempty = genericMempty
854 mappend = (<>)
856instance Semigroup ParamOtherSchema where
857 (<>) = genericMappend
858instance Monoid ParamOtherSchema where
859 mempty = genericMempty
860 mappend = (<>)
862instance Semigroup Header where
863 (<>) = genericMappend
864instance Monoid Header where
865 mempty = genericMempty
866 mappend = (<>)
868instance Semigroup Responses where
869 (<>) = genericMappend
870instance Monoid Responses where
871 mempty = genericMempty
872 mappend = (<>)
874instance Semigroup Response where
875 (<>) = genericMappend
876instance Monoid Response where
877 mempty = genericMempty
878 mappend = (<>)
880instance Semigroup ExternalDocs where
881 (<>) = genericMappend
882instance Monoid ExternalDocs where
883 mempty = genericMempty
884 mappend = (<>)
886instance Semigroup Operation where
887 (<>) = genericMappend
888instance Monoid Operation where
889 mempty = genericMempty
890 mappend = (<>)
892instance Semigroup Example where
893 (<>) = genericMappend
894instance Monoid Example where
895 mempty = genericMempty
896 mappend = (<>)
898-- =======================================================================
899-- SwaggerMonoid helper instances
900-- =======================================================================
902instance SwaggerMonoid Info
903instance SwaggerMonoid PathItem
904instance SwaggerMonoid Schema
905instance SwaggerMonoid (ParamSchema t)
906instance SwaggerMonoid Param
907instance SwaggerMonoid ParamOtherSchema
908instance SwaggerMonoid Responses
909instance SwaggerMonoid Response
910instance SwaggerMonoid ExternalDocs
911instance SwaggerMonoid Operation
913instance SwaggerMonoid MimeList
914deriving instance SwaggerMonoid URL
916instance SwaggerMonoid (SwaggerType t) where
917 swaggerMempty = SwaggerString
918 swaggerMappend _ y = y
920instance SwaggerMonoid ParamLocation where
921 swaggerMempty = ParamQuery
922 swaggerMappend _ y = y
924instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
925 swaggerMempty = InsOrdHashMap.empty
926 swaggerMappend = InsOrdHashMap.unionWith mappend
928instance Monoid a => SwaggerMonoid (Referenced a) where
929 swaggerMempty = Inline mempty
930 swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
931 swaggerMappend _ y = y
933instance SwaggerMonoid ParamAnySchema where
934 swaggerMempty = ParamOther swaggerMempty
935 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
936 swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
937 swaggerMappend _ y = y
939-- =======================================================================
940-- Simple Generic-based ToJSON instances
941-- =======================================================================
943instance ToJSON ParamLocation where
944 toJSON = genericToJSON (jsonPrefix "Param")
946instance ToJSON Info where
947 toJSON = genericToJSON (jsonPrefix "Info")
949instance ToJSON Contact where
950 toJSON = genericToJSON (jsonPrefix "Contact")
952instance ToJSON License where
953 toJSON = genericToJSON (jsonPrefix "License")
955instance ToJSON ApiKeyLocation where
956 toJSON = genericToJSON (jsonPrefix "ApiKey")
958instance ToJSON ApiKeyParams where
959 toJSON = genericToJSON (jsonPrefix "apiKey")
961instance ToJSON Scheme where
962 toJSON = genericToJSON (jsonPrefix "")
964instance ToJSON Tag where
965 toJSON = genericToJSON (jsonPrefix "Tag")
967instance ToJSON ExternalDocs where
968 toJSON = genericToJSON (jsonPrefix "ExternalDocs")
970instance ToJSON Xml where
971 toJSON = genericToJSON (jsonPrefix "Xml")
973-- =======================================================================
974-- Simple Generic-based FromJSON instances
975-- =======================================================================
977instance FromJSON ParamLocation where
978 parseJSON = genericParseJSON (jsonPrefix "Param")
980instance FromJSON Info where
981 parseJSON = genericParseJSON (jsonPrefix "Info")
983instance FromJSON Contact where
984 parseJSON = genericParseJSON (jsonPrefix "Contact")
986instance FromJSON License where
987 parseJSON = genericParseJSON (jsonPrefix "License")
989instance FromJSON ApiKeyLocation where
990 parseJSON = genericParseJSON (jsonPrefix "ApiKey")
992instance FromJSON ApiKeyParams where
993 parseJSON = genericParseJSON (jsonPrefix "apiKey")
995instance FromJSON Scheme where
996 parseJSON = genericParseJSON (jsonPrefix "")
998instance FromJSON Tag where
999 parseJSON = genericParseJSON (jsonPrefix "Tag")
1001instance FromJSON ExternalDocs where
1002 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1004-- =======================================================================
1005-- Manual ToJSON instances
1006-- =======================================================================
1008instance ToJSON OAuth2Flow where
1009 toJSON (OAuth2Implicit authUrl) = object
1010 [ "flow" .= ("implicit" :: Text)
1011 , "authorizationUrl" .= authUrl ]
1012 toJSON (OAuth2Password tokenUrl) = object
1013 [ "flow" .= ("password" :: Text)
1014 , "tokenUrl" .= tokenUrl ]
1015 toJSON (OAuth2Application tokenUrl) = object
1016 [ "flow" .= ("application" :: Text)
1017 , "tokenUrl" .= tokenUrl ]
1018 toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1019 [ "flow" .= ("accessCode" :: Text)
1020 , "authorizationUrl" .= authUrl
1021 , "tokenUrl" .= tokenUrl ]
1023instance ToJSON OAuth2Params where
1024 toJSON = sopSwaggerGenericToJSON
1025 DEFINE_TOENCODING
1027instance ToJSON SecuritySchemeType where
1028 toJSON SecuritySchemeBasic
1029 = object [ "type" .= ("basic" :: Text) ]
1030 toJSON (SecuritySchemeApiKey params)
1031 = toJSON params
1032 <+> object [ "type" .= ("apiKey" :: Text) ]
1033 toJSON (SecuritySchemeOAuth2 params)
1034 = toJSON params
1035 <+> object [ "type" .= ("oauth2" :: Text) ]
1037instance ToJSON Swagger where
1038 toJSON = sopSwaggerGenericToJSON
1039 DEFINE_TOENCODING
1041instance ToJSON SecurityScheme where
1042 toJSON = sopSwaggerGenericToJSON
1043 DEFINE_TOENCODING
1045instance ToJSON Schema where
1046 toJSON = sopSwaggerGenericToJSON
1047 DEFINE_TOENCODING
1049instance ToJSON Header where
1050 toJSON = sopSwaggerGenericToJSON
1051 DEFINE_TOENCODING
1053instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1054 toJSON (SwaggerItemsPrimitive fmt schema) = object
1055 [ "collectionFormat" .= fmt
1056 , "items" .= schema ]
1057 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1058 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1060instance ToJSON Host where
1061 toJSON (Host host mport) = toJSON $
1062 case mport of
1063 Nothing -> host
1064 Just port -> host ++ ":" ++ show port
1066instance ToJSON MimeList where
1067 toJSON (MimeList xs) = toJSON (map show xs)
1069instance ToJSON Param where
1070 toJSON = sopSwaggerGenericToJSON
1071 DEFINE_TOENCODING
1073instance ToJSON ParamAnySchema where
1074 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1075 toJSON (ParamOther s) = toJSON s
1077instance ToJSON ParamOtherSchema where
1078 toJSON = sopSwaggerGenericToJSON
1079 DEFINE_TOENCODING
1081instance ToJSON Responses where
1082 toJSON = sopSwaggerGenericToJSON
1083 DEFINE_TOENCODING
1085instance ToJSON Response where
1086 toJSON = sopSwaggerGenericToJSON
1087 DEFINE_TOENCODING
1089instance ToJSON Operation where
1090 toJSON = sopSwaggerGenericToJSON
1091 DEFINE_TOENCODING
1093instance ToJSON PathItem where
1094 toJSON = sopSwaggerGenericToJSON
1095 DEFINE_TOENCODING
1097instance ToJSON Example where
1098 toJSON = toJSON . Map.mapKeys show . getExample
1100instance ToJSON Reference where
1101 toJSON (Reference ref) = object [ "$ref" .= ref ]
1103referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1104referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1105referencedToJSON _ (Inline x) = toJSON x
1107instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1108instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1109instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1111instance ToJSON (SwaggerType t) where
1112 toJSON SwaggerArray = "array"
1113 toJSON SwaggerString = "string"
1114 toJSON SwaggerInteger = "integer"
1115 toJSON SwaggerNumber = "number"
1116 toJSON SwaggerBoolean = "boolean"
1117 toJSON SwaggerFile = "file"
1118 toJSON SwaggerNull = "null"
1119 toJSON SwaggerObject = "object"
1121instance ToJSON (CollectionFormat t) where
1122 toJSON CollectionCSV = "csv"
1123 toJSON CollectionSSV = "ssv"
1124 toJSON CollectionTSV = "tsv"
1125 toJSON CollectionPipes = "pipes"
1126 toJSON CollectionMulti = "multi"
1128instance ToJSON (ParamSchema k) where
1129 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1130 toJSON = sopSwaggerGenericToJSONWithOpts $
1131 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1133instance ToJSON AdditionalProperties where
1134 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1135 toJSON (AdditionalPropertiesSchema s) = toJSON s
1137-- =======================================================================
1138-- Manual FromJSON instances
1139-- =======================================================================
1141instance FromJSON OAuth2Flow where
1142 parseJSON (Object o) = do
1143 (flow :: Text) <- o .: "flow"
1144 case flow of
1145 "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1146 "password" -> OAuth2Password <$> o .: "tokenUrl"
1147 "application" -> OAuth2Application <$> o .: "tokenUrl"
1148 "accessCode" -> OAuth2AccessCode
1149 <$> o .: "authorizationUrl"
1150 <*> o .: "tokenUrl"
1151 _ -> empty
1152 parseJSON _ = empty
1154instance FromJSON OAuth2Params where
1155 parseJSON = sopSwaggerGenericParseJSON
1157instance FromJSON SecuritySchemeType where
1158 parseJSON js@(Object o) = do
1159 (t :: Text) <- o .: "type"
1160 case t of
1161 "basic" -> pure SecuritySchemeBasic
1162 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1163 "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1164 _ -> empty
1165 parseJSON _ = empty
1167instance FromJSON Swagger where
1168 parseJSON = sopSwaggerGenericParseJSON
1170instance FromJSON SecurityScheme where
1171 parseJSON = sopSwaggerGenericParseJSON
1173instance FromJSON Schema where
1174 parseJSON = sopSwaggerGenericParseJSON
1176instance FromJSON Header where
1177 parseJSON = sopSwaggerGenericParseJSON
1179instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1180 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1181 <$> o .:? "collectionFormat"
1182 <*> (o .: "items" >>= parseJSON)
1184instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1185 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1186 <$> o .:? "collectionFormat"
1187 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1189instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1190 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1191 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1192 parseJSON _ = empty
1194instance FromJSON Host where
1195 parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1196 [host] -> return $ Host host Nothing
1197 [host, port] -> case readMaybe port of
1198 Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1199 Just p -> return $ Host host (Just (fromInteger p))
1200 _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1201 parseJSON _ = empty
1203instance FromJSON MimeList where
1204 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1206instance FromJSON Param where
1207 parseJSON = sopSwaggerGenericParseJSON
1209instance FromJSON ParamAnySchema where
1210 parseJSON js@(Object o) = do
1211 (i :: Text) <- o .: "in"
1212 case i of
1213 "body" -> do
1214 schema <- o .: "schema"
1215 ParamBody <$> parseJSON schema
1216 _ -> ParamOther <$> parseJSON js
1217 parseJSON _ = empty
1219instance FromJSON ParamOtherSchema where
1220 parseJSON = sopSwaggerGenericParseJSON
1222instance FromJSON Responses where
1223 parseJSON (Object o) = Responses
1224 <$> o .:? "default"
1225 <*> (parseJSON (Object (HashMap.delete "default" o)))
1226 parseJSON _ = empty
1228instance FromJSON Example where
1229 parseJSON js = do
1230 m <- parseJSON js
1231 pure $ Example (Map.mapKeys fromString m)
1233instance FromJSON Response where
1234 parseJSON = sopSwaggerGenericParseJSON
1236instance FromJSON Operation where
1237 parseJSON = sopSwaggerGenericParseJSON
1239instance FromJSON PathItem where
1240 parseJSON = sopSwaggerGenericParseJSON
1242instance FromJSON Reference where
1243 parseJSON (Object o) = Reference <$> o .: "$ref"
1244 parseJSON _ = empty
1246referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1247referencedParseJSON prefix js@(Object o) = do
1248 ms <- o .:? "$ref"
1249 case ms of
1250 Nothing -> Inline <$> parseJSON js
1251 Just s -> Ref <$> parseRef s
1252 where
1253 parseRef s = do
1254 case Text.stripPrefix prefix s of
1255 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1256 Just suffix -> pure (Reference suffix)
1257referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1259instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1260instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1261instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1263instance FromJSON Xml where
1264 parseJSON = genericParseJSON (jsonPrefix "xml")
1266instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1267 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1269instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1270 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1272instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1273 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1275instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1276 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1278-- NOTE: There aren't collections of 'Schema'
1279--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1280-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1282instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1283 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1285instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1286 parseJSON = sopSwaggerGenericParseJSON
1287instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1288 parseJSON = sopSwaggerGenericParseJSON
1289instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1290 parseJSON = sopSwaggerGenericParseJSON
1292instance FromJSON AdditionalProperties where
1293 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1294 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1296-------------------------------------------------------------------------------
1297-- TH splices
1298-------------------------------------------------------------------------------
1300deriveGeneric ''Header
1301deriveGeneric ''OAuth2Params
1302deriveGeneric ''Operation
1303deriveGeneric ''Param
1304deriveGeneric ''ParamOtherSchema
1305deriveGeneric ''PathItem
1306deriveGeneric ''Response
1307deriveGeneric ''Responses
1308deriveGeneric ''SecurityScheme
1309deriveGeneric ''Schema
1310deriveGeneric ''ParamSchema
1311deriveGeneric ''Swagger
1313instance HasSwaggerAesonOptions Header where
1314 swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1315instance HasSwaggerAesonOptions OAuth2Params where
1316 swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1317instance HasSwaggerAesonOptions Operation where
1318 swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1319instance HasSwaggerAesonOptions Param where
1320 swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1321instance HasSwaggerAesonOptions ParamOtherSchema where
1322 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1323instance HasSwaggerAesonOptions PathItem where
1324 swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1325instance HasSwaggerAesonOptions Response where
1326 swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1327instance HasSwaggerAesonOptions Responses where
1328 swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1329instance HasSwaggerAesonOptions SecurityScheme where
1330 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1331instance HasSwaggerAesonOptions Schema where
1332 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1333instance HasSwaggerAesonOptions Swagger where
1334 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1336instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1337 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1338instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1339 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1340-- NOTE: Schema doesn't have 'items' sub object!
1341instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1342 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1344instance AesonDefaultValue (ParamSchema s)
1345instance AesonDefaultValue OAuth2Flow
1346instance AesonDefaultValue Responses
1347instance AesonDefaultValue ParamAnySchema
1348instance AesonDefaultValue SecuritySchemeType
1349instance AesonDefaultValue (SwaggerType a)
1350instance AesonDefaultValue MimeList where defaultValue = Just mempty
1351instance AesonDefaultValue Info
1352instance AesonDefaultValue ParamLocation