{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.APIGateway.CreateRestApi
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new RestApi resource.
module Amazonka.APIGateway.CreateRestApi
  ( -- * Creating a Request
    CreateRestApi (..),
    newCreateRestApi,

    -- * Request Lenses
    createRestApi_apiKeySource,
    createRestApi_binaryMediaTypes,
    createRestApi_cloneFrom,
    createRestApi_description,
    createRestApi_disableExecuteApiEndpoint,
    createRestApi_endpointConfiguration,
    createRestApi_minimumCompressionSize,
    createRestApi_policy,
    createRestApi_tags,
    createRestApi_version,
    createRestApi_name,

    -- * Destructuring the Response
    RestApi (..),
    newRestApi,

    -- * Response Lenses
    restApi_apiKeySource,
    restApi_binaryMediaTypes,
    restApi_createdDate,
    restApi_description,
    restApi_disableExecuteApiEndpoint,
    restApi_endpointConfiguration,
    restApi_id,
    restApi_minimumCompressionSize,
    restApi_name,
    restApi_policy,
    restApi_tags,
    restApi_version,
    restApi_warnings,
  )
where

import Amazonka.APIGateway.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The POST Request to add a new RestApi resource to your collection.
--
-- /See:/ 'newCreateRestApi' smart constructor.
data CreateRestApi = CreateRestApi'
  { -- | The source of the API key for metering requests according to a usage
    -- plan. Valid values are: >@HEADER@ to read the API key from the
    -- @X-API-Key@ header of a request. @AUTHORIZER@ to read the API key from
    -- the @UsageIdentifierKey@ from a custom authorizer.
    CreateRestApi -> Maybe ApiKeySourceType
apiKeySource :: Prelude.Maybe ApiKeySourceType,
    -- | The list of binary media types supported by the RestApi. By default, the
    -- RestApi supports only UTF-8-encoded text payloads.
    CreateRestApi -> Maybe [Text]
binaryMediaTypes :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the RestApi that you want to clone from.
    CreateRestApi -> Maybe Text
cloneFrom :: Prelude.Maybe Prelude.Text,
    -- | The description of the RestApi.
    CreateRestApi -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether clients can invoke your API by using the default
    -- @execute-api@ endpoint. By default, clients can invoke your API with the
    -- default @https:\/\/{api_id}.execute-api.{region}.amazonaws.com@
    -- endpoint. To require that clients use a custom domain name to invoke
    -- your API, disable the default endpoint
    CreateRestApi -> Maybe Bool
disableExecuteApiEndpoint :: Prelude.Maybe Prelude.Bool,
    -- | The endpoint configuration of this RestApi showing the endpoint types of
    -- the API.
    CreateRestApi -> Maybe EndpointConfiguration
endpointConfiguration :: Prelude.Maybe EndpointConfiguration,
    -- | A nullable integer that is used to enable compression (with non-negative
    -- between 0 and 10485760 (10M) bytes, inclusive) or disable compression
    -- (with a null value) on an API. When compression is enabled, compression
    -- or decompression is not applied on the payload if the payload size is
    -- smaller than this value. Setting it to zero allows compression for any
    -- payload size.
    CreateRestApi -> Maybe Int
minimumCompressionSize :: Prelude.Maybe Prelude.Int,
    -- | A stringified JSON policy document that applies to this RestApi
    -- regardless of the caller and Method configuration.
    CreateRestApi -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The key-value map of strings. The valid character set is
    -- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
    -- start with @aws:@. The tag value can be up to 256 characters.
    CreateRestApi -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A version identifier for the API.
    CreateRestApi -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
    -- | The name of the RestApi.
    CreateRestApi -> Text
name :: Prelude.Text
  }
  deriving (CreateRestApi -> CreateRestApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRestApi -> CreateRestApi -> Bool
$c/= :: CreateRestApi -> CreateRestApi -> Bool
== :: CreateRestApi -> CreateRestApi -> Bool
$c== :: CreateRestApi -> CreateRestApi -> Bool
Prelude.Eq, ReadPrec [CreateRestApi]
ReadPrec CreateRestApi
Int -> ReadS CreateRestApi
ReadS [CreateRestApi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRestApi]
$creadListPrec :: ReadPrec [CreateRestApi]
readPrec :: ReadPrec CreateRestApi
$creadPrec :: ReadPrec CreateRestApi
readList :: ReadS [CreateRestApi]
$creadList :: ReadS [CreateRestApi]
readsPrec :: Int -> ReadS CreateRestApi
$creadsPrec :: Int -> ReadS CreateRestApi
Prelude.Read, Int -> CreateRestApi -> ShowS
[CreateRestApi] -> ShowS
CreateRestApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRestApi] -> ShowS
$cshowList :: [CreateRestApi] -> ShowS
show :: CreateRestApi -> String
$cshow :: CreateRestApi -> String
showsPrec :: Int -> CreateRestApi -> ShowS
$cshowsPrec :: Int -> CreateRestApi -> ShowS
Prelude.Show, forall x. Rep CreateRestApi x -> CreateRestApi
forall x. CreateRestApi -> Rep CreateRestApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRestApi x -> CreateRestApi
$cfrom :: forall x. CreateRestApi -> Rep CreateRestApi x
Prelude.Generic)

