{-# 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.PutRestApi
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A feature of the API Gateway control service for updating an existing
-- API with an input of external API definitions. The update can take the
-- form of merging the supplied definition into the existing API or
-- overwriting the existing API.
module Amazonka.APIGateway.PutRestApi
  ( -- * Creating a Request
    PutRestApi (..),
    newPutRestApi,

    -- * Request Lenses
    putRestApi_failOnWarnings,
    putRestApi_mode,
    putRestApi_parameters,
    putRestApi_restApiId,
    putRestApi_body,

    -- * 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

-- | A PUT request to update an existing API, with external API definitions
-- specified as the request body.
--
-- /See:/ 'newPutRestApi' smart constructor.
data PutRestApi = PutRestApi'
  { -- | A query parameter to indicate whether to rollback the API update
    -- (@true@) or not (@false@) when a warning is encountered. The default
    -- value is @false@.
    PutRestApi -> Maybe Bool
failOnWarnings :: Prelude.Maybe Prelude.Bool,
    -- | The @mode@ query parameter to specify the update mode. Valid values are
    -- \"merge\" and \"overwrite\". By default, the update mode is \"merge\".
    PutRestApi -> Maybe PutMode
mode :: Prelude.Maybe PutMode,
    -- | Custom header parameters as part of the request. For example, to exclude
    -- DocumentationParts from an imported API, set @ignore=documentation@ as a
    -- @parameters@ value, as in the AWS CLI command of
    -- @aws apigateway import-rest-api --parameters ignore=documentation --body \'file:\/\/\/path\/to\/imported-api-body.json\'@.
    PutRestApi -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    PutRestApi -> Text
restApiId :: Prelude.Text,
    -- | The PUT request body containing external API definitions. Currently,
    -- only OpenAPI definition JSON\/YAML files are supported. The maximum size
    -- of the API definition file is 6MB.
    PutRestApi -> ByteString
body :: Prelude.ByteString
  }
  deriving (PutRestApi -> PutRestApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRestApi -> PutRestApi -> Bool
$c/= :: PutRestApi -> PutRestApi -> Bool
== :: PutRestApi -> PutRestApi -> Bool
$c== :: PutRestApi -> PutRestApi -> Bool
Prelude.Eq, Int -> PutRestApi -> ShowS
[PutRestApi] -> ShowS
PutRestApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRestApi] -> ShowS
$cshowList :: [PutRestApi] -> ShowS
show :: PutRestApi -> String
$cshow :: PutRestApi -> String
showsPrec :: Int -> PutRestApi -> ShowS
$cshowsPrec :: Int -> PutRestApi -> ShowS
Prelude.Show, forall x. Rep PutRestApi x -> PutRestApi
forall x. PutRestApi -> Rep PutRestApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutRestApi x -> PutRestApi
$cfrom :: forall x. PutRestApi -> Rep PutRestApi x
Prelude.Generic)

-- |
-- Create a value of 'PutRestApi' 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:
--
-- 'failOnWarnings', 'putRestApi_failOnWarnings' - A query parameter to indicate whether to rollback the API update
-- (@true@) or not (@false@) when a warning is encountered. The default
-- value is @false@.
--
-- 'mode', 'putRestApi_mode' - The @mode@ query parameter to specify the update mode. Valid values are
-- \"merge\" and \"overwrite\". By default, the update mode is \"merge\".
--
-- 'parameters', 'putRestApi_parameters' - Custom header parameters as part of the request. For example, to exclude
-- DocumentationParts from an imported API, set @ignore=documentation@ as a
-- @parameters@ value, as in the AWS CLI command of
-- @aws apigateway import-rest-api --parameters ignore=documentation --body \'file:\/\/\/path\/to\/imported-api-body.json\'@.
--
-- 'restApiId', 'putRestApi_restApiId' - The string identifier of the associated RestApi.
--
-- 'body', 'putRestApi_body' - The PUT request body containing external API definitions. Currently,
-- only OpenAPI definition JSON\/YAML files are supported. The maximum size
-- of the API definition file is 6MB.
newPutRestApi ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'body'
  Prelude.ByteString ->
  PutRestApi
newPutRestApi :: Text -> ByteString -> PutRestApi
newPutRestApi Text
pRestApiId_ ByteString
pBody_ =
  PutRestApi'
    { $sel:failOnWarnings:PutRestApi' :: Maybe Bool
failOnWarnings = forall a. Maybe a
Prelude.Nothing,
      $sel:mode:PutRestApi' :: Maybe PutMode
mode = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:PutRestApi' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:PutRestApi' :: Text
restApiId = Text
pRestApiId_,
      $sel:body:PutRestApi' :: ByteString
body = ByteString
pBody_
    }

-- | A query parameter to indicate whether to rollback the API update
-- (@true@) or not (@false@) when a warning is encountered. The default
-- value is @false@.
putRestApi_failOnWarnings :: Lens.Lens' PutRestApi (Prelude.Maybe Prelude.Bool)
putRestApi_failOnWarnings :: Lens' PutRestApi (Maybe Bool)
putRestApi_failOnWarnings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRestApi' {Maybe Bool
failOnWarnings :: Maybe Bool
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
failOnWarnings} -> Maybe Bool
failOnWarnings) (\s :: PutRestApi
s@PutRestApi' {} Maybe Bool
a -> PutRestApi
s {$sel:failOnWarnings:PutRestApi' :: Maybe Bool
failOnWarnings = Maybe Bool
a} :: PutRestApi)

