git.iko.soy/typeable/openapi3
on c121663 help sign in
typeable/openapi3/src/Data/Swagger/Internal.hs
1392 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 Data.Hashable (Hashable)
33import qualified Data.HashMap.Strict as HashMap
34import Data.HashSet.InsOrd (InsOrdHashSet)
35import Data.Map (Map)
36import qualified Data.Map as Map
37import Data.Monoid (Monoid (..))
38import Data.Semigroup.Compat (Semigroup (..))
39import Data.Scientific (Scientific)
40import Data.String (IsString(..))
41import Data.Text (Text)
42import qualified Data.Text as Text
43import GHC.Generics (Generic)
44import Network.Socket (HostName, PortNumber)
45import Network.HTTP.Media (MediaType)
46import Text.Read (readMaybe)
48import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51import Generics.SOP.TH (deriveGeneric)
52import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53 ,sopSwaggerGenericToJSONWithOpts
54 ,sopSwaggerGenericParseJSON
55 ,HasSwaggerAesonOptions(..)
56 ,AesonDefaultValue(..)
57 ,mkSwaggerAesonOptions
58 ,saoAdditionalPairs
59 ,saoSubObject)
60import Data.Swagger.Internal.Utils
62#if MIN_VERSION_aeson(0,10,0)
63import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65#else
66#define DEFINE_TOENCODING
67#endif
69-- $setup
70-- >>> :seti -XDataKinds
71-- >>> import Data.Aeson
73-- | A list of definitions that can be used in references.
74type Definitions = InsOrdHashMap Text
76-- | This is the root document object for the API specification.
77data Swagger = Swagger
78 { -- | Provides metadata about the API.
79 -- The metadata can be used by the clients if needed.
80 _swaggerInfo :: Info
82 -- | The host (name or ip) serving the API. It MAY include a port.
83 -- If the host is not included, the host serving the documentation is to be used (including the port).
84 , _swaggerHost :: Maybe Host
86 -- | The base path on which the API is served, which is relative to the host.
87 -- If it is not included, the API is served directly under the host.
88 -- The value MUST start with a leading slash (/).
89 , _swaggerBasePath :: Maybe FilePath
91 -- | The transfer protocol of the API.
92 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
93 , _swaggerSchemes :: Maybe [Scheme]
95 -- | A list of MIME types the APIs can consume.
96 -- This is global to all APIs but can be overridden on specific API calls.
97 , _swaggerConsumes :: MimeList
99 -- | A list of MIME types the APIs can produce.
100 -- This is global to all APIs but can be overridden on specific API calls.
101 , _swaggerProduces :: MimeList
103 -- | The available paths and operations for the API.
104 -- Holds the relative paths to the individual endpoints.
105 -- The path is appended to the @'basePath'@ in order to construct the full URL.
106 , _swaggerPaths :: InsOrdHashMap FilePath PathItem
108 -- | An object to hold data types produced and consumed by operations.
109 , _swaggerDefinitions :: Definitions Schema
111 -- | An object to hold parameters that can be used across operations.
112 -- This property does not define global parameters for all operations.
113 , _swaggerParameters :: Definitions Param
115 -- | An object to hold responses that can be used across operations.
116 -- This property does not define global responses for all operations.
117 , _swaggerResponses :: Definitions Response
119 -- | Security scheme definitions that can be used across the specification.
120 , _swaggerSecurityDefinitions :: Definitions SecurityScheme
122 -- | A declaration of which security schemes are applied for the API as a whole.
123 -- The list of values describes alternative security schemes that can be used
124 -- (that is, there is a logical OR between the security requirements).
125 -- Individual operations can override this definition.
126 , _swaggerSecurity :: [SecurityRequirement]
128 -- | A list of tags used by the specification with additional metadata.
129 -- The order of the tags can be used to reflect on their order by the parsing tools.
130 -- Not all tags that are used by the Operation Object must be declared.
131 -- The tags that are not declared may be organized randomly or based on the tools' logic.
132 -- Each tag name in the list MUST be unique.
133 , _swaggerTags :: InsOrdHashSet Tag
135 -- | Additional external documentation.
136 , _swaggerExternalDocs :: Maybe ExternalDocs
137 } deriving (Eq, Show, Generic, Data, Typeable)
139-- | The object provides metadata about the API.
140-- The metadata can be used by the clients if needed,
141-- and can be presented in the Swagger-UI for convenience.
142data Info = Info
143 { -- | The title of the application.
144 _infoTitle :: Text
146 -- | A short description of the application.
147 -- GFM syntax can be used for rich text representation.
148 , _infoDescription :: Maybe Text
150 -- | The Terms of Service for the API.
151 , _infoTermsOfService :: Maybe Text
153 -- | The contact information for the exposed API.
154 , _infoContact :: Maybe Contact
156 -- | The license information for the exposed API.
157 , _infoLicense :: Maybe License
159 -- | Provides the version of the application API
160 -- (not to be confused with the specification version).
161 , _infoVersion :: Text
162 } deriving (Eq, Show, Generic, Data, Typeable)
164-- | Contact information for the exposed API.
165data Contact = Contact
166 { -- | The identifying name of the contact person/organization.
167 _contactName :: Maybe Text
169 -- | The URL pointing to the contact information.
170 , _contactUrl :: Maybe URL
172 -- | The email address of the contact person/organization.
173 , _contactEmail :: Maybe Text
174 } deriving (Eq, Show, Generic, Data, Typeable)
176-- | License information for the exposed API.
177data License = License
178 { -- | The license name used for the API.
179 _licenseName :: Text
181 -- | A URL to the license used for the API.
182 , _licenseUrl :: Maybe URL
183 } deriving (Eq, Show, Generic, Data, Typeable)
185instance IsString License where
186 fromString s = License (fromString s) Nothing
188-- | The host (name or ip) serving the API. It MAY include a port.
189data Host = Host
190 { _hostName :: HostName -- ^ Host name.
191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
192 } deriving (Eq, Show, Generic, Typeable)
194instance IsString Host where
195 fromString s = Host s Nothing
197hostConstr :: Constr
198hostConstr = mkConstr hostDataType "Host" [] Prefix
200hostDataType :: DataType
201hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
203instance Data Host where
204 gunfold k z c = case constrIndex c of
205 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
206 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
207 toConstr (Host _ _) = hostConstr
208 dataTypeOf _ = hostDataType
210-- | The transfer protocol of the API.
211data Scheme
212 = Http
213 | Https
214 | Ws
215 | Wss
216 deriving (Eq, Show, Generic, Data, Typeable)
218-- | Describes the operations available on a single path.
219-- A @'PathItem'@ may be empty, due to ACL constraints.
220-- The path itself is still exposed to the documentation viewer
221-- but they will not know which operations and parameters are available.
222data PathItem = PathItem
223 { -- | A definition of a GET operation on this path.
224 _pathItemGet :: Maybe Operation
226 -- | A definition of a PUT operation on this path.
227 , _pathItemPut :: Maybe Operation
229 -- | A definition of a POST operation on this path.
230 , _pathItemPost :: Maybe Operation
232 -- | A definition of a DELETE operation on this path.
233 , _pathItemDelete :: Maybe Operation
235 -- | A definition of a OPTIONS operation on this path.
236 , _pathItemOptions :: Maybe Operation
238 -- | A definition of a HEAD operation on this path.
239 , _pathItemHead :: Maybe Operation
241 -- | A definition of a PATCH operation on this path.
242 , _pathItemPatch :: Maybe Operation
244 -- | A list of parameters that are applicable for all the operations described under this path.
245 -- These parameters can be overridden at the operation level, but cannot be removed there.
246 -- The list MUST NOT include duplicated parameters.
247 -- A unique parameter is defined by a combination of a name and location.
248 , _pathItemParameters :: [Referenced Param]
249 } deriving (Eq, Show, Generic, Data, Typeable)
251-- | Describes a single API operation on a path.
252data Operation = Operation
253 { -- | A list of tags for API documentation control.
254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255 _operationTags :: InsOrdHashSet TagName
257 -- | A short summary of what the operation does.
258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
259 , _operationSummary :: Maybe Text
261 -- | A verbose explanation of the operation behavior.
262 -- GFM syntax can be used for rich text representation.
263 , _operationDescription :: Maybe Text
265 -- | Additional external documentation for this operation.
266 , _operationExternalDocs :: Maybe ExternalDocs
268 -- | Unique string used to identify the operation.
269 -- The id MUST be unique among all operations described in the API.
270 -- Tools and libraries MAY use the it to uniquely identify an operation,
271 -- therefore, it is recommended to follow common programming naming conventions.
272 , _operationOperationId :: Maybe Text
274 -- | A list of MIME types the operation can consume.
275 -- This overrides the @'consumes'@.
276 -- @Just []@ MAY be used to clear the global definition.
277 , _operationConsumes :: Maybe MimeList
279 -- | A list of MIME types the operation can produce.
280 -- This overrides the @'produces'@.
281 -- @Just []@ MAY be used to clear the global definition.
282 , _operationProduces :: Maybe MimeList
284 -- | A list of parameters that are applicable for this operation.
285 -- If a parameter is already defined at the @'PathItem'@,
286 -- the new definition will override it, but can never remove it.
287 -- The list MUST NOT include duplicated parameters.
288 -- A unique parameter is defined by a combination of a name and location.
289 , _operationParameters :: [Referenced Param]
291 -- | The list of possible responses as they are returned from executing this operation.
292 , _operationResponses :: Responses
294 -- | The transfer protocol for the operation.
295 -- The value overrides @'schemes'@.
296 , _operationSchemes :: Maybe [Scheme]
298 -- | Declares this operation to be deprecated.
299 -- Usage of the declared operation should be refrained.
300 -- Default value is @False@.
301 , _operationDeprecated :: Maybe Bool
303 -- | A declaration of which security schemes are applied for this operation.
304 -- The list of values describes alternative security schemes that can be used
305 -- (that is, there is a logical OR between the security requirements).
306 -- This definition overrides any declared top-level security.
307 -- To remove a top-level security declaration, @Just []@ can be used.
308 , _operationSecurity :: [SecurityRequirement]
309 } deriving (Eq, Show, Generic, Data, Typeable)
311newtype MimeList = MimeList { getMimeList :: [MediaType] }
312 deriving (Eq, Show, Semigroup, Monoid, Typeable)
314mimeListConstr :: Constr
315mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
317mimeListDataType :: DataType
318mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
320instance Data MimeList where
321 gunfold k z c = case constrIndex c of
322 1 -> k (z (\xs -> MimeList (map fromString xs)))
323 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
324 toConstr (MimeList _) = mimeListConstr
325 dataTypeOf _ = mimeListDataType
327-- | Describes a single operation parameter.
328-- A unique parameter is defined by a combination of a name and location.
329data Param = Param
330 { -- | The name of the parameter.
331 -- Parameter names are case sensitive.
332 _paramName :: Text
334 -- | A brief description of the parameter.
335 -- This could contain examples of use.
336 -- GFM syntax can be used for rich text representation.
337 , _paramDescription :: Maybe Text
339 -- | Determines whether this parameter is mandatory.
340 -- If the parameter is in "path", this property is required and its value MUST be true.
341 -- Otherwise, the property MAY be included and its default value is @False@.
342 , _paramRequired :: Maybe Bool
344 -- | Parameter schema.
345 , _paramSchema :: ParamAnySchema
346 } deriving (Eq, Show, Generic, Data, Typeable)
348data ParamAnySchema
349 = ParamBody (Referenced Schema)
350 | ParamOther ParamOtherSchema
351 deriving (Eq, Show, Generic, Data, Typeable)
353data ParamOtherSchema = ParamOtherSchema
354 { -- | The location of the parameter.
355 _paramOtherSchemaIn :: ParamLocation
357 -- | Sets the ability to pass empty-valued parameters.
358 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
359 -- and allows you to send a parameter with a name only or an empty value.
360 -- Default value is @False@.
361 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
363 , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364 } deriving (Eq, Show, Generic, Typeable, Data)
366-- | Items for @'SwaggerArray'@ schemas.
367--
368-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
369-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
370-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
371-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
372--
373-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
374--
375-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376data SwaggerItems t where
377 SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378 SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
380 deriving (Typeable)
382deriving instance Eq (SwaggerItems t)
383deriving instance Show (SwaggerItems t)
384--deriving instance Typeable (SwaggerItems t)
386swaggerItemsPrimitiveConstr :: Constr
387swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
389swaggerItemsObjectConstr :: Constr
390swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
392swaggerItemsArrayConstr :: Constr
393swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
395swaggerItemsDataType :: DataType
396swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
398-- Note: unfortunately we have to write these Data instances by hand,
399-- to get better contexts / avoid duplicate name when using standalone deriving
401instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402 -- TODO: define gfoldl
403 gunfold k z c = case constrIndex c of
404 1 -> k (k (z SwaggerItemsPrimitive))
405 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406 toConstr _ = swaggerItemsPrimitiveConstr
407 dataTypeOf _ = swaggerItemsDataType
409-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411 -- TODO: define gfoldl
412 gunfold k z c = case constrIndex c of
413 1 -> k (k (z SwaggerItemsPrimitive))
414 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415 toConstr _ = swaggerItemsPrimitiveConstr
416 dataTypeOf _ = swaggerItemsDataType
418instance Data (SwaggerItems 'SwaggerKindSchema) where
419 gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420 gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421 gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
423 gunfold k z c = case constrIndex c of
424 2 -> k (z SwaggerItemsObject)
425 3 -> k (z SwaggerItemsArray)
426 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
428 toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429 toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430 toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
432 dataTypeOf _ = swaggerItemsDataType
434-- | Type used as a kind to avoid overlapping instances.
435data SwaggerKind t
436 = SwaggerKindNormal t
437 | SwaggerKindParamOtherSchema
438 | SwaggerKindSchema
439 deriving (Typeable)
441deriving instance Typeable 'SwaggerKindNormal
442deriving instance Typeable 'SwaggerKindParamOtherSchema
443deriving instance Typeable 'SwaggerKindSchema
445type family SwaggerKindType (k :: SwaggerKind *) :: *
446type instance SwaggerKindType ('SwaggerKindNormal t) = t
447type instance SwaggerKindType 'SwaggerKindSchema = Schema
448type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
450data SwaggerType t where
451 SwaggerString :: SwaggerType t
452 SwaggerNumber :: SwaggerType t
453 SwaggerInteger :: SwaggerType t
454 SwaggerBoolean :: SwaggerType t
455 SwaggerArray :: SwaggerType t
456 SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457 SwaggerNull :: SwaggerType 'SwaggerKindSchema
458 SwaggerObject :: SwaggerType 'SwaggerKindSchema
459 deriving (Typeable)
461deriving instance Eq (SwaggerType t)
462deriving instance Show (SwaggerType t)
464swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
467swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
468swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
470swaggerCommonTypes :: [SwaggerType k]
471swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
473swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
474swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
476swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
477swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
479swaggerTypeConstrs :: [Constr]
480swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
481 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
483instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
484 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485 toConstr = swaggerTypeConstr
486 dataTypeOf = swaggerTypeDataType
488instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
489 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490 toConstr = swaggerTypeConstr
491 dataTypeOf = swaggerTypeDataType
493instance Data (SwaggerType 'SwaggerKindSchema) where
494 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495 toConstr = swaggerTypeConstr
496 dataTypeOf = swaggerTypeDataType
498data ParamLocation
499 = -- | Parameters that are appended to the URL.
500 -- For example, in @/items?id=###@, the query parameter is @id@.
501 ParamQuery
502 -- | Custom headers that are expected as part of the request.
503 | ParamHeader
504 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
505 -- This does not include the host or base path of the API.
506 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
507 | ParamPath
508 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
509 -- or @multipart/form-data@ are used as the content type of the request
510 -- (in Swagger's definition, the @consumes@ property of an operation).
511 -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
512 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
513 -- Form parameters have a different format based on the content-type used
514 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
515 | ParamFormData
516 deriving (Eq, Show, Generic, Data, Typeable)
518type Format = Text
520-- | Determines the format of the array.
521data CollectionFormat t where
522 -- Comma separated values: @foo,bar@.
523 CollectionCSV :: CollectionFormat t
524 -- Space separated values: @foo bar@.
525 CollectionSSV :: CollectionFormat t
526 -- Tab separated values: @foo\\tbar@.
527 CollectionTSV :: CollectionFormat t
528 -- Pipe separated values: @foo|bar@.
529 CollectionPipes :: CollectionFormat t
530 -- Corresponds to multiple parameter instances
531 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533 CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
534 deriving (Typeable)
536deriving instance Eq (CollectionFormat t)
537deriving instance Show (CollectionFormat t)
539collectionFormatConstr :: CollectionFormat t -> Constr
540collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
542collectionFormatDataType :: DataType
543collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
544 map collectionFormatConstr collectionCommonFormats
546collectionCommonFormats :: [CollectionFormat t]
547collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
549instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
550 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551 toConstr = collectionFormatConstr
552 dataTypeOf _ = collectionFormatDataType
554deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
556type ParamName = Text
558data Schema = Schema
559 { _schemaTitle :: Maybe Text
560 , _schemaDescription :: Maybe Text
561 , _schemaRequired :: [ParamName]
563 , _schemaAllOf :: Maybe [Referenced Schema]
564 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565 , _schemaAdditionalProperties :: Maybe AdditionalProperties
567 , _schemaDiscriminator :: Maybe Text
568 , _schemaReadOnly :: Maybe Bool
569 , _schemaXml :: Maybe Xml
570 , _schemaExternalDocs :: Maybe ExternalDocs
571 , _schemaExample :: Maybe Value
573 , _schemaMaxProperties :: Maybe Integer
574 , _schemaMinProperties :: Maybe Integer
576 , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577 } deriving (Eq, Show, Generic, Data, Typeable)
579-- | A @'Schema'@ with an optional name.
580-- This name can be used in references.
581data NamedSchema = NamedSchema
582 { _namedSchemaName :: Maybe Text
583 , _namedSchemaSchema :: Schema
584 } deriving (Eq, Show, Generic, Data, Typeable)
586-- | Regex pattern for @string@ type.
587type Pattern = Text
589data ParamSchema (t :: SwaggerKind *) = ParamSchema
590 { -- | Declares the value of the parameter that the server will use if none is provided,
591 -- for example a @"count"@ to control the number of results per page might default to @100@
592 -- if not supplied by the client in the request.
593 -- (Note: "default" has no meaning for required parameters.)
594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595 _paramSchemaDefault :: Maybe Value
597 , _paramSchemaType :: Maybe (SwaggerType t)
598 , _paramSchemaFormat :: Maybe Format
599 , _paramSchemaItems :: Maybe (SwaggerItems t)
600 , _paramSchemaMaximum :: Maybe Scientific
601 , _paramSchemaExclusiveMaximum :: Maybe Bool
602 , _paramSchemaMinimum :: Maybe Scientific
603 , _paramSchemaExclusiveMinimum :: Maybe Bool
604 , _paramSchemaMaxLength :: Maybe Integer
605 , _paramSchemaMinLength :: Maybe Integer
606 , _paramSchemaPattern :: Maybe Pattern
607 , _paramSchemaMaxItems :: Maybe Integer
608 , _paramSchemaMinItems :: Maybe Integer
609 , _paramSchemaUniqueItems :: Maybe Bool
610 , _paramSchemaEnum :: Maybe [Value]
611 , _paramSchemaMultipleOf :: Maybe Scientific
612 } deriving (Eq, Show, Generic, Typeable)
614deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
616data Xml = Xml
617 { -- | Replaces the name of the element/attribute used for the described schema property.
618 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
619 -- When defined alongside type being array (outside the items),
620 -- it will affect the wrapping element and only if wrapped is true.
621 -- If wrapped is false, it will be ignored.
622 _xmlName :: Maybe Text
624 -- | The URL of the namespace definition.
625 -- Value SHOULD be in the form of a URL.
626 , _xmlNamespace :: Maybe Text
628 -- | The prefix to be used for the name.
629 , _xmlPrefix :: Maybe Text
631 -- | Declares whether the property definition translates to an attribute instead of an element.
632 -- Default value is @False@.
633 , _xmlAttribute :: Maybe Bool
635 -- | MAY be used only for an array definition.
636 -- Signifies whether the array is wrapped
637 -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
638 -- or unwrapped (@\<book/\>\<book/\>@).
639 -- Default value is @False@.
640 -- The definition takes effect only when defined alongside type being array (outside the items).
641 , _xmlWrapped :: Maybe Bool
642 } deriving (Eq, Show, Generic, Data, Typeable)
644-- | A container for the expected responses of an operation.
645-- The container maps a HTTP response code to the expected response.
646-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
647-- since they may not be known in advance.
648-- However, it is expected from the documentation to cover a successful operation response and any known errors.
649data Responses = Responses
650 { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
651 -- It can be used to cover undeclared responses.
652 _responsesDefault :: Maybe (Referenced Response)
654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
655 -- Describes the expected response for those HTTP status codes.
656 , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
657 } deriving (Eq, Show, Generic, Data, Typeable)
659type HttpStatusCode = Int
661-- | Describes a single response from an API Operation.
662data Response = Response
663 { -- | A short description of the response.
664 -- GFM syntax can be used for rich text representation.
665 _responseDescription :: Text
667 -- | A definition of the response structure.
668 -- It can be a primitive, an array or an object.
669 -- If this field does not exist, it means no content is returned as part of the response.
670 -- As an extension to the Schema Object, its root type value may also be "file".
671 -- This SHOULD be accompanied by a relevant produces mime-type.
672 , _responseSchema :: Maybe (Referenced Schema)
674 -- | A list of headers that are sent with the response.
675 , _responseHeaders :: InsOrdHashMap HeaderName Header
677 -- | An example of the response message.
678 , _responseExamples :: Maybe Example
679 } deriving (Eq, Show, Generic, Data, Typeable)
681instance IsString Response where
682 fromString s = Response (fromString s) Nothing mempty Nothing
684type HeaderName = Text
686data Header = Header
687 { -- | A short description of the header.
688 _headerDescription :: Maybe Text
690 , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
691 } deriving (Eq, Show, Generic, Data, Typeable)
693data Example = Example { getExample :: Map MediaType Value }
694 deriving (Eq, Show, Generic, Typeable)
696exampleConstr :: Constr
697exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
699exampleDataType :: DataType
700exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
702instance Data Example where
703 gunfold k z c = case constrIndex c of
704 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
705 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
706 toConstr (Example _) = exampleConstr
707 dataTypeOf _ = exampleDataType
709-- | The location of the API key.
710data ApiKeyLocation
711 = ApiKeyQuery
712 | ApiKeyHeader
713 deriving (Eq, Show, Generic, Data, Typeable)
715data ApiKeyParams = ApiKeyParams
716 { -- | The name of the header or query parameter to be used.
717 _apiKeyName :: Text
719 -- | The location of the API key.
720 , _apiKeyIn :: ApiKeyLocation
721 } deriving (Eq, Show, Generic, Data, Typeable)
723-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
724type AuthorizationURL = Text
726-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
727type TokenURL = Text
729data OAuth2Flow
730 = OAuth2Implicit AuthorizationURL
731 | OAuth2Password TokenURL
732 | OAuth2Application TokenURL
733 | OAuth2AccessCode AuthorizationURL TokenURL
734 deriving (Eq, Show, Generic, Data, Typeable)
736data OAuth2Params = OAuth2Params
737 { -- | The flow used by the OAuth2 security scheme.
738 _oauth2Flow :: OAuth2Flow
740 -- | The available scopes for the OAuth2 security scheme.
741 , _oauth2Scopes :: InsOrdHashMap Text Text
742 } deriving (Eq, Show, Generic, Data, Typeable)
744data SecuritySchemeType
745 = SecuritySchemeBasic
746 | SecuritySchemeApiKey ApiKeyParams
747 | SecuritySchemeOAuth2 OAuth2Params
748 deriving (Eq, Show, Generic, Data, Typeable)
750data SecurityScheme = SecurityScheme
751 { -- | The type of the security scheme.
752 _securitySchemeType :: SecuritySchemeType
754 -- | A short description for security scheme.
755 , _securitySchemeDescription :: Maybe Text
756 } deriving (Eq, Show, Generic, Data, Typeable)
758-- | Lists the required security schemes to execute this operation.
759-- The object can have multiple security schemes declared in it which are all required
760-- (that is, there is a logical AND between the schemes).
761newtype SecurityRequirement = SecurityRequirement
762 { getSecurityRequirement :: InsOrdHashMap Text [Text]
763 } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
765-- | Tag name.
766type TagName = Text
768-- | Allows adding meta data to a single tag that is used by @Operation@.
769-- It is not mandatory to have a @Tag@ per tag used there.
770data Tag = Tag
771 { -- | The name of the tag.
772 _tagName :: TagName
774 -- | A short description for the tag.
775 -- GFM syntax can be used for rich text representation.
776 , _tagDescription :: Maybe Text
778 -- | Additional external documentation for this tag.
779 , _tagExternalDocs :: Maybe ExternalDocs
780 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
782instance Hashable Tag
784instance IsString Tag where
785 fromString s = Tag (fromString s) Nothing Nothing
787-- | Allows referencing an external resource for extended documentation.
788data ExternalDocs = ExternalDocs
789 { -- | A short description of the target documentation.
790 -- GFM syntax can be used for rich text representation.
791 _externalDocsDescription :: Maybe Text
793 -- | The URL for the target documentation.
794 , _externalDocsUrl :: URL
795 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797instance Hashable ExternalDocs
799-- | A simple object to allow referencing other definitions in the specification.
800-- It can be used to reference parameters and responses that are defined at the top level for reuse.
801newtype Reference = Reference { getReference :: Text }
802 deriving (Eq, Show, Data, Typeable)
804data Referenced a
805 = Ref Reference
806 | Inline a
807 deriving (Eq, Show, Functor, Data, Typeable)
809instance IsString a => IsString (Referenced a) where
810 fromString = Inline . fromString
812newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
814data AdditionalProperties
815 = AdditionalPropertiesAllowed Bool
816 | AdditionalPropertiesSchema (Referenced Schema)
817 deriving (Eq, Show, Data, Typeable)
819-- =======================================================================
820-- Monoid instances
821-- =======================================================================
823instance Semigroup Swagger where
824 (<>) = genericMappend
825instance Monoid Swagger where
826 mempty = genericMempty
827 mappend = (<>)
829instance Semigroup Info where
830 (<>) = genericMappend
831instance Monoid Info where
832 mempty = genericMempty
833 mappend = (<>)
835instance Semigroup Contact where
836 (<>) = genericMappend
837instance Monoid Contact where
838 mempty = genericMempty
839 mappend = (<>)
841instance Semigroup PathItem where
842 (<>) = genericMappend
843instance Monoid PathItem where
844 mempty = genericMempty
845 mappend = (<>)
847instance Semigroup Schema where
848 (<>) = genericMappend
849instance Monoid Schema where
850 mempty = genericMempty
851 mappend = (<>)
853instance Semigroup (ParamSchema t) where
854 (<>) = genericMappend
855instance Monoid (ParamSchema t) where
856 mempty = genericMempty
857 mappend = (<>)
859instance Semigroup Param where
860 (<>) = genericMappend
861instance Monoid Param where
862 mempty = genericMempty
863 mappend = (<>)
865instance Semigroup ParamOtherSchema where
866 (<>) = genericMappend
867instance Monoid ParamOtherSchema where
868 mempty = genericMempty
869 mappend = (<>)
871instance Semigroup Header where
872 (<>) = genericMappend
873instance Monoid Header where
874 mempty = genericMempty
875 mappend = (<>)
877instance Semigroup Responses where
878 (<>) = genericMappend
879instance Monoid Responses where
880 mempty = genericMempty
881 mappend = (<>)
883instance Semigroup Response where
884 (<>) = genericMappend
885instance Monoid Response where
886 mempty = genericMempty
887 mappend = (<>)
889instance Semigroup ExternalDocs where
890 (<>) = genericMappend
891instance Monoid ExternalDocs where
892 mempty = genericMempty
893 mappend = (<>)
895instance Semigroup Operation where
896 (<>) = genericMappend
897instance Monoid Operation where
898 mempty = genericMempty
899 mappend = (<>)
901instance Semigroup Example where
902 (<>) = genericMappend
903instance Monoid Example where
904 mempty = genericMempty
905 mappend = (<>)
907-- =======================================================================
908-- SwaggerMonoid helper instances
909-- =======================================================================
911instance SwaggerMonoid Info
912instance SwaggerMonoid PathItem
913instance SwaggerMonoid Schema
914instance SwaggerMonoid (ParamSchema t)
915instance SwaggerMonoid Param
916instance SwaggerMonoid ParamOtherSchema
917instance SwaggerMonoid Responses
918instance SwaggerMonoid Response
919instance SwaggerMonoid ExternalDocs
920instance SwaggerMonoid Operation
921instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
923instance SwaggerMonoid MimeList
924deriving instance SwaggerMonoid URL
926instance SwaggerMonoid (SwaggerType t) where
927 swaggerMempty = SwaggerString
928 swaggerMappend _ y = y
930instance SwaggerMonoid ParamLocation where
931 swaggerMempty = ParamQuery
932 swaggerMappend _ y = y
934instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
935 swaggerMempty = InsOrdHashMap.empty
936 swaggerMappend = InsOrdHashMap.unionWith mappend
938instance Monoid a => SwaggerMonoid (Referenced a) where
939 swaggerMempty = Inline mempty
940 swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
941 swaggerMappend _ y = y
943instance SwaggerMonoid ParamAnySchema where
944 swaggerMempty = ParamOther swaggerMempty
945 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
946 swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
947 swaggerMappend _ y = y
949-- =======================================================================
950-- Simple Generic-based ToJSON instances
951-- =======================================================================
953instance ToJSON ParamLocation where
954 toJSON = genericToJSON (jsonPrefix "Param")
956instance ToJSON Info where
957 toJSON = genericToJSON (jsonPrefix "Info")
959instance ToJSON Contact where
960 toJSON = genericToJSON (jsonPrefix "Contact")
962instance ToJSON License where
963 toJSON = genericToJSON (jsonPrefix "License")
965instance ToJSON ApiKeyLocation where
966 toJSON = genericToJSON (jsonPrefix "ApiKey")
968instance ToJSON ApiKeyParams where
969 toJSON = genericToJSON (jsonPrefix "apiKey")
971instance ToJSON Scheme where
972 toJSON = genericToJSON (jsonPrefix "")
974instance ToJSON Tag where
975 toJSON = genericToJSON (jsonPrefix "Tag")
977instance ToJSON ExternalDocs where
978 toJSON = genericToJSON (jsonPrefix "ExternalDocs")
980instance ToJSON Xml where
981 toJSON = genericToJSON (jsonPrefix "Xml")
983-- =======================================================================
984-- Simple Generic-based FromJSON instances
985-- =======================================================================
987instance FromJSON ParamLocation where
988 parseJSON = genericParseJSON (jsonPrefix "Param")
990instance FromJSON Info where
991 parseJSON = genericParseJSON (jsonPrefix "Info")
993instance FromJSON Contact where
994 parseJSON = genericParseJSON (jsonPrefix "Contact")
996instance FromJSON License where
997 parseJSON = genericParseJSON (jsonPrefix "License")
999instance FromJSON ApiKeyLocation where
1000 parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1002instance FromJSON ApiKeyParams where
1003 parseJSON = genericParseJSON (jsonPrefix "apiKey")
1005instance FromJSON Scheme where
1006 parseJSON = genericParseJSON (jsonPrefix "")
1008instance FromJSON Tag where
1009 parseJSON = genericParseJSON (jsonPrefix "Tag")
1011instance FromJSON ExternalDocs where
1012 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1014-- =======================================================================
1015-- Manual ToJSON instances
1016-- =======================================================================
1018instance ToJSON OAuth2Flow where
1019 toJSON (OAuth2Implicit authUrl) = object
1020 [ "flow" .= ("implicit" :: Text)
1021 , "authorizationUrl" .= authUrl ]
1022 toJSON (OAuth2Password tokenUrl) = object
1023 [ "flow" .= ("password" :: Text)
1024 , "tokenUrl" .= tokenUrl ]
1025 toJSON (OAuth2Application tokenUrl) = object
1026 [ "flow" .= ("application" :: Text)
1027 , "tokenUrl" .= tokenUrl ]
1028 toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1029 [ "flow" .= ("accessCode" :: Text)
1030 , "authorizationUrl" .= authUrl
1031 , "tokenUrl" .= tokenUrl ]
1033instance ToJSON OAuth2Params where
1034 toJSON = sopSwaggerGenericToJSON
1035 DEFINE_TOENCODING
1037instance ToJSON SecuritySchemeType where
1038 toJSON SecuritySchemeBasic
1039 = object [ "type" .= ("basic" :: Text) ]
1040 toJSON (SecuritySchemeApiKey params)
1041 = toJSON params
1042 <+> object [ "type" .= ("apiKey" :: Text) ]
1043 toJSON (SecuritySchemeOAuth2 params)
1044 = toJSON params
1045 <+> object [ "type" .= ("oauth2" :: Text) ]
1047instance ToJSON Swagger where
1048 toJSON = sopSwaggerGenericToJSON
1049 DEFINE_TOENCODING
1051instance ToJSON SecurityScheme where
1052 toJSON = sopSwaggerGenericToJSON
1053 DEFINE_TOENCODING
1055instance ToJSON Schema where
1056 toJSON = sopSwaggerGenericToJSON
1057 DEFINE_TOENCODING
1059instance ToJSON Header where
1060 toJSON = sopSwaggerGenericToJSON
1061 DEFINE_TOENCODING
1063-- | As for nullary schema for 0-arity type constructors, see
1064-- <https://github.com/GetShopTV/swagger2/issues/167>.
1066-- >>> encode (SwaggerItemsArray [])
1067-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1069instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1070 toJSON (SwaggerItemsPrimitive fmt schema) = object
1071 [ "collectionFormat" .= fmt
1072 , "items" .= schema ]
1073 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1074 toJSON (SwaggerItemsArray []) = object
1075 [ "items" .= object []
1076 , "maxItems" .= (0 :: Int)
1077 , "example" .= Array mempty
1079 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1081instance ToJSON Host where
1082 toJSON (Host host mport) = toJSON $
1083 case mport of
1084 Nothing -> host
1085 Just port -> host ++ ":" ++ show port
1087instance ToJSON MimeList where
1088 toJSON (MimeList xs) = toJSON (map show xs)
1090instance ToJSON Param where
1091 toJSON = sopSwaggerGenericToJSON
1092 DEFINE_TOENCODING
1094instance ToJSON ParamAnySchema where
1095 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1096 toJSON (ParamOther s) = toJSON s
1098instance ToJSON ParamOtherSchema where
1099 toJSON = sopSwaggerGenericToJSON
1100 DEFINE_TOENCODING
1102instance ToJSON Responses where
1103 toJSON = sopSwaggerGenericToJSON
1104 DEFINE_TOENCODING
1106instance ToJSON Response where
1107 toJSON = sopSwaggerGenericToJSON
1108 DEFINE_TOENCODING
1110instance ToJSON Operation where
1111 toJSON = sopSwaggerGenericToJSON
1112 DEFINE_TOENCODING
1114instance ToJSON PathItem where
1115 toJSON = sopSwaggerGenericToJSON
1116 DEFINE_TOENCODING
1118instance ToJSON Example where
1119 toJSON = toJSON . Map.mapKeys show . getExample
1121instance ToJSON Reference where
1122 toJSON (Reference ref) = object [ "$ref" .= ref ]
1124referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1125referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1126referencedToJSON _ (Inline x) = toJSON x
1128instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1129instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1130instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1132instance ToJSON (SwaggerType t) where
1133 toJSON SwaggerArray = "array"
1134 toJSON SwaggerString = "string"
1135 toJSON SwaggerInteger = "integer"
1136 toJSON SwaggerNumber = "number"
1137 toJSON SwaggerBoolean = "boolean"
1138 toJSON SwaggerFile = "file"
1139 toJSON SwaggerNull = "null"
1140 toJSON SwaggerObject = "object"
1142instance ToJSON (CollectionFormat t) where
1143 toJSON CollectionCSV = "csv"
1144 toJSON CollectionSSV = "ssv"
1145 toJSON CollectionTSV = "tsv"
1146 toJSON CollectionPipes = "pipes"
1147 toJSON CollectionMulti = "multi"
1149instance ToJSON (ParamSchema k) where
1150 -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1151 toJSON = sopSwaggerGenericToJSONWithOpts $
1152 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1154instance ToJSON AdditionalProperties where
1155 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1156 toJSON (AdditionalPropertiesSchema s) = toJSON s
1158-- =======================================================================
1159-- Manual FromJSON instances
1160-- =======================================================================
1162instance FromJSON OAuth2Flow where
1163 parseJSON (Object o) = do
1164 (flow :: Text) <- o .: "flow"
1165 case flow of
1166 "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1167 "password" -> OAuth2Password <$> o .: "tokenUrl"
1168 "application" -> OAuth2Application <$> o .: "tokenUrl"
1169 "accessCode" -> OAuth2AccessCode
1170 <$> o .: "authorizationUrl"
1171 <*> o .: "tokenUrl"
1172 _ -> empty
1173 parseJSON _ = empty
1175instance FromJSON OAuth2Params where
1176 parseJSON = sopSwaggerGenericParseJSON
1178instance FromJSON SecuritySchemeType where
1179 parseJSON js@(Object o) = do
1180 (t :: Text) <- o .: "type"
1181 case t of
1182 "basic" -> pure SecuritySchemeBasic
1183 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1184 "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1185 _ -> empty
1186 parseJSON _ = empty
1188instance FromJSON Swagger where
1189 parseJSON = sopSwaggerGenericParseJSON
1191instance FromJSON SecurityScheme where
1192 parseJSON = sopSwaggerGenericParseJSON
1194instance FromJSON Schema where
1195 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1196 where nullaryCleanup :: Schema -> Schema
1197 nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1198 if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1199 then s { _schemaExample = Nothing
1200 , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1201 else s
1203instance FromJSON Header where
1204 parseJSON = sopSwaggerGenericParseJSON
1206instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1207 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1208 <$> o .:? "collectionFormat"
1209 <*> (o .: "items" >>= parseJSON)
1211instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1212 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1213 <$> o .:? "collectionFormat"
1214 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1216-- |
1218-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1219-- Just (SwaggerItemsArray [])
1221-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1222-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1224-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1225-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1227instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1228 parseJSON js@(Object obj)
1229 | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1230 | otherwise = SwaggerItemsObject <$> parseJSON js
1231 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1232 parseJSON _ = empty
1234instance FromJSON Host where
1235 parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1236 [host] -> return $ Host host Nothing
1237 [host, port] -> case readMaybe port of
1238 Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1239 Just p -> return $ Host host (Just (fromInteger p))
1240 _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1241 parseJSON _ = empty
1243instance FromJSON MimeList where
1244 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1246instance FromJSON Param where
1247 parseJSON = sopSwaggerGenericParseJSON
1249instance FromJSON ParamAnySchema where
1250 parseJSON js@(Object o) = do
1251 (i :: Text) <- o .: "in"
1252 case i of
1253 "body" -> do
1254 schema <- o .: "schema"
1255 ParamBody <$> parseJSON schema
1256 _ -> ParamOther <$> parseJSON js
1257 parseJSON _ = empty
1259instance FromJSON ParamOtherSchema where
1260 parseJSON = sopSwaggerGenericParseJSON
1262instance FromJSON Responses where
1263 parseJSON (Object o) = Responses
1264 <$> o .:? "default"
1265 <*> (parseJSON (Object (HashMap.delete "default" o)))
1266 parseJSON _ = empty
1268instance FromJSON Example where
1269 parseJSON js = do
1270 m <- parseJSON js
1271 pure $ Example (Map.mapKeys fromString m)
1273instance FromJSON Response where
1274 parseJSON = sopSwaggerGenericParseJSON
1276instance FromJSON Operation where
1277 parseJSON = sopSwaggerGenericParseJSON
1279instance FromJSON PathItem where
1280 parseJSON = sopSwaggerGenericParseJSON
1282instance FromJSON Reference where
1283 parseJSON (Object o) = Reference <$> o .: "$ref"
1284 parseJSON _ = empty
1286referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1287referencedParseJSON prefix js@(Object o) = do
1288 ms <- o .:? "$ref"
1289 case ms of
1290 Nothing -> Inline <$> parseJSON js
1291 Just s -> Ref <$> parseRef s
1292 where
1293 parseRef s = do
1294 case Text.stripPrefix prefix s of
1295 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1296 Just suffix -> pure (Reference suffix)
1297referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1299instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1300instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1301instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1303instance FromJSON Xml where
1304 parseJSON = genericParseJSON (jsonPrefix "xml")
1306instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1307 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1309instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1310 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1312instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1313 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1315instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1316 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1318-- NOTE: There aren't collections of 'Schema'
1319--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1320-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1322instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1323 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1325instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1326 parseJSON = sopSwaggerGenericParseJSON
1327instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1328 parseJSON = sopSwaggerGenericParseJSON
1329instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1330 parseJSON = sopSwaggerGenericParseJSON
1332instance FromJSON AdditionalProperties where
1333 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1334 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1336-------------------------------------------------------------------------------
1337-- TH splices
1338-------------------------------------------------------------------------------
1340deriveGeneric ''Header
1341deriveGeneric ''OAuth2Params
1342deriveGeneric ''Operation
1343deriveGeneric ''Param
1344deriveGeneric ''ParamOtherSchema
1345deriveGeneric ''PathItem
1346deriveGeneric ''Response
1347deriveGeneric ''Responses
1348deriveGeneric ''SecurityScheme
1349deriveGeneric ''Schema
1350deriveGeneric ''ParamSchema
1351deriveGeneric ''Swagger
1353instance HasSwaggerAesonOptions Header where
1354 swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1355instance HasSwaggerAesonOptions OAuth2Params where
1356 swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1357instance HasSwaggerAesonOptions Operation where
1358 swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1359instance HasSwaggerAesonOptions Param where
1360 swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1361instance HasSwaggerAesonOptions ParamOtherSchema where
1362 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1363instance HasSwaggerAesonOptions PathItem where
1364 swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1365instance HasSwaggerAesonOptions Response where
1366 swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1367instance HasSwaggerAesonOptions Responses where
1368 swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1369instance HasSwaggerAesonOptions SecurityScheme where
1370 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1371instance HasSwaggerAesonOptions Schema where
1372 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1373instance HasSwaggerAesonOptions Swagger where
1374 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1376instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1377 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1378instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1379 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1380-- NOTE: Schema doesn't have 'items' sub object!
1381instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1382 swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1384instance AesonDefaultValue (ParamSchema s)
1385instance AesonDefaultValue OAuth2Flow
1386instance AesonDefaultValue Responses
1387instance AesonDefaultValue ParamAnySchema
1388instance AesonDefaultValue SecuritySchemeType
1389instance AesonDefaultValue (SwaggerType a)
1390instance AesonDefaultValue MimeList where defaultValue = Just mempty
1391instance AesonDefaultValue Info
1392instance AesonDefaultValue ParamLocation