@@ -1,5 +1,4 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE DeriveDataTypeable #-}
43{-# LANGUAGE DeriveFunctor #-}
54{-# LANGUAGE DeriveGeneric #-}
@@ -12,12 +11,11 @@
1211{-# LANGUAGE RecordWildCards #-}
1312{-# LANGUAGE ScopedTypeVariables #-}
1413{-# LANGUAGE StandaloneDeriving #-}
15−{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
1714{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
20−#endif
15+
16+{-# LANGUAGE DataKinds #-}
17+{-# LANGUAGE TypeFamilies #-}
18+{-# LANGUAGE TemplateHaskell #-}
2119#include "overlapping-compat.h"
2220module Data.Swagger.Internal where
2321
@@ -26,22 +24,22 @@ import Prelude.Compat
2624
2725import Control.Lens ((&), (.~), (?~))
2826import Control.Applicative
27+import Control.Monad
2928import Data.Aeson
3029import qualified Data.Aeson.Types as JSON
3130import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32−import Data.Hashable (Hashable)
31+import Data.HashMap.Strict (HashMap)
3332import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
3533import Data.Map (Map)
3634import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
38−import Data.Semigroup.Compat (Semigroup (..))
35+import Data.Monoid
3936import Data.Scientific (Scientific)
37+import Data.Set (Set)
4038import Data.String (IsString(..))
4139import Data.Text (Text)
4240import qualified Data.Text as Text
4341import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
42+import Network (HostName, PortNumber)
4543import Network.HTTP.Media (MediaType)
4644import Text.Read (readMaybe)
4745
@@ -50,26 +48,11 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5048
5149import Generics.SOP.TH (deriveGeneric)
5250import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53− ,sopSwaggerGenericToJSONWithOpts
54− ,sopSwaggerGenericParseJSON
55− ,HasSwaggerAesonOptions(..)
56− ,AesonDefaultValue(..)
5751 ,mkSwaggerAesonOptions
5852 ,saoAdditionalPairs
5953 ,saoSubObject)
6054import Data.Swagger.Internal.Utils
6155
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−
7356-- | A list of definitions that can be used in references.
7457type Definitions = InsOrdHashMap Text
7558
@@ -117,7 +100,7 @@ data Swagger = Swagger
117100 , _swaggerResponses :: Definitions Response
118101
119102 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
103+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme
121104
122105 -- | A declaration of which security schemes are applied for the API as a whole.
123106 -- The list of values describes alternative security schemes that can be used
@@ -130,7 +113,7 @@ data Swagger = Swagger
130113 -- Not all tags that are used by the Operation Object must be declared.
131114 -- The tags that are not declared may be organized randomly or based on the tools' logic.
132115 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
116+ , _swaggerTags :: Set Tag
134117
135118 -- | Additional external documentation.
136119 , _swaggerExternalDocs :: Maybe ExternalDocs
@@ -252,7 +235,7 @@ data PathItem = PathItem
252235data Operation = Operation
253236 { -- | A list of tags for API documentation control.
254237 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
238+ _operationTags :: Set TagName
256239
257240 -- | A short summary of what the operation does.
258241 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -309,7 +292,7 @@ data Operation = Operation
309292 } deriving (Eq, Show, Generic, Data, Typeable)
310293
311294newtype MimeList = MimeList { getMimeList :: [MediaType] }
312− deriving (Eq, Show, Semigroup, Monoid, Typeable)
295+ deriving (Eq, Show, Monoid, Typeable)
313296
314297mimeListConstr :: Constr
315298mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
@@ -360,8 +343,8 @@ data ParamOtherSchema = ParamOtherSchema
360343 -- Default value is @False@.
361344 , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362345
363− , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364− } deriving (Eq, Show, Generic, Typeable, Data)
346+ , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema
347+ } deriving (Eq, Show, Generic, Data, Typeable)
365348
366349-- | Items for @'SwaggerArray'@ schemas.
367350--
@@ -374,9 +357,9 @@ data ParamOtherSchema = ParamOtherSchema
374357--
375358-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376359data SwaggerItems t where
377− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
360+ SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
361+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems Schema
362+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems Schema
380363 deriving (Typeable)
381364
382365deriving instance Eq (SwaggerItems t)
@@ -386,66 +369,17 @@ deriving instance Show (SwaggerItems t)
386369swaggerItemsPrimitiveConstr :: Constr
387370swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388371
389−swaggerItemsObjectConstr :: Constr
390−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391−
392−swaggerItemsArrayConstr :: Constr
393−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394−
395372swaggerItemsDataType :: DataType
396373swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397374
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
375+instance OVERLAPPABLE_ Data t => Data (SwaggerItems t) where
403376 gunfold k z c = case constrIndex c of
404377 1 -> k (k (z SwaggerItemsPrimitive))
405378 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406379 toConstr _ = swaggerItemsPrimitiveConstr
407380 dataTypeOf _ = swaggerItemsDataType
408381
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
382+deriving instance Data (SwaggerItems Schema)
449383
450384data SwaggerType t where
451385 SwaggerString :: SwaggerType t
@@ -453,9 +387,9 @@ data SwaggerType t where
453387 SwaggerInteger :: SwaggerType t
454388 SwaggerBoolean :: SwaggerType t
455389 SwaggerArray :: SwaggerType t
456− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457− SwaggerNull :: SwaggerType 'SwaggerKindSchema
458− SwaggerObject :: SwaggerType 'SwaggerKindSchema
390+ SwaggerFile :: SwaggerType ParamOtherSchema
391+ SwaggerNull :: SwaggerType Schema
392+ SwaggerObject :: SwaggerType Schema
459393 deriving (Typeable)
460394
461395deriving instance Eq (SwaggerType t)
@@ -464,33 +398,33 @@ deriving instance Show (SwaggerType t)
464398swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465399swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466400
467−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
401+swaggerTypeDataType :: Data (SwaggerType t) => SwaggerType t -> DataType
468402swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469403
470−swaggerCommonTypes :: [SwaggerType k]
404+swaggerCommonTypes :: [SwaggerType t]
471405swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472406
473−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
407+swaggerParamTypes :: [SwaggerType ParamOtherSchema]
474408swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475409
476−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
410+swaggerSchemaTypes :: [SwaggerType Schema]
477411swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478412
479413swaggerTypeConstrs :: [Constr]
480−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
414+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType Schema])
481415 ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482416
483−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
417+instance OVERLAPPABLE_ Typeable t => Data (SwaggerType t) where
484418 gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485419 toConstr = swaggerTypeConstr
486420 dataTypeOf = swaggerTypeDataType
487421
488−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
422+instance OVERLAPPABLE_ Data (SwaggerType ParamOtherSchema) where
489423 gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490424 toConstr = swaggerTypeConstr
491425 dataTypeOf = swaggerTypeDataType
492426
493−instance Data (SwaggerType 'SwaggerKindSchema) where
427+instance OVERLAPPABLE_ Data (SwaggerType Schema) where
494428 gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495429 toConstr = swaggerTypeConstr
496430 dataTypeOf = swaggerTypeDataType
@@ -530,7 +464,7 @@ data CollectionFormat t where
530464 -- Corresponds to multiple parameter instances
531465 -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532466 -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
467+ CollectionMulti :: CollectionFormat ParamOtherSchema
534468 deriving (Typeable)
535469
536470deriving instance Eq (CollectionFormat t)
@@ -546,12 +480,12 @@ collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
546480collectionCommonFormats :: [CollectionFormat t]
547481collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548482
549−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
483+instance OVERLAPPABLE_ Data t => Data (CollectionFormat t) where
550484 gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551485 toConstr = collectionFormatConstr
552486 dataTypeOf _ = collectionFormatDataType
553487
554−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
488+deriving instance OVERLAPPABLE_ Data (CollectionFormat ParamOtherSchema)
555489
556490type ParamName = Text
557491
@@ -560,9 +494,9 @@ data Schema = Schema
560494 , _schemaDescription :: Maybe Text
561495 , _schemaRequired :: [ParamName]
562496
563− , _schemaAllOf :: Maybe [Referenced Schema]
497+ , _schemaAllOf :: Maybe [Schema]
564498 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
499+ , _schemaAdditionalProperties :: Maybe (Referenced Schema)
566500
567501 , _schemaDiscriminator :: Maybe Text
568502 , _schemaReadOnly :: Maybe Bool
@@ -573,7 +507,7 @@ data Schema = Schema
573507 , _schemaMaxProperties :: Maybe Integer
574508 , _schemaMinProperties :: Maybe Integer
575509
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
510+ , _schemaParamSchema :: ParamSchema Schema
577511 } deriving (Eq, Show, Generic, Data, Typeable)
578512
579513-- | A @'Schema'@ with an optional name.
@@ -586,7 +520,7 @@ data NamedSchema = NamedSchema
586520-- | Regex pattern for @string@ type.
587521type Pattern = Text
588522
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
523+data ParamSchema t = ParamSchema
590524 { -- | Declares the value of the parameter that the server will use if none is provided,
591525 -- for example a @"count"@ to control the number of results per page might default to @100@
592526 -- if not supplied by the client in the request.
@@ -594,7 +528,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
594528 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595529 _paramSchemaDefault :: Maybe Value
596530
597− , _paramSchemaType :: Maybe (SwaggerType t)
531+ , _paramSchemaType :: SwaggerType t
598532 , _paramSchemaFormat :: Maybe Format
599533 , _paramSchemaItems :: Maybe (SwaggerItems t)
600534 , _paramSchemaMaximum :: Maybe Scientific
@@ -611,7 +545,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
611545 , _paramSchemaMultipleOf :: Maybe Scientific
612546 } deriving (Eq, Show, Generic, Typeable)
613547
614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
548+deriving instance (Data t, Data (SwaggerType t), Data (SwaggerItems t)) => Data (ParamSchema t)
615549
616550data Xml = Xml
617551 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -687,7 +621,7 @@ data Header = Header
687621 { -- | A short description of the header.
688622 _headerDescription :: Maybe Text
689623
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
624+ , _headerParamSchema :: ParamSchema Header
691625 } deriving (Eq, Show, Generic, Data, Typeable)
692626
693627data Example = Example { getExample :: Map MediaType Value }
@@ -755,28 +689,12 @@ data SecurityScheme = SecurityScheme
755689 , _securitySchemeDescription :: Maybe Text
756690 } deriving (Eq, Show, Generic, Data, Typeable)
757691
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−
774692-- | Lists the required security schemes to execute this operation.
775693-- The object can have multiple security schemes declared in it which are all required
776694-- (that is, there is a logical AND between the schemes).
777695newtype SecurityRequirement = SecurityRequirement
778696 { getSecurityRequirement :: InsOrdHashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
697+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
780698
781699-- | Tag name.
782700type TagName = Text
@@ -795,8 +713,6 @@ data Tag = Tag
795713 , _tagExternalDocs :: Maybe ExternalDocs
796714 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797715
798−instance Hashable Tag
799−
800716instance IsString Tag where
801717 fromString s = Tag (fromString s) Nothing Nothing
802718
@@ -810,8 +726,6 @@ data ExternalDocs = ExternalDocs
810726 , _externalDocsUrl :: URL
811727 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812728
813−instance Hashable ExternalDocs
814−
815729-- | A simple object to allow referencing other definitions in the specification.
816730-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817731newtype Reference = Reference { getReference :: Text }
@@ -825,111 +739,67 @@ data Referenced a
825739instance IsString a => IsString (Referenced a) where
826740 fromString = Inline . fromString
827741
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)
833− deriving (Eq, Show, Data, Typeable)
742+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
834743
835744-- =======================================================================
836745-- Monoid instances
837746-- =======================================================================
838747
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841748instance Monoid Swagger where
842749 mempty = genericMempty
843− mappend = (<>)
750+ mappend = genericMappend
844751
845−instance Semigroup Info where
846− (<>) = genericMappend
847752instance Monoid Info where
848753 mempty = genericMempty
849− mappend = (<>)
754+ mappend = genericMappend
850755
851−instance Semigroup Contact where
852− (<>) = genericMappend
853756instance Monoid Contact where
854757 mempty = genericMempty
855− mappend = (<>)
758+ mappend = genericMappend
856759
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859760instance Monoid PathItem where
860761 mempty = genericMempty
861− mappend = (<>)
762+ mappend = genericMappend
862763
863−instance Semigroup Schema where
864− (<>) = genericMappend
865764instance Monoid Schema where
866765 mempty = genericMempty
867− mappend = (<>)
766+ mappend = genericMappend
868767
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871768instance Monoid (ParamSchema t) where
872769 mempty = genericMempty
873− mappend = (<>)
770+ mappend = genericMappend
874771
875−instance Semigroup Param where
876− (<>) = genericMappend
877772instance Monoid Param where
878773 mempty = genericMempty
879− mappend = (<>)
774+ mappend = genericMappend
880775
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883776instance Monoid ParamOtherSchema where
884777 mempty = genericMempty
885− mappend = (<>)
778+ mappend = genericMappend
886779
887−instance Semigroup Header where
888− (<>) = genericMappend
889780instance Monoid Header where
890781 mempty = genericMempty
891− mappend = (<>)
782+ mappend = genericMappend
892783
893−instance Semigroup Responses where
894− (<>) = genericMappend
895784instance Monoid Responses where
896785 mempty = genericMempty
897− mappend = (<>)
786+ mappend = genericMappend
898787
899−instance Semigroup Response where
900− (<>) = genericMappend
901788instance Monoid Response where
902789 mempty = genericMempty
903− mappend = (<>)
790+ mappend = genericMappend
904791
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907792instance Monoid ExternalDocs where
908793 mempty = genericMempty
909− mappend = (<>)
794+ mappend = genericMappend
910795
911−instance Semigroup Operation where
912− (<>) = genericMappend
913796instance Monoid Operation where
914797 mempty = genericMempty
915− mappend = (<>)
798+ mappend = genericMappend
916799
917−instance Semigroup Example where
918− (<>) = genericMappend
919800instance Monoid Example where
920801 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 = (<>)
802+ mappend = genericMappend
933803
934804-- =======================================================================
935805-- SwaggerMonoid helper instances
@@ -945,8 +815,6 @@ instance SwaggerMonoid Responses
945815instance SwaggerMonoid Response
946816instance SwaggerMonoid ExternalDocs
947817instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950818
951819instance SwaggerMonoid MimeList
952820deriving instance SwaggerMonoid URL
@@ -959,13 +827,17 @@ instance SwaggerMonoid ParamLocation where
959827 swaggerMempty = ParamQuery
960828 swaggerMappend _ y = y
961829
830+instance OVERLAPPING_ SwaggerMonoid (HashMap FilePath PathItem) where
831+ swaggerMempty = HashMap.empty
832+ swaggerMappend = HashMap.unionWith mappend
833+
962834instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963835 swaggerMempty = InsOrdHashMap.empty
964836 swaggerMappend = InsOrdHashMap.unionWith mappend
965837
966838instance Monoid a => SwaggerMonoid (Referenced a) where
967839 swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
840+ swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
969841 swaggerMappend _ y = y
970842
971843instance SwaggerMonoid ParamAnySchema where
@@ -1059,8 +931,8 @@ instance ToJSON OAuth2Flow where
1059931 , "tokenUrl" .= tokenUrl ]
1060932
1061933instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
1063− DEFINE_TOENCODING
934+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "oauth2" &
935+ saoSubObject ?~ "flow"
1064936
1065937instance ToJSON SecuritySchemeType where
1066938 toJSON SecuritySchemeBasic
@@ -1073,37 +945,26 @@ instance ToJSON SecuritySchemeType where
1073945 <+> object [ "type" .= ("oauth2" :: Text) ]
1074946
1075947instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
1077− DEFINE_TOENCODING
948+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "swagger" &
949+ saoAdditionalPairs .~ [("swagger", "2.0")]
1078950
1079951instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
1081− DEFINE_TOENCODING
952+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "securityScheme" &
953+ saoSubObject ?~ "type"
1082954
1083955instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
1085− DEFINE_TOENCODING
956+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "schema" &
957+ saoSubObject ?~ "paramSchema"
1086958
1087959instance ToJSON Header where
1088− toJSON = sopSwaggerGenericToJSON
1089− DEFINE_TOENCODING
960+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "header" &
961+ saoSubObject ?~ "paramSchema"
1090962
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
963+instance ToJSON (SwaggerItems t) where
1098964 toJSON (SwaggerItemsPrimitive fmt schema) = object
1099965 [ "collectionFormat" .= fmt
1100966 , "items" .= schema ]
1101967 toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102− toJSON (SwaggerItemsArray []) = object
1103− [ "items" .= object []
1104− , "maxItems" .= (0 :: Int)
1105− , "example" .= Array mempty
1106− ]
1107968 toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1108969
1109970instance ToJSON Host where
@@ -1116,39 +977,33 @@ instance ToJSON MimeList where
1116977 toJSON (MimeList xs) = toJSON (map show xs)
1117978
1118979instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
1120− DEFINE_TOENCODING
980+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "param" &
981+ saoSubObject ?~ "schema"
1121982
1122983instance ToJSON ParamAnySchema where
1123984 toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124985 toJSON (ParamOther s) = toJSON s
1125986
1126987instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
1128− DEFINE_TOENCODING
988+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "paramOtherSchema" &
989+ saoSubObject ?~ "paramSchema"
1129990
1130991instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
1132− DEFINE_TOENCODING
992+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "responses" &
993+ saoSubObject ?~ "responses"
1133994
1134995instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
1136− DEFINE_TOENCODING
996+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "response"
1137997
1138998instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
1140− DEFINE_TOENCODING
999+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "operation"
11411000
11421001instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
1144− DEFINE_TOENCODING
1002+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "pathItem"
11451003
11461004instance ToJSON Example where
11471005 toJSON = toJSON . Map.mapKeys show . getExample
11481006
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
11521007instance ToJSON Reference where
11531008 toJSON (Reference ref) = object [ "$ref" .= ref ]
11541009
@@ -1177,14 +1032,9 @@ instance ToJSON (CollectionFormat t) where
11771032 toJSON CollectionPipes = "pipes"
11781033 toJSON CollectionMulti = "multi"
11791034
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
1035+instance ToJSON (ParamSchema t) where
1036+ toJSON = sopSwaggerGenericToJSON $ mkSwaggerAesonOptions "paramSchema" &
1037+ saoSubObject ?~ "items"
11881038
11891039-- =======================================================================
11901040-- Manual FromJSON instances
@@ -1204,7 +1054,7 @@ instance FromJSON OAuth2Flow where
12041054 parseJSON _ = empty
12051055
12061056instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
1057+ parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "oauth2")
12081058
12091059instance FromJSON SecuritySchemeType where
12101060 parseJSON js@(Object o) = do
@@ -1217,48 +1067,39 @@ instance FromJSON SecuritySchemeType where
12171067 parseJSON _ = empty
12181068
12191069instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
1070+ parseJSON js@(Object o) = do
1071+ (version :: Text) <- o .: "swagger"
1072+ when (version /= "2.0") empty
1073+ (genericParseJSON (jsonPrefix "swagger")
1074+ `withDefaults` [ "consumes" .= (mempty :: MimeList)
1075+ , "produces" .= (mempty :: MimeList)
1076+ , "security" .= ([] :: [SecurityRequirement])
1077+ , "tags" .= ([] :: [Tag])
1078+ , "definitions" .= (mempty :: Definitions Schema)
1079+ , "parameters" .= (mempty :: Definitions Param)
1080+ , "responses" .= (mempty :: Definitions Response)
1081+ , "securityDefinitions" .= (mempty :: Definitions SecurityScheme)
1082+ ] ) js
1083+ parseJSON _ = empty
12211084
12221085instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
1086+ parseJSON = genericParseJSONWithSub "type" (jsonPrefix "securityScheme")
12241087
12251088instance 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
1089+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "schema")
1090+ `withDefaults` [ "properties" .= (mempty :: InsOrdHashMap Text Schema)
1091+ , "required" .= ([] :: [ParamName]) ]
12331092
12341093instance FromJSON Header where
1235− parseJSON = sopSwaggerGenericParseJSON
1094+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header")
12361095
1237−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1096+instance OVERLAPPABLE_ (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where
12381097 parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
12391098 <$> o .:? "collectionFormat"
12401099 <*> (o .: "items" >>= parseJSON)
12411100
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
1101+instance OVERLAPPABLE_ FromJSON (SwaggerItems Schema) where
1102+ parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
12621103 parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
12631104 parseJSON _ = empty
12641105
@@ -1275,7 +1116,7 @@ instance FromJSON MimeList where
12751116 parseJSON js = (MimeList . map fromString) <$> parseJSON js
12761117
12771118instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
1119+ parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "param")
12791120
12801121instance FromJSON ParamAnySchema where
12811122 parseJSON js@(Object o) = do
@@ -1288,7 +1129,7 @@ instance FromJSON ParamAnySchema where
12881129 parseJSON _ = empty
12891130
12901131instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
1132+ parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "paramOtherSchema")
12921133
12931134instance FromJSON Responses where
12941135 parseJSON (Object o) = Responses
@@ -1302,16 +1143,18 @@ instance FromJSON Example where
13021143 pure $ Example (Map.mapKeys fromString m)
13031144
13041145instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
1146+ parseJSON = genericParseJSON (jsonPrefix "response")
1147+ `withDefaults` [ "headers" .= (mempty :: InsOrdHashMap HeaderName Header) ]
13061148
13071149instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
1150+ parseJSON = genericParseJSON (jsonPrefix "operation")
1151+ `withDefaults` [ "security" .= ([] :: [SecurityRequirement])
1152+ , "tags" .= ([] :: [Tag])
1153+ , "parameters" .= ([] :: [Referenced Param]) ]
13091154
13101155instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1312−
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1156+ parseJSON = genericParseJSON (jsonPrefix "pathItem")
1157+ `withDefaults` [ "parameters" .= ([] :: [Param]) ]
13151158
13161159instance FromJSON Reference where
13171160 parseJSON (Object o) = Reference <$> o .: "$ref"
@@ -1337,35 +1180,28 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
13371180instance FromJSON Xml where
13381181 parseJSON = genericParseJSON (jsonPrefix "xml")
13391182
1340−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1183+instance FromJSON (SwaggerType Schema) where
13411184 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
13421185
1343−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1186+instance FromJSON (SwaggerType ParamOtherSchema) where
13441187 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
13451188
1346−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1189+instance OVERLAPPABLE_ FromJSON (SwaggerType t) where
13471190 parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
13481191
1349−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1192+instance OVERLAPPABLE_ FromJSON (CollectionFormat t) where
13501193 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
13511194
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
1195+instance FromJSON (CollectionFormat ParamOtherSchema) where
13571196 parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
13581197
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
1198+-- NOTE: The constraints @FromJSON (SwaggerType t)@ and
1199+-- @FromJSON (SwaggerItems t)@ are necessary here!
1200+-- Without the constraint the general instance will be used
1201+-- that only accepts common types (i.e. NOT object, null or file)
1202+-- and primitive array items.
1203+instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where
1204+ parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")
13691205
13701206-------------------------------------------------------------------------------
13711207-- TH splices
@@ -1383,45 +1219,3 @@ deriveGeneric ''SecurityScheme
13831219deriveGeneric ''Schema
13841220deriveGeneric ''ParamSchema
13851221deriveGeneric ''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