-- |
-- Create a value of 'CreateRestApi' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'apiKeySource', 'createRestApi_apiKeySource' - The source of the API key for metering requests according to a usage
-- plan. Valid values are: >@HEADER@ to read the API key from the
-- @X-API-Key@ header of a request. @AUTHORIZER@ to read the API key from
-- the @UsageIdentifierKey@ from a custom authorizer.
--
-- 'binaryMediaTypes', 'createRestApi_binaryMediaTypes' - The list of binary media types supported by the RestApi. By default, the
-- RestApi supports only UTF-8-encoded text payloads.
--
-- 'cloneFrom', 'createRestApi_cloneFrom' - The ID of the RestApi that you want to clone from.
--
-- 'description', 'createRestApi_description' - The description of the RestApi.
--
-- 'disableExecuteApiEndpoint', 'createRestApi_disableExecuteApiEndpoint' - Specifies whether clients can invoke your API by using the default
-- @execute-api@ endpoint. By default, clients can invoke your API with the
-- default @https:\/\/{api_id}.execute-api.{region}.amazonaws.com@
-- endpoint. To require that clients use a custom domain name to invoke
-- your API, disable the default endpoint
--
-- 'endpointConfiguration', 'createRestApi_endpointConfiguration' - The endpoint configuration of this RestApi showing the endpoint types of
-- the API.
--
-- 'minimumCompressionSize', 'createRestApi_minimumCompressionSize' - A nullable integer that is used to enable compression (with non-negative
-- between 0 and 10485760 (10M) bytes, inclusive) or disable compression
-- (with a null value) on an API. When compression is enabled, compression
-- or decompression is not applied on the payload if the payload size is
-- smaller than this value. Setting it to zero allows compression for any
-- payload size.
--
-- 'policy', 'createRestApi_policy' - A stringified JSON policy document that applies to this RestApi
-- regardless of the caller and Method configuration.
--
-- 'tags', 'createRestApi_tags' - The key-value map of strings. The valid character set is
-- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
-- start with @aws:@. The tag value can be up to 256 characters.
--
-- 'version', 'createRestApi_version' - A version identifier for the API.
--
-- 'name', 'createRestApi_name' - The name of the RestApi.
newCreateRestApi ::
  -- | 'name'
  Prelude.Text ->
  CreateRestApi
newCreateRestApi :: Text -> CreateRestApi
newCreateRestApi Text
pName_ =
  CreateRestApi'
    { $sel:apiKeySource:CreateRestApi' :: Maybe ApiKeySourceType
apiKeySource = forall a. Maybe a
Prelude.Nothing,
      $sel:binaryMediaTypes:CreateRestApi' :: Maybe [Text]
binaryMediaTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:cloneFrom:CreateRestApi' :: Maybe Text
cloneFrom = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateRestApi' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:disableExecuteApiEndpoint:CreateRestApi' :: Maybe Bool
disableExecuteApiEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointConfiguration:CreateRestApi' :: Maybe EndpointConfiguration
endpointConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumCompressionSize:CreateRestApi' :: Maybe Int
minimumCompressionSize = forall a. Maybe a
Prelude.Nothing,
      $sel:policy:CreateRestApi' :: Maybe Text
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateRestApi' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateRestApi' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateRestApi' :: Text
name = Text
pName_
    }

