{-# 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.ImportApiKeys
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Import API keys from an external source, such as a CSV-formatted file.
module Amazonka.APIGateway.ImportApiKeys
  ( -- * Creating a Request
    ImportApiKeys (..),
    newImportApiKeys,

    -- * Request Lenses
    importApiKeys_failOnWarnings,
    importApiKeys_body,
    importApiKeys_format,

    -- * Destructuring the Response
    ImportApiKeysResponse (..),
    newImportApiKeysResponse,

    -- * Response Lenses
    importApiKeysResponse_ids,
    importApiKeysResponse_warnings,
    importApiKeysResponse_httpStatus,
  )
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 import API keys from an external source, such as a
-- CSV-formatted file.
--
-- /See:/ 'newImportApiKeys' smart constructor.
data ImportApiKeys = ImportApiKeys'
  { -- | A query parameter to indicate whether to rollback ApiKey importation
    -- (@true@) or not (@false@) when error is encountered.
    ImportApiKeys -> Maybe Bool
failOnWarnings :: Prelude.Maybe Prelude.Bool,
    -- | The payload of the POST request to import API keys. For the payload
    -- format, see API Key File Format.
    ImportApiKeys -> ByteString
body :: Prelude.ByteString,
    -- | A query parameter to specify the input format to imported API keys.
    -- Currently, only the @csv@ format is supported.
    ImportApiKeys -> ApiKeysFormat
format :: ApiKeysFormat
  }
  deriving (ImportApiKeys -> ImportApiKeys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportApiKeys -> ImportApiKeys -> Bool
$c/= :: ImportApiKeys -> ImportApiKeys -> Bool
== :: ImportApiKeys -> ImportApiKeys -> Bool
$c== :: ImportApiKeys -> ImportApiKeys -> Bool
Prelude.Eq, Int -> ImportApiKeys -> ShowS
[ImportApiKeys] -> ShowS
ImportApiKeys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportApiKeys] -> ShowS
$cshowList :: [ImportApiKeys] -> ShowS
show :: ImportApiKeys -> String
$cshow :: ImportApiKeys -> String
showsPrec :: Int -> ImportApiKeys -> ShowS
$cshowsPrec :: Int -> ImportApiKeys -> ShowS
Prelude.Show, forall x. Rep ImportApiKeys x -> ImportApiKeys
forall x. ImportApiKeys -> Rep ImportApiKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportApiKeys x -> ImportApiKeys
$cfrom :: forall x. ImportApiKeys -> Rep ImportApiKeys x
Prelude.Generic)

-- |
-- Create a value of 'ImportApiKeys' 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', 'importApiKeys_failOnWarnings' - A query parameter to indicate whether to rollback ApiKey importation
-- (@true@) or not (@false@) when error is encountered.
--
-- 'body', 'importApiKeys_body' - The payload of the POST request to import API keys. For the payload
-- format, see API Key File Format.
--
-- 'format', 'importApiKeys_format' - A query parameter to specify the input format to imported API keys.
-- Currently, only the @csv@ format is supported.
newImportApiKeys ::
  -- | 'body'
  Prelude.ByteString ->
  -- | 'format'
  ApiKeysFormat ->
  ImportApiKeys
newImportApiKeys :: ByteString -> ApiKeysFormat -> ImportApiKeys
newImportApiKeys ByteString
pBody_ ApiKeysFormat
pFormat_ =
  ImportApiKeys'
    { $sel:failOnWarnings:ImportApiKeys' :: Maybe Bool
failOnWarnings = forall a. Maybe a
Prelude.Nothing,
      $sel:body:ImportApiKeys' :: ByteString
body = ByteString
pBody_,
      $sel:format:ImportApiKeys' :: ApiKeysFormat
format = ApiKeysFormat
pFormat_
    }

-- | A query parameter to indicate whether to rollback ApiKey importation
-- (@true@) or not (@false@) when error is encountered.
importApiKeys_failOnWarnings :: Lens.Lens' ImportApiKeys (Prelude.Maybe Prelude.Bool)
importApiKeys_failOnWarnings :: Lens' ImportApiKeys (Maybe Bool)
importApiKeys_failOnWarnings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeys' {Maybe Bool
failOnWarnings :: Maybe Bool
$sel:failOnWarnings:ImportApiKeys' :: ImportApiKeys -> Maybe Bool
failOnWarnings} -> Maybe Bool
failOnWarnings) (\s :: ImportApiKeys
s@ImportApiKeys' {} Maybe Bool
a -> ImportApiKeys
s {$sel:failOnWarnings:ImportApiKeys' :: Maybe Bool
failOnWarnings = Maybe Bool
a} :: ImportApiKeys)

