@@ -1,7 +1,4 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
31{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFunctor #-}
52{-# LANGUAGE DeriveGeneric #-}
63{-# LANGUAGE DeriveTraversable #-}
74{-# LANGUAGE FlexibleContexts #-}
@@ -12,128 +9,89 @@
129{-# LANGUAGE RecordWildCards #-}
1310{-# LANGUAGE ScopedTypeVariables #-}
1411{-# LANGUAGE StandaloneDeriving #-}
15−{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
1712{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
20−#endif
21−#include "overlapping-compat.h"
2213module Data.Swagger.Internal where
2314
24−import Prelude ()
25−import Prelude.Compat
26−
27−import Control.Lens ((&), (.~), (?~))
2815import Control.Applicative
16+import Control.Monad
2917import Data.Aeson
3018import qualified Data.Aeson.Types as JSON
3119import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32−import Data.Hashable (Hashable)
20+import Data.HashMap.Strict (HashMap)
3321import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
3522import Data.Map (Map)
3623import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
38−import Data.Semigroup.Compat (Semigroup (..))
24+import Data.Monoid
3925import Data.Scientific (Scientific)
40−import Data.String (IsString(..))
26+import Data.String (fromString)
4127import Data.Text (Text)
4228import qualified Data.Text as Text
4329import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
30+import Network (HostName, PortNumber)
4531import Network.HTTP.Media (MediaType)
4632import Text.Read (readMaybe)
4733
48−import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50−
51−import Generics.SOP.TH (deriveGeneric)
52−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53− ,sopSwaggerGenericToJSONWithOpts
54− ,sopSwaggerGenericParseJSON
55− ,HasSwaggerAesonOptions(..)
56− ,AesonDefaultValue(..)
57− ,mkSwaggerAesonOptions
58− ,saoAdditionalPairs
59− ,saoSubObject)
6034import Data.Swagger.Internal.Utils
6135
62−#if MIN_VERSION_aeson(0,10,0)
63−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64−#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65−#else
66−#define DEFINE_TOENCODING
67−#endif
68−
69−-- $setup
70−-- >>> :seti -XDataKinds
71−-- >>> import Data.Aeson
72−
73−-- | A list of definitions that can be used in references.
74−type Definitions = InsOrdHashMap Text
75−
7636-- | This is the root document object for the API specification.
7737data Swagger = Swagger
7838 { -- | Provides metadata about the API.
7939 -- The metadata can be used by the clients if needed.
80− _swaggerInfo :: Info
40+ _info :: Info
8141
8242 -- | The host (name or ip) serving the API. It MAY include a port.
8343 -- 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
8545
8646 -- | The base path on which the API is served, which is relative to the host.
8747 -- If it is not included, the API is served directly under the host.
8848 -- The value MUST start with a leading slash (/).
89− , _swaggerBasePath :: Maybe FilePath
49+ , _basePath :: Maybe FilePath
9050
9151 -- | The transfer protocol of the API.
9252 -- 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]
9454
9555 -- | A list of MIME types the APIs can consume.
9656 -- This is global to all APIs but can be overridden on specific API calls.
97− , _swaggerConsumes :: MimeList
57+ , _consumes :: MimeList
9858
9959 -- | A list of MIME types the APIs can produce.
100− -- This is global to all APIs but can be overridden on specific API calls.
101− , _swaggerProduces :: MimeList
60+ -- This is global to all APIs but can be overridden on specific API calls.
61+ , _produces :: MimeList
10262
10363 -- | The available paths and operations for the API.
104− -- Holds the relative paths to the individual endpoints.
105− -- The path is appended to the @'basePath'@ in order to construct the full URL.
106− , _swaggerPaths :: InsOrdHashMap FilePath PathItem
64+ , _paths :: Paths
10765
10866 -- | An object to hold data types produced and consumed by operations.
109− , _swaggerDefinitions :: Definitions Schema
67+ , _definitions :: HashMap Text Schema
11068
11169 -- | An object to hold parameters that can be used across operations.
11270 -- This property does not define global parameters for all operations.
113− , _swaggerParameters :: Definitions Param
71+ , _parameters :: HashMap Text Param
11472
11573 -- | An object to hold responses that can be used across operations.
11674 -- This property does not define global responses for all operations.
117− , _swaggerResponses :: Definitions Response
75+ , _responses :: HashMap Text Response
11876
11977 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
78+ , _securityDefinitions :: HashMap Text SecurityScheme
12179
12280 -- | A declaration of which security schemes are applied for the API as a whole.
12381 -- The list of values describes alternative security schemes that can be used
12482 -- (that is, there is a logical OR between the security requirements).
12583 -- Individual operations can override this definition.
126− , _swaggerSecurity :: [SecurityRequirement]
84+ , _security :: [SecurityRequirement]
12785
12886 -- | A list of tags used by the specification with additional metadata.
12987 -- The order of the tags can be used to reflect on their order by the parsing tools.
13088 -- Not all tags that are used by the Operation Object must be declared.
13189 -- The tags that are not declared may be organized randomly or based on the tools' logic.
13290 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
91+ , _tags :: [Tag]
13492
13593 -- | Additional external documentation.
136− , _swaggerExternalDocs :: Maybe ExternalDocs
94+ , _externalDocs :: Maybe ExternalDocs
13795 } deriving (Eq, Show, Generic, Data, Typeable)
13896
13997-- | The object provides metadata about the API.
@@ -182,18 +140,12 @@ data License = License
182140 , _licenseUrl :: Maybe URL
183141 } deriving (Eq, Show, Generic, Data, Typeable)
184142
185−instance IsString License where
186− fromString s = License (fromString s) Nothing
187−
188143-- | The host (name or ip) serving the API. It MAY include a port.
189144data Host = Host
190145 { _hostName :: HostName -- ^ Host name.
191146 , _hostPort :: Maybe PortNumber -- ^ Optional port.
192147 } deriving (Eq, Show, Generic, Typeable)
193148
194−instance IsString Host where
195− fromString s = Host s Nothing
196−
197149hostConstr :: Constr
198150hostConstr = mkConstr hostDataType "Host" [] Prefix
199151
@@ -215,6 +167,13 @@ data Scheme
215167 | Wss
216168 deriving (Eq, Show, Generic, Data, Typeable)
217169
170+-- | The available paths and operations for the API.
171+data Paths = Paths
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)
176+
218177-- | Describes the operations available on a single path.
219178-- A @'PathItem'@ may be empty, due to ACL constraints.
220179-- The path itself is still exposed to the documentation viewer
@@ -252,7 +211,7 @@ data PathItem = PathItem
252211data Operation = Operation
253212 { -- | A list of tags for API documentation control.
254213 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
214+ _operationTags :: [TagName]
256215
257216 -- | A short summary of what the operation does.
258217 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -309,7 +268,7 @@ data Operation = Operation
309268 } deriving (Eq, Show, Generic, Data, Typeable)
310269
311270newtype MimeList = MimeList { getMimeList :: [MediaType] }
312− deriving (Eq, Show, Semigroup, Monoid, Typeable)
271+ deriving (Eq, Show, Monoid, Typeable)
313272
314273mimeListConstr :: Constr
315274mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
@@ -360,8 +319,8 @@ data ParamOtherSchema = ParamOtherSchema
360319 -- Default value is @False@.
361320 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362321
363− , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364− } deriving (Eq, Show, Generic, Typeable, Data)
322+ , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
323+ } deriving (Eq, Show, Generic, Data, Typeable)
365324
366325-- | Items for @'SwaggerArray'@ schemas.
367326--
@@ -374,78 +333,28 @@ data ParamOtherSchema = ParamOtherSchema
374333--
375334-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376335data SwaggerItems t where
377− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
380− deriving (Typeable)
336+ SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
337+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
338+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
381339
382340deriving instance Eq (SwaggerItems t)
383341deriving instance Show (SwaggerItems t)
384−--deriving instance Typeable (SwaggerItems t)
342+deriving instance Typeable (SwaggerItems t)
385343
386344swaggerItemsPrimitiveConstr :: Constr
387345swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388346
389−swaggerItemsObjectConstr :: Constr
390−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391−
392−swaggerItemsArrayConstr :: Constr
393−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394−
395347swaggerItemsDataType :: DataType
396348swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397349
398−-- Note: unfortunately we have to write these Data instances by hand,
399−-- to get better contexts / avoid duplicate name when using standalone deriving
400−
401−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402− -- TODO: define gfoldl
350+instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where
403351 gunfold k z c = case constrIndex c of
404352 1 -> k (k (z SwaggerItemsPrimitive))
405353 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406354 toConstr _ = swaggerItemsPrimitiveConstr
407355 dataTypeOf _ = swaggerItemsDataType
408356
409−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
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
417−
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
422−
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)."
427−
428− toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431−
432− dataTypeOf _ = swaggerItemsDataType
433−
434−-- | Type used as a kind to avoid overlapping instances.
435−data SwaggerKind t
436− = SwaggerKindNormal t
437− | SwaggerKindParamOtherSchema
438− | SwaggerKindSchema
439− deriving (Typeable)
440−
441−deriving instance Typeable 'SwaggerKindNormal
442−deriving instance Typeable 'SwaggerKindParamOtherSchema
443−deriving instance Typeable 'SwaggerKindSchema
444−
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
357+deriving instance Data (SwaggerItems Schema)
449358
450359data SwaggerType t where
451360 SwaggerString :: SwaggerType t
@@ -453,44 +362,44 @@ data SwaggerType t where
453362 SwaggerInteger :: SwaggerType t
454363 SwaggerBoolean :: SwaggerType t
455364 SwaggerArray :: SwaggerType t
456− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457− SwaggerNull :: SwaggerType 'SwaggerKindSchema
458− SwaggerObject :: SwaggerType 'SwaggerKindSchema
459− deriving (Typeable)
365+ SwaggerFile :: SwaggerType ParamOtherSchema
366+ SwaggerNull :: SwaggerType Schema
367+ SwaggerObject :: SwaggerType Schema
460368
461369deriving instance Eq (SwaggerType t)
462370deriving instance Show (SwaggerType t)
371+deriving instance Typeable (SwaggerType t)
463372
464373swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465374swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466375
467−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
376+swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
468377swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469378
470−swaggerCommonTypes :: [SwaggerType k]
379+swaggerCommonTypes :: [SwaggerType t]
471380swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472381
473−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
382+swaggerParamTypes :: [SwaggerType ParamOtherSchema]
474383swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475384
476−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
385+swaggerSchemaTypes :: [SwaggerType Schema]
477386swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478387
479388swaggerTypeConstrs :: [Constr]
480−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
389+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
481390 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482391
483−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
392+instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerType t) where
484393 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485394 toConstr = swaggerTypeConstr
486395 dataTypeOf = swaggerTypeDataType
487396
488−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
397+instance {-# OVERLAPPING #-} Data (SwaggerType ParamOtherSchema) where
489398 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490399 toConstr = swaggerTypeConstr
491400 dataTypeOf = swaggerTypeDataType
492401
493−instance Data (SwaggerType 'SwaggerKindSchema) where
402+instance {-# OVERLAPPING #-} Data (SwaggerType Schema) where
494403 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495404 toConstr = swaggerTypeConstr
496405 dataTypeOf = swaggerTypeDataType
@@ -530,11 +439,11 @@ data CollectionFormat t where
530439 -- Corresponds to multiple parameter instances
531440 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532441 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
534− deriving (Typeable)
442+ CollectionMulti :: CollectionFormat ParamOtherSchema
535443
536444deriving instance Eq (CollectionFormat t)
537445deriving instance Show (CollectionFormat t)
446+deriving instance Typeable (CollectionFormat t)
538447
539448collectionFormatConstr :: CollectionFormat t -> Constr
540449collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
@@ -546,12 +455,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
546455collectionCommonFormats :: [CollectionFormat t]
547456collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548457
549−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
458+instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where
550459 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551460 toConstr = collectionFormatConstr
552461 dataTypeOf _ = collectionFormatDataType
553462
554−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
463+deriving instance {-# OVERLAPPING #-} Data (CollectionFormat ParamOtherSchema)
555464
556465type ParamName = Text
557466
@@ -560,9 +469,9 @@ data Schema = Schema
560469 , _schemaDescription :: Maybe Text
561470 , _schemaRequired :: [ParamName]
562471
563− , _schemaAllOf :: Maybe [Referenced Schema]
564− , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
472+ , _schemaAllOf :: Maybe [Schema]
473+ , _schemaProperties :: HashMap Text (Referenced Schema)
474+ , _schemaAdditionalProperties :: Maybe Schema
566475
567476 , _schemaDiscriminator :: Maybe Text
568477 , _schemaReadOnly :: Maybe Bool
@@ -573,20 +482,10 @@ data Schema = Schema
573482 , _schemaMaxProperties :: Maybe Integer
574483 , _schemaMinProperties :: Maybe Integer
575484
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577− } deriving (Eq, Show, Generic, Data, Typeable)
578−
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
485+ , _schemaParamSchema :: ParamSchema Schema
584486 } deriving (Eq, Show, Generic, Data, Typeable)
585487
586−-- | Regex pattern for @string@ type.
587−type Pattern = Text
588−
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
488+data ParamSchema t = ParamSchema
590489 { -- | Declares the value of the parameter that the server will use if none is provided,
591490 -- for example a @"count"@ to control the number of results per page might default to @100@
592491 -- if not supplied by the client in the request.
@@ -594,7 +493,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
594493 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595494 _paramSchemaDefault :: Maybe Value
596495
597− , _paramSchemaType :: Maybe (SwaggerType t)
496+ , _paramSchemaType :: SwaggerType t
598497 , _paramSchemaFormat :: Maybe Format
599498 , _paramSchemaItems :: Maybe (SwaggerItems t)
600499 , _paramSchemaMaximum :: Maybe Scientific
@@ -603,7 +502,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
603502 , _paramSchemaExclusiveMinimum :: Maybe Bool
604503 , _paramSchemaMaxLength :: Maybe Integer
605504 , _paramSchemaMinLength :: Maybe Integer
606− , _paramSchemaPattern :: Maybe Pattern
505+ , _paramSchemaPattern :: Maybe Text
607506 , _paramSchemaMaxItems :: Maybe Integer
608507 , _paramSchemaMinItems :: Maybe Integer
609508 , _paramSchemaUniqueItems :: Maybe Bool
@@ -611,7 +510,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
611510 , _paramSchemaMultipleOf :: Maybe Scientific
612511 } deriving (Eq, Show, Generic, Typeable)
613512
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)
615514
616515data Xml = Xml
617516 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -653,7 +552,7 @@ data Responses = Responses
653552
654553 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
655554 -- Describes the expected response for those HTTP status codes.
656− , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
555+ , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
657556 } deriving (Eq, Show, Generic, Data, Typeable)
658557
659558type HttpStatusCode = Int
@@ -672,22 +571,19 @@ data Response = Response
672571 , _responseSchema :: Maybe (Referenced Schema)
673572
674573 -- | A list of headers that are sent with the response.
675− , _responseHeaders :: InsOrdHashMap HeaderName Header
574+ , _responseHeaders :: HashMap HeaderName Header
676575
677576 -- | An example of the response message.
678577 , _responseExamples :: Maybe Example
679578 } deriving (Eq, Show, Generic, Data, Typeable)
680579
681−instance IsString Response where
682− fromString s = Response (fromString s) Nothing mempty Nothing
683−
684580type HeaderName = Text
685581
686582data Header = Header
687583 { -- | A short description of the header.
688584 _headerDescription :: Maybe Text
689585
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
586+ , _headerParamSchema :: ParamSchema Header
691587 } deriving (Eq, Show, Generic, Data, Typeable)
692588
693589data Example = Example { getExample :: Map MediaType Value }
@@ -738,7 +634,7 @@ data OAuth2Params = OAuth2Params
738634 _oauth2Flow :: OAuth2Flow
739635
740636 -- | The available scopes for the OAuth2 security scheme.
741− , _oauth2Scopes :: InsOrdHashMap Text Text
637+ , _oauth2Scopes :: HashMap Text Text
742638 } deriving (Eq, Show, Generic, Data, Typeable)
743639
744640data SecuritySchemeType
@@ -755,28 +651,12 @@ data SecurityScheme = SecurityScheme
755651 , _securitySchemeDescription :: Maybe Text
756652 } deriving (Eq, Show, Generic, Data, Typeable)
757653
758−
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
766− else
767− s1
768−mergeSecurityScheme s1 _ = s1
769−
770−newtype SecurityDefinitions
771− = SecurityDefinitions (Definitions SecurityScheme)
772− deriving (Eq, Show, Generic, Data, Typeable)
773−
774654-- | Lists the required security schemes to execute this operation.
775655-- The object can have multiple security schemes declared in it which are all required
776656-- (that is, there is a logical AND between the schemes).
777657newtype SecurityRequirement = SecurityRequirement
778− { getSecurityRequirement :: InsOrdHashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
658+ { getSecurityRequirement :: HashMap Text [Text]
659+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
780660
781661-- | Tag name.
782662type TagName = Text
@@ -793,12 +673,7 @@ data Tag = Tag
793673
794674 -- | Additional external documentation for this tag.
795675 , _tagExternalDocs :: Maybe ExternalDocs
796− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797−
798−instance Hashable Tag
799−
800−instance IsString Tag where
801− fromString s = Tag (fromString s) Nothing Nothing
676+ } deriving (Eq, Show, Generic, Data, Typeable)
802677
803678-- | Allows referencing an external resource for extended documentation.
804679data ExternalDocs = ExternalDocs
@@ -808,9 +683,7 @@ data ExternalDocs = ExternalDocs
808683
809684 -- | The URL for the target documentation.
810685 , _externalDocsUrl :: URL
811− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812−
813−instance Hashable ExternalDocs
686+ } deriving (Eq, Show, Generic, Data, Typeable)
814687
815688-- | A simple object to allow referencing other definitions in the specification.
816689-- It can be used to reference parameters and responses that are defined at the top level for reuse.
@@ -820,122 +693,76 @@ newtype Reference = Reference { getReference :: Text }
820693data Referenced a
821694 = Ref Reference
822695 | Inline a
823− deriving (Eq, Show, Functor, Data, Typeable)
824−
825−instance IsString a => IsString (Referenced a) where
826− fromString = Inline . fromString
827−
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
829−
830−data AdditionalProperties
831− = AdditionalPropertiesAllowed Bool
832− | AdditionalPropertiesSchema (Referenced Schema)
833696 deriving (Eq, Show, Data, Typeable)
834697
698+newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)
699+
835700-- =======================================================================
836701-- Monoid instances
837702-- =======================================================================
838703
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841704instance Monoid Swagger where
842705 mempty = genericMempty
843− mappend = (<>)
706+ mappend = genericMappend
844707
845−instance Semigroup Info where
846− (<>) = genericMappend
847708instance Monoid Info where
848709 mempty = genericMempty
849− mappend = (<>)
710+ mappend = genericMappend
850711
851−instance Semigroup Contact where
852− (<>) = genericMappend
853−instance Monoid Contact where
712+instance Monoid Paths where
854713 mempty = genericMempty
855− mappend = (<>)
714+ mappend = genericMappend
856715
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859716instance Monoid PathItem where
860717 mempty = genericMempty
861− mappend = (<>)
718+ mappend = genericMappend
862719
863−instance Semigroup Schema where
864− (<>) = genericMappend
865720instance Monoid Schema where
866721 mempty = genericMempty
867− mappend = (<>)
722+ mappend = genericMappend
868723
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871724instance Monoid (ParamSchema t) where
872725 mempty = genericMempty
873− mappend = (<>)
726+ mappend = genericMappend
874727
875−instance Semigroup Param where
876− (<>) = genericMappend
877728instance Monoid Param where
878729 mempty = genericMempty
879− mappend = (<>)
730+ mappend = genericMappend
880731
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883732instance Monoid ParamOtherSchema where
884733 mempty = genericMempty
885− mappend = (<>)
734+ mappend = genericMappend
886735
887−instance Semigroup Header where
888− (<>) = genericMappend
889736instance Monoid Header where
890737 mempty = genericMempty
891− mappend = (<>)
738+ mappend = genericMappend
892739
893−instance Semigroup Responses where
894− (<>) = genericMappend
895740instance Monoid Responses where
896741 mempty = genericMempty
897− mappend = (<>)
742+ mappend = genericMappend
898743
899−instance Semigroup Response where
900− (<>) = genericMappend
901744instance Monoid Response where
902745 mempty = genericMempty
903− mappend = (<>)
746+ mappend = genericMappend
904747
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907748instance Monoid ExternalDocs where
908749 mempty = genericMempty
909− mappend = (<>)
750+ mappend = genericMappend
910751
911−instance Semigroup Operation where
912− (<>) = genericMappend
913752instance Monoid Operation where
914753 mempty = genericMempty
915− mappend = (<>)
754+ mappend = genericMappend
916755
917−instance Semigroup Example where
918− (<>) = genericMappend
919756instance Monoid Example where
920757 mempty = genericMempty
921− mappend = (<>)
922−
923−instance Semigroup SecurityScheme where
924− (<>) = mergeSecurityScheme
925−
926−instance Semigroup SecurityDefinitions where
927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929−
930−instance Monoid SecurityDefinitions where
931− mempty = SecurityDefinitions $ InsOrdHashMap.empty
932− mappend = (<>)
758+ mappend = genericMappend
933759
934760-- =======================================================================
935761-- SwaggerMonoid helper instances
936762-- =======================================================================
937763
938764instance SwaggerMonoid Info
765+instance SwaggerMonoid Paths
939766instance SwaggerMonoid PathItem
940767instance SwaggerMonoid Schema
941768instance SwaggerMonoid (ParamSchema t)
@@ -945,8 +772,6 @@ instance SwaggerMonoid Responses
945772instance SwaggerMonoid Response
946773instance SwaggerMonoid ExternalDocs
947774instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950775
951776instance SwaggerMonoid MimeList
952777deriving instance SwaggerMonoid URL
@@ -959,13 +784,13 @@ instance SwaggerMonoid ParamLocation where
959784 swaggerMempty = ParamQuery
960785 swaggerMappend _ y = y
961786
962−instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963− swaggerMempty = InsOrdHashMap.empty
964− swaggerMappend = InsOrdHashMap.unionWith mappend
787+instance SwaggerMonoid (HashMap FilePath PathItem) where
788+ swaggerMempty = HashMap.empty
789+ swaggerMappend = HashMap.unionWith mappend
965790
966791instance Monoid a => SwaggerMonoid (Referenced a) where
967792 swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
793+ swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
969794 swaggerMappend _ y = y
970795
971796instance SwaggerMonoid ParamAnySchema where
@@ -1059,8 +884,7 @@ instance ToJSON OAuth2Flow where
1059884 , "tokenUrl" .= tokenUrl ]
1060885
1061886instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
1063− DEFINE_TOENCODING
887+ toJSON = omitEmpties . genericToJSONWithSub "flow" (jsonPrefix "oauth2")
1064888
1065889instance ToJSON SecuritySchemeType where
1066890 toJSON SecuritySchemeBasic
@@ -1073,37 +897,28 @@ instance ToJSON SecuritySchemeType where
1073897 <+> object [ "type" .= ("oauth2" :: Text) ]
1074898
1075899instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
1077− DEFINE_TOENCODING
900+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
901+ where
902+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
903+ addVersion _ = error "impossible"
1078904
1079905instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
1081− DEFINE_TOENCODING
906+ toJSON = genericToJSONWithSub "type" (jsonPrefix "securityScheme")
1082907
1083908instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
1085− DEFINE_TOENCODING
909+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "paramSchema" (jsonPrefix "schema")
910+ where
911+ f "items" (Array _) = True
912+ f _ _ = False
1086913
1087914instance ToJSON Header where
1088− toJSON = sopSwaggerGenericToJSON
1089− DEFINE_TOENCODING
915+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header")
1090916
1091−-- | As for nullary schema for 0-arity type constructors, see
1092−-- <https://github.com/GetShopTV/swagger2/issues/167>.
1093−--
1094−-- >>> encode (SwaggerItemsArray [])
1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1096−--
1097−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
917+instance ToJSON (SwaggerItems t) where
1098918 toJSON (SwaggerItemsPrimitive fmt schema) = object
1099919 [ "collectionFormat" .= fmt
1100920 , "items" .= schema ]
1101921 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102− toJSON (SwaggerItemsArray []) = object
1103− [ "items" .= object []
1104− , "maxItems" .= (0 :: Int)
1105− , "example" .= Array mempty
1106− ]
1107922 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1108923
1109924instance ToJSON Host where
@@ -1112,43 +927,38 @@ instance ToJSON Host where
1112927 Nothing -> host
1113928 Just port -> host ++ ":" ++ show port
1114929
930+instance ToJSON Paths where
931+ toJSON (Paths m) = toJSON m
932+
1115933instance ToJSON MimeList where
1116934 toJSON (MimeList xs) = toJSON (map show xs)
1117935
1118936instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
1120− DEFINE_TOENCODING
937+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "param")
1121938
1122939instance ToJSON ParamAnySchema where
1123940 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124941 toJSON (ParamOther s) = toJSON s
1125942
1126943instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
1128− DEFINE_TOENCODING
944+ toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
1129945
1130946instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
1132− DEFINE_TOENCODING
947+ toJSON (Responses def rs) = omitEmpties $
948+ toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
1133949
1134950instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
1136− DEFINE_TOENCODING
951+ toJSON = omitEmpties . genericToJSON (jsonPrefix "response")
1137952
1138953instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
1140− DEFINE_TOENCODING
954+ toJSON = omitEmpties . genericToJSON (jsonPrefix "operation")
1141955
1142956instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
1144− DEFINE_TOENCODING
957+ toJSON = omitEmpties . genericToJSON (jsonPrefix "pathItem")
1145958
1146959instance ToJSON Example where
1147960 toJSON = toJSON . Map.mapKeys show . getExample
1148961
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
1152962instance ToJSON Reference where
1153963 toJSON (Reference ref) = object [ "$ref" .= ref ]
1154964
@@ -1177,14 +987,11 @@ instance ToJSON (CollectionFormat t) where
1177987 toJSON CollectionPipes = "pipes"
1178988 toJSON CollectionMulti = "multi"
1179989
1180−instance ToJSON (ParamSchema k) where
1181− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1182− toJSON = sopSwaggerGenericToJSONWithOpts $
1183− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1184−
1185−instance ToJSON AdditionalProperties where
1186− toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187− toJSON (AdditionalPropertiesSchema s) = toJSON s
990+instance ToJSON (ParamSchema t) where
991+ toJSON = omitEmptiesExcept f . genericToJSONWithSub "items" (jsonPrefix "paramSchema")
992+ where
993+ f "items" (Array _) = True
994+ f _ _ = False
1188995
1189996-- =======================================================================
1190997-- Manual FromJSON instances
@@ -1204,7 +1011,7 @@ instance FromJSON OAuth2Flow where
12041011 parseJSON _ = empty
12051012
12061013instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
1014+ parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
12081015
12091016instance FromJSON SecuritySchemeType where
12101017 parseJSON js@(Object o) = do
@@ -1217,65 +1024,60 @@ instance FromJSON SecuritySchemeType where
12171024 parseJSON _ = empty
12181025
12191026instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
1027+ parseJSON js@(Object o) = do
1028+ (version :: Text) <- o .: "swagger"
1029+ when (version /= "2.0") empty
1030+ (genericParseJSON (jsonPrefix "")
1031+ `withDefaults` [ "consumes" .= (mempty :: MimeList)
1032+ , "produces" .= (mempty :: MimeList)
1033+ , "security" .= ([] :: [SecurityRequirement])
1034+ , "tags" .= ([] :: [Tag])
1035+ , "definitions" .= (mempty :: HashMap Text Schema)
1036+ , "parameters" .= (mempty :: HashMap Text Param)
1037+ , "responses" .= (mempty :: HashMap Text Response)
1038+ , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)
1039+ ] ) js
1040+ parseJSON _ = empty
12211041
12221042instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
1043+ parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
12241044
12251045instance FromJSON Schema where
1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1227− where nullaryCleanup :: Schema -> Schema
1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230− then s { _schemaExample = Nothing
1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1232− else s
1046+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1047+ `withDefaults` [ "properties" .= (mempty :: HashMap Text Schema)
1048+ , "required" .= ([] :: [ParamName]) ]
12331049
12341050instance FromJSON Header where
1235− parseJSON = sopSwaggerGenericParseJSON
1051+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
12361052
1237−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1238− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1053+instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
1054+ parseJSON (Object o) = SwaggerItemsPrimitive
12391055 <$> o .:? "collectionFormat"
12401056 <*> (o .: "items" >>= parseJSON)
12411057
1242−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244− <$> o .:? "collectionFormat"
1245− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1246−
1247−-- |
1248−--
1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250−-- Just (SwaggerItemsArray [])
1251−--
1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1254−--
1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1257−--
1258−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259− parseJSON js@(Object obj)
1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261− | otherwise = SwaggerItemsObject <$> parseJSON js
1058+instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where
1059+ parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
12621060 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
12631061 parseJSON _ = empty
12641062
12651063instance FromJSON Host where
1266− parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1267− [host] -> return $ Host host Nothing
1268− [host, port] -> case readMaybe port of
1269− Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1270− Just p -> return $ Host host (Just (fromInteger p))
1271− _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1064+ parseJSON (String s) =
1065+ case fromInteger <$> readMaybe portStr of
1066+ Nothing | not (null portStr) -> fail $ "Invalid port `" ++ portStr ++ "'"
1067+ mport -> pure $ Host host mport
1068+ where
1069+ (hostText, portText) = Text.breakOn ":" s
1070+ [host, portStr] = map Text.unpack [hostText, portText]
12721071 parseJSON _ = empty
12731072
1073+instance FromJSON Paths where
1074+ parseJSON js = Paths <$> parseJSON js
1075+
12741076instance FromJSON MimeList where
12751077 parseJSON js = (MimeList . map fromString) <$> parseJSON js
12761078
12771079instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
1080+ parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
12791081
12801082instance FromJSON ParamAnySchema where
12811083 parseJSON js@(Object o) = do
@@ -1288,12 +1090,12 @@ instance FromJSON ParamAnySchema where
12881090 parseJSON _ = empty
12891091
12901092instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
1093+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
12921094
12931095instance FromJSON Responses where
12941096 parseJSON (Object o) = Responses
12951097 <$> o .:? "default"
1296− <*> (parseJSON (Object (HashMap.delete "default" o)))
1098+ <*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
12971099 parseJSON _ = empty
12981100
12991101instance FromJSON Example where
@@ -1302,16 +1104,16 @@ instance FromJSON Example where
13021104 pure $ Example (Map.mapKeys fromString m)
13031105
13041106instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
1107+ parseJSON = genericParseJSON (jsonPrefix "response")
1108+ `withDefaults` [ "headers" .= (mempty :: HashMap HeaderName Header) ]
13061109
13071110instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
1111+ parseJSON = genericParseJSON (jsonPrefix "operation")
1112+ `withDefaults` [ "security" .= ([] :: [SecurityRequirement]) ]
13091113
13101114instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1312−
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1115+ parseJSON = genericParseJSON (jsonPrefix "pathItem")
1116+ `withDefaults` [ "parameters" .= ([] :: [Param]) ]
13151117
13161118instance FromJSON Reference where
13171119 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1328,7 +1130,6 @@ referencedParseJSON prefix js@(Object o) = do
13281130 case Text.stripPrefix prefix s of
13291131 Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
13301132 Just suffix -> pure (Reference suffix)
1331−referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
13321133
13331134instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
13341135instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
@@ -1337,91 +1138,26 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
13371138instance FromJSON Xml where
13381139 parseJSON = genericParseJSON (jsonPrefix "xml")
13391140
1340−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1141+instance FromJSON (SwaggerType Schema) where
13411142 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
13421143
1343−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1144+instance FromJSON (SwaggerType ParamOtherSchema) where
13441145 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
13451146
1346−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1147+instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where
13471148 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
13481149
1349−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1150+instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where
13501151 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
13511152
1352−-- NOTE: There aren't collections of 'Schema'
1353−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1355−
1356−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1153+instance FromJSON (CollectionFormat ParamOtherSchema) where
13571154 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
13581155
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
1365−
1366−instance FromJSON AdditionalProperties where
1367− parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368− parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1369−
1370−-------------------------------------------------------------------------------
1371−-- TH splices
1372−-------------------------------------------------------------------------------
1373−
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
1386−
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")]
1409−
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"
1417−
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
1156+-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1157+-- @FromJSON (SwaggerItems t)@ are necessary here!
1158+-- Without the constraint the general instance will be used
1159+-- that only accepts common types (i.e. NOT object, null or file)
1160+-- and primitive array items.
1161+instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1162+ parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")
1163+