module Data.Swagger.Internal where
import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Foldable (Foldable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Traversable (Traversable)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Network (HostName, PortNumber)
import Network.HTTP.Media (MediaType)
import Text.Read (readMaybe)
import Data.Swagger.Internal.Utils
data Swagger = Swagger
{
swaggerInfo :: SwaggerInfo
, swaggerHost :: Maybe SwaggerHost
, swaggerBasePath :: Maybe FilePath
, swaggerSchemes :: Maybe [SwaggerScheme]
, swaggerConsumes :: SwaggerMimeList
, swaggerProduces :: SwaggerMimeList
, swaggerPaths :: SwaggerPaths
, swaggerDefinitions :: HashMap Text SwaggerSchema
, swaggerParameters :: HashMap Text SwaggerParameter
, swaggerResponses :: HashMap Text SwaggerResponse
, swaggerSecurityDefinitions :: HashMap Text SwaggerSecurityScheme
, swaggerSecurity :: [SwaggerSecurityRequirement]
, swaggerTags :: [SwaggerTag]
, swaggerExternalDocs :: Maybe SwaggerExternalDocs
} deriving (Eq, Show, Generic)
data SwaggerInfo = SwaggerInfo
{
swaggerInfoTitle :: Text
, swaggerInfoDescription :: Maybe Text
, swaggerInfoTermsOfService :: Maybe Text
, swaggerInfoContact :: Maybe SwaggerContact
, swaggerInfoLicense :: Maybe SwaggerLicense
, swaggerInfoVersion :: Text
} deriving (Eq, Show, Generic)
data SwaggerContact = SwaggerContact
{
swaggerContactName :: Maybe Text
, swaggerContactUrl :: Maybe URL
, swaggerContactEmail :: Maybe Text
} deriving (Eq, Show)
data SwaggerLicense = SwaggerLicense
{
swaggerLicenseName :: Text
, swaggerLicenseUrl :: Maybe URL
} deriving (Eq, Show)
data SwaggerHost = SwaggerHost
{ swaggerHostName :: HostName
, swaggerHostPort :: Maybe PortNumber
} deriving (Eq, Show)
data SwaggerScheme
= Http
| Https
| Ws
| Wss
deriving (Eq, Show)
data SwaggerPaths = SwaggerPaths
{
swaggerPathsMap :: HashMap FilePath SwaggerPathItem
} deriving (Eq, Show, Generic)
data SwaggerPathItem = SwaggerPathItem
{
swaggerPathItemGet :: Maybe SwaggerOperation
, swaggerPathItemPut :: Maybe SwaggerOperation
, swaggerPathItemPost :: Maybe SwaggerOperation
, swaggerPathItemDelete :: Maybe SwaggerOperation
, swaggerPathItemOptions :: Maybe SwaggerOperation
, swaggerPathItemHead :: Maybe SwaggerOperation
, swaggerPathItemPatch :: Maybe SwaggerOperation
, swaggerPathItemParameters :: [SwaggerParameter]
} deriving (Eq, Show, Generic)
data SwaggerOperation = SwaggerOperation
{
swaggerOperationTags :: [Text]
, swaggerOperationSummary :: Maybe Text
, swaggerOperationDescription :: Maybe Text
, swaggerOperationExternalDocs :: Maybe SwaggerExternalDocs
, swaggerOperationOperationId :: Maybe Text
, swaggerOperationConsumes :: Maybe SwaggerMimeList
, swaggerOperationProduces :: Maybe SwaggerMimeList
, swaggerOperationParameters :: [SwaggerParameter]
, swaggerOperationResponses :: SwaggerResponses
, swaggerOperationSchemes :: Maybe [SwaggerScheme]
, swaggerOperationDeprecated :: Bool
, swaggerOperationSecurity :: [SwaggerSecurityRequirement]
} deriving (Eq, Show, Generic)
newtype SwaggerMimeList = SwaggerMimeList { getSwaggerMimeList :: [MediaType] }
deriving (Eq, Show, Monoid)
data SwaggerParameter = SwaggerParameter
{
swaggerParameterName :: Text
, swaggerParameterDescription :: Maybe Text
, swaggerParameterRequired :: Bool
, swaggerParameterSchema :: SwaggerParameterSchema
} deriving (Eq, Show, Generic)
data SwaggerParameterSchema
= SwaggerParameterBody SwaggerSchema
| SwaggerParameterOther SwaggerParameterOtherSchema
deriving (Eq, Show)
data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema
{
swaggerParameterOtherSchemaIn :: SwaggerParameterLocation
, swaggerParameterOtherSchemaType :: SwaggerParameterType
, swaggerParameterOtherSchemaFormat :: Maybe SwaggerFormat
, swaggerParameterOtherSchemaAllowEmptyValue :: Bool
, swaggerParameterOtherSchemaItems :: Maybe SwaggerItems
, swaggerParameterOtherSchemaCollectionFormat :: Maybe SwaggerCollectionFormat
, swaggerParameterOtherSchemaCommon :: SwaggerSchemaCommon
} deriving (Eq, Show, Generic)
data SwaggerParameterType
= SwaggerParamString
| SwaggerParamNumber
| SwaggerParamInteger
| SwaggerParamBoolean
| SwaggerParamArray
| SwaggerParamFile
deriving (Eq, Show)
data SwaggerParameterLocation
=
SwaggerParameterQuery
| SwaggerParameterHeader
| SwaggerParameterPath
| SwaggerParameterFormData
deriving (Eq, Show)
type SwaggerFormat = Text
data SwaggerCollectionFormat
= SwaggerCollectionCSV
| SwaggerCollectionSSV
| SwaggerCollectionTSV
| SwaggerCollectionPipes
| SwaggerCollectionMulti
deriving (Eq, Show)
data SwaggerItemsType
= SwaggerItemsString
| SwaggerItemsNumber
| SwaggerItemsInteger
| SwaggerItemsBoolean
| SwaggerItemsArray
deriving (Eq, Show)
data SwaggerSchemaType
= SwaggerSchemaArray
| SwaggerSchemaBoolean
| SwaggerSchemaInteger
| SwaggerSchemaNumber
| SwaggerSchemaNull
| SwaggerSchemaObject
| SwaggerSchemaString
deriving (Eq, Show)
data SwaggerItemsCollectionFormat
= SwaggerItemsCollectionCSV
| SwaggerItemsCollectionSSV
| SwaggerItemsCollectionTSV
| SwaggerItemsCollectionPipes
deriving (Eq, Show)
type SwaggerParamName = Text
data SwaggerSchema = SwaggerSchema
{ swaggerSchemaType :: SwaggerSchemaType
, swaggerSchemaFormat :: Maybe SwaggerFormat
, swaggerSchemaTitle :: Maybe Text
, swaggerSchemaDescription :: Maybe Text
, swaggerSchemaRequired :: [SwaggerParamName]
, swaggerSchemaItems :: Maybe SwaggerSchemaItems
, swaggerSchemaAllOf :: Maybe [SwaggerSchema]
, swaggerSchemaProperties :: HashMap Text SwaggerSchema
, swaggerSchemaAdditionalProperties :: Maybe SwaggerSchema
, swaggerSchemaDiscriminator :: Maybe Text
, swaggerSchemaReadOnly :: Maybe Bool
, swaggerSchemaXml :: Maybe SwaggerXml
, swaggerSchemaExternalDocs :: Maybe SwaggerExternalDocs
, swaggerSchemaExample :: Maybe Value
, swaggerSchemaMaxProperties :: Maybe Integer
, swaggerSchemaMinProperties :: Maybe Integer
, swaggerSchemaCommon :: SwaggerSchemaCommon
} deriving (Eq, Show, Generic)
data SwaggerSchemaItems
= SwaggerSchemaItemsObject SwaggerSchema
| SwaggerSchemaItemsArray [SwaggerSchema]
deriving (Eq, Show)
data SwaggerSchemaCommon = SwaggerSchemaCommon
{
swaggerSchemaDefault :: Maybe Value
, swaggerSchemaMaximum :: Maybe Integer
, swaggerSchemaExclusiveMaximum :: Maybe Bool
, swaggerSchemaMinimum :: Maybe Integer
, swaggerSchemaExclusiveMinimum :: Maybe Bool
, swaggerSchemaMaxLength :: Maybe Integer
, swaggerSchemaMinLength :: Maybe Integer
, swaggerSchemaPattern :: Maybe Text
, swaggerSchemaMaxItems :: Maybe Integer
, swaggerSchemaMinItems :: Maybe Integer
, swaggerSchemaUniqueItems :: Maybe Bool
, swaggerSchemaEnum :: Maybe [Value]
, swaggerSchemaMultipleOf :: Maybe Integer
} deriving (Eq, Show, Generic)
data SwaggerXml = SwaggerXml
{
swaggerXmlName :: Maybe Text
, swaggerXmlNamespace :: Maybe Text
, swaggerXmlPrefix :: Maybe Text
, swaggerXmlAttribute :: Bool
, swaggerXmlWrapped :: Bool
} deriving (Eq, Show)
data SwaggerItems = SwaggerItems
{
swaggerItemsType :: SwaggerItemsType
, swaggerItemsFormat :: SwaggerFormat
, swaggerItemsItems :: SwaggerItems
, swaggerItemsCollectionFormat :: SwaggerItemsCollectionFormat
, swaggerItemsCommon :: SwaggerSchemaCommon
} deriving (Eq, Show, Generic)
data SwaggerResponses = SwaggerResponses
{
swaggerResponsesDefault :: Maybe SwaggerResponse
, swaggerResponsesResponses :: HashMap HttpStatusCode SwaggerResponse
} deriving (Eq, Show, Generic)
type HttpStatusCode = Int
data SwaggerResponse = SwaggerResponse
{
swaggerResponseDescription :: Text
, swaggerResponseSchema :: Maybe SwaggerSchema
, swaggerResponseHeaders :: HashMap HeaderName SwaggerHeader
, swaggerResponseExamples :: Maybe SwaggerExample
} deriving (Eq, Show, Generic)
type HeaderName = Text
data SwaggerHeader = SwaggerHeader
{
swaggerHeaderDescription :: Maybe String
, swaggerHeaderType :: SwaggerItemsType
, swaggerHeaderFormat :: Maybe SwaggerFormat
, swaggerHeaderItems :: SwaggerItems
, swaggerHeaderCollectionFormat :: SwaggerItemsCollectionFormat
, swaggerHeaderCommon :: SwaggerSchemaCommon
} deriving (Eq, Show, Generic)
data SwaggerExample = SwaggerExample { getSwaggerExample :: Map MediaType Value }
deriving (Eq, Show)
data SwaggerApiKeyLocation
= SwaggerApiKeyQuery
| SwaggerApiKeyHeader
deriving (Eq, Show)
data SwaggerApiKeyParams = SwaggerApiKeyParams
{
swaggerApiKeyName :: Text
, swaggerApiKeyIn :: SwaggerApiKeyLocation
} deriving (Eq, Show)
type AuthorizationURL = Text
type TokenURL = Text
data SwaggerOAuth2Flow
= SwaggerOAuth2Implicit AuthorizationURL
| SwaggerOAuth2Password TokenURL
| SwaggerOAuth2Application TokenURL
| SwaggerOAuth2AccessCode AuthorizationURL TokenURL
deriving (Eq, Show)
data SwaggerOAuth2Params = SwaggerOAuth2Params
{
swaggerOAuth2Flow :: SwaggerOAuth2Flow
, swaggerOAuth2Scopes :: HashMap Text Text
} deriving (Eq, Show, Generic)
data SwaggerSecuritySchemeType
= SwaggerSecuritySchemeBasic
| SwaggerSecuritySchemeApiKey SwaggerApiKeyParams
| SwaggerSecuritySchemeOAuth2 SwaggerOAuth2Params
deriving (Eq, Show)
data SwaggerSecurityScheme = SwaggerSecurityScheme
{
swaggerSecuritySchemeType :: SwaggerSecuritySchemeType
, swaggerSecuritySchemeDescription :: Maybe Text
} deriving (Eq, Show, Generic)
newtype SwaggerSecurityRequirement = SwaggerSecurityRequirement
{ getSwaggerSecurityRequirement :: HashMap Text [Text]
} deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
data SwaggerTag = SwaggerTag
{
swaggerTagName :: Text
, swaggerTagDescription :: Maybe Text
, swaggerTagExternalDocs :: Maybe SwaggerExternalDocs
} deriving (Eq, Show)
data SwaggerExternalDocs = SwaggerExternalDocs
{
swaggerExternalDocsDescription :: Maybe Text
, swaggerExternalDocsUrl :: URL
} deriving (Eq, Show, Generic)
newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON)
instance Monoid Swagger where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerInfo where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerPaths where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerPathItem where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerSchema where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerSchemaCommon where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerParameter where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerParameterOtherSchema where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerResponses where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerResponse where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerExternalDocs where
mempty = genericMempty
mappend = genericMappend
instance Monoid SwaggerOperation where
mempty = genericMempty
mappend = genericMappend
instance SwaggerMonoid SwaggerInfo
instance SwaggerMonoid SwaggerPaths
instance SwaggerMonoid SwaggerPathItem
instance SwaggerMonoid SwaggerSchema
instance SwaggerMonoid SwaggerSchemaCommon
instance SwaggerMonoid SwaggerParameter
instance SwaggerMonoid SwaggerParameterOtherSchema
instance SwaggerMonoid SwaggerResponses
instance SwaggerMonoid SwaggerResponse
instance SwaggerMonoid SwaggerExternalDocs
instance SwaggerMonoid SwaggerOperation
instance SwaggerMonoid SwaggerMimeList
deriving instance SwaggerMonoid URL
instance SwaggerMonoid SwaggerSchemaType where
swaggerMempty = SwaggerSchemaNull
swaggerMappend _ y = y
instance SwaggerMonoid SwaggerParameterType where
swaggerMempty = SwaggerParamString
swaggerMappend _ y = y
instance SwaggerMonoid SwaggerParameterLocation where
swaggerMempty = SwaggerParameterQuery
swaggerMappend _ y = y
instance SwaggerMonoid (HashMap Text SwaggerSchema) where
swaggerMempty = HashMap.empty
swaggerMappend = HashMap.unionWith mappend
instance SwaggerMonoid (HashMap Text SwaggerParameter) where
swaggerMempty = HashMap.empty
swaggerMappend = HashMap.unionWith mappend
instance SwaggerMonoid (HashMap Text SwaggerResponse) where
swaggerMempty = HashMap.empty
swaggerMappend = flip HashMap.union
instance SwaggerMonoid (HashMap Text SwaggerSecurityScheme) where
swaggerMempty = HashMap.empty
swaggerMappend = flip HashMap.union
instance SwaggerMonoid (HashMap FilePath SwaggerPathItem) where
swaggerMempty = HashMap.empty
swaggerMappend = HashMap.unionWith mappend
instance SwaggerMonoid (HashMap HeaderName SwaggerHeader) where
swaggerMempty = HashMap.empty
swaggerMappend = flip HashMap.union
instance SwaggerMonoid (HashMap HttpStatusCode SwaggerResponse) where
swaggerMempty = HashMap.empty
swaggerMappend = flip HashMap.union
instance SwaggerMonoid SwaggerParameterSchema where
swaggerMempty = SwaggerParameterOther swaggerMempty
swaggerMappend (SwaggerParameterBody x) (SwaggerParameterBody y) = SwaggerParameterBody (swaggerMappend x y)
swaggerMappend (SwaggerParameterOther x) (SwaggerParameterOther y) = SwaggerParameterOther (swaggerMappend x y)
swaggerMappend _ y = y
deriveJSON (jsonPrefix "SwaggerParameter") ''SwaggerParameterLocation
deriveJSON (jsonPrefix "SwaggerParam") ''SwaggerParameterType
deriveJSON' ''SwaggerInfo
deriveJSON' ''SwaggerContact
deriveJSON' ''SwaggerLicense
deriveJSON (jsonPrefix "SwaggerSchema") ''SwaggerSchemaType
deriveJSON (jsonPrefix "SwaggerItems") ''SwaggerItemsType
deriveJSON (jsonPrefix "SwaggerItemsCollection") ''SwaggerItemsCollectionFormat
deriveJSON (jsonPrefix "SwaggerCollection") ''SwaggerCollectionFormat
deriveJSON (jsonPrefix "SwaggerApiKey") ''SwaggerApiKeyLocation
deriveJSON (jsonPrefix "swaggerApiKey") ''SwaggerApiKeyParams
deriveJSON (jsonPrefix "swaggerSchema") ''SwaggerSchemaCommon
deriveJSONDefault ''SwaggerScheme
deriveJSON' ''SwaggerTag
deriveJSON' ''SwaggerExternalDocs
deriveJSON' ''SwaggerXml
deriveToJSON' ''SwaggerOperation
deriveToJSON' ''SwaggerResponse
deriveToJSON' ''SwaggerPathItem
instance ToJSON SwaggerOAuth2Flow where
toJSON (SwaggerOAuth2Implicit authUrl) = object
[ "flow" .= ("implicit" :: Text)
, "authorizationUrl" .= authUrl ]
toJSON (SwaggerOAuth2Password tokenUrl) = object
[ "flow" .= ("password" :: Text)
, "tokenUrl" .= tokenUrl ]
toJSON (SwaggerOAuth2Application tokenUrl) = object
[ "flow" .= ("application" :: Text)
, "tokenUrl" .= tokenUrl ]
toJSON (SwaggerOAuth2AccessCode authUrl tokenUrl) = object
[ "flow" .= ("accessCode" :: Text)
, "authorizationUrl" .= authUrl
, "tokenUrl" .= tokenUrl ]
instance ToJSON SwaggerOAuth2Params where
toJSON = genericToJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")
instance ToJSON SwaggerSecuritySchemeType where
toJSON SwaggerSecuritySchemeBasic
= object [ "type" .= ("basic" :: Text) ]
toJSON (SwaggerSecuritySchemeApiKey params)
= toJSON params
<+> object [ "type" .= ("apiKey" :: Text) ]
toJSON (SwaggerSecuritySchemeOAuth2 params)
= toJSON params
<+> object [ "type" .= ("oauth2" :: Text) ]
instance ToJSON Swagger where
toJSON = addVersion . genericToJSON (jsonPrefix "swagger")
where
addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
addVersion _ = error "impossible"
instance ToJSON SwaggerSecurityScheme where
toJSON = genericToJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")
instance ToJSON SwaggerSchema where
toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerSchema")
instance ToJSON SwaggerHeader where
toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerHeader")
instance ToJSON SwaggerItems where
toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerItems")
instance ToJSON SwaggerHost where
toJSON (SwaggerHost host mport) = toJSON $
case mport of
Nothing -> host
Just port -> host ++ ":" ++ show port
instance ToJSON SwaggerPaths where
toJSON (SwaggerPaths m) = toJSON m
instance ToJSON SwaggerMimeList where
toJSON (SwaggerMimeList xs) = toJSON (map show xs)
instance ToJSON SwaggerParameter where
toJSON = genericToJSONWithSub "schema" (jsonPrefix "swaggerParameter")
instance ToJSON SwaggerParameterSchema where
toJSON (SwaggerParameterBody s) = toJSON s <+> object [ "in" .= ("body" :: Text) ]
toJSON (SwaggerParameterOther s) = toJSON s
instance ToJSON SwaggerParameterOtherSchema where
toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
instance ToJSON SwaggerSchemaItems where
toJSON (SwaggerSchemaItemsObject x) = toJSON x
toJSON (SwaggerSchemaItemsArray xs) = toJSON xs
instance ToJSON SwaggerResponses where
toJSON (SwaggerResponses def rs) = toJSON (hashMapMapKeys show rs) <+> object [ "default" .= def ]
instance ToJSON SwaggerExample where
toJSON = toJSON . Map.mapKeys show . getSwaggerExample
instance FromJSON SwaggerOAuth2Flow where
parseJSON (Object o) = do
(flow :: Text) <- o .: "flow"
case flow of
"implicit" -> SwaggerOAuth2Implicit <$> o .: "authorizationUrl"
"password" -> SwaggerOAuth2Password <$> o .: "tokenUrl"
"application" -> SwaggerOAuth2Application <$> o .: "tokenUrl"
"accessCode" -> SwaggerOAuth2AccessCode
<$> o .: "authorizationUrl"
<*> o .: "tokenUrl"
_ -> empty
parseJSON _ = empty
instance FromJSON SwaggerOAuth2Params where
parseJSON = genericParseJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")
instance FromJSON SwaggerSecuritySchemeType where
parseJSON json@(Object o) = do
(t :: Text) <- o .: "type"
case t of
"basic" -> pure SwaggerSecuritySchemeBasic
"apiKey" -> SwaggerSecuritySchemeApiKey <$> parseJSON json
"oauth2" -> SwaggerSecuritySchemeOAuth2 <$> parseJSON json
_ -> empty
parseJSON _ = empty
instance FromJSON Swagger where
parseJSON json@(Object o) = do
(version :: Text) <- o .: "swagger"
when (version /= "2.0") empty
(genericParseJSON (jsonPrefix "swagger")
`withDefaults` [ "consumes" .= (mempty :: SwaggerMimeList)
, "produces" .= (mempty :: SwaggerMimeList)
, "security" .= ([] :: [SwaggerSecurityRequirement])
, "tags" .= ([] :: [SwaggerTag])
, "definitions" .= (mempty :: HashMap Text SwaggerSchema)
, "parameters" .= (mempty :: HashMap Text SwaggerParameter)
, "responses" .= (mempty :: HashMap Text SwaggerResponse)
, "securityDefinitions" .= (mempty :: HashMap Text SwaggerSecurityScheme)
] ) json
parseJSON _ = empty
instance FromJSON SwaggerSecurityScheme where
parseJSON = genericParseJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")
instance FromJSON SwaggerSchema where
parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerSchema")
`withDefaults` [ "properties" .= (mempty :: HashMap Text SwaggerSchema)
, "required" .= ([] :: [SwaggerParamName]) ]
instance FromJSON SwaggerHeader where
parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerHeader")
instance FromJSON SwaggerItems where
parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerItems")
instance FromJSON SwaggerHost where
parseJSON (String s) =
case fromInteger <$> readMaybe portStr of
Nothing | not (null portStr) -> empty
mport -> pure $ SwaggerHost host mport
where
(hostText, portText) = Text.breakOnEnd ":" s
[host, portStr] = map Text.unpack [hostText, portText]
parseJSON _ = empty
instance FromJSON SwaggerPaths where
parseJSON json = SwaggerPaths <$> parseJSON json
instance FromJSON SwaggerMimeList where
parseJSON json = (SwaggerMimeList . map fromString) <$> parseJSON json
instance FromJSON SwaggerParameter where
parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "swaggerParameter")
`withDefaults` [ "required" .= False ]
instance FromJSON SwaggerParameterSchema where
parseJSON json@(Object o) = do
(i :: Text) <- o .: "in"
case i of
"body" -> SwaggerParameterBody <$> parseJSON json
_ -> SwaggerParameterOther <$> parseJSON json
parseJSON _ = empty
instance FromJSON SwaggerParameterOtherSchema where
parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
`withDefaults` [ "allowEmptyValue" .= False ]
instance FromJSON SwaggerSchemaItems where
parseJSON json@(Object _) = SwaggerSchemaItemsObject <$> parseJSON json
parseJSON json@(Array _) = SwaggerSchemaItemsArray <$> parseJSON json
parseJSON _ = empty
instance FromJSON SwaggerResponses where
parseJSON (Object o) = SwaggerResponses
<$> o .:? "default"
<*> (parseJSON (Object (HashMap.delete "default" o)) >>= hashMapReadKeys)
parseJSON _ = empty
instance FromJSON SwaggerExample where
parseJSON json = do
m <- parseJSON json
pure $ SwaggerExample (Map.mapKeys fromString m)
instance FromJSON SwaggerResponse where
parseJSON = genericParseJSON (jsonPrefix "swaggerResponse")
`withDefaults` [ "headers" .= (mempty :: HashMap HeaderName SwaggerHeader) ]
instance FromJSON SwaggerOperation where
parseJSON = genericParseJSON (jsonPrefix "swaggerOperation")
`withDefaults` [ "deprecated" .= False
, "security" .= ([] :: [SwaggerSecurityRequirement]) ]
instance FromJSON SwaggerPathItem where
parseJSON = genericParseJSON (jsonPrefix "swaggerPathItem")
`withDefaults` [ "parameters" .= ([] :: [SwaggerParameter]) ]