{-# 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.ImportRestApi
-- 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 creating a new API from
-- an external API definition file.
module Amazonka.APIGateway.ImportRestApi
  ( -- * Creating a Request
    ImportRestApi (..),
    newImportRestApi,

    -- * Request Lenses
    importRestApi_failOnWarnings,
    importRestApi_parameters,
    importRestApi_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 POST request to import an API to API Gateway using an input of an API
-- definition file.
--
-- /See:/ 'newImportRestApi' smart constructor.
data ImportRestApi = ImportRestApi'
  { -- | A query parameter to indicate whether to rollback the API creation
    -- (@true@) or not (@false@) when a warning is encountered. The default
    -- value is @false@.
    ImportRestApi -> Maybe Bool
failOnWarnings :: Prelude.Maybe Prelude.Bool,
    -- | A key-value map of context-specific query string parameters specifying
    -- the behavior of different API importing operations. The following shows
    -- operation-specific parameters and their supported values.
    --
    -- To exclude DocumentationParts from the import, set @parameters@ as
    -- @ignore=documentation@.
    --
    -- To configure the endpoint type, set @parameters@ as
    -- @endpointConfigurationTypes=EDGE@,
    -- @endpointConfigurationTypes=REGIONAL@, or
    -- @endpointConfigurationTypes=PRIVATE@. The default endpoint type is
    -- @EDGE@.
    --
    -- To handle imported @basepath@, set @parameters@ as @basepath=ignore@,
    -- @basepath=prepend@ or @basepath=split@.
    --
    -- For example, the AWS CLI command to exclude documentation from the
    -- imported API is:
    --
    -- The AWS CLI command to set the regional endpoint on the imported API is:
    ImportRestApi -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The POST 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.
    ImportRestApi -> ByteString
body :: Prelude.ByteString
  }
  deriving (ImportRestApi -> ImportRestApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportRestApi -> ImportRestApi -> Bool
$c/= :: ImportRestApi -> ImportRestApi -> Bool
== :: ImportRestApi -> ImportRestApi -> Bool
$c== :: ImportRestApi -> ImportRestApi -> Bool
Prelude.Eq, Int -> ImportRestApi -> ShowS
[ImportRestApi] -> ShowS
ImportRestApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportRestApi] -> ShowS
$cshowList :: [ImportRestApi] -> ShowS
show :: ImportRestApi -> String
$cshow :: ImportRestApi -> String
showsPrec :: Int -> ImportRestApi -> ShowS
$cshowsPrec :: Int -> ImportRestApi -> ShowS
Prelude.Show, forall x. Rep ImportRestApi x -> ImportRestApi
forall x. ImportRestApi -> Rep ImportRestApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportRestApi x -> ImportRestApi
$cfrom :: forall x. ImportRestApi -> Rep ImportRestApi x
Prelude.Generic)

-- |
-- Create a value of 'ImportRestApi' 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', 'importRestApi_failOnWarnings' - A query parameter to indicate whether to rollback the API creation
-- (@true@) or not (@false@) when a warning is encountered. The default
-- value is @false@.
--
-- 'parameters', 'importRestApi_parameters' - A key-value map of context-specific query string parameters specifying
-- the behavior of different API importing operations. The following shows
-- operation-specific parameters and their supported values.
--
-- To exclude DocumentationParts from the import, set @parameters@ as
-- @ignore=documentation@.
--
-- To configure the endpoint type, set @parameters@ as
-- @endpointConfigurationTypes=EDGE@,
-- @endpointConfigurationTypes=REGIONAL@, or
-- @endpointConfigurationTypes=PRIVATE@. The default endpoint type is
-- @EDGE@.
--
-- To handle imported @basepath@, set @parameters@ as @basepath=ignore@,
-- @basepath=prepend@ or @basepath=split@.
--
-- For example, the AWS CLI command to exclude documentation from the
-- imported API is:
--
-- The AWS CLI command to set the regional endpoint on the imported API is:
--
-- 'body', 'importRestApi_body' - The POST 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.
newImportRestApi ::
  -- | 'body'
  Prelude.ByteString ->
  ImportRestApi
newImportRestApi :: ByteString -> ImportRestApi
newImportRestApi ByteString
pBody_ =
  ImportRestApi'
    { $sel:failOnWarnings:ImportRestApi' :: Maybe Bool
failOnWarnings = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:ImportRestApi' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:body:ImportRestApi' :: ByteString
body = ByteString
pBody_
    }

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

-- | A key-value map of context-specific query string parameters specifying
-- the behavior of different API importing operations. The following shows
-- operation-specific parameters and their supported values.
--
-- To exclude DocumentationParts from the import, set @parameters@ as
-- @ignore=documentation@.
--
-- To configure the endpoint type, set @parameters@ as
-- @endpointConfigurationTypes=EDGE@,
-- @endpointConfigurationTypes=REGIONAL@, or
-- @endpointConfigurationTypes=PRIVATE@. The default endpoint type is
-- @EDGE@.
--
-- To handle imported @basepath@, set @parameters@ as @basepath=ignore@,
-- @basepath=prepend@ or @basepath=split@.
--
-- For example, the AWS CLI command to exclude documentation from the
-- imported API is:
--
-- The AWS CLI command to set the regional endpoint on the imported API is:
importRestApi_parameters :: Lens.Lens' ImportRestApi (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
importRestApi_parameters :: Lens' ImportRestApi (Maybe (HashMap Text Text))
importRestApi_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportRestApi' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:ImportRestApi' :: ImportRestApi -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: ImportRestApi
s@ImportRestApi' {} Maybe (HashMap Text Text)
a -> ImportRestApi
s {$sel:parameters:ImportRestApi' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: ImportRestApi) 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 POST 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.
importRestApi_body :: Lens.Lens' ImportRestApi Prelude.ByteString
importRestApi_body :: Lens' ImportRestApi ByteString
importRestApi_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportRestApi' {ByteString
body :: ByteString
$sel:body:ImportRestApi' :: ImportRestApi -> ByteString
body} -> ByteString
body) (\s :: ImportRestApi
s@ImportRestApi' {} ByteString
a -> ImportRestApi
s {$sel:body:ImportRestApi' :: ByteString
body = ByteString
a} :: ImportRestApi)

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