-- | The source of the API key for metering requests according to a usage
-- plan. Valid values are: >@HEADER@ to read the API key from the
-- @X-API-Key@ header of a request. @AUTHORIZER@ to read the API key from
-- the @UsageIdentifierKey@ from a custom authorizer.
createRestApi_apiKeySource :: Lens.Lens' CreateRestApi (Prelude.Maybe ApiKeySourceType)
createRestApi_apiKeySource :: Lens' CreateRestApi (Maybe ApiKeySourceType)
createRestApi_apiKeySource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe ApiKeySourceType
apiKeySource :: Maybe ApiKeySourceType
$sel:apiKeySource:CreateRestApi' :: CreateRestApi -> Maybe ApiKeySourceType
apiKeySource} -> Maybe ApiKeySourceType
apiKeySource) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe ApiKeySourceType
a -> CreateRestApi
s {$sel:apiKeySource:CreateRestApi' :: Maybe ApiKeySourceType
apiKeySource = Maybe ApiKeySourceType
a} :: CreateRestApi)

-- | The list of binary media types supported by the RestApi. By default, the
-- RestApi supports only UTF-8-encoded text payloads.
createRestApi_binaryMediaTypes :: Lens.Lens' CreateRestApi (Prelude.Maybe [Prelude.Text])
createRestApi_binaryMediaTypes :: Lens' CreateRestApi (Maybe [Text])
createRestApi_binaryMediaTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe [Text]
binaryMediaTypes :: Maybe [Text]
$sel:binaryMediaTypes:CreateRestApi' :: CreateRestApi -> Maybe [Text]
binaryMediaTypes} -> Maybe [Text]
binaryMediaTypes) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe [Text]
a -> CreateRestApi
s {$sel:binaryMediaTypes:CreateRestApi' :: Maybe [Text]
binaryMediaTypes = Maybe [Text]
a} :: CreateRestApi) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ID of the RestApi that you want to clone from.
createRestApi_cloneFrom :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Text)
createRestApi_cloneFrom :: Lens' CreateRestApi (Maybe Text)
createRestApi_cloneFrom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Text
cloneFrom :: Maybe Text
$sel:cloneFrom:CreateRestApi' :: CreateRestApi -> Maybe Text
cloneFrom} -> Maybe Text
cloneFrom) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Text
a -> CreateRestApi
s {$sel:cloneFrom:CreateRestApi' :: Maybe Text
cloneFrom = Maybe Text
a} :: CreateRestApi)

-- | The description of the RestApi.
createRestApi_description :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Text)
createRestApi_description :: Lens' CreateRestApi (Maybe Text)
createRestApi_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Text
description :: Maybe Text
$sel:description:CreateRestApi' :: CreateRestApi -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Text
a -> CreateRestApi
s {$sel:description:CreateRestApi' :: Maybe Text
description = Maybe Text
a} :: CreateRestApi)

-- | Specifies whether clients can invoke your API by using the default
-- @execute-api@ endpoint. By default, clients can invoke your API with the
-- default @https:\/\/{api_id}.execute-api.{region}.amazonaws.com@
-- endpoint. To require that clients use a custom domain name to invoke
-- your API, disable the default endpoint
createRestApi_disableExecuteApiEndpoint :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Bool)
createRestApi_disableExecuteApiEndpoint :: Lens' CreateRestApi (Maybe Bool)
createRestApi_disableExecuteApiEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Bool
disableExecuteApiEndpoint :: Maybe Bool
$sel:disableExecuteApiEndpoint:CreateRestApi' :: CreateRestApi -> Maybe Bool
disableExecuteApiEndpoint} -> Maybe Bool
disableExecuteApiEndpoint) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Bool
a -> CreateRestApi
s {$sel:disableExecuteApiEndpoint:CreateRestApi' :: Maybe Bool
disableExecuteApiEndpoint = Maybe Bool
a} :: CreateRestApi)

-- | The endpoint configuration of this RestApi showing the endpoint types of
-- the API.
createRestApi_endpointConfiguration :: Lens.Lens' CreateRestApi (Prelude.Maybe EndpointConfiguration)
createRestApi_endpointConfiguration :: Lens' CreateRestApi (Maybe EndpointConfiguration)
createRestApi_endpointConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe EndpointConfiguration
endpointConfiguration :: Maybe EndpointConfiguration
$sel:endpointConfiguration:CreateRestApi' :: CreateRestApi -> Maybe EndpointConfiguration
endpointConfiguration} -> Maybe EndpointConfiguration
endpointConfiguration) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe EndpointConfiguration
a -> CreateRestApi
s {$sel:endpointConfiguration:CreateRestApi' :: Maybe EndpointConfiguration
endpointConfiguration = Maybe EndpointConfiguration
a} :: CreateRestApi)

