@@ -1,7 +1,4 @@
2−{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
6{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE DeriveTraversable #-}
7{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
@@ -12,128 +9,89 @@
12{-# LANGUAGE RecordWildCards #-}
9{-# LANGUAGE RecordWildCards #-}
13{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE StandaloneDeriving #-}
11{-# LANGUAGE StandaloneDeriving #-}
15−{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
17{-# LANGUAGE UndecidableInstances #-}
12{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
21−#include "overlapping-compat.h"
22module Data.Swagger.Internal where
13module Data.Swagger.Internal where
27−import Control.Lens ((&), (.~), (?~))
28import Control.Applicative
15import Control.Applicative
29import Data.Aeson
17import Data.Aeson
30import qualified Data.Aeson.Types as JSON
18import qualified Data.Aeson.Types as JSON
31import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
19import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32−import Data.Hashable (Hashable)
20+import Data.HashMap.Strict (HashMap)
33import qualified Data.HashMap.Strict as HashMap
21import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
35import Data.Map (Map)
22import Data.Map (Map)
36import qualified Data.Map as Map
23import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
24+import Data.Monoid
38−import Data.Semigroup.Compat (Semigroup (..))
39import Data.Scientific (Scientific)
25import Data.Scientific (Scientific)
40−import Data.String (IsString(..))
26+import Data.String (fromString)
41import Data.Text (Text)
27import Data.Text (Text)
42import qualified Data.Text as Text
28import qualified Data.Text as Text
43import GHC.Generics (Generic)
29import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
30+import Network (HostName, PortNumber)
45import Network.HTTP.Media (MediaType)
31import Network.HTTP.Media (MediaType)
46import Text.Read (readMaybe)
32import Text.Read (readMaybe)
48−import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51−import Generics.SOP.TH (deriveGeneric)
52−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53− ,sopSwaggerGenericToJSONWithOpts
54− ,sopSwaggerGenericParseJSON
55− ,HasSwaggerAesonOptions(..)
56− ,AesonDefaultValue(..)
57− ,mkSwaggerAesonOptions
60import Data.Swagger.Internal.Utils
34import Data.Swagger.Internal.Utils
62−#if MIN_VERSION_aeson(0,10,0)
63−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64−#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
66−#define DEFINE_TOENCODING
70−-- >>> :seti -XDataKinds
71−-- >>> import Data.Aeson
73−-- | A list of definitions that can be used in references.
74−type Definitions = InsOrdHashMap Text
76-- | This is the root document object for the API specification.
36-- | This is the root document object for the API specification.
77data Swagger = Swagger
37data Swagger = Swagger
78 { -- | Provides metadata about the API.
38 { -- | Provides metadata about the API.
79 -- The metadata can be used by the clients if needed.
39 -- The metadata can be used by the clients if needed.
80− _swaggerInfo :: Info
40+ _info :: Info
82 -- | The host (name or ip) serving the API. It MAY include a port.
42 -- | 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).
43 -- If the host is not included, the host serving the documentation is to be used (including the port).
84− , _swaggerHost :: Maybe Host
44+ , _host :: Maybe Host
86 -- | The base path on which the API is served, which is relative to the host.
46 -- | 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.
47 -- If it is not included, the API is served directly under the host.
88 -- The value MUST start with a leading slash (/).
48 -- The value MUST start with a leading slash (/).
89− , _swaggerBasePath :: Maybe FilePath
49+ , _basePath :: Maybe FilePath
91 -- | The transfer protocol of the API.
51 -- | 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.
52 -- 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]
53+ , _schemes :: Maybe [Scheme]
95 -- | A list of MIME types the APIs can consume.
55 -- | A list of MIME types the APIs can consume.
96 -- This is global to all APIs but can be overridden on specific API calls.
56 -- This is global to all APIs but can be overridden on specific API calls.
97− , _swaggerConsumes :: MimeList
57+ , _consumes :: MimeList
99 -- | A list of MIME types the APIs can produce.
59 -- | A list of MIME types the APIs can produce.
100− -- This is global to all APIs but can be overridden on specific API calls.
60+ -- This is global to all APIs but can be overridden on specific API calls.
101− , _swaggerProduces :: MimeList
61+ , _produces :: MimeList
103 -- | The available paths and operations for the API.
63 -- | The available paths and operations for the API.
104− -- Holds the relative paths to the individual endpoints.
64+ , _paths :: Paths
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.
66 -- | An object to hold data types produced and consumed by operations.
109− , _swaggerDefinitions :: Definitions Schema
67+ , _definitions :: HashMap Text Schema
111 -- | An object to hold parameters that can be used across operations.
69 -- | An object to hold parameters that can be used across operations.
112 -- This property does not define global parameters for all operations.
70 -- This property does not define global parameters for all operations.
113− , _swaggerParameters :: Definitions Param
71+ , _parameters :: HashMap Text Param
115 -- | An object to hold responses that can be used across operations.
73 -- | An object to hold responses that can be used across operations.
116 -- This property does not define global responses for all operations.
74 -- This property does not define global responses for all operations.
117− , _swaggerResponses :: Definitions Response
75+ , _responses :: HashMap Text Response
119 -- | Security scheme definitions that can be used across the specification.
77 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
78+ , _securityDefinitions :: HashMap Text SecurityScheme
122 -- | A declaration of which security schemes are applied for the API as a whole.
80 -- | 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
81 -- The list of values describes alternative security schemes that can be used
124 -- (that is, there is a logical OR between the security requirements).
82 -- (that is, there is a logical OR between the security requirements).
125 -- Individual operations can override this definition.
83 -- Individual operations can override this definition.
126− , _swaggerSecurity :: [SecurityRequirement]
84+ , _security :: [SecurityRequirement]
128 -- | A list of tags used by the specification with additional metadata.
86 -- | 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.
87 -- 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.
88 -- 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.
89 -- 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.
90 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
91+ , _tags :: [Tag]
135 -- | Additional external documentation.
93 -- | Additional external documentation.
136− , _swaggerExternalDocs :: Maybe ExternalDocs
94+ , _externalDocs :: Maybe ExternalDocs
137 } deriving (Eq, Show, Generic, Data, Typeable)
95 } deriving (Eq, Show, Generic, Data, Typeable)
139-- | The object provides metadata about the API.
97-- | The object provides metadata about the API.
@@ -182,18 +140,12 @@ data License = License
182 , _licenseUrl :: Maybe URL
140 , _licenseUrl :: Maybe URL
183 } deriving (Eq, Show, Generic, Data, Typeable)
141 } deriving (Eq, Show, Generic, Data, Typeable)
185−instance IsString License where
186− fromString s = License (fromString s) Nothing
188-- | The host (name or ip) serving the API. It MAY include a port.
143-- | The host (name or ip) serving the API. It MAY include a port.
189data Host = Host
144data Host = Host
190 { _hostName :: HostName -- ^ Host name.
145 { _hostName :: HostName -- ^ Host name.
191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
146 , _hostPort :: Maybe PortNumber -- ^ Optional port.
192 } deriving (Eq, Show, Generic, Typeable)
147 } deriving (Eq, Show, Generic, Typeable)
194−instance IsString Host where
195− fromString s = Host s Nothing
197hostConstr :: Constr
149hostConstr :: Constr
198hostConstr = mkConstr hostDataType "Host" [] Prefix
150hostConstr = mkConstr hostDataType "Host" [] Prefix
@@ -215,6 +167,13 @@ data Scheme
216 deriving (Eq, Show, Generic, Data, Typeable)
168 deriving (Eq, Show, Generic, Data, Typeable)
170+-- | The available paths and operations for the API.
172+ { -- | Holds the relative paths to the individual endpoints.
173+ -- The path is appended to the @'basePath'@ in order to construct the full URL.
174+ _pathsMap :: HashMap FilePath PathItem
175+ } deriving (Eq, Show, Generic, Data, Typeable)
218-- | Describes the operations available on a single path.
177-- | Describes the operations available on a single path.
219-- A @'PathItem'@ may be empty, due to ACL constraints.
178-- A @'PathItem'@ may be empty, due to ACL constraints.
220-- The path itself is still exposed to the documentation viewer
179-- The path itself is still exposed to the documentation viewer
@@ -252,7 +211,7 @@ data PathItem = PathItem
252data Operation = Operation
211data Operation = Operation
253 { -- | A list of tags for API documentation control.
212 { -- | A list of tags for API documentation control.
254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
213 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
214+ _operationTags :: [Text]
257 -- | A short summary of what the operation does.
216 -- | A short summary of what the operation does.
258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
217 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -309,7 +268,7 @@ data Operation = Operation
309 } deriving (Eq, Show, Generic, Data, Typeable)
268 } deriving (Eq, Show, Generic, Data, Typeable)
311newtype MimeList = MimeList { getMimeList :: [MediaType] }
270newtype MimeList = MimeList { getMimeList :: [MediaType] }
312− deriving (Eq, Show, Semigroup, Monoid, Typeable)
271+ deriving (Eq, Show, Monoid, Typeable)
314mimeListConstr :: Constr
273mimeListConstr :: Constr
315mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
274mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
@@ -360,8 +319,8 @@ data ParamOtherSchema = ParamOtherSchema
360 -- Default value is @False@.
319 -- Default value is @False@.
361 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
320 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
363− , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
322+ , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
364− } deriving (Eq, Show, Generic, Typeable, Data)
323+ } deriving (Eq, Show, Generic, Data, Typeable)
366-- | Items for @'SwaggerArray'@ schemas.
325-- | Items for @'SwaggerArray'@ schemas.
@@ -374,78 +333,28 @@ data ParamOtherSchema = ParamOtherSchema
375-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
334-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376data SwaggerItems t where
335data SwaggerItems t where
377− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
336+ SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
378− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
337+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
379− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
338+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
382deriving instance Eq (SwaggerItems t)
340deriving instance Eq (SwaggerItems t)
383deriving instance Show (SwaggerItems t)
341deriving instance Show (SwaggerItems t)
384−--deriving instance Typeable (SwaggerItems t)
342+deriving instance Typeable (SwaggerItems t)
386swaggerItemsPrimitiveConstr :: Constr
344swaggerItemsPrimitiveConstr :: Constr
387swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
345swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
389−swaggerItemsObjectConstr :: Constr
390−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
392−swaggerItemsArrayConstr :: Constr
393−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
395swaggerItemsDataType :: DataType
347swaggerItemsDataType :: DataType
396swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
348swaggerItemsDataType = 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
401−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
350+instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where
402− -- TODO: define gfoldl
403 gunfold k z c = case constrIndex c of
351 gunfold k z c = case constrIndex c of
404 1 -> k (k (z SwaggerItemsPrimitive))
352 1 -> k (k (z SwaggerItemsPrimitive))
405 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
353 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406 toConstr _ = swaggerItemsPrimitiveConstr
354 toConstr _ = swaggerItemsPrimitiveConstr
407 dataTypeOf _ = swaggerItemsDataType
355 dataTypeOf _ = swaggerItemsDataType
409−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410−instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
357+deriving instance Data (SwaggerItems Schema)
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
418−instance Data (SwaggerItems 'SwaggerKindSchema) where
419− gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420− gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421− gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
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.
436− = SwaggerKindNormal t
437− | SwaggerKindParamOtherSchema
441−deriving instance Typeable 'SwaggerKindNormal
442−deriving instance Typeable 'SwaggerKindParamOtherSchema
443−deriving instance Typeable 'SwaggerKindSchema
445−type family SwaggerKindType (k :: SwaggerKind *) :: *
446−type instance SwaggerKindType ('SwaggerKindNormal t) = t
447−type instance SwaggerKindType 'SwaggerKindSchema = Schema
448−type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
450data SwaggerType t where
359data SwaggerType t where
451 SwaggerString :: SwaggerType t
360 SwaggerString :: SwaggerType t
@@ -453,44 +362,44 @@ data SwaggerType t where
453 SwaggerInteger :: SwaggerType t
362 SwaggerInteger :: SwaggerType t
454 SwaggerBoolean :: SwaggerType t
363 SwaggerBoolean :: SwaggerType t
455 SwaggerArray :: SwaggerType t
364 SwaggerArray :: SwaggerType t
456− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
365+ SwaggerFile :: SwaggerType ParamOtherSchema
457− SwaggerNull :: SwaggerType 'SwaggerKindSchema
366+ SwaggerNull :: SwaggerType Schema
458− SwaggerObject :: SwaggerType 'SwaggerKindSchema
367+ SwaggerObject :: SwaggerType Schema
461deriving instance Eq (SwaggerType t)
369deriving instance Eq (SwaggerType t)
462deriving instance Show (SwaggerType t)
370deriving instance Show (SwaggerType t)
371+deriving instance Typeable (SwaggerType t)
464swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
373swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
374swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
467−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
376+swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
468swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
377swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
470−swaggerCommonTypes :: [SwaggerType k]
379+swaggerCommonTypes :: [SwaggerType t]
471swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
380swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
473−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
382+swaggerParamTypes :: [SwaggerType ParamOtherSchema]
474swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
383swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
476−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
385+swaggerSchemaTypes :: [SwaggerType Schema]
477swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
386swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
479swaggerTypeConstrs :: [Constr]
388swaggerTypeConstrs :: [Constr]
480−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
389+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
481 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
390 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
483−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
392+instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerType t) where
484 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
393 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485 toConstr = swaggerTypeConstr
394 toConstr = swaggerTypeConstr
486 dataTypeOf = swaggerTypeDataType
395 dataTypeOf = swaggerTypeDataType
488−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
397+instance {-# OVERLAPPING #-} Data (SwaggerType ParamOtherSchema) where
489 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
398 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490 toConstr = swaggerTypeConstr
399 toConstr = swaggerTypeConstr
491 dataTypeOf = swaggerTypeDataType
400 dataTypeOf = swaggerTypeDataType
493−instance Data (SwaggerType 'SwaggerKindSchema) where
402+instance {-# OVERLAPPING #-} Data (SwaggerType Schema) where
494 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
403 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495 toConstr = swaggerTypeConstr
404 toConstr = swaggerTypeConstr
496 dataTypeOf = swaggerTypeDataType
405 dataTypeOf = swaggerTypeDataType
@@ -530,11 +439,11 @@ data CollectionFormat t where
530 -- Corresponds to multiple parameter instances
439 -- Corresponds to multiple parameter instances
531 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
440 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
441 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
442+ CollectionMulti :: CollectionFormat Param
536deriving instance Eq (CollectionFormat t)
444deriving instance Eq (CollectionFormat t)
537deriving instance Show (CollectionFormat t)
445deriving instance Show (CollectionFormat t)
446+deriving instance Typeable (CollectionFormat t)
539collectionFormatConstr :: CollectionFormat t -> Constr
448collectionFormatConstr :: CollectionFormat t -> Constr
540collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
449collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
@@ -546,12 +455,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
546collectionCommonFormats :: [CollectionFormat t]
455collectionCommonFormats :: [CollectionFormat t]
547collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
456collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
549−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
458+instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where
550 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
459 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551 toConstr = collectionFormatConstr
460 toConstr = collectionFormatConstr
552 dataTypeOf _ = collectionFormatDataType
461 dataTypeOf _ = collectionFormatDataType
554−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
463+deriving instance {-# OVERLAPPING #-} Data (CollectionFormat Param)
556type ParamName = Text
465type ParamName = Text
@@ -560,9 +469,9 @@ data Schema = Schema
560 , _schemaDescription :: Maybe Text
469 , _schemaDescription :: Maybe Text
561 , _schemaRequired :: [ParamName]
470 , _schemaRequired :: [ParamName]
563− , _schemaAllOf :: Maybe [Referenced Schema]
472+ , _schemaAllOf :: Maybe [Schema]
564− , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
473+ , _schemaProperties :: HashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
474+ , _schemaAdditionalProperties :: Maybe Schema
567 , _schemaDiscriminator :: Maybe Text
476 , _schemaDiscriminator :: Maybe Text
568 , _schemaReadOnly :: Maybe Bool
477 , _schemaReadOnly :: Maybe Bool
@@ -573,20 +482,10 @@ data Schema = Schema
573 , _schemaMaxProperties :: Maybe Integer
482 , _schemaMaxProperties :: Maybe Integer
574 , _schemaMinProperties :: Maybe Integer
483 , _schemaMinProperties :: Maybe Integer
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
485+ , _schemaParamSchema :: ParamSchema Schema
577 } deriving (Eq, Show, Generic, Data, Typeable)
486 } deriving (Eq, Show, Generic, Data, Typeable)
579−-- | A @'Schema'@ with an optional name.
580−-- This name can be used in references.
581−data NamedSchema = NamedSchema
582− { _namedSchemaName :: Maybe Text
583− , _namedSchemaSchema :: Schema
584− } deriving (Eq, Show, Generic, Data, Typeable)
586−-- | Regex pattern for @string@ type.
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
488+data ParamSchema t = ParamSchema
590 { -- | Declares the value of the parameter that the server will use if none is provided,
489 { -- | 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@
490 -- 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.
491 -- if not supplied by the client in the request.
@@ -594,7 +493,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
493 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595 _paramSchemaDefault :: Maybe Value
494 _paramSchemaDefault :: Maybe Value
597− , _paramSchemaType :: Maybe (SwaggerType t)
496+ , _paramSchemaType :: SwaggerType t
598 , _paramSchemaFormat :: Maybe Format
497 , _paramSchemaFormat :: Maybe Format
599 , _paramSchemaItems :: Maybe (SwaggerItems t)
498 , _paramSchemaItems :: Maybe (SwaggerItems t)
600 , _paramSchemaMaximum :: Maybe Scientific
499 , _paramSchemaMaximum :: Maybe Scientific
@@ -603,7 +502,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
603 , _paramSchemaExclusiveMinimum :: Maybe Bool
502 , _paramSchemaExclusiveMinimum :: Maybe Bool
604 , _paramSchemaMaxLength :: Maybe Integer
503 , _paramSchemaMaxLength :: Maybe Integer
605 , _paramSchemaMinLength :: Maybe Integer
504 , _paramSchemaMinLength :: Maybe Integer
606− , _paramSchemaPattern :: Maybe Pattern
505+ , _paramSchemaPattern :: Maybe Text
607 , _paramSchemaMaxItems :: Maybe Integer
506 , _paramSchemaMaxItems :: Maybe Integer
608 , _paramSchemaMinItems :: Maybe Integer
507 , _paramSchemaMinItems :: Maybe Integer
609 , _paramSchemaUniqueItems :: Maybe Bool
508 , _paramSchemaUniqueItems :: Maybe Bool
@@ -611,7 +510,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
611 , _paramSchemaMultipleOf :: Maybe Scientific
510 , _paramSchemaMultipleOf :: Maybe Scientific
612 } deriving (Eq, Show, Generic, Typeable)
511 } deriving (Eq, Show, Generic, Typeable)
614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
513+deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data (ParamSchema t)
616data Xml = Xml
515data Xml = Xml
617 { -- | Replaces the name of the element/attribute used for the described schema property.
516 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -653,7 +552,7 @@ data Responses = Responses
654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
553 -- | 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.
554 -- Describes the expected response for those HTTP status codes.
656− , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
555+ , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
657 } deriving (Eq, Show, Generic, Data, Typeable)
556 } deriving (Eq, Show, Generic, Data, Typeable)
659type HttpStatusCode = Int
558type HttpStatusCode = Int
@@ -672,22 +571,19 @@ data Response = Response
672 , _responseSchema :: Maybe (Referenced Schema)
571 , _responseSchema :: Maybe (Referenced Schema)
674 -- | A list of headers that are sent with the response.
573 -- | A list of headers that are sent with the response.
675− , _responseHeaders :: InsOrdHashMap HeaderName Header
574+ , _responseHeaders :: HashMap HeaderName Header
677 -- | An example of the response message.
576 -- | An example of the response message.
678 , _responseExamples :: Maybe Example
577 , _responseExamples :: Maybe Example
679 } deriving (Eq, Show, Generic, Data, Typeable)
578 } deriving (Eq, Show, Generic, Data, Typeable)
681−instance IsString Response where
682− fromString s = Response (fromString s) Nothing mempty Nothing
684type HeaderName = Text
580type HeaderName = Text
686data Header = Header
582data Header = Header
687 { -- | A short description of the header.
583 { -- | A short description of the header.
688 _headerDescription :: Maybe Text
584 _headerDescription :: Maybe Text
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
586+ , _headerParamSchema :: ParamSchema Header
691 } deriving (Eq, Show, Generic, Data, Typeable)
587 } deriving (Eq, Show, Generic, Data, Typeable)
693data Example = Example { getExample :: Map MediaType Value }
589data Example = Example { getExample :: Map MediaType Value }
@@ -738,7 +634,7 @@ data OAuth2Params = OAuth2Params
738 _oauth2Flow :: OAuth2Flow
634 _oauth2Flow :: OAuth2Flow
740 -- | The available scopes for the OAuth2 security scheme.
636 -- | The available scopes for the OAuth2 security scheme.
741− , _oauth2Scopes :: InsOrdHashMap Text Text
637+ , _oauth2Scopes :: HashMap Text Text
742 } deriving (Eq, Show, Generic, Data, Typeable)
638 } deriving (Eq, Show, Generic, Data, Typeable)
744data SecuritySchemeType
640data SecuritySchemeType
@@ -755,37 +651,18 @@ data SecurityScheme = SecurityScheme
755 , _securitySchemeDescription :: Maybe Text
651 , _securitySchemeDescription :: Maybe Text
756 } deriving (Eq, Show, Generic, Data, Typeable)
652 } deriving (Eq, Show, Generic, Data, Typeable)
759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760−-- In other case returns first security scheme
761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764− = if flow1 == flow2 then
765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
768−mergeSecurityScheme s1 _ = s1
770−newtype SecurityDefinitions
771− = SecurityDefinitions (Definitions SecurityScheme)
772− deriving (Eq, Show, Generic, Data, Typeable)
774-- | Lists the required security schemes to execute this operation.
654-- | Lists the required security schemes to execute this operation.
775-- The object can have multiple security schemes declared in it which are all required
655-- The object can have multiple security schemes declared in it which are all required
776-- (that is, there is a logical AND between the schemes).
656-- (that is, there is a logical AND between the schemes).
777newtype SecurityRequirement = SecurityRequirement
657newtype SecurityRequirement = SecurityRequirement
778− { getSecurityRequirement :: InsOrdHashMap Text [Text]
658+ { getSecurityRequirement :: HashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
659+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
784-- | Allows adding meta data to a single tag that is used by @Operation@.
661-- | Allows adding meta data to a single tag that is used by @Operation@.
785-- It is not mandatory to have a @Tag@ per tag used there.
662-- It is not mandatory to have a @Tag@ per tag used there.
786data Tag = Tag
663data Tag = Tag
787 { -- | The name of the tag.
664 { -- | The name of the tag.
788− _tagName :: TagName
665+ _tagName :: Text
790 -- | A short description for the tag.
667 -- | A short description for the tag.
791 -- GFM syntax can be used for rich text representation.
668 -- GFM syntax can be used for rich text representation.
@@ -793,12 +670,7 @@ data Tag = Tag
794 -- | Additional external documentation for this tag.
671 -- | Additional external documentation for this tag.
795 , _tagExternalDocs :: Maybe ExternalDocs
672 , _tagExternalDocs :: Maybe ExternalDocs
796− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
673+ } deriving (Eq, Show, Generic, Data, Typeable)
798−instance Hashable Tag
800−instance IsString Tag where
801− fromString s = Tag (fromString s) Nothing Nothing
803-- | Allows referencing an external resource for extended documentation.
675-- | Allows referencing an external resource for extended documentation.
804data ExternalDocs = ExternalDocs
676data ExternalDocs = ExternalDocs
@@ -808,9 +680,7 @@ data ExternalDocs = ExternalDocs
809 -- | The URL for the target documentation.
681 -- | The URL for the target documentation.
810 , _externalDocsUrl :: URL
682 , _externalDocsUrl :: URL
811− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
683+ } deriving (Eq, Show, Generic, Data, Typeable)
813−instance Hashable ExternalDocs
815-- | A simple object to allow referencing other definitions in the specification.
685-- | A simple object to allow referencing other definitions in the specification.
816-- It can be used to reference parameters and responses that are defined at the top level for reuse.
686-- It can be used to reference parameters and responses that are defined at the top level for reuse.
@@ -820,122 +690,76 @@ newtype Reference = Reference { getReference :: Text }
820data Referenced a
690data Referenced a
821 = Ref Reference
691 = Ref Reference
822 | Inline a
692 | Inline a
823− deriving (Eq, Show, Functor, Data, Typeable)
825−instance IsString a => IsString (Referenced a) where
826− fromString = Inline . fromString
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
830−data AdditionalProperties
831− = AdditionalPropertiesAllowed Bool
832− | AdditionalPropertiesSchema (Referenced Schema)
833 deriving (Eq, Show, Data, Typeable)
693 deriving (Eq, Show, Data, Typeable)
695+newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)
835-- =======================================================================
697-- =======================================================================
836-- Monoid instances
698-- Monoid instances
837-- =======================================================================
699-- =======================================================================
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841instance Monoid Swagger where
701instance Monoid Swagger where
842 mempty = genericMempty
702 mempty = genericMempty
843− mappend = (<>)
703+ mappend = genericMappend
845−instance Semigroup Info where
846− (<>) = genericMappend
847instance Monoid Info where
705instance Monoid Info where
848 mempty = genericMempty
706 mempty = genericMempty
849− mappend = (<>)
707+ mappend = genericMappend
851−instance Semigroup Contact where
852− (<>) = genericMappend
853−instance Monoid Contact where
709+instance Monoid Paths where
854 mempty = genericMempty
710 mempty = genericMempty
855− mappend = (<>)
711+ mappend = genericMappend
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859instance Monoid PathItem where
713instance Monoid PathItem where
860 mempty = genericMempty
714 mempty = genericMempty
861− mappend = (<>)
715+ mappend = genericMappend
863−instance Semigroup Schema where
864− (<>) = genericMappend
865instance Monoid Schema where
717instance Monoid Schema where
866 mempty = genericMempty
718 mempty = genericMempty
867− mappend = (<>)
719+ mappend = genericMappend
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871instance Monoid (ParamSchema t) where
721instance Monoid (ParamSchema t) where
872 mempty = genericMempty
722 mempty = genericMempty
873− mappend = (<>)
723+ mappend = genericMappend
875−instance Semigroup Param where
876− (<>) = genericMappend
877instance Monoid Param where
725instance Monoid Param where
878 mempty = genericMempty
726 mempty = genericMempty
879− mappend = (<>)
727+ mappend = genericMappend
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883instance Monoid ParamOtherSchema where
729instance Monoid ParamOtherSchema where
884 mempty = genericMempty
730 mempty = genericMempty
885− mappend = (<>)
731+ mappend = genericMappend
887−instance Semigroup Header where
888− (<>) = genericMappend
889instance Monoid Header where
733instance Monoid Header where
890 mempty = genericMempty
734 mempty = genericMempty
891− mappend = (<>)
735+ mappend = genericMappend
893−instance Semigroup Responses where
894− (<>) = genericMappend
895instance Monoid Responses where
737instance Monoid Responses where
896 mempty = genericMempty
738 mempty = genericMempty
897− mappend = (<>)
739+ mappend = genericMappend
899−instance Semigroup Response where
900− (<>) = genericMappend
901instance Monoid Response where
741instance Monoid Response where
902 mempty = genericMempty
742 mempty = genericMempty
903− mappend = (<>)
743+ mappend = genericMappend
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907instance Monoid ExternalDocs where
745instance Monoid ExternalDocs where
908 mempty = genericMempty
746 mempty = genericMempty
909− mappend = (<>)
747+ mappend = genericMappend
911−instance Semigroup Operation where
912− (<>) = genericMappend
913instance Monoid Operation where
749instance Monoid Operation where
914 mempty = genericMempty
750 mempty = genericMempty
915− mappend = (<>)
751+ mappend = genericMappend
917−instance Semigroup Example where
918− (<>) = genericMappend
919instance Monoid Example where
753instance Monoid Example where
920 mempty = genericMempty
754 mempty = genericMempty
921− mappend = (<>)
755+ mappend = genericMappend
923−instance Semigroup SecurityScheme where
924− (<>) = mergeSecurityScheme
926−instance Semigroup SecurityDefinitions where
927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
930−instance Monoid SecurityDefinitions where
931− mempty = SecurityDefinitions $ InsOrdHashMap.empty
934-- =======================================================================
757-- =======================================================================
935-- SwaggerMonoid helper instances
758-- SwaggerMonoid helper instances
936-- =======================================================================
759-- =======================================================================
938instance SwaggerMonoid Info
761instance SwaggerMonoid Info
762+instance SwaggerMonoid Paths
939instance SwaggerMonoid PathItem
763instance SwaggerMonoid PathItem
940instance SwaggerMonoid Schema
764instance SwaggerMonoid Schema
941instance SwaggerMonoid (ParamSchema t)
765instance SwaggerMonoid (ParamSchema t)
@@ -945,8 +769,6 @@ instance SwaggerMonoid Responses
945instance SwaggerMonoid Response
769instance SwaggerMonoid Response
946instance SwaggerMonoid ExternalDocs
770instance SwaggerMonoid ExternalDocs
947instance SwaggerMonoid Operation
771instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
951instance SwaggerMonoid MimeList
773instance SwaggerMonoid MimeList
952deriving instance SwaggerMonoid URL
774deriving instance SwaggerMonoid URL
@@ -959,15 +781,43 @@ instance SwaggerMonoid ParamLocation where
959 swaggerMempty = ParamQuery
781 swaggerMempty = ParamQuery
960 swaggerMappend _ y = y
782 swaggerMappend _ y = y
962−instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
784+instance SwaggerMonoid (HashMap Text Schema) where
963− swaggerMempty = InsOrdHashMap.empty
785+ swaggerMempty = HashMap.empty
964− swaggerMappend = InsOrdHashMap.unionWith mappend
786+ swaggerMappend = HashMap.unionWith mappend
788+instance SwaggerMonoid (HashMap Text (Referenced Schema)) where
789+ swaggerMempty = HashMap.empty
790+ swaggerMappend = HashMap.unionWith swaggerMappend
966instance Monoid a => SwaggerMonoid (Referenced a) where
792instance Monoid a => SwaggerMonoid (Referenced a) where
967 swaggerMempty = Inline mempty
793 swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
794+ swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
969 swaggerMappend _ y = y
795 swaggerMappend _ y = y
797+instance SwaggerMonoid (HashMap Text Param) where
798+ swaggerMempty = HashMap.empty
799+ swaggerMappend = HashMap.unionWith mappend
801+instance SwaggerMonoid (HashMap Text Response) where
802+ swaggerMempty = HashMap.empty
803+ swaggerMappend = flip HashMap.union
805+instance SwaggerMonoid (HashMap Text SecurityScheme) where
806+ swaggerMempty = HashMap.empty
807+ swaggerMappend = flip HashMap.union
809+instance SwaggerMonoid (HashMap FilePath PathItem) where
810+ swaggerMempty = HashMap.empty
811+ swaggerMappend = HashMap.unionWith mappend
813+instance SwaggerMonoid (HashMap HeaderName Header) where
814+ swaggerMempty = HashMap.empty
815+ swaggerMappend = flip HashMap.union
817+instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where
818+ swaggerMempty = HashMap.empty
819+ swaggerMappend = flip HashMap.union
971instance SwaggerMonoid ParamAnySchema where
821instance SwaggerMonoid ParamAnySchema where
972 swaggerMempty = ParamOther swaggerMempty
822 swaggerMempty = ParamOther swaggerMempty
973 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
823 swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
@@ -1059,8 +909,7 @@ instance ToJSON OAuth2Flow where
1059 , "tokenUrl" .= tokenUrl ]
909 , "tokenUrl" .= tokenUrl ]
1061instance ToJSON OAuth2Params where
911instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
912+ toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1065instance ToJSON SecuritySchemeType where
914instance ToJSON SecuritySchemeType where
1066 toJSON SecuritySchemeBasic
915 toJSON SecuritySchemeBasic
@@ -1073,37 +922,25 @@ instance ToJSON SecuritySchemeType where
1073 <+> object [ "type" .= ("oauth2" :: Text) ]
922 <+> object [ "type" .= ("oauth2" :: Text) ]
1075instance ToJSON Swagger where
924instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
925+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
1077− DEFINE_TOENCODING
926+ where
927+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
928+ addVersion _ = error "impossible"
1079instance ToJSON SecurityScheme where
930instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
931+ toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1083instance ToJSON Schema where
933instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
934+ toJSON = omitEmpties . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
1087instance ToJSON Header where
936instance ToJSON Header where
1088− toJSON = sopSwaggerGenericToJSON
937+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
1091−-- | As for nullary schema for 0-arity type constructors, see
1092−-- <https://github.com/GetShopTV/swagger2/issues/167>.
1094−-- >>> encode (SwaggerItemsArray [])
1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1097−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
939+instance ToJSON (SwaggerItems t) where
1098 toJSON (SwaggerItemsPrimitive fmt schema) = object
940 toJSON (SwaggerItemsPrimitive fmt schema) = object
1099 [ "collectionFormat" .= fmt
941 [ "collectionFormat" .= fmt
1100 , "items" .= schema ]
942 , "items" .= schema ]
1101 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
943 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102− toJSON (SwaggerItemsArray []) = object
1103− [ "items" .= object []
1104− , "maxItems" .= (0 :: Int)
1105− , "example" .= Array mempty
1107 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
944 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1109instance ToJSON Host where
946instance ToJSON Host where
@@ -1112,43 +949,38 @@ instance ToJSON Host where
1112 Nothing -> host
949 Nothing -> host
1113 Just port -> host ++ ":" ++ show port
950 Just port -> host ++ ":" ++ show port
952+instance ToJSON Paths where
953+ toJSON (Paths m) = toJSON m
1115instance ToJSON MimeList where
955instance ToJSON MimeList where
1116 toJSON (MimeList xs) = toJSON (map show xs)
956 toJSON (MimeList xs) = toJSON (map show xs)
1118instance ToJSON Param where
958instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
959+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1122instance ToJSON ParamAnySchema where
961instance ToJSON ParamAnySchema where
1123 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
962 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124 toJSON (ParamOther s) = toJSON s
963 toJSON (ParamOther s) = toJSON s
1126instance ToJSON ParamOtherSchema where
965instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
966+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1130instance ToJSON Responses where
968instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
969+ toJSON (Responses def rs) = omitEmpties $
1132− DEFINE_TOENCODING
970+ toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1134instance ToJSON Response where
972instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
973+ toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
1138instance ToJSON Operation where
975instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
976+ toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
1142instance ToJSON PathItem where
978instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
979+ toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
1146instance ToJSON Example where
981instance ToJSON Example where
1147 toJSON = toJSON . Map.mapKeys show . getExample
982 toJSON = toJSON . Map.mapKeys show . getExample
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1152instance ToJSON Reference where
984instance ToJSON Reference where
1153 toJSON (Reference ref) = object [ "$ref" .= ref ]
985 toJSON (Reference ref) = object [ "$ref" .= ref ]
@@ -1177,14 +1009,8 @@ instance ToJSON (CollectionFormat t) where
1177 toJSON CollectionPipes = "pipes"
1009 toJSON CollectionPipes = "pipes"
1178 toJSON CollectionMulti = "multi"
1010 toJSON CollectionMulti = "multi"
1180−instance ToJSON (ParamSchema k) where
1012+instance ToJSON (ParamSchema t) where
1181− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1013+ toJSON = omitEmpties . genericToJSONWithSub "items" (jsonPrefix "paramSchema")
1182− toJSON = sopSwaggerGenericToJSONWithOpts $
1183− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1185−instance ToJSON AdditionalProperties where
1186− toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187− toJSON (AdditionalPropertiesSchema s) = toJSON s
1189-- =======================================================================
1015-- =======================================================================
1190-- Manual FromJSON instances
1016-- Manual FromJSON instances
@@ -1204,7 +1030,7 @@ instance FromJSON OAuth2Flow where
1204 parseJSON _ = empty
1030 parseJSON _ = empty
1206instance FromJSON OAuth2Params where
1032instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
1033+ parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1209instance FromJSON SecuritySchemeType where
1035instance FromJSON SecuritySchemeType where
1210 parseJSON js@(Object o) = do
1036 parseJSON js@(Object o) = do
@@ -1217,65 +1043,60 @@ instance FromJSON SecuritySchemeType where
1217 parseJSON _ = empty
1043 parseJSON _ = empty
1219instance FromJSON Swagger where
1045instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
1046+ parseJSON js@(Object o) = do
1047+ (version :: Text) <- o .: "swagger"
1048+ when (version /= "2.0") empty
1049+ (genericParseJSON (jsonPrefix "")
1050+ `withDefaults` [ "consumes" .= (mempty :: MimeList)
1051+ , "produces" .= (mempty :: MimeList)
1052+ , "security" .= ([] :: [SecurityRequirement])
1053+ , "tags" .= ([] :: [Tag])
1054+ , "definitions" .= (mempty :: HashMap Text Schema)
1055+ , "parameters" .= (mempty :: HashMap Text Param)
1056+ , "responses" .= (mempty :: HashMap Text Response)
1057+ , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
1059+ parseJSON _ = empty
1222instance FromJSON SecurityScheme where
1061instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
1062+ parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1225instance FromJSON Schema where
1064instance FromJSON Schema where
1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1065+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1227− where nullaryCleanup :: Schema -> Schema
1066+ `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1067+ , "required" .= ([] :: [ParamName]) ]
1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230− then s { _schemaExample = Nothing
1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1234instance FromJSON Header where
1069instance FromJSON Header where
1235− parseJSON = sopSwaggerGenericParseJSON
1070+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
1237−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1072+instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1238− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1073+ parseJSON (Object o) = SwaggerItemsPrimitive
1239 <$> o .:? "collectionFormat"
1074 <$> o .:? "collectionFormat"
1240 <*> (o .: "items" >>= parseJSON)
1075 <*> (o .: "items" >>= parseJSON)
1242−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244− <$> o .:? "collectionFormat"
1245− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250−-- Just (SwaggerItemsArray [])
1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1258−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1077+instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where
1259− parseJSON js@(Object obj)
1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261− | otherwise = SwaggerItemsObject <$> parseJSON js
1078+ parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1262 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1079 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1263 parseJSON _ = empty
1080 parseJSON _ = empty
1265instance FromJSON Host where
1082instance FromJSON Host where
1266− parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1083+ parseJSON (String s) =
1267− [host] -> return $ Host host Nothing
1084+ case fromInteger <$> readMaybe portStr of
1268− [host, port] -> case readMaybe port of
1085+ Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1269− Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1086+ mport -> pure $ Host host mport
1270− Just p -> return $ Host host (Just (fromInteger p))
1087+ where
1271− _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1088+ (hostText, portText) = Text.breakOn ":" s
1089+ [host, portStr] = map Text.unpack [hostText, portText]
1272 parseJSON _ = empty
1090 parseJSON _ = empty
1092+instance FromJSON Paths where
1093+ parseJSON js = Paths <$> parseJSON js
1274instance FromJSON MimeList where
1095instance FromJSON MimeList where
1275 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1096 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1277instance FromJSON Param where
1098instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
1099+ parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1280instance FromJSON ParamAnySchema where
1101instance FromJSON ParamAnySchema where
1281 parseJSON js@(Object o) = do
1102 parseJSON js@(Object o) = do
@@ -1288,12 +1109,12 @@ instance FromJSON ParamAnySchema where
1288 parseJSON _ = empty
1109 parseJSON _ = empty
1290instance FromJSON ParamOtherSchema where
1111instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
1112+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1293instance FromJSON Responses where
1114instance FromJSON Responses where
1294 parseJSON (Object o) = Responses
1115 parseJSON (Object o) = Responses
1295 <$> o .:? "default"
1116 <$> o .:? "default"
1296− <*> (parseJSON (Object (HashMap.delete "default" o)))
1117+ <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1297 parseJSON _ = empty
1118 parseJSON _ = empty
1299instance FromJSON Example where
1120instance FromJSON Example where
@@ -1302,16 +1123,16 @@ instance FromJSON Example where
1302 pure $ Example (Map.mapKeys fromString m)
1123 pure $ Example (Map.mapKeys fromString m)
1304instance FromJSON Response where
1125instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
1126+ parseJSON = genericParseJSON (jsonPrefix "response")
1127+ `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
1307instance FromJSON Operation where
1129instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
1130+ parseJSON = genericParseJSON (jsonPrefix "operation")
1131+ `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
1310instance FromJSON PathItem where
1133instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1134+ parseJSON = genericParseJSON (jsonPrefix "pathItem")
1312−
1135+ `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1316instance FromJSON Reference where
1137instance FromJSON Reference where
1317 parseJSON (Object o) = Reference <$> o .: "$ref"
1138 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1328,7 +1149,6 @@ referencedParseJSON prefix js@(Object o) = do
1328 case Text.stripPrefix prefix s of
1149 case Text.stripPrefix prefix s of
1329 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1150 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1330 Just suffix -> pure (Reference suffix)
1151 Just suffix -> pure (Reference suffix)
1331−referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1333instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1153instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1334instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1154instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
@@ -1337,91 +1157,26 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
1337instance FromJSON Xml where
1157instance FromJSON Xml where
1338 parseJSON = genericParseJSON (jsonPrefix "xml")
1158 parseJSON = genericParseJSON (jsonPrefix "xml")
1340−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1160+instance FromJSON (SwaggerType Schema) where
1341 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1161 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1343−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1163+instance FromJSON (SwaggerType ParamOtherSchema) where
1344 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1164 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1346−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1166+instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where
1347 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1167 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1349−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1169+instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where
1350 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1170 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1352−-- NOTE: There aren't collections of 'Schema'
1353−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1172+instance FromJSON (CollectionFormat Param) where
1354−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1356−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1357 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1173 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1359−instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1175+-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1360− parseJSON = sopSwaggerGenericParseJSON
1176+-- @FromJSON (SwaggerItems t)@ are necessary here!
1361−instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1177+-- Without the constraint the general instance will be used
1362− parseJSON = sopSwaggerGenericParseJSON
1178+-- that only accepts common types (i.e. NOT object, null or file)
1363−instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1179+-- and primitive array items.
1364− parseJSON = sopSwaggerGenericParseJSON
1180+instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1365−
1181+ parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")
1366−instance FromJSON AdditionalProperties where
1182+
1367− parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368− parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1370−-------------------------------------------------------------------------------
1372−-------------------------------------------------------------------------------
1374−deriveGeneric ''Header
1375−deriveGeneric ''OAuth2Params
1376−deriveGeneric ''Operation
1377−deriveGeneric ''Param
1378−deriveGeneric ''ParamOtherSchema
1379−deriveGeneric ''PathItem
1380−deriveGeneric ''Response
1381−deriveGeneric ''Responses
1382−deriveGeneric ''SecurityScheme
1383−deriveGeneric ''Schema
1384−deriveGeneric ''ParamSchema
1385−deriveGeneric ''Swagger
1387−instance HasSwaggerAesonOptions Header where
1388− swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1389−instance HasSwaggerAesonOptions OAuth2Params where
1390− swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1391−instance HasSwaggerAesonOptions Operation where
1392− swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1393−instance HasSwaggerAesonOptions Param where
1394− swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1395−instance HasSwaggerAesonOptions ParamOtherSchema where
1396− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1397−instance HasSwaggerAesonOptions PathItem where
1398− swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1399−instance HasSwaggerAesonOptions Response where
1400− swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1401−instance HasSwaggerAesonOptions Responses where
1402− swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1403−instance HasSwaggerAesonOptions SecurityScheme where
1404− swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1405−instance HasSwaggerAesonOptions Schema where
1406− swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1407−instance HasSwaggerAesonOptions Swagger where
1408− swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1410−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1411− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1412−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1413− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1414−-- NOTE: Schema doesn't have 'items' sub object!
1415−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1416− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1418−instance AesonDefaultValue (ParamSchema s)
1419−instance AesonDefaultValue OAuth2Flow
1420−instance AesonDefaultValue Responses
1421−instance AesonDefaultValue ParamAnySchema
1422−instance AesonDefaultValue SecuritySchemeType
1423−instance AesonDefaultValue (SwaggerType a)
1424−instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425−instance AesonDefaultValue Info
1426−instance AesonDefaultValue ParamLocation
1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty