@@ -1,4 +1,7 @@
2+{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveTraversable #-}
6{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleContexts #-}
@@ -9,92 +12,128 @@
9{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE RecordWildCards #-}
10{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE StandaloneDeriving #-}
14{-# LANGUAGE StandaloneDeriving #-}
15+{-# LANGUAGE TemplateHaskell #-}
16+{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE UndecidableInstances #-}
17{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ <710
19+{-# LANGUAGE PolyKinds #-}
21+#include "overlapping-compat.h"
13module Data.Swagger.Internal where
22module Data.Swagger.Internal where
27+import Control.Lens ((&), (.~), (?~))
15import Control.Applicative
28import Control.Applicative
17import Data.Aeson
29import Data.Aeson
18import qualified Data.Aeson.Types as JSON
30import qualified Data.Aeson.Types as JSON
19import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
31import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
20−import Data.HashMap.Strict (HashMap)
32+import Data.Hashable (Hashable)
21import qualified Data.HashMap.Strict as HashMap
33import qualified Data.HashMap.Strict as HashMap
34+import Data.HashSet.InsOrd (InsOrdHashSet)
22import Data.Map (Map)
35import Data.Map (Map)
23import qualified Data.Map as Map
36import qualified Data.Map as Map
24−import Data.Monoid
37+import Data.Monoid (Monoid (..))
38+import Data.Semigroup.Compat (Semigroup (..))
25import Data.Scientific (Scientific)
39import Data.Scientific (Scientific)
26−import Data.String (fromString)
40+import Data.String (IsString(..))
27import Data.Text (Text)
41import Data.Text (Text)
28import qualified Data.Text as Text
42import qualified Data.Text as Text
29import GHC.Generics (Generic)
43import GHC.Generics (Generic)
30−import Network (HostName, PortNumber)
44+import Network.Socket (HostName, PortNumber)
31import Network.HTTP.Media (MediaType)
45import Network.HTTP.Media (MediaType)
32import Text.Read (readMaybe)
46import 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
34import Data.Swagger.Internal.Utils
60import 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
36-- | A list of definitions that can be used in references.
73-- | A list of definitions that can be used in references.
37−type Definitions = HashMap Text
74+type Definitions = InsOrdHashMap Text
39-- | This is the root document object for the API specification.
76-- | This is the root document object for the API specification.
40data Swagger = Swagger
77data Swagger = Swagger
41 { -- | Provides metadata about the API.
78 { -- | Provides metadata about the API.
42 -- The metadata can be used by the clients if needed.
79 -- The metadata can be used by the clients if needed.
43− _info :: Info
80+ _swaggerInfo :: Info
45 -- | The host (name or ip) serving the API. It MAY include a port.
82 -- | The host (name or ip) serving the API. It MAY include a port.
46 -- If the host is not included, the host serving the documentation is to be used (including the port).
83 -- If the host is not included, the host serving the documentation is to be used (including the port).
47− , _host :: Maybe Host
84+ , _swaggerHost :: Maybe Host
49 -- | The base path on which the API is served, which is relative to the host.
86 -- | The base path on which the API is served, which is relative to the host.
50 -- If it is not included, the API is served directly under the host.
87 -- If it is not included, the API is served directly under the host.
51 -- The value MUST start with a leading slash (/).
88 -- The value MUST start with a leading slash (/).
52− , _basePath :: Maybe FilePath
89+ , _swaggerBasePath :: Maybe FilePath
54 -- | The transfer protocol of the API.
91 -- | The transfer protocol of the API.
55 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
92 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
56− , _schemes :: Maybe [Scheme]
93+ , _swaggerSchemes :: Maybe [Scheme]
58 -- | A list of MIME types the APIs can consume.
95 -- | A list of MIME types the APIs can consume.
59 -- This is global to all APIs but can be overridden on specific API calls.
96 -- This is global to all APIs but can be overridden on specific API calls.
60− , _consumes :: MimeList
97+ , _swaggerConsumes :: MimeList
62 -- | A list of MIME types the APIs can produce.
99 -- | A list of MIME types the APIs can produce.
63 -- This is global to all APIs but can be overridden on specific API calls.
100 -- This is global to all APIs but can be overridden on specific API calls.
64− , _produces :: MimeList
101+ , _swaggerProduces :: MimeList
66 -- | The available paths and operations for the API.
103 -- | The available paths and operations for the API.
67− , _paths :: Paths
104+ -- Holds the relative paths to the individual endpoints.
105+ -- The path is appended to the @'basePath'@ in order to construct the full URL.
106+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem
69 -- | An object to hold data types produced and consumed by operations.
108 -- | An object to hold data types produced and consumed by operations.
70− , _definitions :: Definitions Schema
109+ , _swaggerDefinitions :: Definitions Schema
72 -- | An object to hold parameters that can be used across operations.
111 -- | An object to hold parameters that can be used across operations.
73 -- This property does not define global parameters for all operations.
112 -- This property does not define global parameters for all operations.
74− , _parameters :: Definitions Param
113+ , _swaggerParameters :: Definitions Param
76 -- | An object to hold responses that can be used across operations.
115 -- | An object to hold responses that can be used across operations.
77 -- This property does not define global responses for all operations.
116 -- This property does not define global responses for all operations.
78− , _responses :: Definitions Response
117+ , _swaggerResponses :: Definitions Response
80 -- | Security scheme definitions that can be used across the specification.
119 -- | Security scheme definitions that can be used across the specification.
81− , _securityDefinitions :: Definitions SecurityScheme
120+ , _swaggerSecurityDefinitions :: SecurityDefinitions
83 -- | A declaration of which security schemes are applied for the API as a whole.
122 -- | A declaration of which security schemes are applied for the API as a whole.
84 -- The list of values describes alternative security schemes that can be used
123 -- The list of values describes alternative security schemes that can be used
85 -- (that is, there is a logical OR between the security requirements).
124 -- (that is, there is a logical OR between the security requirements).
86 -- Individual operations can override this definition.
125 -- Individual operations can override this definition.
87− , _security :: [SecurityRequirement]
126+ , _swaggerSecurity :: [SecurityRequirement]
89 -- | A list of tags used by the specification with additional metadata.
128 -- | A list of tags used by the specification with additional metadata.
90 -- The order of the tags can be used to reflect on their order by the parsing tools.
129 -- The order of the tags can be used to reflect on their order by the parsing tools.
91 -- Not all tags that are used by the Operation Object must be declared.
130 -- Not all tags that are used by the Operation Object must be declared.
92 -- The tags that are not declared may be organized randomly or based on the tools' logic.
131 -- The tags that are not declared may be organized randomly or based on the tools' logic.
93 -- Each tag name in the list MUST be unique.
132 -- Each tag name in the list MUST be unique.
94− , _tags :: [Tag]
133+ , _swaggerTags :: InsOrdHashSet Tag
96 -- | Additional external documentation.
135 -- | Additional external documentation.
97− , _externalDocs :: Maybe ExternalDocs
136+ , _swaggerExternalDocs :: Maybe ExternalDocs
98 } deriving (Eq, Show, Generic, Data, Typeable)
137 } deriving (Eq, Show, Generic, Data, Typeable)
100-- | The object provides metadata about the API.
139-- | The object provides metadata about the API.
@@ -143,12 +182,18 @@ data License = License
143 , _licenseUrl :: Maybe URL
182 , _licenseUrl :: Maybe URL
144 } deriving (Eq, Show, Generic, Data, Typeable)
183 } deriving (Eq, Show, Generic, Data, Typeable)
185+instance IsString License where
186+ fromString s = License (fromString s) Nothing
146-- | The host (name or ip) serving the API. It MAY include a port.
188-- | The host (name or ip) serving the API. It MAY include a port.
147data Host = Host
189data Host = Host
148 { _hostName :: HostName -- ^ Host name.
190 { _hostName :: HostName -- ^ Host name.
149 , _hostPort :: Maybe PortNumber -- ^ Optional port.
191 , _hostPort :: Maybe PortNumber -- ^ Optional port.
150 } deriving (Eq, Show, Generic, Typeable)
192 } deriving (Eq, Show, Generic, Typeable)
194+instance IsString Host where
195+ fromString s = Host s Nothing
152hostConstr :: Constr
197hostConstr :: Constr
153hostConstr = mkConstr hostDataType "Host" [] Prefix
198hostConstr = mkConstr hostDataType "Host" [] Prefix
@@ -170,13 +215,6 @@ data Scheme
171 deriving (Eq, Show, Generic, Data, Typeable)
216 deriving (Eq, Show, Generic, Data, Typeable)
173−-- | The available paths and operations for the API.
175− { -- | Holds the relative paths to the individual endpoints.
176− -- The path is appended to the @'basePath'@ in order to construct the full URL.
177− _pathsMap :: HashMap FilePath PathItem
178− } deriving (Eq, Show, Generic, Data, Typeable)
180-- | Describes the operations available on a single path.
218-- | Describes the operations available on a single path.
181-- A @'PathItem'@ may be empty, due to ACL constraints.
219-- A @'PathItem'@ may be empty, due to ACL constraints.
182-- The path itself is still exposed to the documentation viewer
220-- The path itself is still exposed to the documentation viewer
@@ -214,7 +252,7 @@ data PathItem = PathItem
214data Operation = Operation
252data Operation = Operation
215 { -- | A list of tags for API documentation control.
253 { -- | A list of tags for API documentation control.
216 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
254 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
217− _operationTags :: [TagName]
255+ _operationTags :: InsOrdHashSet TagName
219 -- | A short summary of what the operation does.
257 -- | A short summary of what the operation does.
220 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
258 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -271,7 +309,7 @@ data Operation = Operation
271 } deriving (Eq, Show, Generic, Data, Typeable)
309 } deriving (Eq, Show, Generic, Data, Typeable)
273newtype MimeList = MimeList { getMimeList :: [MediaType] }
311newtype MimeList = MimeList { getMimeList :: [MediaType] }
274− deriving (Eq, Show, Monoid, Typeable)
312+ deriving (Eq, Show, Semigroup, Monoid, Typeable)
276mimeListConstr :: Constr
314mimeListConstr :: Constr
277mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
315mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
@@ -322,8 +360,8 @@ data ParamOtherSchema = ParamOtherSchema
322 -- Default value is @False@.
360 -- Default value is @False@.
323 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
361 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
325− , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
363+ , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
326− } deriving (Eq, Show, Generic, Data, Typeable)
364+ } deriving (Eq, Show, Generic, Typeable, Data)
328-- | Items for @'SwaggerArray'@ schemas.
366-- | Items for @'SwaggerArray'@ schemas.
@@ -336,28 +374,78 @@ data ParamOtherSchema = ParamOtherSchema
337-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
375-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
338data SwaggerItems t where
376data SwaggerItems t where
339− SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
377+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
340− SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
378+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
341− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
379+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
343deriving instance Eq (SwaggerItems t)
382deriving instance Eq (SwaggerItems t)
344deriving instance Show (SwaggerItems t)
383deriving instance Show (SwaggerItems t)
345−deriving instance Typeable (SwaggerItems t)
384+--deriving instance Typeable (SwaggerItems t)
347swaggerItemsPrimitiveConstr :: Constr
386swaggerItemsPrimitiveConstr :: Constr
348swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
387swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
389+swaggerItemsObjectConstr :: Constr
390+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
392+swaggerItemsArrayConstr :: Constr
393+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
350swaggerItemsDataType :: DataType
395swaggerItemsDataType :: DataType
351swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
396swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
398+-- Note: unfortunately we have to write these Data instances by hand,
399+-- to get better contexts / avoid duplicate name when using standalone deriving
353−instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where
401+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402+ -- TODO: define gfoldl
354 gunfold k z c = case constrIndex c of
403 gunfold k z c = case constrIndex c of
355 1 -> k (k (z SwaggerItemsPrimitive))
404 1 -> k (k (z SwaggerItemsPrimitive))
356 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
405 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
357 toConstr _ = swaggerItemsPrimitiveConstr
406 toConstr _ = swaggerItemsPrimitiveConstr
358 dataTypeOf _ = swaggerItemsDataType
407 dataTypeOf _ = swaggerItemsDataType
409+-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
360−deriving instance Data (SwaggerItems Schema)
410+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411+ -- TODO: define gfoldl
412+ gunfold k z c = case constrIndex c of
413+ 1 -> k (k (z SwaggerItemsPrimitive))
414+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415+ toConstr _ = swaggerItemsPrimitiveConstr
416+ dataTypeOf _ = swaggerItemsDataType
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
362data SwaggerType t where
450data SwaggerType t where
363 SwaggerString :: SwaggerType t
451 SwaggerString :: SwaggerType t
@@ -365,44 +453,44 @@ data SwaggerType t where
365 SwaggerInteger :: SwaggerType t
453 SwaggerInteger :: SwaggerType t
366 SwaggerBoolean :: SwaggerType t
454 SwaggerBoolean :: SwaggerType t
367 SwaggerArray :: SwaggerType t
455 SwaggerArray :: SwaggerType t
368− SwaggerFile :: SwaggerType ParamOtherSchema
456+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
369− SwaggerNull :: SwaggerType Schema
457+ SwaggerNull :: SwaggerType 'SwaggerKindSchema
370− SwaggerObject :: SwaggerType Schema
458+ SwaggerObject :: SwaggerType 'SwaggerKindSchema
372deriving instance Eq (SwaggerType t)
461deriving instance Eq (SwaggerType t)
373deriving instance Show (SwaggerType t)
462deriving instance Show (SwaggerType t)
374−deriving instance Typeable (SwaggerType t)
376swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
464swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
377swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
465swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
379−swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
467+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
380swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
468swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
382−swaggerCommonTypes :: [SwaggerType t]
470+swaggerCommonTypes :: [SwaggerType k]
383swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
471swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
385−swaggerParamTypes :: [SwaggerType ParamOtherSchema]
473+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
386swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
474swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
388−swaggerSchemaTypes :: [SwaggerType Schema]
476+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
389swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
477swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
391swaggerTypeConstrs :: [Constr]
479swaggerTypeConstrs :: [Constr]
392−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
480+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
393 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
481 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
395−instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerType t) where
483+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
396 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
484 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
397 toConstr = swaggerTypeConstr
485 toConstr = swaggerTypeConstr
398 dataTypeOf = swaggerTypeDataType
486 dataTypeOf = swaggerTypeDataType
400−instance {-# OVERLAPPING #-} Data (SwaggerType ParamOtherSchema) where
488+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
401 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
489 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
402 toConstr = swaggerTypeConstr
490 toConstr = swaggerTypeConstr
403 dataTypeOf = swaggerTypeDataType
491 dataTypeOf = swaggerTypeDataType
405−instance {-# OVERLAPPING #-} Data (SwaggerType Schema) where
493+instance Data (SwaggerType 'SwaggerKindSchema) where
406 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
494 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
407 toConstr = swaggerTypeConstr
495 toConstr = swaggerTypeConstr
408 dataTypeOf = swaggerTypeDataType
496 dataTypeOf = swaggerTypeDataType
@@ -442,11 +530,11 @@ data CollectionFormat t where
442 -- Corresponds to multiple parameter instances
530 -- Corresponds to multiple parameter instances
443 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
531 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
444 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
532 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
445− CollectionMulti :: CollectionFormat ParamOtherSchema
533+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
447deriving instance Eq (CollectionFormat t)
536deriving instance Eq (CollectionFormat t)
448deriving instance Show (CollectionFormat t)
537deriving instance Show (CollectionFormat t)
449−deriving instance Typeable (CollectionFormat t)
451collectionFormatConstr :: CollectionFormat t -> Constr
539collectionFormatConstr :: CollectionFormat t -> Constr
452collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
540collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
@@ -458,12 +546,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
458collectionCommonFormats :: [CollectionFormat t]
546collectionCommonFormats :: [CollectionFormat t]
459collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
547collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
461−instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where
549+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
462 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
550 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
463 toConstr = collectionFormatConstr
551 toConstr = collectionFormatConstr
464 dataTypeOf _ = collectionFormatDataType
552 dataTypeOf _ = collectionFormatDataType
466−deriving instance {-# OVERLAPPING #-} Data (CollectionFormat ParamOtherSchema)
554+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
468type ParamName = Text
556type ParamName = Text
@@ -472,9 +560,9 @@ data Schema = Schema
472 , _schemaDescription :: Maybe Text
560 , _schemaDescription :: Maybe Text
473 , _schemaRequired :: [ParamName]
561 , _schemaRequired :: [ParamName]
475− , _schemaAllOf :: Maybe [Schema]
563+ , _schemaAllOf :: Maybe [Referenced Schema]
476− , _schemaProperties :: HashMap Text (Referenced Schema)
564+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
477− , _schemaAdditionalProperties :: Maybe Schema
565+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
479 , _schemaDiscriminator :: Maybe Text
567 , _schemaDiscriminator :: Maybe Text
480 , _schemaReadOnly :: Maybe Bool
568 , _schemaReadOnly :: Maybe Bool
@@ -485,7 +573,7 @@ data Schema = Schema
485 , _schemaMaxProperties :: Maybe Integer
573 , _schemaMaxProperties :: Maybe Integer
486 , _schemaMinProperties :: Maybe Integer
574 , _schemaMinProperties :: Maybe Integer
488− , _schemaParamSchema :: ParamSchema Schema
576+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
489 } deriving (Eq, Show, Generic, Data, Typeable)
577 } deriving (Eq, Show, Generic, Data, Typeable)
491-- | A @'Schema'@ with an optional name.
579-- | A @'Schema'@ with an optional name.
@@ -495,7 +583,10 @@ data NamedSchema = NamedSchema
495 , _namedSchemaSchema :: Schema
583 , _namedSchemaSchema :: Schema
496 } deriving (Eq, Show, Generic, Data, Typeable)
584 } deriving (Eq, Show, Generic, Data, Typeable)
586+-- | Regex pattern for @string@ type.
498−data ParamSchema t = ParamSchema
589+data ParamSchema (t :: SwaggerKind *) = ParamSchema
499 { -- | Declares the value of the parameter that the server will use if none is provided,
590 { -- | Declares the value of the parameter that the server will use if none is provided,
500 -- for example a @"count"@ to control the number of results per page might default to @100@
591 -- for example a @"count"@ to control the number of results per page might default to @100@
501 -- if not supplied by the client in the request.
592 -- if not supplied by the client in the request.
@@ -503,7 +594,7 @@ data ParamSchema t = ParamSchema
503 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
594 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
504 _paramSchemaDefault :: Maybe Value
595 _paramSchemaDefault :: Maybe Value
506− , _paramSchemaType :: SwaggerType t
597+ , _paramSchemaType :: Maybe (SwaggerType t)
507 , _paramSchemaFormat :: Maybe Format
598 , _paramSchemaFormat :: Maybe Format
508 , _paramSchemaItems :: Maybe (SwaggerItems t)
599 , _paramSchemaItems :: Maybe (SwaggerItems t)
509 , _paramSchemaMaximum :: Maybe Scientific
600 , _paramSchemaMaximum :: Maybe Scientific
@@ -512,7 +603,7 @@ data ParamSchema t = ParamSchema
512 , _paramSchemaExclusiveMinimum :: Maybe Bool
603 , _paramSchemaExclusiveMinimum :: Maybe Bool
513 , _paramSchemaMaxLength :: Maybe Integer
604 , _paramSchemaMaxLength :: Maybe Integer
514 , _paramSchemaMinLength :: Maybe Integer
605 , _paramSchemaMinLength :: Maybe Integer
515− , _paramSchemaPattern :: Maybe Text
606+ , _paramSchemaPattern :: Maybe Pattern
516 , _paramSchemaMaxItems :: Maybe Integer
607 , _paramSchemaMaxItems :: Maybe Integer
517 , _paramSchemaMinItems :: Maybe Integer
608 , _paramSchemaMinItems :: Maybe Integer
518 , _paramSchemaUniqueItems :: Maybe Bool
609 , _paramSchemaUniqueItems :: Maybe Bool
@@ -520,7 +611,7 @@ data ParamSchema t = ParamSchema
520 , _paramSchemaMultipleOf :: Maybe Scientific
611 , _paramSchemaMultipleOf :: Maybe Scientific
521 } deriving (Eq, Show, Generic, Typeable)
612 } deriving (Eq, Show, Generic, Typeable)
523−deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data (ParamSchema t)
614+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
525data Xml = Xml
616data Xml = Xml
526 { -- | Replaces the name of the element/attribute used for the described schema property.
617 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -562,7 +653,7 @@ data Responses = Responses
563 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
654 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
564 -- Describes the expected response for those HTTP status codes.
655 -- Describes the expected response for those HTTP status codes.
565− , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
656+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
566 } deriving (Eq, Show, Generic, Data, Typeable)
657 } deriving (Eq, Show, Generic, Data, Typeable)
568type HttpStatusCode = Int
659type HttpStatusCode = Int
@@ -581,19 +672,22 @@ data Response = Response
581 , _responseSchema :: Maybe (Referenced Schema)
672 , _responseSchema :: Maybe (Referenced Schema)
583 -- | A list of headers that are sent with the response.
674 -- | A list of headers that are sent with the response.
584− , _responseHeaders :: HashMap HeaderName Header
675+ , _responseHeaders :: InsOrdHashMap HeaderName Header
586 -- | An example of the response message.
677 -- | An example of the response message.
587 , _responseExamples :: Maybe Example
678 , _responseExamples :: Maybe Example
588 } deriving (Eq, Show, Generic, Data, Typeable)
679 } deriving (Eq, Show, Generic, Data, Typeable)
681+instance IsString Response where
682+ fromString s = Response (fromString s) Nothing mempty Nothing
590type HeaderName = Text
684type HeaderName = Text
592data Header = Header
686data Header = Header
593 { -- | A short description of the header.
687 { -- | A short description of the header.
594 _headerDescription :: Maybe Text
688 _headerDescription :: Maybe Text
596− , _headerParamSchema :: ParamSchema Header
690+ , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
597 } deriving (Eq, Show, Generic, Data, Typeable)
691 } deriving (Eq, Show, Generic, Data, Typeable)
599data Example = Example { getExample :: Map MediaType Value }
693data Example = Example { getExample :: Map MediaType Value }
@@ -644,7 +738,7 @@ data OAuth2Params = OAuth2Params
644 _oauth2Flow :: OAuth2Flow
738 _oauth2Flow :: OAuth2Flow
646 -- | The available scopes for the OAuth2 security scheme.
740 -- | The available scopes for the OAuth2 security scheme.
647− , _oauth2Scopes :: HashMap Text Text
741+ , _oauth2Scopes :: InsOrdHashMap Text Text
648 } deriving (Eq, Show, Generic, Data, Typeable)
742 } deriving (Eq, Show, Generic, Data, Typeable)
650data SecuritySchemeType
744data SecuritySchemeType
@@ -661,12 +755,28 @@ data SecurityScheme = SecurityScheme
661 , _securitySchemeDescription :: Maybe Text
755 , _securitySchemeDescription :: Maybe Text
662 } deriving (Eq, Show, Generic, Data, Typeable)
756 } 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)
664-- | Lists the required security schemes to execute this operation.
774-- | Lists the required security schemes to execute this operation.
665-- The object can have multiple security schemes declared in it which are all required
775-- The object can have multiple security schemes declared in it which are all required
666-- (that is, there is a logical AND between the schemes).
776-- (that is, there is a logical AND between the schemes).
667newtype SecurityRequirement = SecurityRequirement
777newtype SecurityRequirement = SecurityRequirement
668− { getSecurityRequirement :: HashMap Text [Text]
778+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
669− } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
779+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
671-- | Tag name.
781-- | Tag name.
672type TagName = Text
782type TagName = Text
@@ -683,7 +793,12 @@ data Tag = Tag
684 -- | Additional external documentation for this tag.
794 -- | Additional external documentation for this tag.
685 , _tagExternalDocs :: Maybe ExternalDocs
795 , _tagExternalDocs :: Maybe ExternalDocs
686− } deriving (Eq, Show, Generic, Data, Typeable)
796+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
798+instance Hashable Tag
800+instance IsString Tag where
801+ fromString s = Tag (fromString s) Nothing Nothing
688-- | Allows referencing an external resource for extended documentation.
803-- | Allows referencing an external resource for extended documentation.
689data ExternalDocs = ExternalDocs
804data ExternalDocs = ExternalDocs
@@ -693,7 +808,9 @@ data ExternalDocs = ExternalDocs
694 -- | The URL for the target documentation.
809 -- | The URL for the target documentation.
695 , _externalDocsUrl :: URL
810 , _externalDocsUrl :: URL
696− } deriving (Eq, Show, Generic, Data, Typeable)
811+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
813+instance Hashable ExternalDocs
698-- | A simple object to allow referencing other definitions in the specification.
815-- | A simple object to allow referencing other definitions in the specification.
699-- It can be used to reference parameters and responses that are defined at the top level for reuse.
816-- It can be used to reference parameters and responses that are defined at the top level for reuse.
@@ -703,76 +820,122 @@ newtype Reference = Reference { getReference :: Text }
703data Referenced a
820data Referenced a
704 = Ref Reference
821 = Ref Reference
705 | Inline a
822 | Inline a
706− deriving (Eq, Show, Data, Typeable)
823+ deriving (Eq, Show, Functor, Data, Typeable)
825+instance IsString a => IsString (Referenced a) where
826+ fromString = Inline . fromString
708−newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)
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)
710-- =======================================================================
835-- =======================================================================
711-- Monoid instances
836-- Monoid instances
712-- =======================================================================
837-- =======================================================================
839+instance Semigroup Swagger where
840+ (<>) = genericMappend
714instance Monoid Swagger where
841instance Monoid Swagger where
715 mempty = genericMempty
842 mempty = genericMempty
716− mappend = genericMappend
843+ mappend = (<>)
845+instance Semigroup Info where
846+ (<>) = genericMappend
718instance Monoid Info where
847instance Monoid Info where
719 mempty = genericMempty
848 mempty = genericMempty
720− mappend = genericMappend
849+ mappend = (<>)
851+instance Semigroup Contact where
852+ (<>) = genericMappend
722−instance Monoid Paths where
853+instance Monoid Contact where
723 mempty = genericMempty
854 mempty = genericMempty
724− mappend = genericMappend
855+ mappend = (<>)
857+instance Semigroup PathItem where
858+ (<>) = genericMappend
726instance Monoid PathItem where
859instance Monoid PathItem where
727 mempty = genericMempty
860 mempty = genericMempty
728− mappend = genericMappend
861+ mappend = (<>)
863+instance Semigroup Schema where
864+ (<>) = genericMappend
730instance Monoid Schema where
865instance Monoid Schema where
731 mempty = genericMempty
866 mempty = genericMempty
732− mappend = genericMappend
867+ mappend = (<>)
869+instance Semigroup (ParamSchema t) where
870+ (<>) = genericMappend
734instance Monoid (ParamSchema t) where
871instance Monoid (ParamSchema t) where
735 mempty = genericMempty
872 mempty = genericMempty
736− mappend = genericMappend
873+ mappend = (<>)
875+instance Semigroup Param where
876+ (<>) = genericMappend
738instance Monoid Param where
877instance Monoid Param where
739 mempty = genericMempty
878 mempty = genericMempty
740− mappend = genericMappend
879+ mappend = (<>)
881+instance Semigroup ParamOtherSchema where
882+ (<>) = genericMappend
742instance Monoid ParamOtherSchema where
883instance Monoid ParamOtherSchema where
743 mempty = genericMempty
884 mempty = genericMempty
744− mappend = genericMappend
885+ mappend = (<>)
887+instance Semigroup Header where
888+ (<>) = genericMappend
746instance Monoid Header where
889instance Monoid Header where
747 mempty = genericMempty
890 mempty = genericMempty
748− mappend = genericMappend
891+ mappend = (<>)
893+instance Semigroup Responses where
894+ (<>) = genericMappend
750instance Monoid Responses where
895instance Monoid Responses where
751 mempty = genericMempty
896 mempty = genericMempty
752− mappend = genericMappend
897+ mappend = (<>)
899+instance Semigroup Response where
900+ (<>) = genericMappend
754instance Monoid Response where
901instance Monoid Response where
755 mempty = genericMempty
902 mempty = genericMempty
756− mappend = genericMappend
903+ mappend = (<>)
905+instance Semigroup ExternalDocs where
906+ (<>) = genericMappend
758instance Monoid ExternalDocs where
907instance Monoid ExternalDocs where
759 mempty = genericMempty
908 mempty = genericMempty
760− mappend = genericMappend
909+ mappend = (<>)
911+instance Semigroup Operation where
912+ (<>) = genericMappend
762instance Monoid Operation where
913instance Monoid Operation where
763 mempty = genericMempty
914 mempty = genericMempty
764− mappend = genericMappend
915+ mappend = (<>)
917+instance Semigroup Example where
918+ (<>) = genericMappend
766instance Monoid Example where
919instance Monoid Example where
767 mempty = genericMempty
920 mempty = genericMempty
768− mappend = genericMappend
921+ mappend = (<>)
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
770-- =======================================================================
934-- =======================================================================
771-- SwaggerMonoid helper instances
935-- SwaggerMonoid helper instances
772-- =======================================================================
936-- =======================================================================
774instance SwaggerMonoid Info
938instance SwaggerMonoid Info
775−instance SwaggerMonoid Paths
776instance SwaggerMonoid PathItem
939instance SwaggerMonoid PathItem
777instance SwaggerMonoid Schema
940instance SwaggerMonoid Schema
778instance SwaggerMonoid (ParamSchema t)
941instance SwaggerMonoid (ParamSchema t)
@@ -782,6 +945,8 @@ instance SwaggerMonoid Responses
782instance SwaggerMonoid Response
945instance SwaggerMonoid Response
783instance SwaggerMonoid ExternalDocs
946instance SwaggerMonoid ExternalDocs
784instance SwaggerMonoid Operation
947instance SwaggerMonoid Operation
948+instance SwaggerMonoid SecurityDefinitions
949+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
786instance SwaggerMonoid MimeList
951instance SwaggerMonoid MimeList
787deriving instance SwaggerMonoid URL
952deriving instance SwaggerMonoid URL
@@ -794,13 +959,13 @@ instance SwaggerMonoid ParamLocation where
794 swaggerMempty = ParamQuery
959 swaggerMempty = ParamQuery
795 swaggerMappend _ y = y
960 swaggerMappend _ y = y
797−instance SwaggerMonoid (HashMap FilePath PathItem) where
962+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
798− swaggerMempty = HashMap.empty
963+ swaggerMempty = InsOrdHashMap.empty
799− swaggerMappend = HashMap.unionWith mappend
964+ swaggerMappend = InsOrdHashMap.unionWith mappend
801instance Monoid a => SwaggerMonoid (Referenced a) where
966instance Monoid a => SwaggerMonoid (Referenced a) where
802 swaggerMempty = Inline mempty
967 swaggerMempty = Inline mempty
803− swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
968+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
804 swaggerMappend _ y = y
969 swaggerMappend _ y = y
806instance SwaggerMonoid ParamAnySchema where
971instance SwaggerMonoid ParamAnySchema where
@@ -894,7 +1059,8 @@ instance ToJSON OAuth2Flow where
894 , "tokenUrl" .= tokenUrl ]
1059 , "tokenUrl" .= tokenUrl ]
896instance ToJSON OAuth2Params where
1061instance ToJSON OAuth2Params where
897− toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1062+ toJSON = sopSwaggerGenericToJSON
899instance ToJSON SecuritySchemeType where
1065instance ToJSON SecuritySchemeType where
900 toJSON SecuritySchemeBasic
1066 toJSON SecuritySchemeBasic
@@ -907,28 +1073,37 @@ instance ToJSON SecuritySchemeType where
907 <+> object [ "type" .= ("oauth2" :: Text) ]
1073 <+> object [ "type" .= ("oauth2" :: Text) ]
909instance ToJSON Swagger where
1075instance ToJSON Swagger where
910− toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
1076+ toJSON = sopSwaggerGenericToJSON
911− where
1077+ DEFINE_TOENCODING
912− addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
913− addVersion _ = error "impossible"
915instance ToJSON SecurityScheme where
1079instance ToJSON SecurityScheme where
916− toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1080+ toJSON = sopSwaggerGenericToJSON
918instance ToJSON Schema where
1083instance ToJSON Schema where
919− toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
1084+ toJSON = sopSwaggerGenericToJSON
920− where
1085+ DEFINE_TOENCODING
921− f "items" (Array _) = True
924instance ToJSON Header where
1087instance ToJSON Header where
925− toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
1088+ toJSON = sopSwaggerGenericToJSON
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}"
927−instance ToJSON (SwaggerItems t) where
1097+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
928 toJSON (SwaggerItemsPrimitive fmt schema) = object
1098 toJSON (SwaggerItemsPrimitive fmt schema) = object
929 [ "collectionFormat" .= fmt
1099 [ "collectionFormat" .= fmt
930 , "items" .= schema ]
1100 , "items" .= schema ]
931 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1101 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102+ toJSON (SwaggerItemsArray []) = object
1103+ [ "items" .= object []
1104+ , "maxItems" .= (0 :: Int)
1105+ , "example" .= Array mempty
932 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1107 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
934instance ToJSON Host where
1109instance ToJSON Host where
@@ -937,38 +1112,43 @@ instance ToJSON Host where
937 Nothing -> host
1112 Nothing -> host
938 Just port -> host ++ ":" ++ show port
1113 Just port -> host ++ ":" ++ show port
940−instance ToJSON Paths where
941− toJSON (Paths m) = toJSON m
943instance ToJSON MimeList where
1115instance ToJSON MimeList where
944 toJSON (MimeList xs) = toJSON (map show xs)
1116 toJSON (MimeList xs) = toJSON (map show xs)
946instance ToJSON Param where
1118instance ToJSON Param where
947− toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1119+ toJSON = sopSwaggerGenericToJSON
949instance ToJSON ParamAnySchema where
1122instance ToJSON ParamAnySchema where
950 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1123 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
951 toJSON (ParamOther s) = toJSON s
1124 toJSON (ParamOther s) = toJSON s
953instance ToJSON ParamOtherSchema where
1126instance ToJSON ParamOtherSchema where
954− toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1127+ toJSON = sopSwaggerGenericToJSON
956instance ToJSON Responses where
1130instance ToJSON Responses where
957− toJSON (Responses def rs) = omitEmpties $
1131+ toJSON = sopSwaggerGenericToJSON
958− toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1132+ DEFINE_TOENCODING
960instance ToJSON Response where
1134instance ToJSON Response where
961− toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
1135+ toJSON = sopSwaggerGenericToJSON
963instance ToJSON Operation where
1138instance ToJSON Operation where
964− toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
1139+ toJSON = sopSwaggerGenericToJSON
966instance ToJSON PathItem where
1142instance ToJSON PathItem where
967− toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
1143+ toJSON = sopSwaggerGenericToJSON
969instance ToJSON Example where
1146instance ToJSON Example where
970 toJSON = toJSON . Map.mapKeys show . getExample
1147 toJSON = toJSON . Map.mapKeys show . getExample
1149+instance ToJSON SecurityDefinitions where
1150+ toJSON (SecurityDefinitions sd) = toJSON sd
972instance ToJSON Reference where
1152instance ToJSON Reference where
973 toJSON (Reference ref) = object [ "$ref" .= ref ]
1153 toJSON (Reference ref) = object [ "$ref" .= ref ]
@@ -997,11 +1177,14 @@ instance ToJSON (CollectionFormat t) where
997 toJSON CollectionPipes = "pipes"
1177 toJSON CollectionPipes = "pipes"
998 toJSON CollectionMulti = "multi"
1178 toJSON CollectionMulti = "multi"
1000−instance ToJSON (ParamSchema t) where
1180+instance ToJSON (ParamSchema k) where
1001− toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")
1181+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1002− where
1182+ toJSON = sopSwaggerGenericToJSONWithOpts $
1003− f "items" (Array _) = True
1183+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1185+instance ToJSON AdditionalProperties where
1186+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187+ toJSON (AdditionalPropertiesSchema s) = toJSON s
1006-- =======================================================================
1189-- =======================================================================
1007-- Manual FromJSON instances
1190-- Manual FromJSON instances
@@ -1021,7 +1204,7 @@ instance FromJSON OAuth2Flow where
1021 parseJSON _ = empty
1204 parseJSON _ = empty
1023instance FromJSON OAuth2Params where
1206instance FromJSON OAuth2Params where
1024− parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
1207+ parseJSON = sopSwaggerGenericParseJSON
1026instance FromJSON SecuritySchemeType where
1209instance FromJSON SecuritySchemeType where
1027 parseJSON js@(Object o) = do
1210 parseJSON js@(Object o) = do
@@ -1034,60 +1217,65 @@ instance FromJSON SecuritySchemeType where
1034 parseJSON _ = empty
1217 parseJSON _ = empty
1036instance FromJSON Swagger where
1219instance FromJSON Swagger where
1037− parseJSON js@(Object o) = do
1220+ parseJSON = sopSwaggerGenericParseJSON
1038− (version :: Text) <- o .: "swagger"
1039− when (version /= "2.0") empty
1040− (genericParseJSON (jsonPrefix "")
1041− `withDefaults` [ "consumes" .= (mempty :: MimeList)
1042− , "produces" .= (mempty :: MimeList)
1043− , "security" .= ([] :: [SecurityRequirement])
1044− , "tags" .= ([] :: [Tag])
1045− , "definitions" .= (mempty :: Definitions Schema)
1046− , "parameters" .= (mempty :: Definitions Param)
1047− , "responses" .= (mempty :: Definitions Response)
1048− , "securityDefinitions" .= (mempty :: Definitions SecurityScheme)
1050− parseJSON _ = empty
1052instance FromJSON SecurityScheme where
1222instance FromJSON SecurityScheme where
1053− parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
1223+ parseJSON = sopSwaggerGenericParseJSON
1055instance FromJSON Schema where
1225instance FromJSON Schema where
1056− parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1226+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1057− `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1227+ where nullaryCleanup :: Schema -> Schema
1058− , "required" .= ([] :: [ParamName]) ]
1228+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230+ then s { _schemaExample = Nothing
1231+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1060instance FromJSON Header where
1234instance FromJSON Header where
1061− parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
1235+ parseJSON = sopSwaggerGenericParseJSON
1063−instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1237+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1064− parseJSON (Object o) = SwaggerItemsPrimitive
1238+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1065 <$> o .:? "collectionFormat"
1239 <$> o .:? "collectionFormat"
1066 <*> (o .: "items" >>= parseJSON)
1240 <*> (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"})])
1068−instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where
1258+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259+ parseJSON js@(Object obj)
1260+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1069− parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
1261+ | otherwise = SwaggerItemsObject <$> parseJSON js
1070 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1262 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1071 parseJSON _ = empty
1263 parseJSON _ = empty
1073instance FromJSON Host where
1265instance FromJSON Host where
1074− parseJSON (String s) =
1266+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1075− case fromInteger <$> readMaybe portStr of
1267+ [host] -> return $ Host host Nothing
1076− Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1268+ [host, port] -> case readMaybe port of
1077− mport -> pure $ Host host mport
1269+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1078− where
1270+ Just p -> return $ Host host (Just (fromInteger p))
1079− (hostText, portText) = Text.breakOn ":" s
1271+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1080− [host, portStr] = map Text.unpack [hostText, portText]
1081 parseJSON _ = empty
1272 parseJSON _ = empty
1083−instance FromJSON Paths where
1084− parseJSON js = Paths <$> parseJSON js
1086instance FromJSON MimeList where
1274instance FromJSON MimeList where
1087 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1275 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1089instance FromJSON Param where
1277instance FromJSON Param where
1090− parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
1278+ parseJSON = sopSwaggerGenericParseJSON
1092instance FromJSON ParamAnySchema where
1280instance FromJSON ParamAnySchema where
1093 parseJSON js@(Object o) = do
1281 parseJSON js@(Object o) = do
@@ -1100,12 +1288,12 @@ instance FromJSON ParamAnySchema where
1100 parseJSON _ = empty
1288 parseJSON _ = empty
1102instance FromJSON ParamOtherSchema where
1290instance FromJSON ParamOtherSchema where
1103− parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1291+ parseJSON = sopSwaggerGenericParseJSON
1105instance FromJSON Responses where
1293instance FromJSON Responses where
1106 parseJSON (Object o) = Responses
1294 parseJSON (Object o) = Responses
1107 <$> o .:? "default"
1295 <$> o .:? "default"
1108− <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
1296+ <*> (parseJSON (Object (HashMap.delete "default" o)))
1109 parseJSON _ = empty
1297 parseJSON _ = empty
1111instance FromJSON Example where
1299instance FromJSON Example where
@@ -1114,16 +1302,16 @@ instance FromJSON Example where
1114 pure $ Example (Map.mapKeys fromString m)
1302 pure $ Example (Map.mapKeys fromString m)
1116instance FromJSON Response where
1304instance FromJSON Response where
1117− parseJSON = genericParseJSON (jsonPrefix "response")
1305+ parseJSON = sopSwaggerGenericParseJSON
1118− `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
1120instance FromJSON Operation where
1307instance FromJSON Operation where
1121− parseJSON = genericParseJSON (jsonPrefix "operation")
1308+ parseJSON = sopSwaggerGenericParseJSON
1122− `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
1124instance FromJSON PathItem where
1310instance FromJSON PathItem where
1125− parseJSON = genericParseJSON (jsonPrefix "pathItem")
1311+ parseJSON = sopSwaggerGenericParseJSON
1126− `withDefaults` [ "parameters" .= ([] :: [Param]) ]
1312+
1313+instance FromJSON SecurityDefinitions where
1314+ parseJSON js = SecurityDefinitions <$> parseJSON js
1128instance FromJSON Reference where
1316instance FromJSON Reference where
1129 parseJSON (Object o) = Reference <$> o .: "$ref"
1317 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1140,6 +1328,7 @@ referencedParseJSON prefix js@(Object o) = do
1140 case Text.stripPrefix prefix s of
1328 case Text.stripPrefix prefix s of
1141 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1329 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1142 Just suffix -> pure (Reference suffix)
1330 Just suffix -> pure (Reference suffix)
1331+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1144instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1333instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1145instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1334instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
@@ -1148,26 +1337,91 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
1148instance FromJSON Xml where
1337instance FromJSON Xml where
1149 parseJSON = genericParseJSON (jsonPrefix "xml")
1338 parseJSON = genericParseJSON (jsonPrefix "xml")
1151−instance FromJSON (SwaggerType Schema) where
1340+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1152 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1341 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1154−instance FromJSON (SwaggerType ParamOtherSchema) where
1343+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1155 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1344 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1157−instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where
1346+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1158 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1347 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1160−instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where
1349+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1161 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1350 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1352+-- NOTE: There aren't collections of 'Schema'
1163−instance FromJSON (CollectionFormat ParamOtherSchema) where
1353+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1164− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1354+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1166−-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1356+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1167−-- @FromJSON (SwaggerItems t)@ are necessary here!
1357+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1168−-- Without the constraint the general instance will be used
1169−-- that only accepts common types (i.e. NOT object, null or file)
1170−-- and primitive array items.
1171−instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1172− parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")
1359+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1360+ parseJSON = sopSwaggerGenericParseJSON
1361+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1362+ parseJSON = sopSwaggerGenericParseJSON
1363+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1364+ parseJSON = sopSwaggerGenericParseJSON
1366+instance FromJSON AdditionalProperties where
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