{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | This module specifies the data types from the OpenAPI specification 3.0.3
--
-- For more information see http://spec.openapis.org/oas/v3.0.3
--
-- All names in this module correspond to the respective OpenAPI types
module OpenAPI.Generate.Types
  ( module OpenAPI.Generate.Types.ExternalDocumentation,
    module OpenAPI.Generate.Types.Referencable,
    module OpenAPI.Generate.Types.Schema,
    module OpenAPI.Generate.Types,
  )
where

import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Yaml
import GHC.Generics
import OpenAPI.Common (jsonObjectToList)
import OpenAPI.Generate.Types.ExternalDocumentation
import OpenAPI.Generate.Types.Referencable
import OpenAPI.Generate.Types.Schema (Schema)
import Text.Read (readMaybe)

data OpenApiSpecification = OpenApiSpecification
  { OpenApiSpecification -> Text
openApiSpecificationOpenapi :: Text,
    OpenApiSpecification -> InfoObject
openApiSpecificationInfo :: InfoObject,
    OpenApiSpecification -> [ServerObject]
openApiSpecificationServers :: [ServerObject],
    OpenApiSpecification -> PathsObject
openApiSpecificationPaths :: PathsObject,
    OpenApiSpecification -> ComponentsObject
openApiSpecificationComponents :: ComponentsObject,
    OpenApiSpecification -> [SecurityRequirementObject]
openApiSpecificationSecurity :: [SecurityRequirementObject],
    OpenApiSpecification -> [TagObject]
openApiSpecificationTags :: [TagObject],
    OpenApiSpecification -> Maybe ExternalDocumentationObject
openApiSpecificationExternalDocs :: Maybe ExternalDocumentationObject
  }
  deriving (Int -> OpenApiSpecification -> ShowS
[OpenApiSpecification] -> ShowS
OpenApiSpecification -> String
(Int -> OpenApiSpecification -> ShowS)
-> (OpenApiSpecification -> String)
-> ([OpenApiSpecification] -> ShowS)
-> Show OpenApiSpecification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenApiSpecification -> ShowS
showsPrec :: Int -> OpenApiSpecification -> ShowS
$cshow :: OpenApiSpecification -> String
show :: OpenApiSpecification -> String
$cshowList :: [OpenApiSpecification] -> ShowS
showList :: [OpenApiSpecification] -> ShowS
Show, OpenApiSpecification -> OpenApiSpecification -> Bool
(OpenApiSpecification -> OpenApiSpecification -> Bool)
-> (OpenApiSpecification -> OpenApiSpecification -> Bool)
-> Eq OpenApiSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenApiSpecification -> OpenApiSpecification -> Bool
== :: OpenApiSpecification -> OpenApiSpecification -> Bool
$c/= :: OpenApiSpecification -> OpenApiSpecification -> Bool
/= :: OpenApiSpecification -> OpenApiSpecification -> Bool
Eq, (forall x. OpenApiSpecification -> Rep OpenApiSpecification x)
-> (forall x. Rep OpenApiSpecification x -> OpenApiSpecification)
-> Generic OpenApiSpecification
forall x. Rep OpenApiSpecification x -> OpenApiSpecification
forall x. OpenApiSpecification -> Rep OpenApiSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpenApiSpecification -> Rep OpenApiSpecification x
from :: forall x. OpenApiSpecification -> Rep OpenApiSpecification x
$cto :: forall x. Rep OpenApiSpecification x -> OpenApiSpecification
to :: forall x. Rep OpenApiSpecification x -> OpenApiSpecification
Generic)

instance FromJSON OpenApiSpecification where
  parseJSON :: Value -> Parser OpenApiSpecification
parseJSON = String
-> (Object -> Parser OpenApiSpecification)
-> Value
-> Parser OpenApiSpecification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OpenApiSpecification" ((Object -> Parser OpenApiSpecification)
 -> Value -> Parser OpenApiSpecification)
-> (Object -> Parser OpenApiSpecification)
-> Value
-> Parser OpenApiSpecification
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> InfoObject
-> [ServerObject]
-> PathsObject
-> ComponentsObject
-> [SecurityRequirementObject]
-> [TagObject]
-> Maybe ExternalDocumentationObject
-> OpenApiSpecification
OpenApiSpecification
      (Text
 -> InfoObject
 -> [ServerObject]
 -> PathsObject
 -> ComponentsObject
 -> [SecurityRequirementObject]
 -> [TagObject]
 -> Maybe ExternalDocumentationObject
 -> OpenApiSpecification)