instance Prelude.NFData ImportRestApi where
  rnf :: ImportRestApi -> ()
rnf ImportRestApi' {Maybe Bool
Maybe (HashMap Text Text)
ByteString
body :: ByteString
parameters :: Maybe (HashMap Text Text)
failOnWarnings :: Maybe Bool
$sel:body:ImportRestApi' :: ImportRestApi -> ByteString
$sel:parameters:ImportRestApi' :: ImportRestApi -> Maybe (HashMap Text Text)
$sel:failOnWarnings:ImportRestApi' :: ImportRestApi -> 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 (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ByteString
body

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

instance Data.ToHeaders ImportRestApi where
  toHeaders :: ImportRestApi -> 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 ImportRestApi where
  toPath :: ImportRestApi -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/restapis"

instance Data.ToQuery ImportRestApi where
  toQuery :: ImportRestApi -> QueryString
toQuery ImportRestApi' {Maybe Bool
Maybe (HashMap Text Text)
ByteString
body :: ByteString
parameters :: Maybe (HashMap Text Text)
failOnWarnings :: Maybe Bool
$sel:body:ImportRestApi' :: ImportRestApi -> ByteString
$sel:parameters:ImportRestApi' :: ImportRestApi -> Maybe (HashMap Text Text)
$sel:failOnWarnings:ImportRestApi' :: ImportRestApi -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"failonwarnings" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
failOnWarnings,
        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
            ),
        QueryString
"mode=import"
      ]