-- | A nullable integer that is used to enable compression (with non-negative
-- between 0 and 10485760 (10M) bytes, inclusive) or disable compression
-- (with a null value) on an API. When compression is enabled, compression
-- or decompression is not applied on the payload if the payload size is
-- smaller than this value. Setting it to zero allows compression for any
-- payload size.
createRestApi_minimumCompressionSize :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Int)
createRestApi_minimumCompressionSize :: Lens' CreateRestApi (Maybe Int)
createRestApi_minimumCompressionSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Int
minimumCompressionSize :: Maybe Int
$sel:minimumCompressionSize:CreateRestApi' :: CreateRestApi -> Maybe Int
minimumCompressionSize} -> Maybe Int
minimumCompressionSize) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Int
a -> CreateRestApi
s {$sel:minimumCompressionSize:CreateRestApi' :: Maybe Int
minimumCompressionSize = Maybe Int
a} :: CreateRestApi)

-- | A stringified JSON policy document that applies to this RestApi
-- regardless of the caller and Method configuration.
createRestApi_policy :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Text)
createRestApi_policy :: Lens' CreateRestApi (Maybe Text)
createRestApi_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Text
policy :: Maybe Text
$sel:policy:CreateRestApi' :: CreateRestApi -> Maybe Text
policy} -> Maybe Text
policy) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Text
a -> CreateRestApi
s {$sel:policy:CreateRestApi' :: Maybe Text
policy = Maybe Text
a} :: CreateRestApi)

-- | The key-value map of strings. The valid character set is
-- [a-zA-Z+-=._:\/]. The tag key can be up to 128 characters and must not
-- start with @aws:@. The tag value can be up to 256 characters.
createRestApi_tags :: Lens.Lens' CreateRestApi (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createRestApi_tags :: Lens' CreateRestApi (Maybe (HashMap Text Text))
createRestApi_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateRestApi' :: CreateRestApi -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe (HashMap Text Text)
a -> CreateRestApi
s {$sel:tags:CreateRestApi' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateRestApi) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A version identifier for the API.
createRestApi_version :: Lens.Lens' CreateRestApi (Prelude.Maybe Prelude.Text)
createRestApi_version :: Lens' CreateRestApi (Maybe Text)
createRestApi_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Maybe Text
version :: Maybe Text
$sel:version:CreateRestApi' :: CreateRestApi -> Maybe Text
version} -> Maybe Text
version) (\s :: CreateRestApi
s@CreateRestApi' {} Maybe Text
a -> CreateRestApi
s {$sel:version:CreateRestApi' :: Maybe Text
version = Maybe Text
a} :: CreateRestApi)

-- | The name of the RestApi.
createRestApi_name :: Lens.Lens' CreateRestApi Prelude.Text
createRestApi_name :: Lens' CreateRestApi Text
createRestApi_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestApi' {Text
name :: Text
$sel:name:CreateRestApi' :: CreateRestApi -> Text
name} -> Text
name) (\s :: CreateRestApi
s@CreateRestApi' {} Text
a -> CreateRestApi
s {$sel:name:CreateRestApi' :: Text
name = Text
a} :: CreateRestApi)

instance Core.AWSRequest CreateRestApi where
  type AWSResponse CreateRestApi = RestApi
  request :: (Service -> Service) -> CreateRestApi -> Request CreateRestApi
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateRestApi
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateRestApi)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateRestApi where
  hashWithSalt :: Int -> CreateRestApi -> Int
hashWithSalt Int
_salt CreateRestApi' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ApiKeySourceType
Maybe EndpointConfiguration
Text
name :: Text
version :: Maybe Text
tags :: Maybe (HashMap Text Text)
policy :: Maybe Text
minimumCompressionSize :: Maybe Int
endpointConfiguration :: Maybe EndpointConfiguration
disableExecuteApiEndpoint :: Maybe Bool
description :: Maybe Text
cloneFrom :: Maybe Text
binaryMediaTypes :: Maybe [Text]
apiKeySource :: Maybe ApiKeySourceType
$sel:name:CreateRestApi' :: CreateRestApi -> Text
$sel:version:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:tags:CreateRestApi' :: CreateRestApi -> Maybe (HashMap Text Text)
$sel:policy:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:minimumCompressionSize:CreateRestApi' :: CreateRestApi -> Maybe Int
$sel:endpointConfiguration:CreateRestApi' :: CreateRestApi -> Maybe EndpointConfiguration
$sel:disableExecuteApiEndpoint:CreateRestApi' :: CreateRestApi -> Maybe Bool
$sel:description:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:cloneFrom:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:binaryMediaTypes:CreateRestApi' :: CreateRestApi -> Maybe [Text]
$sel:apiKeySource:CreateRestApi' :: CreateRestApi -> Maybe ApiKeySourceType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiKeySourceType
apiKeySource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
binaryMediaTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cloneFrom
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
disableExecuteApiEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointConfiguration
endpointConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minimumCompressionSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
version
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateRestApi where
  rnf :: CreateRestApi -> ()