-> Parser Text
-> Parser
     (InfoObject
      -> [ServerObject]
      -> PathsObject
      -> ComponentsObject
      -> [SecurityRequirementObject]
      -> [TagObject]
      -> Maybe ExternalDocumentationObject
      -> OpenApiSpecification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"openapi"
      Parser
  (InfoObject
   -> [ServerObject]
   -> PathsObject
   -> ComponentsObject
   -> [SecurityRequirementObject]
   -> [TagObject]
   -> Maybe ExternalDocumentationObject
   -> OpenApiSpecification)
-> Parser InfoObject
-> Parser
     ([ServerObject]
      -> PathsObject
      -> ComponentsObject
      -> [SecurityRequirementObject]
      -> [TagObject]
      -> Maybe ExternalDocumentationObject
      -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser InfoObject
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"info"
      Parser
  ([ServerObject]
   -> PathsObject
   -> ComponentsObject
   -> [SecurityRequirementObject]
   -> [TagObject]
   -> Maybe ExternalDocumentationObject
   -> OpenApiSpecification)
-> Parser [ServerObject]
-> Parser
     (PathsObject
      -> ComponentsObject
      -> [SecurityRequirementObject]
      -> [TagObject]
      -> Maybe ExternalDocumentationObject
      -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [ServerObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"servers" Parser (Maybe [ServerObject])
-> [ServerObject] -> Parser [ServerObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  (PathsObject
   -> ComponentsObject
   -> [SecurityRequirementObject]
   -> [TagObject]
   -> Maybe ExternalDocumentationObject
   -> OpenApiSpecification)
-> Parser PathsObject
-> Parser
     (ComponentsObject
      -> [SecurityRequirementObject]
      -> [TagObject]
      -> Maybe ExternalDocumentationObject
      -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser PathsObject
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"paths"
      Parser
  (ComponentsObject
   -> [SecurityRequirementObject]
   -> [TagObject]
   -> Maybe ExternalDocumentationObject
   -> OpenApiSpecification)
-> Parser ComponentsObject
-> Parser
     ([SecurityRequirementObject]
      -> [TagObject]
      -> Maybe ExternalDocumentationObject
      -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
        Object -> Key -> Parser (Maybe ComponentsObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"components"
        Parser (Maybe ComponentsObject)
-> ComponentsObject -> Parser ComponentsObject
forall a. Parser (Maybe a) -> a -> Parser a
.!= ComponentsObject
          { componentsObjectSchemas :: Map Text Schema
componentsObjectSchemas = Map Text Schema
forall k a. Map k a
Map.empty,
            componentsObjectResponses :: Map Text (Referencable ResponseObject)
componentsObjectResponses = Map Text (Referencable ResponseObject)
forall k a. Map k a
Map.empty,
            componentsObjectParameters :: Map Text (Referencable ParameterObject)
componentsObjectParameters = Map Text (Referencable ParameterObject)
forall k a. Map k a
Map.empty,
            componentsObjectExamples :: Map Text (Referencable ExampleObject)
componentsObjectExamples = Map Text (Referencable ExampleObject)
forall k a. Map k a
Map.empty,
            componentsObjectRequestBodies :: Map Text (Referencable RequestBodyObject)
componentsObjectRequestBodies = Map Text (Referencable RequestBodyObject)
forall k a. Map k a
Map.empty,
            componentsObjectHeaders :: Map Text (Referencable HeaderObject)
componentsObjectHeaders = Map Text (Referencable HeaderObject)
forall k a. Map k a
Map.empty,
            componentsObjectSecuritySchemes :: Map Text (Referencable SecuritySchemeObject)
componentsObjectSecuritySchemes = Map Text (Referencable SecuritySchemeObject)
forall k a. Map k a
Map.empty
          }
      Parser
  ([SecurityRequirementObject]
   -> [TagObject]
   -> Maybe ExternalDocumentationObject
   -> OpenApiSpecification)
-> Parser [SecurityRequirementObject]
-> Parser
     ([TagObject]
      -> Maybe ExternalDocumentationObject -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [SecurityRequirementObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"security" Parser (Maybe [SecurityRequirementObject])
-> [SecurityRequirementObject]
-> Parser [SecurityRequirementObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  ([TagObject]
   -> Maybe ExternalDocumentationObject -> OpenApiSpecification)
-> Parser [TagObject]
-> Parser
     (Maybe ExternalDocumentationObject -> OpenApiSpecification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [TagObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags" Parser (Maybe [TagObject]) -> [TagObject] -> Parser [TagObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser (Maybe ExternalDocumentationObject -> OpenApiSpecification)
-> Parser (Maybe ExternalDocumentationObject)
-> Parser OpenApiSpecification
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExternalDocumentationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"externalDocs"

data InfoObject = InfoObject
  { InfoObject -> Text
infoObjectTitle :: Text,
    InfoObject -> Maybe Text
infoObjectDescription :: Maybe Text,
    InfoObject -> Maybe Text
infoObjectTermsOfService :: Maybe Text,
    InfoObject -> Maybe ContactObject
infoObjectContact :: Maybe ContactObject,
    InfoObject -> Maybe LicenseObject
infoObjectLicense :: Maybe LicenseObject,
    InfoObject -> Text
infoObjectVersion :: Text
  }
  deriving (Int -> InfoObject -> ShowS
[InfoObject] -> ShowS
InfoObject -> String
(Int -> InfoObject -> ShowS)
-> (InfoObject -> String)
-> ([InfoObject] -> ShowS)
-> Show InfoObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InfoObject -> ShowS
showsPrec :: Int -> InfoObject -> ShowS
$cshow :: InfoObject -> String
show :: InfoObject -> String
$cshowList :: [InfoObject] -> ShowS
showList :: [InfoObject] -> ShowS
Show, InfoObject -> InfoObject -> Bool
(InfoObject -> InfoObject -> Bool)
-> (InfoObject -> InfoObject -> Bool) -> Eq InfoObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InfoObject -> InfoObject -> Bool
== :: InfoObject -> InfoObject -> Bool
$c/= :: InfoObject -> InfoObject -> Bool
/= :: InfoObject -> InfoObject -> Bool
Eq, (forall x. InfoObject -> Rep InfoObject x)
-> (forall x. Rep InfoObject x -> InfoObject) -> Generic InfoObject
forall x. Rep InfoObject x -> InfoObject
forall x. InfoObject -> Rep InfoObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InfoObject -> Rep InfoObject x
from :: forall x. InfoObject -> Rep InfoObject x
$cto :: forall x. Rep InfoObject x -> InfoObject
to :: forall x. Rep InfoObject x -> InfoObject
Generic)

instance FromJSON InfoObject where
  parseJSON :: Value -> Parser InfoObject
parseJSON = String
-> (Object -> Parser InfoObject) -> Value -> Parser InfoObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InfoObject" ((Object -> Parser InfoObject) -> Value -> Parser InfoObject)
-> (Object -> Parser InfoObject) -> Value -> Parser InfoObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text
-> Maybe Text
-> Maybe ContactObject
-> Maybe LicenseObject
-> Text
-> InfoObject
InfoObject
      (Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe ContactObject
 -> Maybe LicenseObject
 -> Text
 -> InfoObject)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ContactObject
      -> Maybe LicenseObject
      -> Text
      -> InfoObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ContactObject
   -> Maybe LicenseObject
   -> Text
   -> InfoObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ContactObject
      -> Maybe LicenseObject
      -> Text
      -> InfoObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (Maybe Text
   -> Maybe ContactObject
   -> Maybe LicenseObject
   -> Text
   -> InfoObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe ContactObject -> Maybe LicenseObject -> Text -> InfoObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"termsOfService"
      Parser
  (Maybe ContactObject -> Maybe LicenseObject -> Text -> InfoObject)
-> Parser (Maybe ContactObject)
-> Parser (Maybe LicenseObject -> Text -> InfoObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ContactObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contact"
      Parser (Maybe LicenseObject -> Text -> InfoObject)
-> Parser (Maybe LicenseObject) -> Parser (Text -> InfoObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe LicenseObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"license"
      Parser (Text -> InfoObject) -> Parser Text -> Parser InfoObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"

data ContactObject = ContactObject
  { ContactObject -> Maybe Text
contactObjectName :: Maybe Text,
    ContactObject -> Maybe Text
contactObjectUrl :: Maybe Text,
    ContactObject -> Maybe Text
contactObjectEmail :: Maybe Text
  }
  deriving (Int -> ContactObject -> ShowS
[ContactObject] -> ShowS
ContactObject -> String
(Int -> ContactObject -> ShowS)
-> (ContactObject -> String)
-> ([ContactObject] -> ShowS)
-> Show ContactObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContactObject -> ShowS
showsPrec :: Int -> ContactObject -> ShowS
$cshow :: ContactObject -> String
show :: ContactObject -> String
$cshowList :: [ContactObject] -> ShowS
showList :: [ContactObject] -> ShowS
Show, ContactObject -> ContactObject -> Bool
(ContactObject -> ContactObject -> Bool)
-> (ContactObject -> ContactObject -> Bool) -> Eq ContactObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContactObject -> ContactObject -> Bool
== :: ContactObject -> ContactObject -> Bool
$c/= :: ContactObject -> ContactObject -> Bool
/= :: ContactObject -> ContactObject -> Bool
Eq, (forall x. ContactObject -> Rep ContactObject x)
-> (forall x. Rep ContactObject x -> ContactObject)
-> Generic ContactObject
forall x. Rep ContactObject x -> ContactObject
forall x. ContactObject -> Rep ContactObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContactObject -> Rep ContactObject x
from :: forall x. ContactObject -> Rep ContactObject x
$cto :: forall x. Rep ContactObject x -> ContactObject
to :: forall x. Rep ContactObject x -> ContactObject
Generic)

instance FromJSON ContactObject where
  parseJSON :: Value -> Parser ContactObject
parseJSON = String
-> (Object -> Parser ContactObject)
-> Value
-> Parser ContactObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContactObject" ((Object -> Parser ContactObject) -> Value -> Parser ContactObject)
-> (Object -> Parser ContactObject)
-> Value
-> Parser ContactObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> ContactObject
ContactObject
      (Maybe Text -> Maybe Text -> Maybe Text -> ContactObject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ContactObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
      Parser (Maybe Text -> Maybe Text -> ContactObject)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ContactObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
      Parser (Maybe Text -> ContactObject)
-> Parser (Maybe Text) -> Parser ContactObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"

data LicenseObject = LicenseObject
  { LicenseObject -> Text
licenseObjectName :: Text,
    LicenseObject -> Maybe Text
licenseObjectUrl :: Maybe Text
  }
  deriving (Int -> LicenseObject -> ShowS
[LicenseObject] -> ShowS
LicenseObject -> String
(Int -> LicenseObject -> ShowS)
-> (LicenseObject -> String)
-> ([LicenseObject] -> ShowS)
-> Show LicenseObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LicenseObject -> ShowS
showsPrec :: Int -> LicenseObject -> ShowS
$cshow :: LicenseObject -> String
show :: LicenseObject -> String
$cshowList :: [LicenseObject] -> ShowS
showList :: [LicenseObject] -> ShowS
Show, LicenseObject -> LicenseObject -> Bool
(LicenseObject -> LicenseObject -> Bool)
-> (LicenseObject -> LicenseObject -> Bool) -> Eq LicenseObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LicenseObject -> LicenseObject -> Bool
== :: LicenseObject -> LicenseObject -> Bool
$c/= :: LicenseObject -> LicenseObject -> Bool
/= :: LicenseObject -> LicenseObject -> Bool
Eq, (forall x. LicenseObject -> Rep LicenseObject x)
-> (forall x. Rep LicenseObject x -> LicenseObject)
-> Generic LicenseObject
forall x. Rep LicenseObject x -> LicenseObject
forall x. LicenseObject -> Rep LicenseObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LicenseObject -> Rep LicenseObject x
from :: forall x. LicenseObject -> Rep LicenseObject x
$cto :: forall x. Rep LicenseObject x -> LicenseObject
to :: forall x. Rep LicenseObject x -> LicenseObject
Generic)

instance FromJSON LicenseObject where
  parseJSON :: Value -> Parser LicenseObject
parseJSON = String
-> (Object -> Parser LicenseObject)
-> Value
-> Parser LicenseObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LicenseObject" ((Object -> Parser LicenseObject) -> Value -> Parser LicenseObject)
-> (Object -> Parser LicenseObject)
-> Value
-> Parser LicenseObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> LicenseObject
LicenseObject
      (Text -> Maybe Text -> LicenseObject)
-> Parser Text -> Parser (Maybe Text -> LicenseObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (Maybe Text -> LicenseObject)
-> Parser (Maybe Text) -> Parser LicenseObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"

type PathsObject = Map.Map Text PathItemObject

data PathItemObject = PathItemObject
  { PathItemObject -> Maybe Text
pathItemObjectRef :: Maybe Text,
    PathItemObject -> Maybe Text
pathItemObjectSummary :: Maybe Text,
    PathItemObject -> Maybe Text
pathItemObjectDescription :: Maybe Text,
    PathItemObject -> Maybe OperationObject
pathItemObjectGet :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectPut :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectPost :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectDelete :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectOptions :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectHead :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectPatch :: Maybe OperationObject,
    PathItemObject -> Maybe OperationObject
pathItemObjectTrace :: Maybe OperationObject,
    PathItemObject -> [ServerObject]
pathItemObjectServers :: [ServerObject],
    PathItemObject -> [Referencable ParameterObject]
pathItemObjectParameters :: [Referencable ParameterObject]
  }
  deriving (Int -> PathItemObject -> ShowS
[PathItemObject] -> ShowS
PathItemObject -> String
(Int -> PathItemObject -> ShowS)
-> (PathItemObject -> String)
-> ([PathItemObject] -> ShowS)
-> Show PathItemObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathItemObject -> ShowS
showsPrec :: Int -> PathItemObject -> ShowS
$cshow :: PathItemObject -> String
show :: PathItemObject -> String
$cshowList :: [PathItemObject] -> ShowS
showList :: [PathItemObject] -> ShowS
Show, PathItemObject -> PathItemObject -> Bool
(PathItemObject -> PathItemObject -> Bool)
-> (PathItemObject -> PathItemObject -> Bool) -> Eq PathItemObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathItemObject -> PathItemObject -> Bool
== :: PathItemObject -> PathItemObject -> Bool
$c/= :: PathItemObject -> PathItemObject -> Bool
/= :: PathItemObject -> PathItemObject -> Bool
Eq, (forall x. PathItemObject -> Rep PathItemObject x)
-> (forall x. Rep PathItemObject x -> PathItemObject)
-> Generic PathItemObject
forall x. Rep PathItemObject x -> PathItemObject
forall x. PathItemObject -> Rep PathItemObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathItemObject -> Rep PathItemObject x
from :: forall x. PathItemObject -> Rep PathItemObject x
$cto :: forall x. Rep PathItemObject x -> PathItemObject
to :: forall x. Rep PathItemObject x -> PathItemObject
Generic)

instance FromJSON PathItemObject where
  parseJSON :: Value -> Parser PathItemObject
parseJSON = String
-> (Object -> Parser PathItemObject)
-> Value
-> Parser PathItemObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PathItemObject" ((Object -> Parser PathItemObject)
 -> Value -> Parser PathItemObject)
-> (Object -> Parser PathItemObject)
-> Value
-> Parser PathItemObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> Maybe OperationObject
-> [ServerObject]
-> [Referencable ParameterObject]
-> PathItemObject
PathItemObject
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> Maybe OperationObject
 -> [ServerObject]
 -> [Referencable ParameterObject]
 -> PathItemObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"summary"
      Parser
  (Maybe Text
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"get"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"put"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"post"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delete"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head"
      Parser
  (Maybe OperationObject
   -> Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     (Maybe OperationObject
      -> [ServerObject]
      -> [Referencable ParameterObject]
      -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"patch"
      Parser
  (Maybe OperationObject
   -> [ServerObject]
   -> [Referencable ParameterObject]
   -> PathItemObject)
-> Parser (Maybe OperationObject)
-> Parser
     ([ServerObject]
      -> [Referencable ParameterObject] -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OperationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"trace"
      Parser
  ([ServerObject]
   -> [Referencable ParameterObject] -> PathItemObject)
-> Parser [ServerObject]
-> Parser ([Referencable ParameterObject] -> PathItemObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [ServerObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"servers" Parser (Maybe [ServerObject])
-> [ServerObject] -> Parser [ServerObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Referencable ParameterObject] -> PathItemObject)
-> Parser [Referencable ParameterObject] -> Parser PathItemObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Referencable ParameterObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameters" Parser (Maybe [Referencable ParameterObject])
-> [Referencable ParameterObject]
-> Parser [Referencable ParameterObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

data OperationObject = OperationObject
  { OperationObject -> [Text]
operationObjectTags :: [Text],
    OperationObject -> Maybe Text
operationObjectSummary :: Maybe Text,
    OperationObject -> Maybe Text
operationObjectDescription :: Maybe Text,
    OperationObject -> Maybe ExternalDocumentationObject
operationObjectExternalDocs :: Maybe ExternalDocumentationObject,
    OperationObject -> Maybe Text
operationObjectOperationId :: Maybe Text,
    OperationObject -> [Referencable ParameterObject]
operationObjectParameters :: [Referencable ParameterObject],
    OperationObject -> Maybe (Referencable RequestBodyObject)
operationObjectRequestBody :: Maybe (Referencable RequestBodyObject),
    OperationObject -> ResponsesObject
operationObjectResponses :: ResponsesObject,
    OperationObject -> Bool
operationObjectDeprecated :: Bool,
    OperationObject -> [SecurityRequirementObject]
operationObjectSecurity :: [SecurityRequirementObject],
    OperationObject -> [ServerObject]
operationObjectServers :: [ServerObject]
    -- callbacks (http://spec.openapis.org/oas/v3.0.3#operation-object) are omitted because they are not needed
  }
  deriving (Int -> OperationObject -> ShowS
[OperationObject] -> ShowS
OperationObject -> String
(Int -> OperationObject -> ShowS)
-> (OperationObject -> String)
-> ([OperationObject] -> ShowS)
-> Show OperationObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationObject -> ShowS
showsPrec :: Int -> OperationObject -> ShowS
$cshow :: OperationObject -> String
show :: OperationObject -> String
$cshowList :: [OperationObject] -> ShowS
showList :: [OperationObject] -> ShowS
Show, OperationObject -> OperationObject -> Bool
(OperationObject -> OperationObject -> Bool)
-> (OperationObject -> OperationObject -> Bool)
-> Eq OperationObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationObject -> OperationObject -> Bool
== :: OperationObject -> OperationObject -> Bool
$c/= :: OperationObject -> OperationObject -> Bool
/= :: OperationObject -> OperationObject -> Bool
Eq, (forall x. OperationObject -> Rep OperationObject x)
-> (forall x. Rep OperationObject x -> OperationObject)
-> Generic OperationObject
forall x. Rep OperationObject x -> OperationObject
forall x. OperationObject -> Rep OperationObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OperationObject -> Rep OperationObject x
from :: forall x. OperationObject -> Rep OperationObject x
$cto :: forall x. Rep OperationObject x -> OperationObject
to :: forall x. Rep OperationObject x -> OperationObject
Generic)

instance FromJSON OperationObject where
  parseJSON :: Value -> Parser OperationObject
parseJSON = String
-> (Object -> Parser OperationObject)
-> Value
-> Parser OperationObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OperationObject" ((Object -> Parser OperationObject)
 -> Value -> Parser OperationObject)
-> (Object -> Parser OperationObject)
-> Value
-> Parser OperationObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text]
-> Maybe Text
-> Maybe Text
-> Maybe ExternalDocumentationObject
-> Maybe Text
-> [Referencable ParameterObject]
-> Maybe (Referencable RequestBodyObject)
-> ResponsesObject
-> Bool
-> [SecurityRequirementObject]
-> [ServerObject]
-> OperationObject
OperationObject
      ([Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe ExternalDocumentationObject
 -> Maybe Text
 -> [Referencable ParameterObject]
 -> Maybe (Referencable RequestBodyObject)
 -> ResponsesObject
 -> Bool
 -> [SecurityRequirementObject]
 -> [ServerObject]
 -> OperationObject)
-> Parser [Text]
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ExternalDocumentationObject
      -> Maybe Text
      -> [Referencable ParameterObject]
      -> Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ExternalDocumentationObject
   -> Maybe Text
   -> [Referencable ParameterObject]
   -> Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ExternalDocumentationObject
      -> Maybe Text
      -> [Referencable ParameterObject]
      -> Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"summary"
      Parser
  (Maybe Text
   -> Maybe ExternalDocumentationObject
   -> Maybe Text
   -> [Referencable ParameterObject]
   -> Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe ExternalDocumentationObject
      -> Maybe Text
      -> [Referencable ParameterObject]
      -> Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (Maybe ExternalDocumentationObject
   -> Maybe Text
   -> [Referencable ParameterObject]
   -> Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser (Maybe ExternalDocumentationObject)
-> Parser
     (Maybe Text
      -> [Referencable ParameterObject]
      -> Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExternalDocumentationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"externalDocs"
      Parser
  (Maybe Text
   -> [Referencable ParameterObject]
   -> Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser (Maybe Text)
-> Parser
     ([Referencable ParameterObject]
      -> Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"operationId"
      Parser
  ([Referencable ParameterObject]
   -> Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser [Referencable ParameterObject]
-> Parser
     (Maybe (Referencable RequestBodyObject)
      -> ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Referencable ParameterObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameters" Parser (Maybe [Referencable ParameterObject])
-> [Referencable ParameterObject]
-> Parser [Referencable ParameterObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  (Maybe (Referencable RequestBodyObject)
   -> ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser (Maybe (Referencable RequestBodyObject))
-> Parser
     (ResponsesObject
      -> Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable RequestBodyObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requestBody"
      Parser
  (ResponsesObject
   -> Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser ResponsesObject
-> Parser
     (Bool
      -> [SecurityRequirementObject]
      -> [ServerObject]
      -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ResponsesObject
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"responses"
      Parser
  (Bool
   -> [SecurityRequirementObject]
   -> [ServerObject]
   -> OperationObject)
-> Parser Bool
-> Parser
     ([SecurityRequirementObject] -> [ServerObject] -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser
  ([SecurityRequirementObject] -> [ServerObject] -> OperationObject)
-> Parser [SecurityRequirementObject]
-> Parser ([ServerObject] -> OperationObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [SecurityRequirementObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"security" Parser (Maybe [SecurityRequirementObject])
-> [SecurityRequirementObject]
-> Parser [SecurityRequirementObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([ServerObject] -> OperationObject)
-> Parser [ServerObject] -> Parser OperationObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [ServerObject])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"servers" Parser (Maybe [ServerObject])
-> [ServerObject] -> Parser [ServerObject]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

type SecurityRequirementObject = Map.Map Text [Text]

data RequestBodyObject = RequestBodyObject
  { RequestBodyObject -> Map Text MediaTypeObject
requestBodyObjectContent :: Map.Map Text MediaTypeObject,
    RequestBodyObject -> Maybe Text
requestBodyObjectDescription :: Maybe Text,
    RequestBodyObject -> Bool
requestBodyObjectRequired :: Bool
  }
  deriving (Int -> RequestBodyObject -> ShowS
[RequestBodyObject] -> ShowS
RequestBodyObject -> String
(Int -> RequestBodyObject -> ShowS)
-> (RequestBodyObject -> String)
-> ([RequestBodyObject] -> ShowS)
-> Show RequestBodyObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestBodyObject -> ShowS
showsPrec :: Int -> RequestBodyObject -> ShowS
$cshow :: RequestBodyObject -> String
show :: RequestBodyObject -> String
$cshowList :: [RequestBodyObject] -> ShowS
showList :: [RequestBodyObject] -> ShowS
Show, RequestBodyObject -> RequestBodyObject -> Bool
(RequestBodyObject -> RequestBodyObject -> Bool)
-> (RequestBodyObject -> RequestBodyObject -> Bool)
-> Eq RequestBodyObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestBodyObject -> RequestBodyObject -> Bool
== :: RequestBodyObject -> RequestBodyObject -> Bool
$c/= :: RequestBodyObject -> RequestBodyObject -> Bool
/= :: RequestBodyObject -> RequestBodyObject -> Bool
Eq, (forall x. RequestBodyObject -> Rep RequestBodyObject x)
-> (forall x. Rep RequestBodyObject x -> RequestBodyObject)
-> Generic RequestBodyObject
forall x. Rep RequestBodyObject x -> RequestBodyObject
forall x. RequestBodyObject -> Rep RequestBodyObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestBodyObject -> Rep RequestBodyObject x
from :: forall x. RequestBodyObject -> Rep RequestBodyObject x
$cto :: forall x. Rep RequestBodyObject x -> RequestBodyObject
to :: forall x. Rep RequestBodyObject x -> RequestBodyObject
Generic)

instance FromJSON RequestBodyObject where
  parseJSON :: Value -> Parser RequestBodyObject
parseJSON = String
-> (Object -> Parser RequestBodyObject)
-> Value
-> Parser RequestBodyObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RequestBodyObject" ((Object -> Parser RequestBodyObject)
 -> Value -> Parser RequestBodyObject)
-> (Object -> Parser RequestBodyObject)
-> Value
-> Parser RequestBodyObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Map Text MediaTypeObject -> Maybe Text -> Bool -> RequestBodyObject
RequestBodyObject
      (Map Text MediaTypeObject
 -> Maybe Text -> Bool -> RequestBodyObject)
-> Parser (Map Text MediaTypeObject)
-> Parser (Maybe Text -> Bool -> RequestBodyObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Map Text MediaTypeObject)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
      Parser (Maybe Text -> Bool -> RequestBodyObject)
-> Parser (Maybe Text) -> Parser (Bool -> RequestBodyObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Bool -> RequestBodyObject)
-> Parser Bool -> Parser RequestBodyObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

data MediaTypeObject = MediaTypeObject
  { MediaTypeObject -> Maybe Schema
mediaTypeObjectSchema :: Maybe Schema,
    MediaTypeObject -> Maybe Value
mediaTypeObjectExample :: Maybe Value,
    MediaTypeObject -> Map Text (Referencable ExampleObject)
mediaTypeObjectExamples :: Map.Map Text (Referencable ExampleObject),
    MediaTypeObject -> Map Text EncodingObject
mediaTypeObjectEncoding :: Map.Map Text EncodingObject
  }
  deriving (Int -> MediaTypeObject -> ShowS
[MediaTypeObject] -> ShowS
MediaTypeObject -> String
(Int -> MediaTypeObject -> ShowS)
-> (MediaTypeObject -> String)
-> ([MediaTypeObject] -> ShowS)
-> Show MediaTypeObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MediaTypeObject -> ShowS
showsPrec :: Int -> MediaTypeObject -> ShowS
$cshow :: MediaTypeObject -> String
show :: MediaTypeObject -> String
$cshowList :: [MediaTypeObject] -> ShowS
showList :: [MediaTypeObject] -> ShowS
Show, MediaTypeObject -> MediaTypeObject -> Bool
(MediaTypeObject -> MediaTypeObject -> Bool)
-> (MediaTypeObject -> MediaTypeObject -> Bool)
-> Eq MediaTypeObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MediaTypeObject -> MediaTypeObject -> Bool
== :: MediaTypeObject -> MediaTypeObject -> Bool
$c/= :: MediaTypeObject -> MediaTypeObject -> Bool
/= :: MediaTypeObject -> MediaTypeObject -> Bool
Eq, (forall x. MediaTypeObject -> Rep MediaTypeObject x)
-> (forall x. Rep MediaTypeObject x -> MediaTypeObject)
-> Generic MediaTypeObject
forall x. Rep MediaTypeObject x -> MediaTypeObject
forall x. MediaTypeObject -> Rep MediaTypeObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MediaTypeObject -> Rep MediaTypeObject x
from :: forall x. MediaTypeObject -> Rep MediaTypeObject x
$cto :: forall x. Rep MediaTypeObject x -> MediaTypeObject
to :: forall x. Rep MediaTypeObject x -> MediaTypeObject
Generic)

instance FromJSON MediaTypeObject where
  parseJSON :: Value -> Parser MediaTypeObject
parseJSON = String
-> (Object -> Parser MediaTypeObject)
-> Value
-> Parser MediaTypeObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MediaTypeObject" ((Object -> Parser MediaTypeObject)
 -> Value -> Parser MediaTypeObject)
-> (Object -> Parser MediaTypeObject)
-> Value
-> Parser MediaTypeObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Schema
-> Maybe Value
-> Map Text (Referencable ExampleObject)
-> Map Text EncodingObject
-> MediaTypeObject
MediaTypeObject
      (Maybe Schema
 -> Maybe Value
 -> Map Text (Referencable ExampleObject)
 -> Map Text EncodingObject
 -> MediaTypeObject)
-> Parser (Maybe Schema)
-> Parser
     (Maybe Value
      -> Map Text (Referencable ExampleObject)
      -> Map Text EncodingObject
      -> MediaTypeObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Schema)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema"
      Parser
  (Maybe Value
   -> Map Text (Referencable ExampleObject)
   -> Map Text EncodingObject
   -> MediaTypeObject)
-> Parser (Maybe Value)
-> Parser
     (Map Text (Referencable ExampleObject)
      -> Map Text EncodingObject -> MediaTypeObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"example"
      Parser
  (Map Text (Referencable ExampleObject)
   -> Map Text EncodingObject -> MediaTypeObject)
-> Parser (Map Text (Referencable ExampleObject))
-> Parser (Map Text EncodingObject -> MediaTypeObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable ExampleObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"examples" Parser (Maybe (Map Text (Referencable ExampleObject)))
-> Map Text (Referencable ExampleObject)
-> Parser (Map Text (Referencable ExampleObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable ExampleObject)
forall k a. Map k a
Map.empty
      Parser (Map Text EncodingObject -> MediaTypeObject)
-> Parser (Map Text EncodingObject) -> Parser MediaTypeObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Map Text EncodingObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"encoding" Parser (Maybe (Map Text EncodingObject))
-> Map Text EncodingObject -> Parser (Map Text EncodingObject)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text EncodingObject
forall k a. Map k a
Map.empty

data ExampleObject = ExampleObject
  { ExampleObject -> Maybe Text
exampleObjectSummary :: Maybe Text,
    ExampleObject -> Maybe Text
exampleObjectDescription :: Maybe Text,
    ExampleObject -> Maybe Value
exampleObjectValue :: Maybe Value, -- value and externalValue are mutually exclusive, maybe this should be encoded in this data type
    ExampleObject -> Maybe Text
exampleObjectExternalValue :: Maybe Text
  }
  deriving (Int -> ExampleObject -> ShowS
[ExampleObject] -> ShowS
ExampleObject -> String
(Int -> ExampleObject -> ShowS)
-> (ExampleObject -> String)
-> ([ExampleObject] -> ShowS)
-> Show ExampleObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExampleObject -> ShowS
showsPrec :: Int -> ExampleObject -> ShowS
$cshow :: ExampleObject -> String
show :: ExampleObject -> String
$cshowList :: [ExampleObject] -> ShowS
showList :: [ExampleObject] -> ShowS
Show, ExampleObject -> ExampleObject -> Bool
(ExampleObject -> ExampleObject -> Bool)
-> (ExampleObject -> ExampleObject -> Bool) -> Eq ExampleObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExampleObject -> ExampleObject -> Bool
== :: ExampleObject -> ExampleObject -> Bool
$c/= :: ExampleObject -> ExampleObject -> Bool
/= :: ExampleObject -> ExampleObject -> Bool
Eq, (forall x. ExampleObject -> Rep ExampleObject x)
-> (forall x. Rep ExampleObject x -> ExampleObject)
-> Generic ExampleObject
forall x. Rep ExampleObject x -> ExampleObject
forall x. ExampleObject -> Rep ExampleObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExampleObject -> Rep ExampleObject x
from :: forall x. ExampleObject -> Rep ExampleObject x
$cto :: forall x. Rep ExampleObject x -> ExampleObject
to :: forall x. Rep ExampleObject x -> ExampleObject
Generic)

instance FromJSON ExampleObject where
  parseJSON :: Value -> Parser ExampleObject
parseJSON = String
-> (Object -> Parser ExampleObject)
-> Value
-> Parser ExampleObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExampleObject" ((Object -> Parser ExampleObject) -> Value -> Parser ExampleObject)
-> (Object -> Parser ExampleObject)
-> Value
-> Parser ExampleObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Value -> Maybe Text -> ExampleObject
ExampleObject
      (Maybe Text
 -> Maybe Text -> Maybe Value -> Maybe Text -> ExampleObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Value -> Maybe Text -> ExampleObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"summary"
      Parser (Maybe Text -> Maybe Value -> Maybe Text -> ExampleObject)
-> Parser (Maybe Text)
-> Parser (Maybe Value -> Maybe Text -> ExampleObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Maybe Value -> Maybe Text -> ExampleObject)
-> Parser (Maybe Value) -> Parser (Maybe Text -> ExampleObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
      Parser (Maybe Text -> ExampleObject)
-> Parser (Maybe Text) -> Parser ExampleObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"externalValue"

data EncodingObject = EncodingObject
  { EncodingObject -> Maybe Text
encodingObjectContentType :: Maybe Text,
    EncodingObject -> Map Text (Referencable HeaderObject)
encodingObjectHeaders :: Map.Map Text (Referencable HeaderObject),
    EncodingObject -> Maybe Text
encodingObjectStyle :: Maybe Text,
    EncodingObject -> Bool
encodingObjectExplode :: Bool,
    EncodingObject -> Bool
encodingObjectAllowReserved :: Bool
  }
  deriving (Int -> EncodingObject -> ShowS
[EncodingObject] -> ShowS
EncodingObject -> String
(Int -> EncodingObject -> ShowS)
-> (EncodingObject -> String)
-> ([EncodingObject] -> ShowS)
-> Show EncodingObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodingObject -> ShowS
showsPrec :: Int -> EncodingObject -> ShowS
$cshow :: EncodingObject -> String
show :: EncodingObject -> String
$cshowList :: [EncodingObject] -> ShowS
showList :: [EncodingObject] -> ShowS
Show, EncodingObject -> EncodingObject -> Bool
(EncodingObject -> EncodingObject -> Bool)
-> (EncodingObject -> EncodingObject -> Bool) -> Eq EncodingObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodingObject -> EncodingObject -> Bool
== :: EncodingObject -> EncodingObject -> Bool
$c/= :: EncodingObject -> EncodingObject -> Bool
/= :: EncodingObject -> EncodingObject -> Bool
Eq, (forall x. EncodingObject -> Rep EncodingObject x)
-> (forall x. Rep EncodingObject x -> EncodingObject)
-> Generic EncodingObject
forall x. Rep EncodingObject x -> EncodingObject
forall x. EncodingObject -> Rep EncodingObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EncodingObject -> Rep EncodingObject x
from :: forall x. EncodingObject -> Rep EncodingObject x
$cto :: forall x. Rep EncodingObject x -> EncodingObject
to :: forall x. Rep EncodingObject x -> EncodingObject
Generic)

instance FromJSON EncodingObject where
  parseJSON :: Value -> Parser EncodingObject
parseJSON = String
-> (Object -> Parser EncodingObject)
-> Value
-> Parser EncodingObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EncodingObject" ((Object -> Parser EncodingObject)
 -> Value -> Parser EncodingObject)
-> (Object -> Parser EncodingObject)
-> Value
-> Parser EncodingObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Map Text (Referencable HeaderObject)
-> Maybe Text
-> Bool
-> Bool
-> EncodingObject
EncodingObject
      (Maybe Text
 -> Map Text (Referencable HeaderObject)
 -> Maybe Text
 -> Bool
 -> Bool
 -> EncodingObject)
-> Parser (Maybe Text)
-> Parser
     (Map Text (Referencable HeaderObject)
      -> Maybe Text -> Bool -> Bool -> EncodingObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contentType"
      Parser
  (Map Text (Referencable HeaderObject)
   -> Maybe Text -> Bool -> Bool -> EncodingObject)
-> Parser (Map Text (Referencable HeaderObject))
-> Parser (Maybe Text -> Bool -> Bool -> EncodingObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable HeaderObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe (Map Text (Referencable HeaderObject)))
-> Map Text (Referencable HeaderObject)
-> Parser (Map Text (Referencable HeaderObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable HeaderObject)
forall k a. Map k a
Map.empty
      Parser (Maybe Text -> Bool -> Bool -> EncodingObject)
-> Parser (Maybe Text) -> Parser (Bool -> Bool -> EncodingObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
      Parser (Bool -> Bool -> EncodingObject)
-> Parser Bool -> Parser (Bool -> EncodingObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"explode" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True
      Parser (Bool -> EncodingObject)
-> Parser Bool -> Parser EncodingObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowReserved" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

data ResponsesObject = ResponsesObject
  { ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectDefault :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectRange1XX :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectRange2XX :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectRange3XX :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectRange4XX :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Maybe (Referencable ResponseObject)
responsesObjectRange5XX :: Maybe (Referencable ResponseObject),
    ResponsesObject -> Map Int (Referencable ResponseObject)
responsesObjectPerStatusCode :: Map.Map Int (Referencable ResponseObject)
  }
  deriving (Int -> ResponsesObject -> ShowS
[ResponsesObject] -> ShowS
ResponsesObject -> String
(Int -> ResponsesObject -> ShowS)
-> (ResponsesObject -> String)
-> ([ResponsesObject] -> ShowS)
-> Show ResponsesObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponsesObject -> ShowS
showsPrec :: Int -> ResponsesObject -> ShowS
$cshow :: ResponsesObject -> String
show :: ResponsesObject -> String
$cshowList :: [ResponsesObject] -> ShowS
showList :: [ResponsesObject] -> ShowS
Show, ResponsesObject -> ResponsesObject -> Bool
(ResponsesObject -> ResponsesObject -> Bool)
-> (ResponsesObject -> ResponsesObject -> Bool)
-> Eq ResponsesObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponsesObject -> ResponsesObject -> Bool
== :: ResponsesObject -> ResponsesObject -> Bool
$c/= :: ResponsesObject -> ResponsesObject -> Bool
/= :: ResponsesObject -> ResponsesObject -> Bool
Eq, (forall x. ResponsesObject -> Rep ResponsesObject x)
-> (forall x. Rep ResponsesObject x -> ResponsesObject)
-> Generic ResponsesObject
forall x. Rep ResponsesObject x -> ResponsesObject
forall x. ResponsesObject -> Rep ResponsesObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponsesObject -> Rep ResponsesObject x
from :: forall x. ResponsesObject -> Rep ResponsesObject x
$cto :: forall x. Rep ResponsesObject x -> ResponsesObject
to :: forall x. Rep ResponsesObject x -> ResponsesObject
Generic)

instance FromJSON ResponsesObject where
  parseJSON :: Value -> Parser ResponsesObject
parseJSON = String
-> (Object -> Parser ResponsesObject)
-> Value
-> Parser ResponsesObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResponsesObject" ((Object -> Parser ResponsesObject)
 -> Value -> Parser ResponsesObject)
-> (Object -> Parser ResponsesObject)
-> Value
-> Parser ResponsesObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Referencable ResponseObject)
-> Maybe (Referencable ResponseObject)
-> Maybe (Referencable ResponseObject)
-> Maybe (Referencable ResponseObject)
-> Maybe (Referencable ResponseObject)
-> Maybe (Referencable ResponseObject)
-> Map Int (Referencable ResponseObject)
-> ResponsesObject
ResponsesObject
      (Maybe (Referencable ResponseObject)
 -> Maybe (Referencable ResponseObject)
 -> Maybe (Referencable ResponseObject)
 -> Maybe (Referencable ResponseObject)
 -> Maybe (Referencable ResponseObject)
 -> Maybe (Referencable ResponseObject)
 -> Map Int (Referencable ResponseObject)
 -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Map Int (Referencable ResponseObject)
      -> ResponsesObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default"
      Parser
  (Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Map Int (Referencable ResponseObject)
   -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Map Int (Referencable ResponseObject)
      -> ResponsesObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"1XX"
      Parser
  (Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Map Int (Referencable ResponseObject)
   -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Map Int (Referencable ResponseObject)
      -> ResponsesObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"2XX"
      Parser
  (Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Map Int (Referencable ResponseObject)
   -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Maybe (Referencable ResponseObject)
      -> Maybe (Referencable ResponseObject)
      -> Map Int (Referencable ResponseObject)
      -> ResponsesObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"3XX"
      Parser
  (Maybe (Referencable ResponseObject)
   -> Maybe (Referencable ResponseObject)
   -> Map Int (Referencable ResponseObject)
   -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Maybe (Referencable ResponseObject)
      -> Map Int (Referencable ResponseObject) -> ResponsesObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"4XX"
      Parser
  (Maybe (Referencable ResponseObject)
   -> Map Int (Referencable ResponseObject) -> ResponsesObject)
-> Parser (Maybe (Referencable ResponseObject))
-> Parser
     (Map Int (Referencable ResponseObject) -> ResponsesObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Referencable ResponseObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"5XX"
      Parser (Map Int (Referencable ResponseObject) -> ResponsesObject)
-> Parser (Map Int (Referencable ResponseObject))
-> Parser ResponsesObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser (Referencable ResponseObject))
-> Map Int Value -> Parser (Map Int (Referencable ResponseObject))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map Int a -> m (Map Int b)
mapM
        Value -> Parser (Referencable ResponseObject)
forall a. FromJSON a => Value -> Parser a
parseJSON
        ( [(Int, Value)] -> Map Int Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            ([(Int, Value)] -> Map Int Value)
-> ([(Text, Value)] -> [(Int, Value)])
-> [(Text, Value)]
-> Map Int Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Value) -> Bool) -> [(Int, Value)] -> [(Int, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
code, Value
_) -> Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600)
            ([(Int, Value)] -> [(Int, Value)])
-> ([(Text, Value)] -> [(Int, Value)])
-> [(Text, Value)]
-> [(Int, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Maybe (Int, Value))
-> [(Text, Value)] -> [(Int, Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
              ( \(Text
code, Value
response) -> (Int -> (Int, Value)) -> Maybe Int -> Maybe (Int, Value)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Value
response) (Maybe Int -> Maybe (Int, Value))
-> (Text -> Maybe Int) -> Text -> Maybe (Int, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe (Int, Value)) -> Text -> Maybe (Int, Value)
forall a b. (a -> b) -> a -> b
$ Text
code
              )
            ([(Text, Value)] -> Map Int Value)
-> [(Text, Value)] -> Map Int Value
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
jsonObjectToList Object
o
        )

data ResponseObject = ResponseObject
  { ResponseObject -> Text
responseObjectDescription :: Text,
    ResponseObject -> Map Text (Referencable HeaderObject)
responseObjectHeaders :: Map.Map Text (Referencable HeaderObject),
    ResponseObject -> Map Text MediaTypeObject
responseObjectContent :: Map.Map Text MediaTypeObject
    -- links (http://spec.openapis.org/oas/v3.0.3#fixed-fields-14) are omitted because they are not needed
  }
  deriving (Int -> ResponseObject -> ShowS
[ResponseObject] -> ShowS
ResponseObject -> String
(Int -> ResponseObject -> ShowS)
-> (ResponseObject -> String)
-> ([ResponseObject] -> ShowS)
-> Show ResponseObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseObject -> ShowS
showsPrec :: Int -> ResponseObject -> ShowS
$cshow :: ResponseObject -> String
show :: ResponseObject -> String
$cshowList :: [ResponseObject] -> ShowS
showList :: [ResponseObject] -> ShowS
Show, ResponseObject -> ResponseObject -> Bool
(ResponseObject -> ResponseObject -> Bool)
-> (ResponseObject -> ResponseObject -> Bool) -> Eq ResponseObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseObject -> ResponseObject -> Bool
== :: ResponseObject -> ResponseObject -> Bool
$c/= :: ResponseObject -> ResponseObject -> Bool
/= :: ResponseObject -> ResponseObject -> Bool
Eq, (forall x. ResponseObject -> Rep ResponseObject x)
-> (forall x. Rep ResponseObject x -> ResponseObject)
-> Generic ResponseObject
forall x. Rep ResponseObject x -> ResponseObject
forall x. ResponseObject -> Rep ResponseObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseObject -> Rep ResponseObject x
from :: forall x. ResponseObject -> Rep ResponseObject x
$cto :: forall x. Rep ResponseObject x -> ResponseObject
to :: forall x. Rep ResponseObject x -> ResponseObject
Generic)

instance FromJSON ResponseObject where
  parseJSON :: Value -> Parser ResponseObject
parseJSON = String
-> (Object -> Parser ResponseObject)
-> Value
-> Parser ResponseObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResponseObject" ((Object -> Parser ResponseObject)
 -> Value -> Parser ResponseObject)
-> (Object -> Parser ResponseObject)
-> Value
-> Parser ResponseObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Map Text (Referencable HeaderObject)
-> Map Text MediaTypeObject
-> ResponseObject
ResponseObject
      (Text
 -> Map Text (Referencable HeaderObject)
 -> Map Text MediaTypeObject
 -> ResponseObject)
-> Parser Text
-> Parser
     (Map Text (Referencable HeaderObject)
      -> Map Text MediaTypeObject -> ResponseObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      Parser
  (Map Text (Referencable HeaderObject)
   -> Map Text MediaTypeObject -> ResponseObject)
-> Parser (Map Text (Referencable HeaderObject))
-> Parser (Map Text MediaTypeObject -> ResponseObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable HeaderObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe (Map Text (Referencable HeaderObject)))
-> Map Text (Referencable HeaderObject)
-> Parser (Map Text (Referencable HeaderObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable HeaderObject)
forall k a. Map k a
Map.empty
      Parser (Map Text MediaTypeObject -> ResponseObject)
-> Parser (Map Text MediaTypeObject) -> Parser ResponseObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Map Text MediaTypeObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content" Parser (Maybe (Map Text MediaTypeObject))
-> Map Text MediaTypeObject -> Parser (Map Text MediaTypeObject)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text MediaTypeObject
forall k a. Map k a
Map.empty

data ServerObject = ServerObject
  { ServerObject -> Text
serverObjectUrl :: Text,
    ServerObject -> Maybe Text
serverObjectDescription :: Maybe Text,
    ServerObject -> Map Text ServerVariableObject
serverObjectVariables :: Map.Map Text ServerVariableObject
  }
  deriving (Int -> ServerObject -> ShowS
[ServerObject] -> ShowS
ServerObject -> String
(Int -> ServerObject -> ShowS)
-> (ServerObject -> String)
-> ([ServerObject] -> ShowS)
-> Show ServerObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerObject -> ShowS
showsPrec :: Int -> ServerObject -> ShowS
$cshow :: ServerObject -> String
show :: ServerObject -> String
$cshowList :: [ServerObject] -> ShowS
showList :: [ServerObject] -> ShowS
Show, ServerObject -> ServerObject -> Bool
(ServerObject -> ServerObject -> Bool)
-> (ServerObject -> ServerObject -> Bool) -> Eq ServerObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerObject -> ServerObject -> Bool
== :: ServerObject -> ServerObject -> Bool
$c/= :: ServerObject -> ServerObject -> Bool
/= :: ServerObject -> ServerObject -> Bool
Eq, (forall x. ServerObject -> Rep ServerObject x)
-> (forall x. Rep ServerObject x -> ServerObject)
-> Generic ServerObject
forall x. Rep ServerObject x -> ServerObject
forall x. ServerObject -> Rep ServerObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerObject -> Rep ServerObject x
from :: forall x. ServerObject -> Rep ServerObject x
$cto :: forall x. Rep ServerObject x -> ServerObject
to :: forall x. Rep ServerObject x -> ServerObject
Generic)

instance FromJSON ServerObject where
  parseJSON :: Value -> Parser ServerObject
parseJSON = String
-> (Object -> Parser ServerObject) -> Value -> Parser ServerObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ServerObject" ((Object -> Parser ServerObject) -> Value -> Parser ServerObject)
-> (Object -> Parser ServerObject) -> Value -> Parser ServerObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> Map Text ServerVariableObject -> ServerObject
ServerObject
      (Text
 -> Maybe Text -> Map Text ServerVariableObject -> ServerObject)
-> Parser Text
-> Parser
     (Maybe Text -> Map Text ServerVariableObject -> ServerObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      Parser
  (Maybe Text -> Map Text ServerVariableObject -> ServerObject)
-> Parser (Maybe Text)
-> Parser (Map Text ServerVariableObject -> ServerObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Map Text ServerVariableObject -> ServerObject)
-> Parser (Map Text ServerVariableObject) -> Parser ServerObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Map Text ServerVariableObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"variables" Parser (Maybe (Map Text ServerVariableObject))
-> Map Text ServerVariableObject
-> Parser (Map Text ServerVariableObject)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text ServerVariableObject
forall k a. Map k a
Map.empty

data ServerVariableObject = ServerVariableObject
  { ServerVariableObject -> [Text]
serverVariableObjectEnum :: [Text],
    ServerVariableObject -> Text
serverVariableObjectDefault :: Text,
    ServerVariableObject -> Maybe Text
serverVariableObjectDescription :: Maybe Text
  }
  deriving (Int -> ServerVariableObject -> ShowS
[ServerVariableObject] -> ShowS
ServerVariableObject -> String
(Int -> ServerVariableObject -> ShowS)
-> (ServerVariableObject -> String)
-> ([ServerVariableObject] -> ShowS)
-> Show ServerVariableObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerVariableObject -> ShowS
showsPrec :: Int -> ServerVariableObject -> ShowS
$cshow :: ServerVariableObject -> String
show :: ServerVariableObject -> String
$cshowList :: [ServerVariableObject] -> ShowS
showList :: [ServerVariableObject] -> ShowS
Show, ServerVariableObject -> ServerVariableObject -> Bool
(ServerVariableObject -> ServerVariableObject -> Bool)
-> (ServerVariableObject -> ServerVariableObject -> Bool)
-> Eq ServerVariableObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerVariableObject -> ServerVariableObject -> Bool
== :: ServerVariableObject -> ServerVariableObject -> Bool
$c/= :: ServerVariableObject -> ServerVariableObject -> Bool
/= :: ServerVariableObject -> ServerVariableObject -> Bool
Eq, (forall x. ServerVariableObject -> Rep ServerVariableObject x)
-> (forall x. Rep ServerVariableObject x -> ServerVariableObject)
-> Generic ServerVariableObject
forall x. Rep ServerVariableObject x -> ServerVariableObject
forall x. ServerVariableObject -> Rep ServerVariableObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerVariableObject -> Rep ServerVariableObject x
from :: forall x. ServerVariableObject -> Rep ServerVariableObject x
$cto :: forall x. Rep ServerVariableObject x -> ServerVariableObject
to :: forall x. Rep ServerVariableObject x -> ServerVariableObject
Generic)

instance FromJSON ServerVariableObject where
  parseJSON :: Value -> Parser ServerVariableObject
parseJSON = String
-> (Object -> Parser ServerVariableObject)
-> Value
-> Parser ServerVariableObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ServerVariableObject" ((Object -> Parser ServerVariableObject)
 -> Value -> Parser ServerVariableObject)
-> (Object -> Parser ServerVariableObject)
-> Value
-> Parser ServerVariableObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text] -> Text -> Maybe Text -> ServerVariableObject
ServerVariableObject
      ([Text] -> Text -> Maybe Text -> ServerVariableObject)
-> Parser [Text]
-> Parser (Text -> Maybe Text -> ServerVariableObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enum" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser (Text -> Maybe Text -> ServerVariableObject)
-> Parser Text -> Parser (Maybe Text -> ServerVariableObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default"
      Parser (Maybe Text -> ServerVariableObject)
-> Parser (Maybe Text) -> Parser ServerVariableObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"

data ParameterObject = ParameterObject
  { ParameterObject -> Text
parameterObjectName :: Text,
    ParameterObject -> ParameterObjectLocation
parameterObjectIn :: ParameterObjectLocation,
    ParameterObject -> Maybe Text
parameterObjectDescription :: Maybe Text,
    ParameterObject -> Bool
parameterObjectRequired :: Bool,
    ParameterObject -> Bool
parameterObjectDeprecated :: Bool,
    ParameterObject -> Bool
parameterObjectAllowEmptyValue :: Bool,
    ParameterObject -> ParameterObjectSchema
parameterObjectSchema :: ParameterObjectSchema
  }
  deriving (Int -> ParameterObject -> ShowS
[ParameterObject] -> ShowS
ParameterObject -> String
(Int -> ParameterObject -> ShowS)
-> (ParameterObject -> String)
-> ([ParameterObject] -> ShowS)
-> Show ParameterObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterObject -> ShowS
showsPrec :: Int -> ParameterObject -> ShowS
$cshow :: ParameterObject -> String
show :: ParameterObject -> String
$cshowList :: [ParameterObject] -> ShowS
showList :: [ParameterObject] -> ShowS
Show, ParameterObject -> ParameterObject -> Bool
(ParameterObject -> ParameterObject -> Bool)
-> (ParameterObject -> ParameterObject -> Bool)
-> Eq ParameterObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterObject -> ParameterObject -> Bool
== :: ParameterObject -> ParameterObject -> Bool
$c/= :: ParameterObject -> ParameterObject -> Bool
/= :: ParameterObject -> ParameterObject -> Bool
Eq, (forall x. ParameterObject -> Rep ParameterObject x)
-> (forall x. Rep ParameterObject x -> ParameterObject)
-> Generic ParameterObject
forall x. Rep ParameterObject x -> ParameterObject
forall x. ParameterObject -> Rep ParameterObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParameterObject -> Rep ParameterObject x
from :: forall x. ParameterObject -> Rep ParameterObject x
$cto :: forall x. Rep ParameterObject x -> ParameterObject
to :: forall x. Rep ParameterObject x -> ParameterObject
Generic)

instance FromJSON ParameterObject where
  parseJSON :: Value -> Parser ParameterObject
parseJSON = String
-> (Object -> Parser ParameterObject)
-> Value
-> Parser ParameterObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ParameterObject" ((Object -> Parser ParameterObject)
 -> Value -> Parser ParameterObject)
-> (Object -> Parser ParameterObject)
-> Value
-> Parser ParameterObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> ParameterObjectLocation
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> ParameterObjectSchema
-> ParameterObject
ParameterObject
      (Text
 -> ParameterObjectLocation
 -> Maybe Text
 -> Bool
 -> Bool
 -> Bool
 -> ParameterObjectSchema
 -> ParameterObject)
-> Parser Text
-> Parser
     (ParameterObjectLocation
      -> Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> ParameterObjectSchema
      -> ParameterObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (ParameterObjectLocation
   -> Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> ParameterObjectSchema
   -> ParameterObject)
-> Parser ParameterObjectLocation
-> Parser
     (Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> ParameterObjectSchema
      -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ParameterObjectLocation
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"in"
      Parser
  (Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> ParameterObjectSchema
   -> ParameterObject)
-> Parser (Maybe Text)
-> Parser
     (Bool -> Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (Bool -> Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool
-> Parser
     (Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool
-> Parser (Bool -> ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool -> Parser (ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowEmptyValue" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (ParameterObjectSchema -> ParameterObject)
-> Parser ParameterObjectSchema -> Parser ParameterObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ParameterObjectSchema
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)

data ParameterObjectLocation
  = QueryParameterObjectLocation
  | HeaderParameterObjectLocation
  | PathParameterObjectLocation
  | CookieParameterObjectLocation
  deriving (Int -> ParameterObjectLocation -> ShowS
[ParameterObjectLocation] -> ShowS
ParameterObjectLocation -> String
(Int -> ParameterObjectLocation -> ShowS)
-> (ParameterObjectLocation -> String)
-> ([ParameterObjectLocation] -> ShowS)
-> Show ParameterObjectLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterObjectLocation -> ShowS
showsPrec :: Int -> ParameterObjectLocation -> ShowS
$cshow :: ParameterObjectLocation -> String
show :: ParameterObjectLocation -> String
$cshowList :: [ParameterObjectLocation] -> ShowS
showList :: [ParameterObjectLocation] -> ShowS
Show, ParameterObjectLocation -> ParameterObjectLocation -> Bool
(ParameterObjectLocation -> ParameterObjectLocation -> Bool)
-> (ParameterObjectLocation -> ParameterObjectLocation -> Bool)
-> Eq ParameterObjectLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterObjectLocation -> ParameterObjectLocation -> Bool
== :: ParameterObjectLocation -> ParameterObjectLocation -> Bool
$c/= :: ParameterObjectLocation -> ParameterObjectLocation -> Bool
/= :: ParameterObjectLocation -> ParameterObjectLocation -> Bool
Eq, (forall x.
 ParameterObjectLocation -> Rep ParameterObjectLocation x)
-> (forall x.
    Rep ParameterObjectLocation x -> ParameterObjectLocation)
-> Generic ParameterObjectLocation
forall x. Rep ParameterObjectLocation x -> ParameterObjectLocation
forall x. ParameterObjectLocation -> Rep ParameterObjectLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParameterObjectLocation -> Rep ParameterObjectLocation x
from :: forall x. ParameterObjectLocation -> Rep ParameterObjectLocation x
$cto :: forall x. Rep ParameterObjectLocation x -> ParameterObjectLocation
to :: forall x. Rep ParameterObjectLocation x -> ParameterObjectLocation
Generic)

instance FromJSON ParameterObjectLocation where
  parseJSON :: Value -> Parser ParameterObjectLocation
parseJSON = String
-> (Text -> Parser ParameterObjectLocation)
-> Value
-> Parser ParameterObjectLocation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ParameterObjectLocation" ((Text -> Parser ParameterObjectLocation)
 -> Value -> Parser ParameterObjectLocation)
-> (Text -> Parser ParameterObjectLocation)
-> Value
-> Parser ParameterObjectLocation
forall a b. (a -> b) -> a -> b
$ \case
    Text
"query" -> ParameterObjectLocation -> Parser ParameterObjectLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterObjectLocation
QueryParameterObjectLocation
    Text
"header" -> ParameterObjectLocation -> Parser ParameterObjectLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterObjectLocation
HeaderParameterObjectLocation
    Text
"path" -> ParameterObjectLocation -> Parser ParameterObjectLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterObjectLocation
PathParameterObjectLocation
    Text
"cookie" -> ParameterObjectLocation -> Parser ParameterObjectLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterObjectLocation
CookieParameterObjectLocation
    Text
_ -> String -> Parser ParameterObjectLocation
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A ParameterObject must have a value of 'query', 'header', 'path' or 'cookie' in the property 'in'."

data ParameterObjectSchema
  = SimpleParameterObjectSchema SimpleParameterSchema
  | ComplexParameterObjectSchema (Map.Map Text MediaTypeObject)
  deriving (Int -> ParameterObjectSchema -> ShowS
[ParameterObjectSchema] -> ShowS
ParameterObjectSchema -> String
(Int -> ParameterObjectSchema -> ShowS)
-> (ParameterObjectSchema -> String)
-> ([ParameterObjectSchema] -> ShowS)
-> Show ParameterObjectSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterObjectSchema -> ShowS
showsPrec :: Int -> ParameterObjectSchema -> ShowS
$cshow :: ParameterObjectSchema -> String
show :: ParameterObjectSchema -> String
$cshowList :: [ParameterObjectSchema] -> ShowS
showList :: [ParameterObjectSchema] -> ShowS
Show, ParameterObjectSchema -> ParameterObjectSchema -> Bool
(ParameterObjectSchema -> ParameterObjectSchema -> Bool)
-> (ParameterObjectSchema -> ParameterObjectSchema -> Bool)
-> Eq ParameterObjectSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterObjectSchema -> ParameterObjectSchema -> Bool
== :: ParameterObjectSchema -> ParameterObjectSchema -> Bool
$c/= :: ParameterObjectSchema -> ParameterObjectSchema -> Bool
/= :: ParameterObjectSchema -> ParameterObjectSchema -> Bool
Eq, (forall x. ParameterObjectSchema -> Rep ParameterObjectSchema x)
-> (forall x. Rep ParameterObjectSchema x -> ParameterObjectSchema)
-> Generic ParameterObjectSchema
forall x. Rep ParameterObjectSchema x -> ParameterObjectSchema
forall x. ParameterObjectSchema -> Rep ParameterObjectSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParameterObjectSchema -> Rep ParameterObjectSchema x
from :: forall x. ParameterObjectSchema -> Rep ParameterObjectSchema x
$cto :: forall x. Rep ParameterObjectSchema x -> ParameterObjectSchema
to :: forall x. Rep ParameterObjectSchema x -> ParameterObjectSchema
Generic)

instance FromJSON ParameterObjectSchema where
  parseJSON :: Value -> Parser ParameterObjectSchema
parseJSON = String
-> (Object -> Parser ParameterObjectSchema)
-> Value
-> Parser ParameterObjectSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ParameterObjectSchema" ((Object -> Parser ParameterObjectSchema)
 -> Value -> Parser ParameterObjectSchema)
-> (Object -> Parser ParameterObjectSchema)
-> Value
-> Parser ParameterObjectSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Schema
maybeSchema <- Object
o Object -> Key -> Parser (Maybe Schema)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schema"
    Maybe (Map Text MediaTypeObject)
maybeContent <- Object
o Object -> Key -> Parser (Maybe (Map Text MediaTypeObject))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content"
    case (Maybe Schema
maybeSchema :: Maybe Schema, Maybe (Map Text MediaTypeObject)
maybeContent) of
      (Just Schema
_, Maybe (Map Text MediaTypeObject)
Nothing) -> SimpleParameterSchema -> ParameterObjectSchema
SimpleParameterObjectSchema (SimpleParameterSchema -> ParameterObjectSchema)
-> Parser SimpleParameterSchema -> Parser ParameterObjectSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SimpleParameterSchema
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      (Maybe Schema
Nothing, Just Map Text MediaTypeObject
content') -> ParameterObjectSchema -> Parser ParameterObjectSchema
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterObjectSchema -> Parser ParameterObjectSchema)
-> ParameterObjectSchema -> Parser ParameterObjectSchema
forall a b. (a -> b) -> a -> b
$ Map Text MediaTypeObject -> ParameterObjectSchema
ComplexParameterObjectSchema Map Text MediaTypeObject
content'
      (Just Schema
_, Just Map Text MediaTypeObject
_) -> String -> Parser ParameterObjectSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ParameterObject (http://spec.openapis.org/oas/v3.0.3#parameter-object) only allows one of the properties schema and content."
      (Maybe Schema
Nothing, Maybe (Map Text MediaTypeObject)
Nothing) -> String -> Parser ParameterObjectSchema
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ParameterObject (http://spec.openapis.org/oas/v3.0.3#parameter-object) requires one of the properties schema and content to be present."

data SimpleParameterSchema = SimpleParameterSchema
  { SimpleParameterSchema -> Maybe Text
simpleParameterSchemaStyle :: Maybe Text,
    SimpleParameterSchema -> Bool
simpleParameterSchemaExplode :: Bool,
    SimpleParameterSchema -> Bool
simpleParameterSchemaAllowReserved :: Bool,
    SimpleParameterSchema -> Schema
simpleParameterSchemaSchema :: Schema,
    SimpleParameterSchema -> Maybe Value
simpleParameterSchemaExample :: Maybe Value,
    SimpleParameterSchema -> Map Text (Referencable ExampleObject)
simpleParameterSchemaExamples :: Map.Map Text (Referencable ExampleObject)
  }
  deriving (Int -> SimpleParameterSchema -> ShowS
[SimpleParameterSchema] -> ShowS
SimpleParameterSchema -> String
(Int -> SimpleParameterSchema -> ShowS)
-> (SimpleParameterSchema -> String)
-> ([SimpleParameterSchema] -> ShowS)
-> Show SimpleParameterSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleParameterSchema -> ShowS
showsPrec :: Int -> SimpleParameterSchema -> ShowS
$cshow :: SimpleParameterSchema -> String
show :: SimpleParameterSchema -> String
$cshowList :: [SimpleParameterSchema] -> ShowS
showList :: [SimpleParameterSchema] -> ShowS
Show, SimpleParameterSchema -> SimpleParameterSchema -> Bool
(SimpleParameterSchema -> SimpleParameterSchema -> Bool)
-> (SimpleParameterSchema -> SimpleParameterSchema -> Bool)
-> Eq SimpleParameterSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleParameterSchema -> SimpleParameterSchema -> Bool
== :: SimpleParameterSchema -> SimpleParameterSchema -> Bool
$c/= :: SimpleParameterSchema -> SimpleParameterSchema -> Bool
/= :: SimpleParameterSchema -> SimpleParameterSchema -> Bool
Eq, (forall x. SimpleParameterSchema -> Rep SimpleParameterSchema x)
-> (forall x. Rep SimpleParameterSchema x -> SimpleParameterSchema)
-> Generic SimpleParameterSchema
forall x. Rep SimpleParameterSchema x -> SimpleParameterSchema
forall x. SimpleParameterSchema -> Rep SimpleParameterSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleParameterSchema -> Rep SimpleParameterSchema x
from :: forall x. SimpleParameterSchema -> Rep SimpleParameterSchema x
$cto :: forall x. Rep SimpleParameterSchema x -> SimpleParameterSchema
to :: forall x. Rep SimpleParameterSchema x -> SimpleParameterSchema
Generic)

instance FromJSON SimpleParameterSchema where
  parseJSON :: Value -> Parser SimpleParameterSchema
parseJSON = String
-> (Object -> Parser SimpleParameterSchema)
-> Value
-> Parser SimpleParameterSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SimpleParameterSchema" ((Object -> Parser SimpleParameterSchema)
 -> Value -> Parser SimpleParameterSchema)
-> (Object -> Parser SimpleParameterSchema)
-> Value
-> Parser SimpleParameterSchema
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Text
maybeStyle <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
    Maybe Text
-> Bool
-> Bool
-> Schema
-> Maybe Value
-> Map Text (Referencable ExampleObject)
-> SimpleParameterSchema
SimpleParameterSchema
      (Maybe Text
 -> Bool
 -> Bool
 -> Schema
 -> Maybe Value
 -> Map Text (Referencable ExampleObject)
 -> SimpleParameterSchema)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> Bool
      -> Schema
      -> Maybe Value
      -> Map Text (Referencable ExampleObject)
      -> SimpleParameterSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"
      Parser
  (Bool
   -> Bool
   -> Schema
   -> Maybe Value
   -> Map Text (Referencable ExampleObject)
   -> SimpleParameterSchema)
-> Parser Bool
-> Parser
     (Bool
      -> Schema
      -> Maybe Value
      -> Map Text (Referencable ExampleObject)
      -> SimpleParameterSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"explode" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= ((Maybe Text
maybeStyle :: Maybe Text) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"form") -- The default value is true for form and false otherwise (http://spec.openapis.org/oas/v3.0.3#parameterExplode)
      Parser
  (Bool
   -> Schema
   -> Maybe Value
   -> Map Text (Referencable ExampleObject)
   -> SimpleParameterSchema)
-> Parser Bool
-> Parser
     (Schema
      -> Maybe Value
      -> Map Text (Referencable ExampleObject)
      -> SimpleParameterSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowReserved" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser
  (Schema
   -> Maybe Value
   -> Map Text (Referencable ExampleObject)
   -> SimpleParameterSchema)
-> Parser Schema
-> Parser
     (Maybe Value
      -> Map Text (Referencable ExampleObject) -> SimpleParameterSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Schema
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema"
      Parser
  (Maybe Value
   -> Map Text (Referencable ExampleObject) -> SimpleParameterSchema)
-> Parser (Maybe Value)
-> Parser
     (Map Text (Referencable ExampleObject) -> SimpleParameterSchema)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"example"
      Parser
  (Map Text (Referencable ExampleObject) -> SimpleParameterSchema)
-> Parser (Map Text (Referencable ExampleObject))
-> Parser SimpleParameterSchema
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable ExampleObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"examples" Parser (Maybe (Map Text (Referencable ExampleObject)))
-> Map Text (Referencable ExampleObject)
-> Parser (Map Text (Referencable ExampleObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable ExampleObject)
forall k a. Map k a
Map.empty

newtype HeaderObject = HeaderObject ParameterObject
  deriving (Int -> HeaderObject -> ShowS
[HeaderObject] -> ShowS
HeaderObject -> String
(Int -> HeaderObject -> ShowS)
-> (HeaderObject -> String)
-> ([HeaderObject] -> ShowS)
-> Show HeaderObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderObject -> ShowS
showsPrec :: Int -> HeaderObject -> ShowS
$cshow :: HeaderObject -> String
show :: HeaderObject -> String
$cshowList :: [HeaderObject] -> ShowS
showList :: [HeaderObject] -> ShowS
Show, HeaderObject -> HeaderObject -> Bool
(HeaderObject -> HeaderObject -> Bool)
-> (HeaderObject -> HeaderObject -> Bool) -> Eq HeaderObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderObject -> HeaderObject -> Bool
== :: HeaderObject -> HeaderObject -> Bool
$c/= :: HeaderObject -> HeaderObject -> Bool
/= :: HeaderObject -> HeaderObject -> Bool
Eq, (forall x. HeaderObject -> Rep HeaderObject x)
-> (forall x. Rep HeaderObject x -> HeaderObject)
-> Generic HeaderObject
forall x. Rep HeaderObject x -> HeaderObject
forall x. HeaderObject -> Rep HeaderObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeaderObject -> Rep HeaderObject x
from :: forall x. HeaderObject -> Rep HeaderObject x
$cto :: forall x. Rep HeaderObject x -> HeaderObject
to :: forall x. Rep HeaderObject x -> HeaderObject
Generic)

instance FromJSON HeaderObject where
  parseJSON :: Value -> Parser HeaderObject
parseJSON = String
-> (Object -> Parser HeaderObject) -> Value -> Parser HeaderObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HeaderObject" ((Object -> Parser HeaderObject) -> Value -> Parser HeaderObject)
-> (Object -> Parser HeaderObject) -> Value -> Parser HeaderObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ParameterObject -> HeaderObject
HeaderObject
      (ParameterObject -> HeaderObject)
-> Parser ParameterObject -> Parser HeaderObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text
-> ParameterObjectLocation
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> ParameterObjectSchema
-> ParameterObject
ParameterObject Text
"name MUST NOT be specified, it is given in the corresponding headers map" ParameterObjectLocation
HeaderParameterObjectLocation
              (Maybe Text
 -> Bool
 -> Bool
 -> Bool
 -> ParameterObjectSchema
 -> ParameterObject)
-> Parser (Maybe Text)
-> Parser
     (Bool -> Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
              Parser
  (Bool -> Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool
-> Parser
     (Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
              Parser (Bool -> Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool
-> Parser (Bool -> ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
              Parser (Bool -> ParameterObjectSchema -> ParameterObject)
-> Parser Bool -> Parser (ParameterObjectSchema -> ParameterObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowEmptyValue" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
              Parser (ParameterObjectSchema -> ParameterObject)
-> Parser ParameterObjectSchema -> Parser ParameterObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ParameterObjectSchema
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
          )

data ComponentsObject = ComponentsObject
  { ComponentsObject -> Map Text Schema
componentsObjectSchemas :: Map.Map Text Schema,
    ComponentsObject -> Map Text (Referencable ResponseObject)
componentsObjectResponses :: Map.Map Text (Referencable ResponseObject),
    ComponentsObject -> Map Text (Referencable ParameterObject)
componentsObjectParameters :: Map.Map Text (Referencable ParameterObject),
    ComponentsObject -> Map Text (Referencable ExampleObject)
componentsObjectExamples :: Map.Map Text (Referencable ExampleObject),
    ComponentsObject -> Map Text (Referencable RequestBodyObject)
componentsObjectRequestBodies :: Map.Map Text (Referencable RequestBodyObject),
    ComponentsObject -> Map Text (Referencable HeaderObject)
componentsObjectHeaders :: Map.Map Text (Referencable HeaderObject),
    ComponentsObject -> Map Text (Referencable SecuritySchemeObject)
componentsObjectSecuritySchemes :: Map.Map Text (Referencable SecuritySchemeObject)
    -- links and callbacks are omitted because they are not supported in the generator
  }
  deriving (Int -> ComponentsObject -> ShowS
[ComponentsObject] -> ShowS
ComponentsObject -> String
(Int -> ComponentsObject -> ShowS)
-> (ComponentsObject -> String)
-> ([ComponentsObject] -> ShowS)
-> Show ComponentsObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComponentsObject -> ShowS
showsPrec :: Int -> ComponentsObject -> ShowS
$cshow :: ComponentsObject -> String
show :: ComponentsObject -> String
$cshowList :: [ComponentsObject] -> ShowS
showList :: [ComponentsObject] -> ShowS
Show, ComponentsObject -> ComponentsObject -> Bool
(ComponentsObject -> ComponentsObject -> Bool)
-> (ComponentsObject -> ComponentsObject -> Bool)
-> Eq ComponentsObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComponentsObject -> ComponentsObject -> Bool
== :: ComponentsObject -> ComponentsObject -> Bool
$c/= :: ComponentsObject -> ComponentsObject -> Bool
/= :: ComponentsObject -> ComponentsObject -> Bool
Eq, (forall x. ComponentsObject -> Rep ComponentsObject x)
-> (forall x. Rep ComponentsObject x -> ComponentsObject)
-> Generic ComponentsObject
forall x. Rep ComponentsObject x -> ComponentsObject
forall x. ComponentsObject -> Rep ComponentsObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ComponentsObject -> Rep ComponentsObject x
from :: forall x. ComponentsObject -> Rep ComponentsObject x
$cto :: forall x. Rep ComponentsObject x -> ComponentsObject
to :: forall x. Rep ComponentsObject x -> ComponentsObject
Generic)

instance FromJSON ComponentsObject where
  parseJSON :: Value -> Parser ComponentsObject
parseJSON = String
-> (Object -> Parser ComponentsObject)
-> Value
-> Parser ComponentsObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ComponentsObject" ((Object -> Parser ComponentsObject)
 -> Value -> Parser ComponentsObject)
-> (Object -> Parser ComponentsObject)
-> Value
-> Parser ComponentsObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Map Text Schema
-> Map Text (Referencable ResponseObject)
-> Map Text (Referencable ParameterObject)
-> Map Text (Referencable ExampleObject)
-> Map Text (Referencable RequestBodyObject)
-> Map Text (Referencable HeaderObject)
-> Map Text (Referencable SecuritySchemeObject)
-> ComponentsObject
ComponentsObject
      (Map Text Schema
 -> Map Text (Referencable ResponseObject)
 -> Map Text (Referencable ParameterObject)
 -> Map Text (Referencable ExampleObject)
 -> Map Text (Referencable RequestBodyObject)
 -> Map Text (Referencable HeaderObject)
 -> Map Text (Referencable SecuritySchemeObject)
 -> ComponentsObject)
-> Parser (Map Text Schema)
-> Parser
     (Map Text (Referencable ResponseObject)
      -> Map Text (Referencable ParameterObject)
      -> Map Text (Referencable ExampleObject)
      -> Map Text (Referencable RequestBodyObject)
      -> Map Text (Referencable HeaderObject)
      -> Map Text (Referencable SecuritySchemeObject)
      -> ComponentsObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Map Text Schema))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schemas" Parser (Maybe (Map Text Schema))
-> Map Text Schema -> Parser (Map Text Schema)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text Schema
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable ResponseObject)
   -> Map Text (Referencable ParameterObject)
   -> Map Text (Referencable ExampleObject)
   -> Map Text (Referencable RequestBodyObject)
   -> Map Text (Referencable HeaderObject)
   -> Map Text (Referencable SecuritySchemeObject)
   -> ComponentsObject)
-> Parser (Map Text (Referencable ResponseObject))
-> Parser
     (Map Text (Referencable ParameterObject)
      -> Map Text (Referencable ExampleObject)
      -> Map Text (Referencable RequestBodyObject)
      -> Map Text (Referencable HeaderObject)
      -> Map Text (Referencable SecuritySchemeObject)
      -> ComponentsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable ResponseObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"responses" Parser (Maybe (Map Text (Referencable ResponseObject)))
-> Map Text (Referencable ResponseObject)
-> Parser (Map Text (Referencable ResponseObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable ResponseObject)
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable ParameterObject)
   -> Map Text (Referencable ExampleObject)
   -> Map Text (Referencable RequestBodyObject)
   -> Map Text (Referencable HeaderObject)
   -> Map Text (Referencable SecuritySchemeObject)
   -> ComponentsObject)
-> Parser (Map Text (Referencable ParameterObject))
-> Parser
     (Map Text (Referencable ExampleObject)
      -> Map Text (Referencable RequestBodyObject)
      -> Map Text (Referencable HeaderObject)
      -> Map Text (Referencable SecuritySchemeObject)
      -> ComponentsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable ParameterObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameters" Parser (Maybe (Map Text (Referencable ParameterObject)))
-> Map Text (Referencable ParameterObject)
-> Parser (Map Text (Referencable ParameterObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable ParameterObject)
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable ExampleObject)
   -> Map Text (Referencable RequestBodyObject)
   -> Map Text (Referencable HeaderObject)
   -> Map Text (Referencable SecuritySchemeObject)
   -> ComponentsObject)
-> Parser (Map Text (Referencable ExampleObject))
-> Parser
     (Map Text (Referencable RequestBodyObject)
      -> Map Text (Referencable HeaderObject)
      -> Map Text (Referencable SecuritySchemeObject)
      -> ComponentsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable ExampleObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"examples" Parser (Maybe (Map Text (Referencable ExampleObject)))
-> Map Text (Referencable ExampleObject)
-> Parser (Map Text (Referencable ExampleObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable ExampleObject)
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable RequestBodyObject)
   -> Map Text (Referencable HeaderObject)
   -> Map Text (Referencable SecuritySchemeObject)
   -> ComponentsObject)
-> Parser (Map Text (Referencable RequestBodyObject))
-> Parser
     (Map Text (Referencable HeaderObject)
      -> Map Text (Referencable SecuritySchemeObject)
      -> ComponentsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key
-> Parser (Maybe (Map Text (Referencable RequestBodyObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requestBodies" Parser (Maybe (Map Text (Referencable RequestBodyObject)))
-> Map Text (Referencable RequestBodyObject)
-> Parser (Map Text (Referencable RequestBodyObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable RequestBodyObject)
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable HeaderObject)
   -> Map Text (Referencable SecuritySchemeObject)
   -> ComponentsObject)
-> Parser (Map Text (Referencable HeaderObject))
-> Parser
     (Map Text (Referencable SecuritySchemeObject) -> ComponentsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key -> Parser (Maybe (Map Text (Referencable HeaderObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe (Map Text (Referencable HeaderObject)))
-> Map Text (Referencable HeaderObject)
-> Parser (Map Text (Referencable HeaderObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable HeaderObject)
forall k a. Map k a
Map.empty
      Parser
  (Map Text (Referencable SecuritySchemeObject) -> ComponentsObject)
-> Parser (Map Text (Referencable SecuritySchemeObject))
-> Parser ComponentsObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object
-> Key
-> Parser (Maybe (Map Text (Referencable SecuritySchemeObject)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"securitySchemes" Parser (Maybe (Map Text (Referencable SecuritySchemeObject)))
-> Map Text (Referencable SecuritySchemeObject)
-> Parser (Map Text (Referencable SecuritySchemeObject))
forall a. Parser (Maybe a) -> a -> Parser a
.!= Map Text (Referencable SecuritySchemeObject)
forall k a. Map k a
Map.empty

data SecuritySchemeObject
  = ApiKeySecuritySchemeObject ApiKeySecurityScheme
  | HttpSecuritySchemeObject HttpSecurityScheme
  | OAuth2SecuritySchemeObject OAuth2SecurityScheme
  | OpenIdConnectSecuritySchemeObject OpenIdConnectSecurityScheme
  deriving (Int -> SecuritySchemeObject -> ShowS
[SecuritySchemeObject] -> ShowS
SecuritySchemeObject -> String
(Int -> SecuritySchemeObject -> ShowS)
-> (SecuritySchemeObject -> String)
-> ([SecuritySchemeObject] -> ShowS)
-> Show SecuritySchemeObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecuritySchemeObject -> ShowS
showsPrec :: Int -> SecuritySchemeObject -> ShowS
$cshow :: SecuritySchemeObject -> String
show :: SecuritySchemeObject -> String
$cshowList :: [SecuritySchemeObject] -> ShowS
showList :: [SecuritySchemeObject] -> ShowS
Show, SecuritySchemeObject -> SecuritySchemeObject -> Bool
(SecuritySchemeObject -> SecuritySchemeObject -> Bool)
-> (SecuritySchemeObject -> SecuritySchemeObject -> Bool)
-> Eq SecuritySchemeObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecuritySchemeObject -> SecuritySchemeObject -> Bool
== :: SecuritySchemeObject -> SecuritySchemeObject -> Bool
$c/= :: SecuritySchemeObject -> SecuritySchemeObject -> Bool
/= :: SecuritySchemeObject -> SecuritySchemeObject -> Bool
Eq, (forall x. SecuritySchemeObject -> Rep SecuritySchemeObject x)
-> (forall x. Rep SecuritySchemeObject x -> SecuritySchemeObject)
-> Generic SecuritySchemeObject
forall x. Rep SecuritySchemeObject x -> SecuritySchemeObject
forall x. SecuritySchemeObject -> Rep SecuritySchemeObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecuritySchemeObject -> Rep SecuritySchemeObject x
from :: forall x. SecuritySchemeObject -> Rep SecuritySchemeObject x
$cto :: forall x. Rep SecuritySchemeObject x -> SecuritySchemeObject
to :: forall x. Rep SecuritySchemeObject x -> SecuritySchemeObject
Generic)

instance FromJSON SecuritySchemeObject where
  parseJSON :: Value -> Parser SecuritySchemeObject
parseJSON = String
-> (Object -> Parser SecuritySchemeObject)
-> Value
-> Parser SecuritySchemeObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SecuritySchemeObject" ((Object -> Parser SecuritySchemeObject)
 -> Value -> Parser SecuritySchemeObject)
-> (Object -> Parser SecuritySchemeObject)
-> Value
-> Parser SecuritySchemeObject
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
type' <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case (Text
type' :: Text) of
      Text
"apiKey" -> ApiKeySecurityScheme -> SecuritySchemeObject
ApiKeySecuritySchemeObject (ApiKeySecurityScheme -> SecuritySchemeObject)
-> Parser ApiKeySecurityScheme -> Parser SecuritySchemeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ApiKeySecurityScheme
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"http" -> HttpSecurityScheme -> SecuritySchemeObject
HttpSecuritySchemeObject (HttpSecurityScheme -> SecuritySchemeObject)
-> Parser HttpSecurityScheme -> Parser SecuritySchemeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser HttpSecurityScheme
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"oauth2" -> OAuth2SecurityScheme -> SecuritySchemeObject
OAuth2SecuritySchemeObject (OAuth2SecurityScheme -> SecuritySchemeObject)
-> Parser OAuth2SecurityScheme -> Parser SecuritySchemeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OAuth2SecurityScheme
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
"openIdConnect" -> OpenIdConnectSecurityScheme -> SecuritySchemeObject
OpenIdConnectSecuritySchemeObject (OpenIdConnectSecurityScheme -> SecuritySchemeObject)
-> Parser OpenIdConnectSecurityScheme
-> Parser SecuritySchemeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OpenIdConnectSecurityScheme
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Text
_ -> String -> Parser SecuritySchemeObject
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A SecuritySchemeObject must have a value of 'apiKey', 'http', 'oauth2' or 'openIdConnect' in the property 'type'."

data ApiKeySecurityScheme = ApiKeySecurityScheme
  { ApiKeySecurityScheme -> Maybe Text
apiKeySecuritySchemeDescription :: Maybe Text,
    ApiKeySecurityScheme -> Text
apiKeySecuritySchemeName :: Text,
    ApiKeySecurityScheme -> ApiKeySecuritySchemeLocation
apiKeySecuritySchemeIn :: ApiKeySecuritySchemeLocation
  }
  deriving (Int -> ApiKeySecurityScheme -> ShowS
[ApiKeySecurityScheme] -> ShowS
ApiKeySecurityScheme -> String
(Int -> ApiKeySecurityScheme -> ShowS)
-> (ApiKeySecurityScheme -> String)
-> ([ApiKeySecurityScheme] -> ShowS)
-> Show ApiKeySecurityScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiKeySecurityScheme -> ShowS
showsPrec :: Int -> ApiKeySecurityScheme -> ShowS
$cshow :: ApiKeySecurityScheme -> String
show :: ApiKeySecurityScheme -> String
$cshowList :: [ApiKeySecurityScheme] -> ShowS
showList :: [ApiKeySecurityScheme] -> ShowS
Show, ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool
(ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool)
-> (ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool)
-> Eq ApiKeySecurityScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool
== :: ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool
$c/= :: ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool
/= :: ApiKeySecurityScheme -> ApiKeySecurityScheme -> Bool
Eq, (forall x. ApiKeySecurityScheme -> Rep ApiKeySecurityScheme x)
-> (forall x. Rep ApiKeySecurityScheme x -> ApiKeySecurityScheme)
-> Generic ApiKeySecurityScheme
forall x. Rep ApiKeySecurityScheme x -> ApiKeySecurityScheme
forall x. ApiKeySecurityScheme -> Rep ApiKeySecurityScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApiKeySecurityScheme -> Rep ApiKeySecurityScheme x
from :: forall x. ApiKeySecurityScheme -> Rep ApiKeySecurityScheme x
$cto :: forall x. Rep ApiKeySecurityScheme x -> ApiKeySecurityScheme
to :: forall x. Rep ApiKeySecurityScheme x -> ApiKeySecurityScheme
Generic)

instance FromJSON ApiKeySecurityScheme where
  parseJSON :: Value -> Parser ApiKeySecurityScheme
parseJSON = String
-> (Object -> Parser ApiKeySecurityScheme)
-> Value
-> Parser ApiKeySecurityScheme
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiKeySecurityScheme" ((Object -> Parser ApiKeySecurityScheme)
 -> Value -> Parser ApiKeySecurityScheme)
-> (Object -> Parser ApiKeySecurityScheme)
-> Value
-> Parser ApiKeySecurityScheme
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Text -> ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme
ApiKeySecurityScheme
      (Maybe Text
 -> Text -> ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme)
-> Parser (Maybe Text)
-> Parser
     (Text -> ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser
  (Text -> ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme)
-> Parser Text
-> Parser (ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (ApiKeySecuritySchemeLocation -> ApiKeySecurityScheme)
-> Parser ApiKeySecuritySchemeLocation
-> Parser ApiKeySecurityScheme
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApiKeySecuritySchemeLocation
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"in"

data ApiKeySecuritySchemeLocation = QueryApiKeySecuritySchemeLocation | HeaderApiKeySecuritySchemeLocation | CookieApiKeySecuritySchemeLocation
  deriving (Int -> ApiKeySecuritySchemeLocation -> ShowS
[ApiKeySecuritySchemeLocation] -> ShowS
ApiKeySecuritySchemeLocation -> String
(Int -> ApiKeySecuritySchemeLocation -> ShowS)
-> (ApiKeySecuritySchemeLocation -> String)
-> ([ApiKeySecuritySchemeLocation] -> ShowS)
-> Show ApiKeySecuritySchemeLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApiKeySecuritySchemeLocation -> ShowS
showsPrec :: Int -> ApiKeySecuritySchemeLocation -> ShowS
$cshow :: ApiKeySecuritySchemeLocation -> String
show :: ApiKeySecuritySchemeLocation -> String
$cshowList :: [ApiKeySecuritySchemeLocation] -> ShowS
showList :: [ApiKeySecuritySchemeLocation] -> ShowS
Show, ApiKeySecuritySchemeLocation
-> ApiKeySecuritySchemeLocation -> Bool
(ApiKeySecuritySchemeLocation
 -> ApiKeySecuritySchemeLocation -> Bool)
-> (ApiKeySecuritySchemeLocation
    -> ApiKeySecuritySchemeLocation -> Bool)
-> Eq ApiKeySecuritySchemeLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApiKeySecuritySchemeLocation
-> ApiKeySecuritySchemeLocation -> Bool
== :: ApiKeySecuritySchemeLocation
-> ApiKeySecuritySchemeLocation -> Bool
$c/= :: ApiKeySecuritySchemeLocation
-> ApiKeySecuritySchemeLocation -> Bool
/= :: ApiKeySecuritySchemeLocation
-> ApiKeySecuritySchemeLocation -> Bool
Eq, (forall x.
 ApiKeySecuritySchemeLocation -> Rep ApiKeySecuritySchemeLocation x)
-> (forall x.
    Rep ApiKeySecuritySchemeLocation x -> ApiKeySecuritySchemeLocation)
-> Generic ApiKeySecuritySchemeLocation
forall x.
Rep ApiKeySecuritySchemeLocation x -> ApiKeySecuritySchemeLocation
forall x.
ApiKeySecuritySchemeLocation -> Rep ApiKeySecuritySchemeLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ApiKeySecuritySchemeLocation -> Rep ApiKeySecuritySchemeLocation x
from :: forall x.
ApiKeySecuritySchemeLocation -> Rep ApiKeySecuritySchemeLocation x
$cto :: forall x.
Rep ApiKeySecuritySchemeLocation x -> ApiKeySecuritySchemeLocation
to :: forall x.
Rep ApiKeySecuritySchemeLocation x -> ApiKeySecuritySchemeLocation
Generic)

instance FromJSON ApiKeySecuritySchemeLocation where
  parseJSON :: Value -> Parser ApiKeySecuritySchemeLocation
parseJSON = String
-> (Text -> Parser ApiKeySecuritySchemeLocation)
-> Value
-> Parser ApiKeySecuritySchemeLocation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ApiKeySecuritySchemeLocation" ((Text -> Parser ApiKeySecuritySchemeLocation)
 -> Value -> Parser ApiKeySecuritySchemeLocation)
-> (Text -> Parser ApiKeySecuritySchemeLocation)
-> Value
-> Parser ApiKeySecuritySchemeLocation
forall a b. (a -> b) -> a -> b
$ \case
    Text
"query" -> ApiKeySecuritySchemeLocation -> Parser ApiKeySecuritySchemeLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiKeySecuritySchemeLocation
QueryApiKeySecuritySchemeLocation
    Text
"header" -> ApiKeySecuritySchemeLocation -> Parser ApiKeySecuritySchemeLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiKeySecuritySchemeLocation
HeaderApiKeySecuritySchemeLocation
    Text
"cookie" -> ApiKeySecuritySchemeLocation -> Parser ApiKeySecuritySchemeLocation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiKeySecuritySchemeLocation
CookieApiKeySecuritySchemeLocation
    Text
_ -> String -> Parser ApiKeySecuritySchemeLocation
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A SecuritySchemeObject with type 'apiKey' must have a value of 'query', 'header' or 'cookie' in the property 'in'."

data HttpSecurityScheme = HttpSecurityScheme
  { HttpSecurityScheme -> Maybe Text
httpSecuritySchemeDescription :: Maybe Text,
    HttpSecurityScheme -> Text
httpSecuritySchemeScheme :: Text,
    HttpSecurityScheme -> Maybe Text
httpSecuritySchemeBearerFormat :: Maybe Text
  }
  deriving (Int -> HttpSecurityScheme -> ShowS
[HttpSecurityScheme] -> ShowS
HttpSecurityScheme -> String
(Int -> HttpSecurityScheme -> ShowS)
-> (HttpSecurityScheme -> String)
-> ([HttpSecurityScheme] -> ShowS)
-> Show HttpSecurityScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpSecurityScheme -> ShowS
showsPrec :: Int -> HttpSecurityScheme -> ShowS
$cshow :: HttpSecurityScheme -> String
show :: HttpSecurityScheme -> String
$cshowList :: [HttpSecurityScheme] -> ShowS
showList :: [HttpSecurityScheme] -> ShowS
Show, HttpSecurityScheme -> HttpSecurityScheme -> Bool
(HttpSecurityScheme -> HttpSecurityScheme -> Bool)
-> (HttpSecurityScheme -> HttpSecurityScheme -> Bool)
-> Eq HttpSecurityScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpSecurityScheme -> HttpSecurityScheme -> Bool
== :: HttpSecurityScheme -> HttpSecurityScheme -> Bool
$c/= :: HttpSecurityScheme -> HttpSecurityScheme -> Bool
/= :: HttpSecurityScheme -> HttpSecurityScheme -> Bool
Eq, (forall x. HttpSecurityScheme -> Rep HttpSecurityScheme x)
-> (forall x. Rep HttpSecurityScheme x -> HttpSecurityScheme)
-> Generic HttpSecurityScheme
forall x. Rep HttpSecurityScheme x -> HttpSecurityScheme
forall x. HttpSecurityScheme -> Rep HttpSecurityScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HttpSecurityScheme -> Rep HttpSecurityScheme x
from :: forall x. HttpSecurityScheme -> Rep HttpSecurityScheme x
$cto :: forall x. Rep HttpSecurityScheme x -> HttpSecurityScheme
to :: forall x. Rep HttpSecurityScheme x -> HttpSecurityScheme
Generic)

instance FromJSON HttpSecurityScheme where
  parseJSON :: Value -> Parser HttpSecurityScheme
parseJSON = String
-> (Object -> Parser HttpSecurityScheme)
-> Value
-> Parser HttpSecurityScheme
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HttpSecurityScheme" ((Object -> Parser HttpSecurityScheme)
 -> Value -> Parser HttpSecurityScheme)
-> (Object -> Parser HttpSecurityScheme)
-> Value
-> Parser HttpSecurityScheme
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Text -> Maybe Text -> HttpSecurityScheme
HttpSecurityScheme
      (Maybe Text -> Text -> Maybe Text -> HttpSecurityScheme)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> HttpSecurityScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Text -> Maybe Text -> HttpSecurityScheme)
-> Parser Text -> Parser (Maybe Text -> HttpSecurityScheme)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scheme"
      Parser (Maybe Text -> HttpSecurityScheme)
-> Parser (Maybe Text) -> Parser HttpSecurityScheme
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bearerFormat"

data OAuth2SecurityScheme = OAuth2SecurityScheme
  { OAuth2SecurityScheme -> Maybe Text
oAuth2SecuritySchemeDescription :: Maybe Text,
    OAuth2SecurityScheme -> OAuthFlowsObject
oAuth2SecuritySchemeFlows :: OAuthFlowsObject
  }
  deriving (Int -> OAuth2SecurityScheme -> ShowS
[OAuth2SecurityScheme] -> ShowS
OAuth2SecurityScheme -> String
(Int -> OAuth2SecurityScheme -> ShowS)
-> (OAuth2SecurityScheme -> String)
-> ([OAuth2SecurityScheme] -> ShowS)
-> Show OAuth2SecurityScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuth2SecurityScheme -> ShowS
showsPrec :: Int -> OAuth2SecurityScheme -> ShowS
$cshow :: OAuth2SecurityScheme -> String
show :: OAuth2SecurityScheme -> String
$cshowList :: [OAuth2SecurityScheme] -> ShowS
showList :: [OAuth2SecurityScheme] -> ShowS
Show, OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool
(OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool)
-> (OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool)
-> Eq OAuth2SecurityScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool
== :: OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool
$c/= :: OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool
/= :: OAuth2SecurityScheme -> OAuth2SecurityScheme -> Bool
Eq, (forall x. OAuth2SecurityScheme -> Rep OAuth2SecurityScheme x)
-> (forall x. Rep OAuth2SecurityScheme x -> OAuth2SecurityScheme)
-> Generic OAuth2SecurityScheme
forall x. Rep OAuth2SecurityScheme x -> OAuth2SecurityScheme
forall x. OAuth2SecurityScheme -> Rep OAuth2SecurityScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuth2SecurityScheme -> Rep OAuth2SecurityScheme x
from :: forall x. OAuth2SecurityScheme -> Rep OAuth2SecurityScheme x
$cto :: forall x. Rep OAuth2SecurityScheme x -> OAuth2SecurityScheme
to :: forall x. Rep OAuth2SecurityScheme x -> OAuth2SecurityScheme
Generic)

instance FromJSON OAuth2SecurityScheme where
  parseJSON :: Value -> Parser OAuth2SecurityScheme
parseJSON = String
-> (Object -> Parser OAuth2SecurityScheme)
-> Value
-> Parser OAuth2SecurityScheme
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OAuth2SecurityScheme" ((Object -> Parser OAuth2SecurityScheme)
 -> Value -> Parser OAuth2SecurityScheme)
-> (Object -> Parser OAuth2SecurityScheme)
-> Value
-> Parser OAuth2SecurityScheme
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> OAuthFlowsObject -> OAuth2SecurityScheme
OAuth2SecurityScheme
      (Maybe Text -> OAuthFlowsObject -> OAuth2SecurityScheme)
-> Parser (Maybe Text)
-> Parser (OAuthFlowsObject -> OAuth2SecurityScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (OAuthFlowsObject -> OAuth2SecurityScheme)
-> Parser OAuthFlowsObject -> Parser OAuth2SecurityScheme
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser OAuthFlowsObject
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"flows"

data OAuthFlowsObject = OAuthFlowsObject
  { OAuthFlowsObject -> Maybe OAuthFlowObject
oAuthFlowsObjectImplicit :: Maybe OAuthFlowObject,
    OAuthFlowsObject -> Maybe OAuthFlowObject
oAuthFlowsObjectPassword :: Maybe OAuthFlowObject,
    OAuthFlowsObject -> Maybe OAuthFlowObject
oAuthFlowsObjectClientCredentials :: Maybe OAuthFlowObject,
    OAuthFlowsObject -> Maybe OAuthFlowObject
oAuthFlowsObjectAuthorizationCode :: Maybe OAuthFlowObject
  }
  deriving (Int -> OAuthFlowsObject -> ShowS
[OAuthFlowsObject] -> ShowS
OAuthFlowsObject -> String
(Int -> OAuthFlowsObject -> ShowS)
-> (OAuthFlowsObject -> String)
-> ([OAuthFlowsObject] -> ShowS)
-> Show OAuthFlowsObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthFlowsObject -> ShowS
showsPrec :: Int -> OAuthFlowsObject -> ShowS
$cshow :: OAuthFlowsObject -> String
show :: OAuthFlowsObject -> String
$cshowList :: [OAuthFlowsObject] -> ShowS
showList :: [OAuthFlowsObject] -> ShowS
Show, OAuthFlowsObject -> OAuthFlowsObject -> Bool
(OAuthFlowsObject -> OAuthFlowsObject -> Bool)
-> (OAuthFlowsObject -> OAuthFlowsObject -> Bool)
-> Eq OAuthFlowsObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthFlowsObject -> OAuthFlowsObject -> Bool
== :: OAuthFlowsObject -> OAuthFlowsObject -> Bool
$c/= :: OAuthFlowsObject -> OAuthFlowsObject -> Bool
/= :: OAuthFlowsObject -> OAuthFlowsObject -> Bool
Eq, (forall x. OAuthFlowsObject -> Rep OAuthFlowsObject x)
-> (forall x. Rep OAuthFlowsObject x -> OAuthFlowsObject)
-> Generic OAuthFlowsObject
forall x. Rep OAuthFlowsObject x -> OAuthFlowsObject
forall x. OAuthFlowsObject -> Rep OAuthFlowsObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthFlowsObject -> Rep OAuthFlowsObject x
from :: forall x. OAuthFlowsObject -> Rep OAuthFlowsObject x
$cto :: forall x. Rep OAuthFlowsObject x -> OAuthFlowsObject
to :: forall x. Rep OAuthFlowsObject x -> OAuthFlowsObject
Generic)

instance FromJSON OAuthFlowsObject where
  parseJSON :: Value -> Parser OAuthFlowsObject
parseJSON = String
-> (Object -> Parser OAuthFlowsObject)
-> Value
-> Parser OAuthFlowsObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OAuthFlowsObject" ((Object -> Parser OAuthFlowsObject)
 -> Value -> Parser OAuthFlowsObject)
-> (Object -> Parser OAuthFlowsObject)
-> Value
-> Parser OAuthFlowsObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe OAuthFlowObject
-> Maybe OAuthFlowObject
-> Maybe OAuthFlowObject
-> Maybe OAuthFlowObject
-> OAuthFlowsObject
OAuthFlowsObject
      (Maybe OAuthFlowObject
 -> Maybe OAuthFlowObject
 -> Maybe OAuthFlowObject
 -> Maybe OAuthFlowObject
 -> OAuthFlowsObject)
-> Parser (Maybe OAuthFlowObject)
-> Parser
     (Maybe OAuthFlowObject
      -> Maybe OAuthFlowObject
      -> Maybe OAuthFlowObject
      -> OAuthFlowsObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe OAuthFlowObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implicit"
      Parser
  (Maybe OAuthFlowObject
   -> Maybe OAuthFlowObject
   -> Maybe OAuthFlowObject
   -> OAuthFlowsObject)
-> Parser (Maybe OAuthFlowObject)
-> Parser
     (Maybe OAuthFlowObject
      -> Maybe OAuthFlowObject -> OAuthFlowsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OAuthFlowObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password"
      Parser
  (Maybe OAuthFlowObject
   -> Maybe OAuthFlowObject -> OAuthFlowsObject)
-> Parser (Maybe OAuthFlowObject)
-> Parser (Maybe OAuthFlowObject -> OAuthFlowsObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OAuthFlowObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"clientCredentials"
      Parser (Maybe OAuthFlowObject -> OAuthFlowsObject)
-> Parser (Maybe OAuthFlowObject) -> Parser OAuthFlowsObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe OAuthFlowObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorizationCode"

data OAuthFlowObject = OAuthFlowObject
  { OAuthFlowObject -> Maybe Text
oAuthFlowObjectAuthorizationUrl :: Maybe Text, -- applies only to implicit and authorizationCode
    OAuthFlowObject -> Maybe Text
oAuthFlowObjectTokenUrl :: Maybe Text, -- applies only to password, clientCredentials and authorizationCode
    OAuthFlowObject -> Maybe Text
oAuthFlowObjectRefreshUrl :: Maybe Text,
    OAuthFlowObject -> Map Text Text
oAuthFlowObjectScopes :: Map.Map Text Text
  }
  deriving (Int -> OAuthFlowObject -> ShowS
[OAuthFlowObject] -> ShowS
OAuthFlowObject -> String
(Int -> OAuthFlowObject -> ShowS)
-> (OAuthFlowObject -> String)
-> ([OAuthFlowObject] -> ShowS)
-> Show OAuthFlowObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuthFlowObject -> ShowS
showsPrec :: Int -> OAuthFlowObject -> ShowS
$cshow :: OAuthFlowObject -> String
show :: OAuthFlowObject -> String
$cshowList :: [OAuthFlowObject] -> ShowS
showList :: [OAuthFlowObject] -> ShowS
Show, OAuthFlowObject -> OAuthFlowObject -> Bool
(OAuthFlowObject -> OAuthFlowObject -> Bool)
-> (OAuthFlowObject -> OAuthFlowObject -> Bool)
-> Eq OAuthFlowObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuthFlowObject -> OAuthFlowObject -> Bool
== :: OAuthFlowObject -> OAuthFlowObject -> Bool
$c/= :: OAuthFlowObject -> OAuthFlowObject -> Bool
/= :: OAuthFlowObject -> OAuthFlowObject -> Bool
Eq, (forall x. OAuthFlowObject -> Rep OAuthFlowObject x)
-> (forall x. Rep OAuthFlowObject x -> OAuthFlowObject)
-> Generic OAuthFlowObject
forall x. Rep OAuthFlowObject x -> OAuthFlowObject
forall x. OAuthFlowObject -> Rep OAuthFlowObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OAuthFlowObject -> Rep OAuthFlowObject x
from :: forall x. OAuthFlowObject -> Rep OAuthFlowObject x
$cto :: forall x. Rep OAuthFlowObject x -> OAuthFlowObject
to :: forall x. Rep OAuthFlowObject x -> OAuthFlowObject
Generic)

instance FromJSON OAuthFlowObject where
  parseJSON :: Value -> Parser OAuthFlowObject
parseJSON = String
-> (Object -> Parser OAuthFlowObject)
-> Value
-> Parser OAuthFlowObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OAuthFlowObject" ((Object -> Parser OAuthFlowObject)
 -> Value -> Parser OAuthFlowObject)
-> (Object -> Parser OAuthFlowObject)
-> Value
-> Parser OAuthFlowObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Map Text Text -> OAuthFlowObject
OAuthFlowObject
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Map Text Text -> OAuthFlowObject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Map Text Text -> OAuthFlowObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorizationUrl"
      Parser
  (Maybe Text -> Maybe Text -> Map Text Text -> OAuthFlowObject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Map Text Text -> OAuthFlowObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenUrl"
      Parser (Maybe Text -> Map Text Text -> OAuthFlowObject)
-> Parser (Maybe Text) -> Parser (Map Text Text -> OAuthFlowObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refreshUrl"
      Parser (Map Text Text -> OAuthFlowObject)
-> Parser (Map Text Text) -> Parser OAuthFlowObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scopes"

data OpenIdConnectSecurityScheme = OpenIdConnectSecurityScheme
  { OpenIdConnectSecurityScheme -> Maybe Text
openIdConnectSecuritySchemeDescription :: Maybe Text,
    OpenIdConnectSecurityScheme -> Text
openIdConnectSecuritySchemeOpenIdConnectUrl :: Text
  }
  deriving (Int -> OpenIdConnectSecurityScheme -> ShowS
[OpenIdConnectSecurityScheme] -> ShowS
OpenIdConnectSecurityScheme -> String
(Int -> OpenIdConnectSecurityScheme -> ShowS)
-> (OpenIdConnectSecurityScheme -> String)
-> ([OpenIdConnectSecurityScheme] -> ShowS)
-> Show OpenIdConnectSecurityScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenIdConnectSecurityScheme -> ShowS
showsPrec :: Int -> OpenIdConnectSecurityScheme -> ShowS
$cshow :: OpenIdConnectSecurityScheme -> String
show :: OpenIdConnectSecurityScheme -> String
$cshowList :: [OpenIdConnectSecurityScheme] -> ShowS
showList :: [OpenIdConnectSecurityScheme] -> ShowS
Show, OpenIdConnectSecurityScheme -> OpenIdConnectSecurityScheme -> Bool
(OpenIdConnectSecurityScheme
 -> OpenIdConnectSecurityScheme -> Bool)
-> (OpenIdConnectSecurityScheme
    -> OpenIdConnectSecurityScheme -> Bool)
-> Eq OpenIdConnectSecurityScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenIdConnectSecurityScheme -> OpenIdConnectSecurityScheme -> Bool
== :: OpenIdConnectSecurityScheme -> OpenIdConnectSecurityScheme -> Bool
$c/= :: OpenIdConnectSecurityScheme -> OpenIdConnectSecurityScheme -> Bool
/= :: OpenIdConnectSecurityScheme -> OpenIdConnectSecurityScheme -> Bool
Eq, (forall x.
 OpenIdConnectSecurityScheme -> Rep OpenIdConnectSecurityScheme x)
-> (forall x.
    Rep OpenIdConnectSecurityScheme x -> OpenIdConnectSecurityScheme)
-> Generic OpenIdConnectSecurityScheme
forall x.
Rep OpenIdConnectSecurityScheme x -> OpenIdConnectSecurityScheme
forall x.
OpenIdConnectSecurityScheme -> Rep OpenIdConnectSecurityScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OpenIdConnectSecurityScheme -> Rep OpenIdConnectSecurityScheme x
from :: forall x.
OpenIdConnectSecurityScheme -> Rep OpenIdConnectSecurityScheme x
$cto :: forall x.
Rep OpenIdConnectSecurityScheme x -> OpenIdConnectSecurityScheme
to :: forall x.
Rep OpenIdConnectSecurityScheme x -> OpenIdConnectSecurityScheme
Generic)

instance FromJSON OpenIdConnectSecurityScheme where
  parseJSON :: Value -> Parser OpenIdConnectSecurityScheme
parseJSON = String
-> (Object -> Parser OpenIdConnectSecurityScheme)
-> Value
-> Parser OpenIdConnectSecurityScheme
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OpenIdConnectSecurityScheme" ((Object -> Parser OpenIdConnectSecurityScheme)
 -> Value -> Parser OpenIdConnectSecurityScheme)
-> (Object -> Parser OpenIdConnectSecurityScheme)
-> Value
-> Parser OpenIdConnectSecurityScheme
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Text -> OpenIdConnectSecurityScheme
OpenIdConnectSecurityScheme
      (Maybe Text -> Text -> OpenIdConnectSecurityScheme)
-> Parser (Maybe Text)
-> Parser (Text -> OpenIdConnectSecurityScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Text -> OpenIdConnectSecurityScheme)
-> Parser Text -> Parser OpenIdConnectSecurityScheme
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"openIdConnectUrl"

data TagObject = TagObject
  { TagObject -> Text
tagObjectName :: Text,
    TagObject -> Maybe Text
tagObjectDescription :: Maybe Text,
    TagObject -> Maybe ExternalDocumentationObject
tagObjectExternalDocs :: Maybe ExternalDocumentationObject
  }
  deriving (Int -> TagObject -> ShowS
[TagObject] -> ShowS
TagObject -> String
(Int -> TagObject -> ShowS)
-> (TagObject -> String)
-> ([TagObject] -> ShowS)
-> Show TagObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagObject -> ShowS
showsPrec :: Int -> TagObject -> ShowS
$cshow :: TagObject -> String
show :: TagObject -> String
$cshowList :: [TagObject] -> ShowS
showList :: [TagObject] -> ShowS
Show, TagObject -> TagObject -> Bool
(TagObject -> TagObject -> Bool)
-> (TagObject -> TagObject -> Bool) -> Eq TagObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagObject -> TagObject -> Bool
== :: TagObject -> TagObject -> Bool
$c/= :: TagObject -> TagObject -> Bool
/= :: TagObject -> TagObject -> Bool
Eq, (forall x. TagObject -> Rep TagObject x)
-> (forall x. Rep TagObject x -> TagObject) -> Generic TagObject
forall x. Rep TagObject x -> TagObject
forall x. TagObject -> Rep TagObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TagObject -> Rep TagObject x
from :: forall x. TagObject -> Rep TagObject x
$cto :: forall x. Rep TagObject x -> TagObject
to :: forall x. Rep TagObject x -> TagObject
Generic)

instance FromJSON TagObject where
  parseJSON :: Value -> Parser TagObject
parseJSON = String -> (Object -> Parser TagObject) -> Value -> Parser TagObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TagObject" ((Object -> Parser TagObject) -> Value -> Parser TagObject)
-> (Object -> Parser TagObject) -> Value -> Parser TagObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text -> Maybe ExternalDocumentationObject -> TagObject
TagObject
      (Text
 -> Maybe Text -> Maybe ExternalDocumentationObject -> TagObject)
-> Parser Text
-> Parser
     (Maybe Text -> Maybe ExternalDocumentationObject -> TagObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Maybe Text -> Maybe ExternalDocumentationObject -> TagObject)
-> Parser (Maybe Text)
-> Parser (Maybe ExternalDocumentationObject -> TagObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      Parser (Maybe ExternalDocumentationObject -> TagObject)
-> Parser (Maybe ExternalDocumentationObject) -> Parser TagObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ExternalDocumentationObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"externalDocs"