#if __GLASGOW_HASKELL__ <710
#endif
#include "overlapping-compat.h"
module Data.Swagger.Internal where
import Prelude ()
import Prelude.Compat
import Control.Lens ((&), (.~), (?~))
import Control.Applicative
import Data.Aeson
import qualified Data.Aeson.Types as JSON
import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
import qualified Data.HashMap.Strict as HashMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Scientific (Scientific)
import Data.Set (Set)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
import Network (HostName, PortNumber)
import Network.HTTP.Media (MediaType)
import Text.Read (readMaybe)
import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Generics.SOP.TH (deriveGeneric)
import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
,sopSwaggerGenericToJSONWithOpts
,sopSwaggerGenericParseJSON
,HasSwaggerAesonOptions(..)
,AesonDefaultValue(..)
,mkSwaggerAesonOptions
,saoAdditionalPairs
,saoSubObject)
import Data.Swagger.Internal.Utils
#if MIN_VERSION_aeson(0,10,0)
import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
#else
#define DEFINE_TOENCODING
#endif
type Definitions = InsOrdHashMap Text
data Swagger = Swagger
{
_swaggerInfo :: Info
, _swaggerHost :: Maybe Host
, _swaggerBasePath :: Maybe FilePath
, _swaggerSchemes :: Maybe [Scheme]
, _swaggerConsumes :: MimeList
, _swaggerProduces :: MimeList
, _swaggerPaths :: InsOrdHashMap FilePath PathItem
, _swaggerDefinitions :: Definitions Schema
, _swaggerParameters :: Definitions Param
, _swaggerResponses :: Definitions Response
, _swaggerSecurityDefinitions :: Definitions SecurityScheme
, _swaggerSecurity :: [SecurityRequirement]
, _swaggerTags :: Set Tag
, _swaggerExternalDocs :: Maybe ExternalDocs
} deriving (Eq, Show, Generic, Data, Typeable)
data Info = Info
{
_infoTitle :: Text
, _infoDescription :: Maybe Text
, _infoTermsOfService :: Maybe Text
, _infoContact :: Maybe Contact
, _infoLicense :: Maybe License
, _infoVersion :: Text
} deriving (Eq, Show, Generic, Data, Typeable)
data Contact = Contact
{
_contactName :: Maybe Text
, _contactUrl :: Maybe URL
, _contactEmail :: Maybe Text
} deriving (Eq, Show, Generic, Data, Typeable)
data License = License
{
_licenseName :: Text
, _licenseUrl :: Maybe URL
} deriving (Eq, Show, Generic, Data, Typeable)
instance IsString License where
fromString s = License (fromString s) Nothing
data Host = Host
{ _hostName :: HostName
, _hostPort :: Maybe PortNumber
} deriving (Eq, Show, Generic, Typeable)
instance IsString Host where
fromString s = Host s Nothing
hostConstr :: Constr
hostConstr = mkConstr hostDataType "Host" [] Prefix
hostDataType :: DataType
hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
instance Data Host where
gunfold k z c = case constrIndex c of
1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
toConstr (Host _ _) = hostConstr
dataTypeOf _ = hostDataType
data Scheme
= Http
| Https
| Ws
| Wss
deriving (Eq, Show, Generic, Data, Typeable)
data PathItem = PathItem
{
_pathItemGet :: Maybe Operation
, _pathItemPut :: Maybe Operation
, _pathItemPost :: Maybe Operation
, _pathItemDelete :: Maybe Operation
, _pathItemOptions :: Maybe Operation
, _pathItemHead :: Maybe Operation
, _pathItemPatch :: Maybe Operation
, _pathItemParameters :: [Referenced Param]
} deriving (Eq, Show, Generic, Data, Typeable)
data Operation = Operation
{
_operationTags :: Set TagName
, _operationSummary :: Maybe Text
, _operationDescription :: Maybe Text
, _operationExternalDocs :: Maybe ExternalDocs
, _operationOperationId :: Maybe Text
, _operationConsumes :: Maybe MimeList
, _operationProduces :: Maybe MimeList
, _operationParameters :: [Referenced Param]
, _operationResponses :: Responses
, _operationSchemes :: Maybe [Scheme]
, _operationDeprecated :: Maybe Bool
, _operationSecurity :: [SecurityRequirement]
} deriving (Eq, Show, Generic, Data, Typeable)
newtype MimeList = MimeList { getMimeList :: [MediaType] }
deriving (Eq, Show, Monoid, Typeable)
mimeListConstr :: Constr
mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
mimeListDataType :: DataType
mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
instance Data MimeList where
gunfold k z c = case constrIndex c of
1 -> k (z (\xs -> MimeList (map fromString xs)))
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
toConstr (MimeList _) = mimeListConstr
dataTypeOf _ = mimeListDataType
data Param = Param
{
_paramName :: Text
, _paramDescription :: Maybe Text
, _paramRequired :: Maybe Bool
, _paramSchema :: ParamAnySchema
} deriving (Eq, Show, Generic, Data, Typeable)
data ParamAnySchema
= ParamBody (Referenced Schema)
| ParamOther ParamOtherSchema
deriving (Eq, Show, Generic, Data, Typeable)
data ParamOtherSchema = ParamOtherSchema
{
_paramOtherSchemaIn :: ParamLocation
, _paramOtherSchemaAllowEmptyValue :: Maybe Bool
, _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
} deriving (Eq, Show, Generic, Typeable, Data)
data SwaggerItems t where
SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
deriving (Typeable)
deriving instance Eq (SwaggerItems t)
deriving instance Show (SwaggerItems t)
swaggerItemsPrimitiveConstr :: Constr
swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
swaggerItemsObjectConstr :: Constr
swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
swaggerItemsArrayConstr :: Constr
swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
swaggerItemsDataType :: DataType
swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
gunfold k z c = case constrIndex c of
1 -> k (k (z SwaggerItemsPrimitive))
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
toConstr _ = swaggerItemsPrimitiveConstr
dataTypeOf _ = swaggerItemsDataType
instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
gunfold k z c = case constrIndex c of
1 -> k (k (z SwaggerItemsPrimitive))
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
toConstr _ = swaggerItemsPrimitiveConstr
dataTypeOf _ = swaggerItemsDataType
instance Data (SwaggerItems 'SwaggerKindSchema) where
gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
gunfold k z c = case constrIndex c of
2 -> k (z SwaggerItemsObject)
3 -> k (z SwaggerItemsArray)
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
dataTypeOf _ = swaggerItemsDataType
data SwaggerKind t
= SwaggerKindNormal t
| SwaggerKindParamOtherSchema
| SwaggerKindSchema
deriving (Typeable)
deriving instance Typeable 'SwaggerKindNormal
deriving instance Typeable 'SwaggerKindParamOtherSchema
deriving instance Typeable 'SwaggerKindSchema
type family SwaggerKindType (k :: SwaggerKind *) :: *
type instance SwaggerKindType ('SwaggerKindNormal t) = t
type instance SwaggerKindType 'SwaggerKindSchema = Schema
type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
data SwaggerType t where
SwaggerString :: SwaggerType t
SwaggerNumber :: SwaggerType t
SwaggerInteger :: SwaggerType t
SwaggerBoolean :: SwaggerType t
SwaggerArray :: SwaggerType t
SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
SwaggerNull :: SwaggerType 'SwaggerKindSchema
SwaggerObject :: SwaggerType 'SwaggerKindSchema
deriving (Typeable)
deriving instance Eq (SwaggerType t)
deriving instance Show (SwaggerType t)
swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
swaggerTypeDataType :: SwaggerType t -> DataType
swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
swaggerCommonTypes :: [SwaggerType k]
swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
swaggerTypeConstrs :: [Constr]
swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
toConstr = swaggerTypeConstr
dataTypeOf = swaggerTypeDataType
instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
toConstr = swaggerTypeConstr
dataTypeOf = swaggerTypeDataType
instance Data (SwaggerType 'SwaggerKindSchema) where
gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
toConstr = swaggerTypeConstr
dataTypeOf = swaggerTypeDataType
data ParamLocation
=
ParamQuery
| ParamHeader
| ParamPath
| ParamFormData
deriving (Eq, Show, Generic, Data, Typeable)
type Format = Text
data CollectionFormat t where
CollectionCSV :: CollectionFormat t
CollectionSSV :: CollectionFormat t
CollectionTSV :: CollectionFormat t
CollectionPipes :: CollectionFormat t
CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
deriving (Typeable)
deriving instance Eq (CollectionFormat t)
deriving instance Show (CollectionFormat t)
collectionFormatConstr :: CollectionFormat t -> Constr
collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
collectionFormatDataType :: DataType
collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
map collectionFormatConstr collectionCommonFormats
collectionCommonFormats :: [CollectionFormat t]
collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
toConstr = collectionFormatConstr
dataTypeOf _ = collectionFormatDataType
deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
type ParamName = Text
data Schema = Schema
{ _schemaTitle :: Maybe Text
, _schemaDescription :: Maybe Text
, _schemaRequired :: [ParamName]
, _schemaAllOf :: Maybe [Schema]
, _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
, _schemaAdditionalProperties :: Maybe (Referenced Schema)
, _schemaDiscriminator :: Maybe Text
, _schemaReadOnly :: Maybe Bool
, _schemaXml :: Maybe Xml
, _schemaExternalDocs :: Maybe ExternalDocs
, _schemaExample :: Maybe Value
, _schemaMaxProperties :: Maybe Integer
, _schemaMinProperties :: Maybe Integer
, _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
} deriving (Eq, Show, Generic, Data, Typeable)
data NamedSchema = NamedSchema
{ _namedSchemaName :: Maybe Text
, _namedSchemaSchema :: Schema
} deriving (Eq, Show, Generic, Data, Typeable)
type Pattern = Text
data ParamSchema (t :: SwaggerKind *) = ParamSchema
{
_paramSchemaDefault :: Maybe Value
, _paramSchemaType :: SwaggerType t
, _paramSchemaFormat :: Maybe Format
, _paramSchemaItems :: Maybe (SwaggerItems t)
, _paramSchemaMaximum :: Maybe Scientific
, _paramSchemaExclusiveMaximum :: Maybe Bool
, _paramSchemaMinimum :: Maybe Scientific
, _paramSchemaExclusiveMinimum :: Maybe Bool
, _paramSchemaMaxLength :: Maybe Integer
, _paramSchemaMinLength :: Maybe Integer
, _paramSchemaPattern :: Maybe Pattern
, _paramSchemaMaxItems :: Maybe Integer
, _paramSchemaMinItems :: Maybe Integer
, _paramSchemaUniqueItems :: Maybe Bool
, _paramSchemaEnum :: Maybe [Value]
, _paramSchemaMultipleOf :: Maybe Scientific
} deriving (Eq, Show, Generic, Typeable)
deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)
data Xml = Xml
{
_xmlName :: Maybe Text
, _xmlNamespace :: Maybe Text
, _xmlPrefix :: Maybe Text
, _xmlAttribute :: Maybe Bool
, _xmlWrapped :: Maybe Bool
} deriving (Eq, Show, Generic, Data, Typeable)
data Responses = Responses
{
_responsesDefault :: Maybe (Referenced Response)
, _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
} deriving (Eq, Show, Generic, Data, Typeable)
type HttpStatusCode = Int
data Response = Response
{
_responseDescription :: Text
, _responseSchema :: Maybe (Referenced Schema)
, _responseHeaders :: InsOrdHashMap HeaderName Header
, _responseExamples :: Maybe Example
} deriving (Eq, Show, Generic, Data, Typeable)
instance IsString Response where
fromString s = Response (fromString s) Nothing mempty Nothing
type HeaderName = Text
data Header = Header
{
_headerDescription :: Maybe Text
, _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
} deriving (Eq, Show, Generic, Data, Typeable)
data Example = Example { getExample :: Map MediaType Value }
deriving (Eq, Show, Generic, Typeable)
exampleConstr :: Constr
exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
exampleDataType :: DataType
exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
instance Data Example where
gunfold k z c = case constrIndex c of
1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
_ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
toConstr (Example _) = exampleConstr
dataTypeOf _ = exampleDataType
data ApiKeyLocation
= ApiKeyQuery
| ApiKeyHeader
deriving (Eq, Show, Generic, Data, Typeable)
data ApiKeyParams = ApiKeyParams
{
_apiKeyName :: Text
, _apiKeyIn :: ApiKeyLocation
} deriving (Eq, Show, Generic, Data, Typeable)
type AuthorizationURL = Text
type TokenURL = Text
data OAuth2Flow
= OAuth2Implicit AuthorizationURL
| OAuth2Password TokenURL
| OAuth2Application TokenURL
| OAuth2AccessCode AuthorizationURL TokenURL
deriving (Eq, Show, Generic, Data, Typeable)
data OAuth2Params = OAuth2Params
{
_oauth2Flow :: OAuth2Flow
, _oauth2Scopes :: InsOrdHashMap Text Text
} deriving (Eq, Show, Generic, Data, Typeable)
data SecuritySchemeType
= SecuritySchemeBasic
| SecuritySchemeApiKey ApiKeyParams
| SecuritySchemeOAuth2 OAuth2Params
deriving (Eq, Show, Generic, Data, Typeable)
data SecurityScheme = SecurityScheme
{
_securitySchemeType :: SecuritySchemeType
, _securitySchemeDescription :: Maybe Text
} deriving (Eq, Show, Generic, Data, Typeable)
newtype SecurityRequirement = SecurityRequirement
{ getSecurityRequirement :: InsOrdHashMap Text [Text]
} deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
type TagName = Text
data Tag = Tag
{
_tagName :: TagName
, _tagDescription :: Maybe Text
, _tagExternalDocs :: Maybe ExternalDocs
} deriving (Eq, Ord, Show, Generic, Data, Typeable)
instance IsString Tag where
fromString s = Tag (fromString s) Nothing Nothing
data ExternalDocs = ExternalDocs
{
_externalDocsDescription :: Maybe Text
, _externalDocsUrl :: URL
} deriving (Eq, Ord, Show, Generic, Data, Typeable)
newtype Reference = Reference { getReference :: Text }
deriving (Eq, Show, Data, Typeable)
data Referenced a
= Ref Reference
| Inline a
deriving (Eq, Show, Functor, Data, Typeable)
instance IsString a => IsString (Referenced a) where
fromString = Inline . fromString
newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
instance Monoid Swagger where
mempty = genericMempty
mappend = genericMappend
instance Monoid Info where
mempty = genericMempty
mappend = genericMappend
instance Monoid Contact where
mempty = genericMempty
mappend = genericMappend
instance Monoid PathItem where
mempty = genericMempty
mappend = genericMappend
instance Monoid Schema where
mempty = genericMempty
mappend = genericMappend
instance Monoid (ParamSchema t) where
mempty = genericMempty
mappend = genericMappend
instance Monoid Param where
mempty = genericMempty
mappend = genericMappend
instance Monoid ParamOtherSchema where
mempty = genericMempty
mappend = genericMappend
instance Monoid Header where
mempty = genericMempty
mappend = genericMappend
instance Monoid Responses where
mempty = genericMempty
mappend = genericMappend
instance Monoid Response where
mempty = genericMempty
mappend = genericMappend
instance Monoid ExternalDocs where
mempty = genericMempty
mappend = genericMappend
instance Monoid Operation where
mempty = genericMempty
mappend = genericMappend
instance Monoid Example where
mempty = genericMempty
mappend = genericMappend
instance SwaggerMonoid Info
instance SwaggerMonoid PathItem
instance SwaggerMonoid Schema
instance SwaggerMonoid (ParamSchema t)
instance SwaggerMonoid Param
instance SwaggerMonoid ParamOtherSchema
instance SwaggerMonoid Responses
instance SwaggerMonoid Response
instance SwaggerMonoid ExternalDocs
instance SwaggerMonoid Operation
instance SwaggerMonoid MimeList
deriving instance SwaggerMonoid URL
instance SwaggerMonoid (SwaggerType t) where
swaggerMempty = SwaggerString
swaggerMappend _ y = y
instance SwaggerMonoid ParamLocation where
swaggerMempty = ParamQuery
swaggerMappend _ y = y
instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
swaggerMempty = InsOrdHashMap.empty
swaggerMappend = InsOrdHashMap.unionWith mappend
instance Monoid a => SwaggerMonoid (Referenced a) where
swaggerMempty = Inline mempty
swaggerMappend (Inline x) (Inline y) = Inline (x <> y)
swaggerMappend _ y = y
instance SwaggerMonoid ParamAnySchema where
swaggerMempty = ParamOther swaggerMempty
swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
swaggerMappend _ y = y
instance ToJSON ParamLocation where
toJSON = genericToJSON (jsonPrefix "Param")
instance ToJSON Info where
toJSON = genericToJSON (jsonPrefix "Info")
instance ToJSON Contact where
toJSON = genericToJSON (jsonPrefix "Contact")
instance ToJSON License where
toJSON = genericToJSON (jsonPrefix "License")
instance ToJSON ApiKeyLocation where
toJSON = genericToJSON (jsonPrefix "ApiKey")
instance ToJSON ApiKeyParams where
toJSON = genericToJSON (jsonPrefix "apiKey")
instance ToJSON Scheme where
toJSON = genericToJSON (jsonPrefix "")
instance ToJSON Tag where
toJSON = genericToJSON (jsonPrefix "Tag")
instance ToJSON ExternalDocs where
toJSON = genericToJSON (jsonPrefix "ExternalDocs")
instance ToJSON Xml where
toJSON = genericToJSON (jsonPrefix "Xml")
instance FromJSON ParamLocation where
parseJSON = genericParseJSON (jsonPrefix "Param")
instance FromJSON Info where
parseJSON = genericParseJSON (jsonPrefix "Info")
instance FromJSON Contact where
parseJSON = genericParseJSON (jsonPrefix "Contact")
instance FromJSON License where
parseJSON = genericParseJSON (jsonPrefix "License")
instance FromJSON ApiKeyLocation where
parseJSON = genericParseJSON (jsonPrefix "ApiKey")
instance FromJSON ApiKeyParams where
parseJSON = genericParseJSON (jsonPrefix "apiKey")
instance FromJSON Scheme where
parseJSON = genericParseJSON (jsonPrefix "")
instance FromJSON Tag where
parseJSON = genericParseJSON (jsonPrefix "Tag")
instance FromJSON ExternalDocs where
parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
instance ToJSON OAuth2Flow where
toJSON (OAuth2Implicit authUrl) = object
[ "flow" .= ("implicit" :: Text)
, "authorizationUrl" .= authUrl ]
toJSON (OAuth2Password tokenUrl) = object
[ "flow" .= ("password" :: Text)
, "tokenUrl" .= tokenUrl ]
toJSON (OAuth2Application tokenUrl) = object
[ "flow" .= ("application" :: Text)
, "tokenUrl" .= tokenUrl ]
toJSON (OAuth2AccessCode authUrl tokenUrl) = object
[ "flow" .= ("accessCode" :: Text)
, "authorizationUrl" .= authUrl
, "tokenUrl" .= tokenUrl ]
instance ToJSON OAuth2Params where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON SecuritySchemeType where
toJSON SecuritySchemeBasic
= object [ "type" .= ("basic" :: Text) ]
toJSON (SecuritySchemeApiKey params)
= toJSON params
<+> object [ "type" .= ("apiKey" :: Text) ]
toJSON (SecuritySchemeOAuth2 params)
= toJSON params
<+> object [ "type" .= ("oauth2" :: Text) ]
instance ToJSON Swagger where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON SecurityScheme where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Schema where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Header where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
toJSON (SwaggerItemsPrimitive fmt schema) = object
[ "collectionFormat" .= fmt
, "items" .= schema ]
toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
instance ToJSON Host where
toJSON (Host host mport) = toJSON $
case mport of
Nothing -> host
Just port -> host ++ ":" ++ show port
instance ToJSON MimeList where
toJSON (MimeList xs) = toJSON (map show xs)
instance ToJSON Param where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON ParamAnySchema where
toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
toJSON (ParamOther s) = toJSON s
instance ToJSON ParamOtherSchema where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Responses where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Response where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Operation where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON PathItem where
toJSON = sopSwaggerGenericToJSON
DEFINE_TOENCODING
instance ToJSON Example where
toJSON = toJSON . Map.mapKeys show . getExample
instance ToJSON Reference where
toJSON (Reference ref) = object [ "$ref" .= ref ]
referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
referencedToJSON _ (Inline x) = toJSON x
instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
instance ToJSON (SwaggerType t) where
toJSON SwaggerArray = "array"
toJSON SwaggerString = "string"
toJSON SwaggerInteger = "integer"
toJSON SwaggerNumber = "number"
toJSON SwaggerBoolean = "boolean"
toJSON SwaggerFile = "file"
toJSON SwaggerNull = "null"
toJSON SwaggerObject = "object"
instance ToJSON (CollectionFormat t) where
toJSON CollectionCSV = "csv"
toJSON CollectionSSV = "ssv"
toJSON CollectionTSV = "tsv"
toJSON CollectionPipes = "pipes"
toJSON CollectionMulti = "multi"
instance ToJSON (ParamSchema k) where
toJSON = sopSwaggerGenericToJSONWithOpts $
mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
instance FromJSON OAuth2Flow where
parseJSON (Object o) = do
(flow :: Text) <- o .: "flow"
case flow of
"implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
"password" -> OAuth2Password <$> o .: "tokenUrl"
"application" -> OAuth2Application <$> o .: "tokenUrl"
"accessCode" -> OAuth2AccessCode
<$> o .: "authorizationUrl"
<*> o .: "tokenUrl"
_ -> empty
parseJSON _ = empty
instance FromJSON OAuth2Params where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON SecuritySchemeType where
parseJSON js@(Object o) = do
(t :: Text) <- o .: "type"
case t of
"basic" -> pure SecuritySchemeBasic
"apiKey" -> SecuritySchemeApiKey <$> parseJSON js
"oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
_ -> empty
parseJSON _ = empty
instance FromJSON Swagger where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON SecurityScheme where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Schema where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Header where
parseJSON = sopSwaggerGenericParseJSON
instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
<$> o .:? "collectionFormat"
<*> (o .: "items" >>= parseJSON)
instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
<$> o .:? "collectionFormat"
<*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js
parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
parseJSON _ = empty
instance FromJSON Host where
parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
[host] -> return $ Host host Nothing
[host, port] -> case readMaybe port of
Nothing -> fail $ "Invalid port `" ++ port ++ "'"
Just p -> return $ Host host (Just (fromInteger p))
_ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
parseJSON _ = empty
instance FromJSON MimeList where
parseJSON js = (MimeList . map fromString) <$> parseJSON js
instance FromJSON Param where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON ParamAnySchema where
parseJSON js@(Object o) = do
(i :: Text) <- o .: "in"
case i of
"body" -> do
schema <- o .: "schema"
ParamBody <$> parseJSON schema
_ -> ParamOther <$> parseJSON js
parseJSON _ = empty
instance FromJSON ParamOtherSchema where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Responses where
parseJSON (Object o) = Responses
<$> o .:? "default"
<*> (parseJSON (Object (HashMap.delete "default" o)))
parseJSON _ = empty
instance FromJSON Example where
parseJSON js = do
m <- parseJSON js
pure $ Example (Map.mapKeys fromString m)
instance FromJSON Response where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Operation where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON PathItem where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON Reference where
parseJSON (Object o) = Reference <$> o .: "$ref"
parseJSON _ = empty
referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
referencedParseJSON prefix js@(Object o) = do
ms <- o .:? "$ref"
case ms of
Nothing -> Inline <$> parseJSON js
Just s -> Ref <$> parseRef s
where
parseRef s = do
case Text.stripPrefix prefix s of
Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
Just suffix -> pure (Reference suffix)
referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
instance FromJSON Xml where
parseJSON = genericParseJSON (jsonPrefix "xml")
instance FromJSON (SwaggerType 'SwaggerKindSchema) where
parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
parseJSON = sopSwaggerGenericParseJSON
instance FromJSON (ParamSchema 'SwaggerKindSchema) where
parseJSON = sopSwaggerGenericParseJSON
deriveGeneric ''Header
deriveGeneric ''OAuth2Params
deriveGeneric ''Operation
deriveGeneric ''Param
deriveGeneric ''ParamOtherSchema
deriveGeneric ''PathItem
deriveGeneric ''Response
deriveGeneric ''Responses
deriveGeneric ''SecurityScheme
deriveGeneric ''Schema
deriveGeneric ''ParamSchema
deriveGeneric ''Swagger
instance HasSwaggerAesonOptions Header where
swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
instance HasSwaggerAesonOptions OAuth2Params where
swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
instance HasSwaggerAesonOptions Operation where
swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
instance HasSwaggerAesonOptions Param where
swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
instance HasSwaggerAesonOptions ParamOtherSchema where
swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
instance HasSwaggerAesonOptions PathItem where
swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
instance HasSwaggerAesonOptions Response where
swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
instance HasSwaggerAesonOptions Responses where
swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
instance HasSwaggerAesonOptions SecurityScheme where
swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
instance HasSwaggerAesonOptions Schema where
swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
instance HasSwaggerAesonOptions Swagger where
swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
instance AesonDefaultValue (ParamSchema s)
instance AesonDefaultValue OAuth2Flow
instance AesonDefaultValue Responses
instance AesonDefaultValue ParamAnySchema
instance AesonDefaultValue SecuritySchemeType
instance AesonDefaultValue (SwaggerType a)
instance AesonDefaultValue MimeList where defaultValue = Just mempty
instance AesonDefaultValue Info
instance AesonDefaultValue ParamLocation