rnf CreateRestApi' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ApiKeySourceType
Maybe EndpointConfiguration
Text
name :: Text
version :: Maybe Text
tags :: Maybe (HashMap Text Text)
policy :: Maybe Text
minimumCompressionSize :: Maybe Int
endpointConfiguration :: Maybe EndpointConfiguration
disableExecuteApiEndpoint :: Maybe Bool
description :: Maybe Text
cloneFrom :: Maybe Text
binaryMediaTypes :: Maybe [Text]
apiKeySource :: Maybe ApiKeySourceType
$sel:name:CreateRestApi' :: CreateRestApi -> Text
$sel:version:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:tags:CreateRestApi' :: CreateRestApi -> Maybe (HashMap Text Text)
$sel:policy:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:minimumCompressionSize:CreateRestApi' :: CreateRestApi -> Maybe Int
$sel:endpointConfiguration:CreateRestApi' :: CreateRestApi -> Maybe EndpointConfiguration
$sel:disableExecuteApiEndpoint:CreateRestApi' :: CreateRestApi -> Maybe Bool
$sel:description:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:cloneFrom:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:binaryMediaTypes:CreateRestApi' :: CreateRestApi -> Maybe [Text]
$sel:apiKeySource:CreateRestApi' :: CreateRestApi -> Maybe ApiKeySourceType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiKeySourceType
apiKeySource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
binaryMediaTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cloneFrom
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
disableExecuteApiEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointConfiguration
endpointConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minimumCompressionSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateRestApi where
  toHeaders :: CreateRestApi -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON CreateRestApi where
  toJSON :: CreateRestApi -> Value
toJSON CreateRestApi' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe ApiKeySourceType
Maybe EndpointConfiguration
Text
name :: Text
version :: Maybe Text
tags :: Maybe (HashMap Text Text)
policy :: Maybe Text
minimumCompressionSize :: Maybe Int
endpointConfiguration :: Maybe EndpointConfiguration
disableExecuteApiEndpoint :: Maybe Bool
description :: Maybe Text
cloneFrom :: Maybe Text
binaryMediaTypes :: Maybe [Text]
apiKeySource :: Maybe ApiKeySourceType
$sel:name:CreateRestApi' :: CreateRestApi -> Text
$sel:version:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:tags:CreateRestApi' :: CreateRestApi -> Maybe (HashMap Text Text)
$sel:policy:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:minimumCompressionSize:CreateRestApi' :: CreateRestApi -> Maybe Int
$sel:endpointConfiguration:CreateRestApi' :: CreateRestApi -> Maybe EndpointConfiguration
$sel:disableExecuteApiEndpoint:CreateRestApi' :: CreateRestApi -> Maybe Bool
$sel:description:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:cloneFrom:CreateRestApi' :: CreateRestApi -> Maybe Text
$sel:binaryMediaTypes:CreateRestApi' :: CreateRestApi -> Maybe [Text]
$sel:apiKeySource:CreateRestApi' :: CreateRestApi -> Maybe ApiKeySourceType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"apiKeySource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ApiKeySourceType
apiKeySource,
            (Key
"binaryMediaTypes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
binaryMediaTypes,
            (Key
"cloneFrom" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
cloneFrom,
            (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"disableExecuteApiEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
disableExecuteApiEndpoint,
            (Key
"endpointConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EndpointConfiguration
endpointConfiguration,
            (Key
"minimumCompressionSize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
minimumCompressionSize,
            (Key
"policy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
policy,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            (Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
version,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateRestApi where
  toPath :: CreateRestApi -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/restapis"

instance Data.ToQuery CreateRestApi where
  toQuery :: CreateRestApi -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty