git.iko.soy/typeable/openapi3
on 29d2ec5 help sign in
typeable/openapi3/src/Data/Swagger/Internal.hs
1168 lines 45 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE DeriveTraversable #-}
5{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE GADTs #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE RecordWildCards #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE StandaloneDeriving #-}
13{-# LANGUAGE UndecidableInstances #-}
14#include "overlapping-compat.h"
15module Data.Swagger.Internal where
17import Prelude ()
18import Prelude.Compat
20import Control.Applicative
21import Control.Monad
22import Data.Aeson
23import qualified Data.Aeson.Types as JSON
24import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
25import Data.HashMap.Strict (HashMap)
26import qualified Data.HashMap.Strict as HashMap
27import Data.Map (Map)
28import qualified Data.Map as Map
29import Data.Monoid
30import Data.Scientific (Scientific)
31import Data.String (fromString)
32import Data.Text (Text)
33import qualified Data.Text as Text
34import GHC.Generics (Generic)
35import Network (HostName, PortNumber)
36import Network.HTTP.Media (MediaType)
37import Text.Read (readMaybe)
39import Data.Swagger.Internal.Utils
41-- | A list of definitions that can be used in references.
42type Definitions = HashMap Text
44-- | This is the root document object for the API specification.
45data Swagger = Swagger
46 { -- | Provides metadata about the API.
47 -- The metadata can be used by the clients if needed.
48 _swaggerInfo :: Info
50 -- | The host (name or ip) serving the API. It MAY include a port.
51 -- If the host is not included, the host serving the documentation is to be used (including the port).
52 , _swaggerHost :: Maybe Host
54 -- | The base path on which the API is served, which is relative to the host.
55 -- If it is not included, the API is served directly under the host.
56 -- The value MUST start with a leading slash (/).
57 , _swaggerBasePath :: Maybe FilePath
59 -- | The transfer protocol of the API.
60 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
61 , _swaggerSchemes :: Maybe [Scheme]
63 -- | A list of MIME types the APIs can consume.
64 -- This is global to all APIs but can be overridden on specific API calls.
65 , _swaggerConsumes :: MimeList
67 -- | A list of MIME types the APIs can produce.
68 -- This is global to all APIs but can be overridden on specific API calls.
69 , _swaggerProduces :: MimeList
71 -- | The available paths and operations for the API.
72 -- Holds the relative paths to the individual endpoints.
73 -- The path is appended to the @'basePath'@ in order to construct the full URL.
74 , _swaggerPaths :: HashMap FilePath PathItem
76 -- | An object to hold data types produced and consumed by operations.
77 , _swaggerDefinitions :: Definitions Schema
79 -- | An object to hold parameters that can be used across operations.
80 -- This property does not define global parameters for all operations.
81 , _swaggerParameters :: Definitions Param
83 -- | An object to hold responses that can be used across operations.
84 -- This property does not define global responses for all operations.
85 , _swaggerResponses :: Definitions Response
87 -- | Security scheme definitions that can be used across the specification.
88 , _swaggerSecurityDefinitions :: Definitions SecurityScheme
90 -- | A declaration of which security schemes are applied for the API as a whole.
91 -- The list of values describes alternative security schemes that can be used
92 -- (that is, there is a logical OR between the security requirements).
93 -- Individual operations can override this definition.
94 , _swaggerSecurity :: [SecurityRequirement]
96 -- | A list of tags used by the specification with additional metadata.
97 -- The order of the tags can be used to reflect on their order by the parsing tools.
98 -- Not all tags that are used by the Operation Object must be declared.
99 -- The tags that are not declared may be organized randomly or based on the tools' logic.
100 -- Each tag name in the list MUST be unique.
101 , _swaggerTags :: [Tag]
103 -- | Additional external documentation.
104 , _swaggerExternalDocs :: Maybe ExternalDocs
105 } deriving (Eq, Show, Generic, Data, Typeable)
107-- | The object provides metadata about the API.
108-- The metadata can be used by the clients if needed,
109-- and can be presented in the Swagger-UI for convenience.
110data Info = Info
111 { -- | The title of the application.
112 _infoTitle :: Text
114 -- | A short description of the application.
115 -- GFM syntax can be used for rich text representation.
116 , _infoDescription :: Maybe Text
118 -- | The Terms of Service for the API.
119 , _infoTermsOfService :: Maybe Text
121 -- | The contact information for the exposed API.
122 , _infoContact :: Maybe Contact
124 -- | The license information for the exposed API.
125 , _infoLicense :: Maybe License
127 -- | Provides the version of the application API
128 -- (not to be confused with the specification version).
129 , _infoVersion :: Text
130 } deriving (Eq, Show, Generic, Data, Typeable)
132-- | Contact information for the exposed API.
133data Contact = Contact
134 { -- | The identifying name of the contact person/organization.
135 _contactName :: Maybe Text
137 -- | The URL pointing to the contact information.
138 , _contactUrl :: Maybe URL
140 -- | The email address of the contact person/organization.
141 , _contactEmail :: Maybe Text
142 } deriving (Eq, Show, Generic, Data, Typeable)
144-- | License information for the exposed API.
145data License = License
146 { -- | The license name used for the API.
147 _licenseName :: Text
149 -- | A URL to the license used for the API.
150 , _licenseUrl :: Maybe URL
151 } deriving (Eq, Show, Generic, Data, Typeable)
153-- | The host (name or ip) serving the API. It MAY include a port.
154data Host = Host
155 { _hostName :: HostName -- ^ Host name.
156 , _hostPort :: Maybe PortNumber -- ^ Optional port.
157 } deriving (Eq, Show, Generic, Typeable)
159hostConstr :: Constr
160hostConstr = mkConstr hostDataType "Host" [] Prefix
162hostDataType :: DataType
163hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
165instance Data Host where
166 gunfold k z c = case constrIndex c of
167 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
168 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
169 toConstr (Host _ _) = hostConstr
170 dataTypeOf _ = hostDataType
172-- | The transfer protocol of the API.
173data Scheme
174 = Http
175 | Https
176 | Ws
177 | Wss
178 deriving (Eq, Show, Generic, Data, Typeable)
180-- | Describes the operations available on a single path.
181-- A @'PathItem'@ may be empty, due to ACL constraints.
182-- The path itself is still exposed to the documentation viewer
183-- but they will not know which operations and parameters are available.
184data PathItem = PathItem
185 { -- | A definition of a GET operation on this path.
186 _pathItemGet :: Maybe Operation
188 -- | A definition of a PUT operation on this path.
189 , _pathItemPut :: Maybe Operation
191 -- | A definition of a POST operation on this path.
192 , _pathItemPost :: Maybe Operation
194 -- | A definition of a DELETE operation on this path.
195 , _pathItemDelete :: Maybe Operation
197 -- | A definition of a OPTIONS operation on this path.
198 , _pathItemOptions :: Maybe Operation
200 -- | A definition of a HEAD operation on this path.
201 , _pathItemHead :: Maybe Operation
203 -- | A definition of a PATCH operation on this path.
204 , _pathItemPatch :: Maybe Operation
206 -- | A list of parameters that are applicable for all the operations described under this path.
207 -- These parameters can be overridden at the operation level, but cannot be removed there.
208 -- The list MUST NOT include duplicated parameters.
209 -- A unique parameter is defined by a combination of a name and location.
210 , _pathItemParameters :: [Referenced Param]
211 } deriving (Eq, Show, Generic, Data, Typeable)
213-- | Describes a single API operation on a path.
214data Operation = Operation
215 { -- | A list of tags for API documentation control.
216 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
217 _operationTags :: [TagName]
219 -- | A short summary of what the operation does.
220 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
221 , _operationSummary :: Maybe Text
223 -- | A verbose explanation of the operation behavior.
224 -- GFM syntax can be used for rich text representation.
225 , _operationDescription :: Maybe Text
227 -- | Additional external documentation for this operation.
228 , _operationExternalDocs :: Maybe ExternalDocs
230 -- | Unique string used to identify the operation.
231 -- The id MUST be unique among all operations described in the API.
232 -- Tools and libraries MAY use the it to uniquely identify an operation,
233 -- therefore, it is recommended to follow common programming naming conventions.
234 , _operationOperationId :: Maybe Text
236 -- | A list of MIME types the operation can consume.
237 -- This overrides the @'consumes'@.
238 -- @Just []@ MAY be used to clear the global definition.
239 , _operationConsumes :: Maybe MimeList
241 -- | A list of MIME types the operation can produce.
242 -- This overrides the @'produces'@.
243 -- @Just []@ MAY be used to clear the global definition.
244 , _operationProduces :: Maybe MimeList
246 -- | A list of parameters that are applicable for this operation.
247 -- If a parameter is already defined at the @'PathItem'@,
248 -- the new definition will override it, but can never remove it.
249 -- The list MUST NOT include duplicated parameters.
250 -- A unique parameter is defined by a combination of a name and location.
251 , _operationParameters :: [Referenced Param]
253 -- | The list of possible responses as they are returned from executing this operation.
254 , _operationResponses :: Responses
256 -- | The transfer protocol for the operation.
257 -- The value overrides @'schemes'@.
258 , _operationSchemes :: Maybe [Scheme]
260 -- | Declares this operation to be deprecated.
261 -- Usage of the declared operation should be refrained.
262 -- Default value is @False@.
263 , _operationDeprecated :: Maybe Bool
265 -- | A declaration of which security schemes are applied for this operation.
266 -- The list of values describes alternative security schemes that can be used
267 -- (that is, there is a logical OR between the security requirements).
268 -- This definition overrides any declared top-level security.
269 -- To remove a top-level security declaration, @Just []@ can be used.
270 , _operationSecurity :: [SecurityRequirement]
271 } deriving (Eq, Show, Generic, Data, Typeable)
273newtype MimeList = MimeList { getMimeList :: [MediaType] }
274 deriving (Eq, Show, Monoid, Typeable)
276mimeListConstr :: Constr
277mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
279mimeListDataType :: DataType
280mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
282instance Data MimeList where
283 gunfold k z c = case constrIndex c of
284 1 -> k (z (\xs -> MimeList (map fromString xs)))
285 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
286 toConstr (MimeList _) = mimeListConstr
287 dataTypeOf _ = mimeListDataType
289-- | Describes a single operation parameter.
290-- A unique parameter is defined by a combination of a name and location.
291data Param = Param
292 { -- | The name of the parameter.
293 -- Parameter names are case sensitive.
294 _paramName :: Text
296 -- | A brief description of the parameter.
297 -- This could contain examples of use.
298 -- GFM syntax can be used for rich text representation.
299 , _paramDescription :: Maybe Text
301 -- | Determines whether this parameter is mandatory.
302 -- If the parameter is in "path", this property is required and its value MUST be true.
303 -- Otherwise, the property MAY be included and its default value is @False@.
304 , _paramRequired :: Maybe Bool
306 -- | Parameter schema.
307 , _paramSchema :: ParamAnySchema
308 } deriving (Eq, Show, Generic, Data, Typeable)
310data ParamAnySchema
311 = ParamBody (Referenced Schema)
312 | ParamOther ParamOtherSchema
313 deriving (Eq, Show, Generic, Data, Typeable)
315data ParamOtherSchema = ParamOtherSchema
316 { -- | The location of the parameter.
317 _paramOtherSchemaIn :: ParamLocation
319 -- | Sets the ability to pass empty-valued parameters.
320 -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
321 -- and allows you to send a parameter with a name only or an empty value.
322 -- Default value is @False@.
323 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
325 , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
326 } deriving (Eq, Show, Generic, Data, Typeable)
328-- | Items for @'SwaggerArray'@ schemas.
329--
330-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
331-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
332-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
333-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
334--
335-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
336--
337-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
338data SwaggerItems t where
339 SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
340 SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
341 SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
342 deriving (Typeable)
344deriving instance Eq (SwaggerItems t)
345deriving instance Show (SwaggerItems t)
346--deriving instance Typeable (SwaggerItems t)
348swaggerItemsPrimitiveConstr :: Constr
349swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
351swaggerItemsDataType :: DataType
352swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
354instance OVERLAPPABLE_ Data t => Data (SwaggerItems t) where
355 gunfold k z c = case constrIndex c of
356 1 -> k (k (z SwaggerItemsPrimitive))
357 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
358 toConstr _ = swaggerItemsPrimitiveConstr
359 dataTypeOf _ = swaggerItemsDataType
361deriving instance Data (SwaggerItems Schema)
363data SwaggerType t where
364 SwaggerString :: SwaggerType t
365 SwaggerNumber :: SwaggerType t
366 SwaggerInteger :: SwaggerType t
367 SwaggerBoolean :: SwaggerType t
368 SwaggerArray :: SwaggerType t
369 SwaggerFile :: SwaggerType ParamOtherSchema
370 SwaggerNull :: SwaggerType Schema
371 SwaggerObject :: SwaggerType Schema
372 deriving (Typeable)
374deriving instance Eq (SwaggerType t)
375deriving instance Show (SwaggerType t)
377swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
378swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
380swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
381swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
383swaggerCommonTypes :: [SwaggerType t]
384swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
386swaggerParamTypes :: [SwaggerType ParamOtherSchema]
387swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
389swaggerSchemaTypes :: [SwaggerType Schema]
390swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
392swaggerTypeConstrs :: [Constr]
393swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
394 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
396instance OVERLAPPABLE_ Typeable t => Data (SwaggerType t) where
397 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
398 toConstr = swaggerTypeConstr
399 dataTypeOf = swaggerTypeDataType
401instance OVERLAPPABLE_ Data (SwaggerType ParamOtherSchema) where
402 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
403 toConstr = swaggerTypeConstr
404 dataTypeOf = swaggerTypeDataType
406instance OVERLAPPABLE_ Data (SwaggerType Schema) where
407 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
408 toConstr = swaggerTypeConstr
409 dataTypeOf = swaggerTypeDataType
411data ParamLocation
412 = -- | Parameters that are appended to the URL.
413 -- For example, in @/items?id=###@, the query parameter is @id@.
414 ParamQuery
415 -- | Custom headers that are expected as part of the request.
416 | ParamHeader
417 -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
418 -- This does not include the host or base path of the API.
419 -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
420 | ParamPath
421 -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
422 -- or @multipart/form-data@ are used as the content type of the request
423 -- (in Swagger's definition, the @consumes@ property of an operation).
424 -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
425 -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
426 -- Form parameters have a different format based on the content-type used
427 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
428 | ParamFormData
429 deriving (Eq, Show, Generic, Data, Typeable)
431type Format = Text
433-- | Determines the format of the array.
434data CollectionFormat t where
435 -- Comma separated values: @foo,bar@.
436 CollectionCSV :: CollectionFormat t
437 -- Space separated values: @foo bar@.
438 CollectionSSV :: CollectionFormat t
439 -- Tab separated values: @foo\\tbar@.
440 CollectionTSV :: CollectionFormat t
441 -- Pipe separated values: @foo|bar@.
442 CollectionPipes :: CollectionFormat t
443 -- Corresponds to multiple parameter instances
444 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
445 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
446 CollectionMulti :: CollectionFormat ParamOtherSchema
447 deriving (Typeable)
449deriving instance Eq (CollectionFormat t)
450deriving instance Show (CollectionFormat t)
452collectionFormatConstr :: CollectionFormat t -> Constr
453collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
455collectionFormatDataType :: DataType
456collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
457 map collectionFormatConstr collectionCommonFormats
459collectionCommonFormats :: [CollectionFormat t]
460collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
462instance OVERLAPPABLE_ Data t => Data (CollectionFormat t) where
463 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
464 toConstr = collectionFormatConstr
465 dataTypeOf _ = collectionFormatDataType
467deriving instance OVERLAPPABLE_ Data (CollectionFormat ParamOtherSchema)
469type ParamName = Text
471data Schema = Schema
472 { _schemaTitle :: Maybe Text
473 , _schemaDescription :: Maybe Text
474 , _schemaRequired :: [ParamName]
476 , _schemaAllOf :: Maybe [Schema]
477 , _schemaProperties :: HashMap Text (Referenced Schema)
478 , _schemaAdditionalProperties :: Maybe Schema
480 , _schemaDiscriminator :: Maybe Text
481 , _schemaReadOnly :: Maybe Bool
482 , _schemaXml :: Maybe Xml
483 , _schemaExternalDocs :: Maybe ExternalDocs
484 , _schemaExample :: Maybe Value
486 , _schemaMaxProperties :: Maybe Integer
487 , _schemaMinProperties :: Maybe Integer
489 , _schemaParamSchema :: ParamSchema Schema
490 } deriving (Eq, Show, Generic, Data, Typeable)
492-- | A @'Schema'@ with an optional name.
493-- This name can be used in references.
494data NamedSchema = NamedSchema
495 { _namedSchemaName :: Maybe Text
496 , _namedSchemaSchema :: Schema
497 } deriving (Eq, Show, Generic, Data, Typeable)
499data ParamSchema t = ParamSchema
500 { -- | Declares the value of the parameter that the server will use if none is provided,
501 -- for example a @"count"@ to control the number of results per page might default to @100@
502 -- if not supplied by the client in the request.
503 -- (Note: "default" has no meaning for required parameters.)
504 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
505 _paramSchemaDefault :: Maybe Value
507 , _paramSchemaType :: SwaggerType t
508 , _paramSchemaFormat :: Maybe Format
509 , _paramSchemaItems :: Maybe (SwaggerItems t)
510 , _paramSchemaMaximum :: Maybe Scientific
511 , _paramSchemaExclusiveMaximum :: Maybe Bool
512 , _paramSchemaMinimum :: Maybe Scientific
513 , _paramSchemaExclusiveMinimum :: Maybe Bool
514 , _paramSchemaMaxLength :: Maybe Integer
515 , _paramSchemaMinLength :: Maybe Integer
516 , _paramSchemaPattern :: Maybe Text
517 , _paramSchemaMaxItems :: Maybe Integer
518 , _paramSchemaMinItems :: Maybe Integer
519 , _paramSchemaUniqueItems :: Maybe Bool
520 , _paramSchemaEnum :: Maybe [Value]
521 , _paramSchemaMultipleOf :: Maybe Scientific
522 } deriving (Eq, Show, Generic, Typeable)
524deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data (ParamSchema t)
526data Xml = Xml
527 { -- | Replaces the name of the element/attribute used for the described schema property.
528 -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
529 -- When defined alongside type being array (outside the items),
530 -- it will affect the wrapping element and only if wrapped is true.
531 -- If wrapped is false, it will be ignored.
532 _xmlName :: Maybe Text
534 -- | The URL of the namespace definition.
535 -- Value SHOULD be in the form of a URL.
536 , _xmlNamespace :: Maybe Text
538 -- | The prefix to be used for the name.
539 , _xmlPrefix :: Maybe Text
541 -- | Declares whether the property definition translates to an attribute instead of an element.
542 -- Default value is @False@.
543 , _xmlAttribute :: Maybe Bool
545 -- | MAY be used only for an array definition.
546 -- Signifies whether the array is wrapped
547 -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
548 -- or unwrapped (@\<book/\>\<book/\>@).
549 -- Default value is @False@.
550 -- The definition takes effect only when defined alongside type being array (outside the items).
551 , _xmlWrapped :: Maybe Bool
552 } deriving (Eq, Show, Generic, Data, Typeable)
554-- | A container for the expected responses of an operation.
555-- The container maps a HTTP response code to the expected response.
556-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
557-- since they may not be known in advance.
558-- However, it is expected from the documentation to cover a successful operation response and any known errors.
559data Responses = Responses
560 { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
561 -- It can be used to cover undeclared responses.
562 _responsesDefault :: Maybe (Referenced Response)
564 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
565 -- Describes the expected response for those HTTP status codes.
566 , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
567 } deriving (Eq, Show, Generic, Data, Typeable)
569type HttpStatusCode = Int
571-- | Describes a single response from an API Operation.
572data Response = Response
573 { -- | A short description of the response.
574 -- GFM syntax can be used for rich text representation.
575 _responseDescription :: Text
577 -- | A definition of the response structure.
578 -- It can be a primitive, an array or an object.
579 -- If this field does not exist, it means no content is returned as part of the response.
580 -- As an extension to the Schema Object, its root type value may also be "file".
581 -- This SHOULD be accompanied by a relevant produces mime-type.
582 , _responseSchema :: Maybe (Referenced Schema)
584 -- | A list of headers that are sent with the response.
585 , _responseHeaders :: HashMap HeaderName Header
587 -- | An example of the response message.
588 , _responseExamples :: Maybe Example
589 } deriving (Eq, Show, Generic, Data, Typeable)
591type HeaderName = Text
593data Header = Header
594 { -- | A short description of the header.
595 _headerDescription :: Maybe Text
597 , _headerParamSchema :: ParamSchema Header
598 } deriving (Eq, Show, Generic, Data, Typeable)
600data Example = Example { getExample :: Map MediaType Value }
601 deriving (Eq, Show, Generic, Typeable)
603exampleConstr :: Constr
604exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
606exampleDataType :: DataType
607exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
609instance Data Example where
610 gunfold k z c = case constrIndex c of
611 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
612 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
613 toConstr (Example _) = exampleConstr
614 dataTypeOf _ = exampleDataType
616-- | The location of the API key.
617data ApiKeyLocation
618 = ApiKeyQuery
619 | ApiKeyHeader
620 deriving (Eq, Show, Generic, Data, Typeable)
622data ApiKeyParams = ApiKeyParams
623 { -- | The name of the header or query parameter to be used.
624 _apiKeyName :: Text
626 -- | The location of the API key.
627 , _apiKeyIn :: ApiKeyLocation
628 } deriving (Eq, Show, Generic, Data, Typeable)
630-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
631type AuthorizationURL = Text
633-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
634type TokenURL = Text
636data OAuth2Flow
637 = OAuth2Implicit AuthorizationURL
638 | OAuth2Password TokenURL
639 | OAuth2Application TokenURL
640 | OAuth2AccessCode AuthorizationURL TokenURL
641 deriving (Eq, Show, Generic, Data, Typeable)
643data OAuth2Params = OAuth2Params
644 { -- | The flow used by the OAuth2 security scheme.
645 _oauth2Flow :: OAuth2Flow
647 -- | The available scopes for the OAuth2 security scheme.
648 , _oauth2Scopes :: HashMap Text Text
649 } deriving (Eq, Show, Generic, Data, Typeable)
651data SecuritySchemeType
652 = SecuritySchemeBasic
653 | SecuritySchemeApiKey ApiKeyParams
654 | SecuritySchemeOAuth2 OAuth2Params
655 deriving (Eq, Show, Generic, Data, Typeable)
657data SecurityScheme = SecurityScheme
658 { -- | The type of the security scheme.
659 _securitySchemeType :: SecuritySchemeType
661 -- | A short description for security scheme.
662 , _securitySchemeDescription :: Maybe Text
663 } deriving (Eq, Show, Generic, Data, Typeable)
665-- | Lists the required security schemes to execute this operation.
666-- The object can have multiple security schemes declared in it which are all required
667-- (that is, there is a logical AND between the schemes).
668newtype SecurityRequirement = SecurityRequirement
669 { getSecurityRequirement :: HashMap Text [Text]
670 } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
672-- | Tag name.
673type TagName = Text
675-- | Allows adding meta data to a single tag that is used by @Operation@.
676-- It is not mandatory to have a @Tag@ per tag used there.
677data Tag = Tag
678 { -- | The name of the tag.
679 _tagName :: TagName
681 -- | A short description for the tag.
682 -- GFM syntax can be used for rich text representation.
683 , _tagDescription :: Maybe Text
685 -- | Additional external documentation for this tag.
686 , _tagExternalDocs :: Maybe ExternalDocs
687 } deriving (Eq, Show, Generic, Data, Typeable)
689-- | Allows referencing an external resource for extended documentation.
690data ExternalDocs = ExternalDocs
691 { -- | A short description of the target documentation.
692 -- GFM syntax can be used for rich text representation.
693 _externalDocsDescription :: Maybe Text
695 -- | The URL for the target documentation.
696 , _externalDocsUrl :: URL
697 } deriving (Eq, Show, Generic, Data, Typeable)
699-- | A simple object to allow referencing other definitions in the specification.
700-- It can be used to reference parameters and responses that are defined at the top level for reuse.
701newtype Reference = Reference { getReference :: Text }
702 deriving (Eq, Show, Data, Typeable)
704data Referenced a
705 = Ref Reference
706 | Inline a
707 deriving (Eq, Show, Data, Typeable)
709newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)
711-- =======================================================================
712-- Monoid instances
713-- =======================================================================
715instance Monoid Swagger where
716 mempty = genericMempty
717 mappend = genericMappend
719instance Monoid Info where
720 mempty = genericMempty
721 mappend = genericMappend
723instance Monoid Contact where
724 mempty = genericMempty
725 mappend = genericMappend
727instance Monoid PathItem where
728 mempty = genericMempty
729 mappend = genericMappend
731instance Monoid Schema where
732 mempty = genericMempty
733 mappend = genericMappend
735instance Monoid (ParamSchema t) where
736 mempty = genericMempty
737 mappend = genericMappend
739instance Monoid Param where
740 mempty = genericMempty
741 mappend = genericMappend
743instance Monoid ParamOtherSchema where
744 mempty = genericMempty
745 mappend = genericMappend
747instance Monoid Header where
748 mempty = genericMempty
749 mappend = genericMappend
751instance Monoid Responses where
752 mempty = genericMempty
753 mappend = genericMappend
755instance Monoid Response where
756 mempty = genericMempty
757 mappend = genericMappend
759instance Monoid ExternalDocs where
760 mempty = genericMempty
761 mappend = genericMappend
763instance Monoid Operation where
764 mempty = genericMempty
765 mappend = genericMappend
767instance Monoid Example where
768 mempty = genericMempty
769 mappend = genericMappend
771-- =======================================================================
772-- SwaggerMonoid helper instances
773-- =======================================================================
775instance SwaggerMonoid Info
776instance SwaggerMonoid PathItem
777instance SwaggerMonoid Schema
778instance SwaggerMonoid (ParamSchema t)
779instance SwaggerMonoid Param
780instance SwaggerMonoid ParamOtherSchema
781instance SwaggerMonoid Responses
782instance SwaggerMonoid Response
783instance SwaggerMonoid ExternalDocs
784instance SwaggerMonoid Operation
786instance SwaggerMonoid MimeList
787deriving instance SwaggerMonoid URL
789instance SwaggerMonoid (SwaggerType t) where
790 swaggerMempty = SwaggerString
791 swaggerMappend _ y = y
793instance SwaggerMonoid ParamLocation where
794 swaggerMempty = ParamQuery
795 swaggerMappend _ y = y
797instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where
798 swaggerMempty = HashMap.empty
799 swaggerMappend = HashMap.unionWith mappend
801instance Monoid a => SwaggerMonoid (Referenced a) where
802 swaggerMempty = Inline mempty
803 swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
804 swaggerMappend _ y = y
806instance SwaggerMonoid ParamAnySchema where
807 swaggerMempty = ParamOther swaggerMempty
808 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
809 swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
810 swaggerMappend _ y = y
812-- =======================================================================
813-- Simple Generic-based ToJSON instances
814-- =======================================================================
816instance ToJSON ParamLocation where
817 toJSON = genericToJSON (jsonPrefix "Param")
819instance ToJSON Info where
820 toJSON = genericToJSON (jsonPrefix "Info")
822instance ToJSON Contact where
823 toJSON = genericToJSON (jsonPrefix "Contact")
825instance ToJSON License where
826 toJSON = genericToJSON (jsonPrefix "License")
828instance ToJSON ApiKeyLocation where
829 toJSON = genericToJSON (jsonPrefix "ApiKey")
831instance ToJSON ApiKeyParams where
832 toJSON = genericToJSON (jsonPrefix "apiKey")
834instance ToJSON Scheme where
835 toJSON = genericToJSON (jsonPrefix "")
837instance ToJSON Tag where
838 toJSON = genericToJSON (jsonPrefix "Tag")
840instance ToJSON ExternalDocs where
841 toJSON = genericToJSON (jsonPrefix "ExternalDocs")
843instance ToJSON Xml where
844 toJSON = genericToJSON (jsonPrefix "Xml")
846-- =======================================================================
847-- Simple Generic-based FromJSON instances
848-- =======================================================================
850instance FromJSON ParamLocation where
851 parseJSON = genericParseJSON (jsonPrefix "Param")
853instance FromJSON Info where
854 parseJSON = genericParseJSON (jsonPrefix "Info")
856instance FromJSON Contact where
857 parseJSON = genericParseJSON (jsonPrefix "Contact")
859instance FromJSON License where
860 parseJSON = genericParseJSON (jsonPrefix "License")
862instance FromJSON ApiKeyLocation where
863 parseJSON = genericParseJSON (jsonPrefix "ApiKey")
865instance FromJSON ApiKeyParams where
866 parseJSON = genericParseJSON (jsonPrefix "apiKey")
868instance FromJSON Scheme where
869 parseJSON = genericParseJSON (jsonPrefix "")
871instance FromJSON Tag where
872 parseJSON = genericParseJSON (jsonPrefix "Tag")
874instance FromJSON ExternalDocs where
875 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
877-- =======================================================================
878-- Manual ToJSON instances
879-- =======================================================================
881instance ToJSON OAuth2Flow where
882 toJSON (OAuth2Implicit authUrl) = object
883 [ "flow" .= ("implicit" :: Text)
884 , "authorizationUrl" .= authUrl ]
885 toJSON (OAuth2Password tokenUrl) = object
886 [ "flow" .= ("password" :: Text)
887 , "tokenUrl" .= tokenUrl ]
888 toJSON (OAuth2Application tokenUrl) = object
889 [ "flow" .= ("application" :: Text)
890 , "tokenUrl" .= tokenUrl ]
891 toJSON (OAuth2AccessCode authUrl tokenUrl) = object
892 [ "flow" .= ("accessCode" :: Text)
893 , "authorizationUrl" .= authUrl
894 , "tokenUrl" .= tokenUrl ]
896instance ToJSON OAuth2Params where
897 toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
899instance ToJSON SecuritySchemeType where
900 toJSON SecuritySchemeBasic
901 = object [ "type" .= ("basic" :: Text) ]
902 toJSON (SecuritySchemeApiKey params)
903 = toJSON params
904 <+> object [ "type" .= ("apiKey" :: Text) ]
905 toJSON (SecuritySchemeOAuth2 params)
906 = toJSON params
907 <+> object [ "type" .= ("oauth2" :: Text) ]
909instance ToJSON Swagger where
910 toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")
911 where
912 addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
913 addVersion _ = error "impossible"
915instance ToJSON SecurityScheme where
916 toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
918instance ToJSON Schema where
919 toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
920 where
921 f "items" (Array _) = True
922 f _ _ = False
924instance ToJSON Header where
925 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
927instance ToJSON (SwaggerItems t) where
928 toJSON (SwaggerItemsPrimitive fmt schema) = object
929 [ "collectionFormat" .= fmt
930 , "items" .= schema ]
931 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
932 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
934instance ToJSON Host where
935 toJSON (Host host mport) = toJSON $
936 case mport of
937 Nothing -> host
938 Just port -> host ++ ":" ++ show port
940instance ToJSON MimeList where
941 toJSON (MimeList xs) = toJSON (map show xs)
943instance ToJSON Param where
944 toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
946instance ToJSON ParamAnySchema where
947 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
948 toJSON (ParamOther s) = toJSON s
950instance ToJSON ParamOtherSchema where
951 toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
953instance ToJSON Responses where
954 toJSON (Responses def rs) = omitEmpties $
955 toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
957instance ToJSON Response where
958 toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
960instance ToJSON Operation where
961 toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
963instance ToJSON PathItem where
964 toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
966instance ToJSON Example where
967 toJSON = toJSON . Map.mapKeys show . getExample
969instance ToJSON Reference where
970 toJSON (Reference ref) = object [ "$ref" .= ref ]
972referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
973referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
974referencedToJSON _ (Inline x) = toJSON x
976instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
977instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
978instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
980instance ToJSON (SwaggerType t) where
981 toJSON SwaggerArray = "array"
982 toJSON SwaggerString = "string"
983 toJSON SwaggerInteger = "integer"
984 toJSON SwaggerNumber = "number"
985 toJSON SwaggerBoolean = "boolean"
986 toJSON SwaggerFile = "file"
987 toJSON SwaggerNull = "null"
988 toJSON SwaggerObject = "object"
990instance ToJSON (CollectionFormat t) where
991 toJSON CollectionCSV = "csv"
992 toJSON CollectionSSV = "ssv"
993 toJSON CollectionTSV = "tsv"
994 toJSON CollectionPipes = "pipes"
995 toJSON CollectionMulti = "multi"
997instance ToJSON (ParamSchema t) where
998 toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")
999 where
1000 f "items" (Array _) = True
1001 f _ _ = False
1003-- =======================================================================
1004-- Manual FromJSON instances
1005-- =======================================================================
1007instance FromJSON OAuth2Flow where
1008 parseJSON (Object o) = do
1009 (flow :: Text) <- o .: "flow"
1010 case flow of
1011 "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1012 "password" -> OAuth2Password <$> o .: "tokenUrl"
1013 "application" -> OAuth2Application <$> o .: "tokenUrl"
1014 "accessCode" -> OAuth2AccessCode
1015 <$> o .: "authorizationUrl"
1016 <*> o .: "tokenUrl"
1017 _ -> empty
1018 parseJSON _ = empty
1020instance FromJSON OAuth2Params where
1021 parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1023instance FromJSON SecuritySchemeType where
1024 parseJSON js@(Object o) = do
1025 (t :: Text) <- o .: "type"
1026 case t of
1027 "basic" -> pure SecuritySchemeBasic
1028 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1029 "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1030 _ -> empty
1031 parseJSON _ = empty
1033instance FromJSON Swagger where
1034 parseJSON js@(Object o) = do
1035 (version :: Text) <- o .: "swagger"
1036 when (version /= "2.0") empty
1037 (genericParseJSON (jsonPrefix "swagger")
1038 `withDefaults` [ "consumes" .= (mempty :: MimeList)
1039 , "produces" .= (mempty :: MimeList)
1040 , "security" .= ([] :: [SecurityRequirement])
1041 , "tags" .= ([] :: [Tag])
1042 , "definitions" .= (mempty :: Definitions Schema)
1043 , "parameters" .= (mempty :: Definitions Param)
1044 , "responses" .= (mempty :: Definitions Response)
1045 , "securityDefinitions" .= (mempty :: Definitions SecurityScheme)
1046 ] ) js
1047 parseJSON _ = empty
1049instance FromJSON SecurityScheme where
1050 parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1052instance FromJSON Schema where
1053 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1054 `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1055 , "required" .= ([] :: [ParamName]) ]
1057instance FromJSON Header where
1058 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
1060instance OVERLAPPABLE_ (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1061 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1062 <$> o .:? "collectionFormat"
1063 <*> (o .: "items" >>= parseJSON)
1065instance OVERLAPPABLE_ FromJSON (SwaggerItems Schema) where
1066 parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1067 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1068 parseJSON _ = empty
1070instance FromJSON Host where
1071 parseJSON (String s) =
1072 case fromInteger <$> readMaybe portStr of
1073 Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1074 mport -> pure $ Host host mport
1075 where
1076 (hostText, portText) = Text.breakOn ":" s
1077 [host, portStr] = map Text.unpack [hostText, portText]
1078 parseJSON _ = empty
1080instance FromJSON MimeList where
1081 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1083instance FromJSON Param where
1084 parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1086instance FromJSON ParamAnySchema where
1087 parseJSON js@(Object o) = do
1088 (i :: Text) <- o .: "in"
1089 case i of
1090 "body" -> do
1091 schema <- o .: "schema"
1092 ParamBody <$> parseJSON schema
1093 _ -> ParamOther <$> parseJSON js
1094 parseJSON _ = empty
1096instance FromJSON ParamOtherSchema where
1097 parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1099instance FromJSON Responses where
1100 parseJSON (Object o) = Responses
1101 <$> o .:? "default"
1102 <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1103 parseJSON _ = empty
1105instance FromJSON Example where
1106 parseJSON js = do
1107 m <- parseJSON js
1108 pure $ Example (Map.mapKeys fromString m)
1110instance FromJSON Response where
1111 parseJSON = genericParseJSON (jsonPrefix "response")
1112 `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
1114instance FromJSON Operation where
1115 parseJSON = genericParseJSON (jsonPrefix "operation")
1116 `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
1118instance FromJSON PathItem where
1119 parseJSON = genericParseJSON (jsonPrefix "pathItem")
1120 `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1122instance FromJSON Reference where
1123 parseJSON (Object o) = Reference <$> o .: "$ref"
1124 parseJSON _ = empty
1126referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1127referencedParseJSON prefix js@(Object o) = do
1128 ms <- o .:? "$ref"
1129 case ms of
1130 Nothing -> Inline <$> parseJSON js
1131 Just s -> Ref <$> parseRef s
1132 where
1133 parseRef s = do
1134 case Text.stripPrefix prefix s of
1135 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1136 Just suffix -> pure (Reference suffix)
1137referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1139instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1140instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1141instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1143instance FromJSON Xml where
1144 parseJSON = genericParseJSON (jsonPrefix "xml")
1146instance FromJSON (SwaggerType Schema) where
1147 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1149instance FromJSON (SwaggerType ParamOtherSchema) where
1150 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1152instance OVERLAPPABLE_ FromJSON (SwaggerType t) where
1153 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1155instance OVERLAPPABLE_ FromJSON (CollectionFormat t) where
1156 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1158instance FromJSON (CollectionFormat ParamOtherSchema) where
1159 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1161-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1162-- @FromJSON (SwaggerItems t)@ are necessary here!
1163-- Without the constraint the general instance will be used
1164-- that only accepts common types (i.e. NOT object, null or file)
1165-- and primitive array items.
1166instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1167 parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")