-- | The payload of the POST request to import API keys. For the payload
-- format, see API Key File Format.
importApiKeys_body :: Lens.Lens' ImportApiKeys Prelude.ByteString
importApiKeys_body :: Lens' ImportApiKeys ByteString
importApiKeys_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeys' {ByteString
body :: ByteString
$sel:body:ImportApiKeys' :: ImportApiKeys -> ByteString
body} -> ByteString
body) (\s :: ImportApiKeys
s@ImportApiKeys' {} ByteString
a -> ImportApiKeys
s {$sel:body:ImportApiKeys' :: ByteString
body = ByteString
a} :: ImportApiKeys)

-- | A query parameter to specify the input format to imported API keys.
-- Currently, only the @csv@ format is supported.
importApiKeys_format :: Lens.Lens' ImportApiKeys ApiKeysFormat
importApiKeys_format :: Lens' ImportApiKeys ApiKeysFormat
importApiKeys_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeys' {ApiKeysFormat
format :: ApiKeysFormat
$sel:format:ImportApiKeys' :: ImportApiKeys -> ApiKeysFormat
format} -> ApiKeysFormat
format) (\s :: ImportApiKeys
s@ImportApiKeys' {} ApiKeysFormat
a -> ImportApiKeys
s {$sel:format:ImportApiKeys' :: ApiKeysFormat
format = ApiKeysFormat
a} :: ImportApiKeys)

instance Core.AWSRequest ImportApiKeys where
  type
    AWSResponse ImportApiKeys =
      ImportApiKeysResponse
  request :: (Service -> Service) -> ImportApiKeys -> Request ImportApiKeys
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 ImportApiKeys
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportApiKeys)))
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 ->
          Maybe [Text] -> Maybe [Text] -> Int -> ImportApiKeysResponse
ImportApiKeysResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ids" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"warnings" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ImportApiKeys where
  hashWithSalt :: Int -> ImportApiKeys -> Int
hashWithSalt Int
_salt ImportApiKeys' {Maybe Bool
ByteString
ApiKeysFormat
format :: ApiKeysFormat
body :: ByteString
failOnWarnings :: Maybe Bool
$sel:format:ImportApiKeys' :: ImportApiKeys -> ApiKeysFormat
$sel:body:ImportApiKeys' :: ImportApiKeys -> ByteString
$sel:failOnWarnings:ImportApiKeys' :: ImportApiKeys -> 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` ByteString
body
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApiKeysFormat
format

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

instance Data.ToBody ImportApiKeys where
  toBody :: ImportApiKeys -> RequestBody
toBody ImportApiKeys' {Maybe Bool
ByteString
ApiKeysFormat
format :: ApiKeysFormat
body :: ByteString
failOnWarnings :: Maybe Bool
$sel:format:ImportApiKeys' :: ImportApiKeys -> ApiKeysFormat
$sel:body:ImportApiKeys' :: ImportApiKeys -> ByteString
$sel:failOnWarnings:ImportApiKeys' :: ImportApiKeys -> Maybe Bool
..} = forall a. ToBody a => a -> RequestBody
Data.toBody ByteString
body

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

instance Data.ToQuery ImportApiKeys where
  toQuery :: ImportApiKeys -> QueryString
toQuery ImportApiKeys' {Maybe Bool
ByteString
ApiKeysFormat
format :: ApiKeysFormat
body :: ByteString
failOnWarnings :: Maybe Bool
$sel:format:ImportApiKeys' :: ImportApiKeys -> ApiKeysFormat
$sel:body:ImportApiKeys' :: ImportApiKeys -> ByteString
$sel:failOnWarnings:ImportApiKeys' :: ImportApiKeys -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"failonwarnings" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
failOnWarnings,
        ByteString
"format" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ApiKeysFormat
format,
        QueryString
"mode=import"
      ]