-- | The @mode@ query parameter to specify the update mode. Valid values are
-- \"merge\" and \"overwrite\". By default, the update mode is \"merge\".
putRestApi_mode :: Lens.Lens' PutRestApi (Prelude.Maybe PutMode)
putRestApi_mode :: Lens' PutRestApi (Maybe PutMode)
putRestApi_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRestApi' {Maybe PutMode
mode :: Maybe PutMode
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
mode} -> Maybe PutMode
mode) (\s :: PutRestApi
s@PutRestApi' {} Maybe PutMode
a -> PutRestApi
s {$sel:mode:PutRestApi' :: Maybe PutMode
mode = Maybe PutMode
a} :: PutRestApi)

-- | Custom header parameters as part of the request. For example, to exclude
-- DocumentationParts from an imported API, set @ignore=documentation@ as a
-- @parameters@ value, as in the AWS CLI command of
-- @aws apigateway import-rest-api --parameters ignore=documentation --body \'file:\/\/\/path\/to\/imported-api-body.json\'@.
putRestApi_parameters :: Lens.Lens' PutRestApi (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putRestApi_parameters :: Lens' PutRestApi (Maybe (HashMap Text Text))
putRestApi_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRestApi' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: PutRestApi
s@PutRestApi' {} Maybe (HashMap Text Text)
a -> PutRestApi
s {$sel:parameters:PutRestApi' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: PutRestApi) 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 string identifier of the associated RestApi.
putRestApi_restApiId :: Lens.Lens' PutRestApi Prelude.Text
putRestApi_restApiId :: Lens' PutRestApi Text
putRestApi_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRestApi' {Text
restApiId :: Text
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
restApiId} -> Text
restApiId) (\s :: PutRestApi
s@PutRestApi' {} Text
a -> PutRestApi
s {$sel:restApiId:PutRestApi' :: Text
restApiId = Text
a} :: PutRestApi)

-- | The PUT request body containing external API definitions. Currently,
-- only OpenAPI definition JSON\/YAML files are supported. The maximum size
-- of the API definition file is 6MB.
putRestApi_body :: Lens.Lens' PutRestApi Prelude.ByteString
putRestApi_body :: Lens' PutRestApi ByteString
putRestApi_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRestApi' {ByteString
body :: ByteString
$sel:body:PutRestApi' :: PutRestApi -> ByteString
body} -> ByteString
body) (\s :: PutRestApi
s@PutRestApi' {} ByteString
a -> PutRestApi
s {$sel:body:PutRestApi' :: ByteString
body = ByteString
a} :: PutRestApi)

instance Core.AWSRequest PutRestApi where
  type AWSResponse PutRestApi = RestApi
  request :: (Service -> Service) -> PutRestApi -> Request PutRestApi
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.putBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutRestApi
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutRestApi)))
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 PutRestApi where
  hashWithSalt :: Int -> PutRestApi -> Int
hashWithSalt Int
_salt PutRestApi' {Maybe Bool
Maybe (HashMap Text Text)
Maybe PutMode
ByteString
Text
body :: ByteString
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
mode :: Maybe PutMode
failOnWarnings :: Maybe Bool
$sel:body:PutRestApi' :: PutRestApi -> ByteString
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
failOnWarnings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PutMode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ByteString
body

instance Prelude.NFData PutRestApi where
  rnf :: PutRestApi -> ()
rnf PutRestApi' {Maybe Bool
Maybe (HashMap Text Text)
Maybe PutMode
ByteString
Text
body :: ByteString
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
mode :: Maybe PutMode
failOnWarnings :: Maybe Bool
$sel:body:PutRestApi' :: PutRestApi -> ByteString
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
failOnWarnings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PutMode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ByteString
body

instance Data.ToBody PutRestApi where
  toBody :: PutRestApi -> RequestBody
toBody PutRestApi' {Maybe Bool
Maybe (HashMap Text Text)
Maybe PutMode
ByteString
Text
body :: ByteString
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
mode :: Maybe PutMode
failOnWarnings :: Maybe Bool
$sel:body:PutRestApi' :: PutRestApi -> ByteString
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
..} = forall a. ToBody a => a -> RequestBody
Data.toBody ByteString
body

instance Data.ToHeaders PutRestApi where
  toHeaders :: PutRestApi -> 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.ToPath PutRestApi where
  toPath :: PutRestApi -> ByteString
toPath PutRestApi' {Maybe Bool
Maybe (HashMap Text Text)
Maybe PutMode
ByteString
Text
body :: ByteString
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
mode :: Maybe PutMode
failOnWarnings :: Maybe Bool
$sel:body:PutRestApi' :: PutRestApi -> ByteString
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/restapis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId]

instance Data.ToQuery PutRestApi where
  toQuery :: PutRestApi -> QueryString
toQuery PutRestApi' {Maybe Bool
Maybe (HashMap Text Text)
Maybe PutMode
ByteString
Text
body :: ByteString
restApiId :: Text
parameters :: Maybe (HashMap Text Text)
mode :: Maybe PutMode
failOnWarnings :: Maybe Bool
$sel:body:PutRestApi' :: PutRestApi -> ByteString
$sel:restApiId:PutRestApi' :: PutRestApi -> Text
$sel:parameters:PutRestApi' :: PutRestApi -> Maybe (HashMap Text Text)
$sel:mode:PutRestApi' :: PutRestApi -> Maybe PutMode
$sel:failOnWarnings:PutRestApi' :: PutRestApi -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"failonwarnings" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
failOnWarnings,
        ByteString
"mode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe PutMode
mode,
        ByteString
"parameters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"entry" ByteString
"key" ByteString
"value"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
parameters
            )
      ]