-- | The identifier of an ApiKey used in a UsagePlan.
--
-- /See:/ 'newImportApiKeysResponse' smart constructor.
data ImportApiKeysResponse = ImportApiKeysResponse'
  { -- | A list of all the ApiKey identifiers.
    ImportApiKeysResponse -> Maybe [Text]
ids :: Prelude.Maybe [Prelude.Text],
    -- | A list of warning messages.
    ImportApiKeysResponse -> Maybe [Text]
warnings :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ImportApiKeysResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportApiKeysResponse -> ImportApiKeysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportApiKeysResponse -> ImportApiKeysResponse -> Bool
$c/= :: ImportApiKeysResponse -> ImportApiKeysResponse -> Bool
== :: ImportApiKeysResponse -> ImportApiKeysResponse -> Bool
$c== :: ImportApiKeysResponse -> ImportApiKeysResponse -> Bool
Prelude.Eq, ReadPrec [ImportApiKeysResponse]
ReadPrec ImportApiKeysResponse
Int -> ReadS ImportApiKeysResponse
ReadS [ImportApiKeysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportApiKeysResponse]
$creadListPrec :: ReadPrec [ImportApiKeysResponse]
readPrec :: ReadPrec ImportApiKeysResponse
$creadPrec :: ReadPrec ImportApiKeysResponse
readList :: ReadS [ImportApiKeysResponse]
$creadList :: ReadS [ImportApiKeysResponse]
readsPrec :: Int -> ReadS ImportApiKeysResponse
$creadsPrec :: Int -> ReadS ImportApiKeysResponse
Prelude.Read, Int -> ImportApiKeysResponse -> ShowS
[ImportApiKeysResponse] -> ShowS
ImportApiKeysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportApiKeysResponse] -> ShowS
$cshowList :: [ImportApiKeysResponse] -> ShowS
show :: ImportApiKeysResponse -> String
$cshow :: ImportApiKeysResponse -> String
showsPrec :: Int -> ImportApiKeysResponse -> ShowS
$cshowsPrec :: Int -> ImportApiKeysResponse -> ShowS
Prelude.Show, forall x. Rep ImportApiKeysResponse x -> ImportApiKeysResponse
forall x. ImportApiKeysResponse -> Rep ImportApiKeysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportApiKeysResponse x -> ImportApiKeysResponse
$cfrom :: forall x. ImportApiKeysResponse -> Rep ImportApiKeysResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportApiKeysResponse' 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:
--
-- 'ids', 'importApiKeysResponse_ids' - A list of all the ApiKey identifiers.
--
-- 'warnings', 'importApiKeysResponse_warnings' - A list of warning messages.
--
-- 'httpStatus', 'importApiKeysResponse_httpStatus' - The response's http status code.
newImportApiKeysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportApiKeysResponse
newImportApiKeysResponse :: Int -> ImportApiKeysResponse
newImportApiKeysResponse Int
pHttpStatus_ =
  ImportApiKeysResponse'
    { $sel:ids:ImportApiKeysResponse' :: Maybe [Text]
ids = forall a. Maybe a
Prelude.Nothing,
      $sel:warnings:ImportApiKeysResponse' :: Maybe [Text]
warnings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportApiKeysResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of all the ApiKey identifiers.
importApiKeysResponse_ids :: Lens.Lens' ImportApiKeysResponse (Prelude.Maybe [Prelude.Text])
importApiKeysResponse_ids :: Lens' ImportApiKeysResponse (Maybe [Text])
importApiKeysResponse_ids = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeysResponse' {Maybe [Text]
ids :: Maybe [Text]
$sel:ids:ImportApiKeysResponse' :: ImportApiKeysResponse -> Maybe [Text]
ids} -> Maybe [Text]
ids) (\s :: ImportApiKeysResponse
s@ImportApiKeysResponse' {} Maybe [Text]
a -> ImportApiKeysResponse
s {$sel:ids:ImportApiKeysResponse' :: Maybe [Text]
ids = Maybe [Text]
a} :: ImportApiKeysResponse) 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 list of warning messages.
importApiKeysResponse_warnings :: Lens.Lens' ImportApiKeysResponse (Prelude.Maybe [Prelude.Text])
importApiKeysResponse_warnings :: Lens' ImportApiKeysResponse (Maybe [Text])
importApiKeysResponse_warnings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeysResponse' {Maybe [Text]
warnings :: Maybe [Text]
$sel:warnings:ImportApiKeysResponse' :: ImportApiKeysResponse -> Maybe [Text]
warnings} -> Maybe [Text]
warnings) (\s :: ImportApiKeysResponse
s@ImportApiKeysResponse' {} Maybe [Text]
a -> ImportApiKeysResponse
s {$sel:warnings:ImportApiKeysResponse' :: Maybe [Text]
warnings = Maybe [Text]
a} :: ImportApiKeysResponse) 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 response's http status code.
importApiKeysResponse_httpStatus :: Lens.Lens' ImportApiKeysResponse Prelude.Int
importApiKeysResponse_httpStatus :: Lens' ImportApiKeysResponse Int
importApiKeysResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportApiKeysResponse' {Int
httpStatus :: Int
$sel:httpStatus:ImportApiKeysResponse' :: ImportApiKeysResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ImportApiKeysResponse
s@ImportApiKeysResponse' {} Int
a -> ImportApiKeysResponse
s {$sel:httpStatus:ImportApiKeysResponse' :: Int
httpStatus = Int
a} :: ImportApiKeysResponse)

instance Prelude.NFData ImportApiKeysResponse where
  rnf :: ImportApiKeysResponse -> ()
rnf ImportApiKeysResponse' {Int
Maybe [Text]
httpStatus :: Int
warnings :: Maybe [Text]
ids :: Maybe [Text]
$sel:httpStatus:ImportApiKeysResponse' :: ImportApiKeysResponse -> Int
$sel:warnings:ImportApiKeysResponse' :: ImportApiKeysResponse -> Maybe [Text]
$sel:ids:ImportApiKeysResponse' :: ImportApiKeysResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
ids
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
warnings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus