{-# 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.DynamoDB.ImportTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports table data from an S3 bucket.
module Amazonka.DynamoDB.ImportTable
  ( -- * Creating a Request
    ImportTable (..),
    newImportTable,

    -- * Request Lenses
    importTable_clientToken,
    importTable_inputCompressionType,
    importTable_inputFormatOptions,
    importTable_s3BucketSource,
    importTable_inputFormat,
    importTable_tableCreationParameters,

    -- * Destructuring the Response
    ImportTableResponse (..),
    newImportTableResponse,

    -- * Response Lenses
    importTableResponse_httpStatus,
    importTableResponse_importTableDescription,
  )
where

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

-- | /See:/ 'newImportTable' smart constructor.
data ImportTable = ImportTable'
  { -- | Providing a @ClientToken@ makes the call to @ImportTableInput@
    -- idempotent, meaning that multiple identical calls have the same effect
    -- as one single call.
    --
    -- A client token is valid for 8 hours after the first request that uses it
    -- is completed. After 8 hours, any request with the same client token is
    -- treated as a new request. Do not resubmit the same request with the same
    -- client token for more than 8 hours, or the result might not be
    -- idempotent.
    --
    -- If you submit a request with the same client token but a change in other
    -- parameters within the 8-hour idempotency window, DynamoDB returns an
    -- @IdempotentParameterMismatch@ exception.
    ImportTable -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Type of compression to be used on the input coming from the imported
    -- table.
    ImportTable -> Maybe InputCompressionType
inputCompressionType :: Prelude.Maybe InputCompressionType,
    -- | Additional properties that specify how the input is formatted,
    ImportTable -> Maybe InputFormatOptions
inputFormatOptions :: Prelude.Maybe InputFormatOptions,
    -- | The S3 bucket that provides the source for the import.
    ImportTable -> S3BucketSource
s3BucketSource :: S3BucketSource,
    -- | The format of the source data. Valid values for @ImportFormat@ are
    -- @CSV@, @DYNAMODB_JSON@ or @ION@.
    ImportTable -> InputFormat
inputFormat :: InputFormat,
    -- | Parameters for the table to import the data into.
    ImportTable -> TableCreationParameters
tableCreationParameters :: TableCreationParameters
  }
  deriving (ImportTable -> ImportTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportTable -> ImportTable -> Bool
$c/= :: ImportTable -> ImportTable -> Bool
== :: ImportTable -> ImportTable -> Bool
$c== :: ImportTable -> ImportTable -> Bool
Prelude.Eq, ReadPrec [ImportTable]
ReadPrec ImportTable
Int -> ReadS ImportTable
ReadS [ImportTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportTable]
$creadListPrec :: ReadPrec [ImportTable]
readPrec :: ReadPrec ImportTable
$creadPrec :: ReadPrec ImportTable
readList :: ReadS [ImportTable]
$creadList :: ReadS [ImportTable]
readsPrec :: Int -> ReadS ImportTable
$creadsPrec :: Int -> ReadS ImportTable
Prelude.Read, Int -> ImportTable -> ShowS
[ImportTable] -> ShowS
ImportTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportTable] -> ShowS
$cshowList :: [ImportTable] -> ShowS
show :: ImportTable -> String
$cshow :: ImportTable -> String
showsPrec :: Int -> ImportTable -> ShowS
$cshowsPrec :: Int -> ImportTable -> ShowS
Prelude.Show, forall x. Rep ImportTable x -> ImportTable
forall x. ImportTable -> Rep ImportTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportTable x -> ImportTable
$cfrom :: forall x. ImportTable -> Rep ImportTable x
Prelude.Generic)

-- |
-- Create a value of 'ImportTable' 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:
--
-- 'clientToken', 'importTable_clientToken' - Providing a @ClientToken@ makes the call to @ImportTableInput@
-- idempotent, meaning that multiple identical calls have the same effect
-- as one single call.
--
-- A client token is valid for 8 hours after the first request that uses it
-- is completed. After 8 hours, any request with the same client token is
-- treated as a new request. Do not resubmit the same request with the same
-- client token for more than 8 hours, or the result might not be
-- idempotent.
--
-- If you submit a request with the same client token but a change in other
-- parameters within the 8-hour idempotency window, DynamoDB returns an
-- @IdempotentParameterMismatch@ exception.
--
-- 'inputCompressionType', 'importTable_inputCompressionType' - Type of compression to be used on the input coming from the imported
-- table.
--
-- 'inputFormatOptions', 'importTable_inputFormatOptions' - Additional properties that specify how the input is formatted,
--
-- 's3BucketSource', 'importTable_s3BucketSource' - The S3 bucket that provides the source for the import.
--
-- 'inputFormat', 'importTable_inputFormat' - The format of the source data. Valid values for @ImportFormat@ are
-- @CSV@, @DYNAMODB_JSON@ or @ION@.
--
-- 'tableCreationParameters', 'importTable_tableCreationParameters' - Parameters for the table to import the data into.
newImportTable ::
  -- | 's3BucketSource'
  S3BucketSource ->
  -- | 'inputFormat'
  InputFormat ->
  -- | 'tableCreationParameters'
  TableCreationParameters ->
  ImportTable
newImportTable :: S3BucketSource
-> InputFormat -> TableCreationParameters -> ImportTable
newImportTable
  S3BucketSource
pS3BucketSource_
  InputFormat
pInputFormat_
  TableCreationParameters
pTableCreationParameters_ =
    ImportTable'
      { $sel:clientToken:ImportTable' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:inputCompressionType:ImportTable' :: Maybe InputCompressionType
inputCompressionType = forall a. Maybe a
Prelude.Nothing,
        $sel:inputFormatOptions:ImportTable' :: Maybe InputFormatOptions
inputFormatOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:s3BucketSource:ImportTable' :: S3BucketSource
s3BucketSource = S3BucketSource
pS3BucketSource_,
        $sel:inputFormat:ImportTable' :: InputFormat
inputFormat = InputFormat
pInputFormat_,
        $sel:tableCreationParameters:ImportTable' :: TableCreationParameters
tableCreationParameters = TableCreationParameters
pTableCreationParameters_
      }

-- | Providing a @ClientToken@ makes the call to @ImportTableInput@
-- idempotent, meaning that multiple identical calls have the same effect
-- as one single call.
--
-- A client token is valid for 8 hours after the first request that uses it
-- is completed. After 8 hours, any request with the same client token is
-- treated as a new request. Do not resubmit the same request with the same
-- client token for more than 8 hours, or the result might not be
-- idempotent.
--
-- If you submit a request with the same client token but a change in other
-- parameters within the 8-hour idempotency window, DynamoDB returns an
-- @IdempotentParameterMismatch@ exception.
importTable_clientToken :: Lens.Lens' ImportTable (Prelude.Maybe Prelude.Text)
importTable_clientToken :: Lens' ImportTable (Maybe Text)
importTable_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:ImportTable' :: ImportTable -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: ImportTable
s@ImportTable' {} Maybe Text
a -> ImportTable
s {$sel:clientToken:ImportTable' :: Maybe Text
clientToken = Maybe Text
a} :: ImportTable)

-- | Type of compression to be used on the input coming from the imported
-- table.
importTable_inputCompressionType :: Lens.Lens' ImportTable (Prelude.Maybe InputCompressionType)
importTable_inputCompressionType :: Lens' ImportTable (Maybe InputCompressionType)
importTable_inputCompressionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {Maybe InputCompressionType
inputCompressionType :: Maybe InputCompressionType
$sel:inputCompressionType:ImportTable' :: ImportTable -> Maybe InputCompressionType
inputCompressionType} -> Maybe InputCompressionType
inputCompressionType) (\s :: ImportTable
s@ImportTable' {} Maybe InputCompressionType
a -> ImportTable
s {$sel:inputCompressionType:ImportTable' :: Maybe InputCompressionType
inputCompressionType = Maybe InputCompressionType
a} :: ImportTable)

-- | Additional properties that specify how the input is formatted,
importTable_inputFormatOptions :: Lens.Lens' ImportTable (Prelude.Maybe InputFormatOptions)
importTable_inputFormatOptions :: Lens' ImportTable (Maybe InputFormatOptions)
importTable_inputFormatOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {Maybe InputFormatOptions
inputFormatOptions :: Maybe InputFormatOptions
$sel:inputFormatOptions:ImportTable' :: ImportTable -> Maybe InputFormatOptions
inputFormatOptions} -> Maybe InputFormatOptions
inputFormatOptions) (\s :: ImportTable
s@ImportTable' {} Maybe InputFormatOptions
a -> ImportTable
s {$sel:inputFormatOptions:ImportTable' :: Maybe InputFormatOptions
inputFormatOptions = Maybe InputFormatOptions
a} :: ImportTable)

-- | The S3 bucket that provides the source for the import.
importTable_s3BucketSource :: Lens.Lens' ImportTable S3BucketSource
importTable_s3BucketSource :: Lens' ImportTable S3BucketSource
importTable_s3BucketSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {S3BucketSource
s3BucketSource :: S3BucketSource
$sel:s3BucketSource:ImportTable' :: ImportTable -> S3BucketSource
s3BucketSource} -> S3BucketSource
s3BucketSource) (\s :: ImportTable
s@ImportTable' {} S3BucketSource
a -> ImportTable
s {$sel:s3BucketSource:ImportTable' :: S3BucketSource
s3BucketSource = S3BucketSource
a} :: ImportTable)

-- | The format of the source data. Valid values for @ImportFormat@ are
-- @CSV@, @DYNAMODB_JSON@ or @ION@.
importTable_inputFormat :: Lens.Lens' ImportTable InputFormat
importTable_inputFormat :: Lens' ImportTable InputFormat
importTable_inputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {InputFormat
inputFormat :: InputFormat
$sel:inputFormat:ImportTable' :: ImportTable -> InputFormat
inputFormat} -> InputFormat
inputFormat) (\s :: ImportTable
s@ImportTable' {} InputFormat
a -> ImportTable
s {$sel:inputFormat:ImportTable' :: InputFormat
inputFormat = InputFormat
a} :: ImportTable)

-- | Parameters for the table to import the data into.
importTable_tableCreationParameters :: Lens.Lens' ImportTable TableCreationParameters
importTable_tableCreationParameters :: Lens' ImportTable TableCreationParameters
importTable_tableCreationParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTable' {TableCreationParameters
tableCreationParameters :: TableCreationParameters
$sel:tableCreationParameters:ImportTable' :: ImportTable -> TableCreationParameters
tableCreationParameters} -> TableCreationParameters
tableCreationParameters) (\s :: ImportTable
s@ImportTable' {} TableCreationParameters
a -> ImportTable
s {$sel:tableCreationParameters:ImportTable' :: TableCreationParameters
tableCreationParameters = TableCreationParameters
a} :: ImportTable)

instance Core.AWSRequest ImportTable where
  type AWSResponse ImportTable = ImportTableResponse
  request :: (Service -> Service) -> ImportTable -> Request ImportTable
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 ImportTable
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportTable)))
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 ->
          Int -> ImportTableDescription -> ImportTableResponse
ImportTableResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ImportTableDescription")
      )

instance Prelude.Hashable ImportTable where
  hashWithSalt :: Int -> ImportTable -> Int
hashWithSalt Int
_salt ImportTable' {Maybe Text
Maybe InputCompressionType
Maybe InputFormatOptions
S3BucketSource
InputFormat
TableCreationParameters
tableCreationParameters :: TableCreationParameters
inputFormat :: InputFormat
s3BucketSource :: S3BucketSource
inputFormatOptions :: Maybe InputFormatOptions
inputCompressionType :: Maybe InputCompressionType
clientToken :: Maybe Text
$sel:tableCreationParameters:ImportTable' :: ImportTable -> TableCreationParameters
$sel:inputFormat:ImportTable' :: ImportTable -> InputFormat
$sel:s3BucketSource:ImportTable' :: ImportTable -> S3BucketSource
$sel:inputFormatOptions:ImportTable' :: ImportTable -> Maybe InputFormatOptions
$sel:inputCompressionType:ImportTable' :: ImportTable -> Maybe InputCompressionType
$sel:clientToken:ImportTable' :: ImportTable -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputCompressionType
inputCompressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputFormatOptions
inputFormatOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3BucketSource
s3BucketSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InputFormat
inputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TableCreationParameters
tableCreationParameters

instance Prelude.NFData ImportTable where
  rnf :: ImportTable -> ()
rnf ImportTable' {Maybe Text
Maybe InputCompressionType
Maybe InputFormatOptions
S3BucketSource
InputFormat
TableCreationParameters
tableCreationParameters :: TableCreationParameters
inputFormat :: InputFormat
s3BucketSource :: S3BucketSource
inputFormatOptions :: Maybe InputFormatOptions
inputCompressionType :: Maybe InputCompressionType
clientToken :: Maybe Text
$sel:tableCreationParameters:ImportTable' :: ImportTable -> TableCreationParameters
$sel:inputFormat:ImportTable' :: ImportTable -> InputFormat
$sel:s3BucketSource:ImportTable' :: ImportTable -> S3BucketSource
$sel:inputFormatOptions:ImportTable' :: ImportTable -> Maybe InputFormatOptions
$sel:inputCompressionType:ImportTable' :: ImportTable -> Maybe InputCompressionType
$sel:clientToken:ImportTable' :: ImportTable -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputCompressionType
inputCompressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputFormatOptions
inputFormatOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3BucketSource
s3BucketSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InputFormat
inputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TableCreationParameters
tableCreationParameters

instance Data.ToHeaders ImportTable where
  toHeaders :: ImportTable -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DynamoDB_20120810.ImportTable" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ImportTable where
  toJSON :: ImportTable -> Value
toJSON ImportTable' {Maybe Text
Maybe InputCompressionType
Maybe InputFormatOptions
S3BucketSource
InputFormat
TableCreationParameters
tableCreationParameters :: TableCreationParameters
inputFormat :: InputFormat
s3BucketSource :: S3BucketSource
inputFormatOptions :: Maybe InputFormatOptions
inputCompressionType :: Maybe InputCompressionType
clientToken :: Maybe Text
$sel:tableCreationParameters:ImportTable' :: ImportTable -> TableCreationParameters
$sel:inputFormat:ImportTable' :: ImportTable -> InputFormat
$sel:s3BucketSource:ImportTable' :: ImportTable -> S3BucketSource
$sel:inputFormatOptions:ImportTable' :: ImportTable -> Maybe InputFormatOptions
$sel:inputCompressionType:ImportTable' :: ImportTable -> Maybe InputCompressionType
$sel:clientToken:ImportTable' :: ImportTable -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"InputCompressionType" 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 InputCompressionType
inputCompressionType,
            (Key
"InputFormatOptions" 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 InputFormatOptions
inputFormatOptions,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"S3BucketSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3BucketSource
s3BucketSource),
            forall a. a -> Maybe a
Prelude.Just (Key
"InputFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InputFormat
inputFormat),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TableCreationParameters"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TableCreationParameters
tableCreationParameters
              )
          ]
      )

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

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

-- | /See:/ 'newImportTableResponse' smart constructor.
data ImportTableResponse = ImportTableResponse'
  { -- | The response's http status code.
    ImportTableResponse -> Int
httpStatus :: Prelude.Int,
    -- | Represents the properties of the table created for the import, and
    -- parameters of the import. The import parameters include import status,
    -- how many items were processed, and how many errors were encountered.
    ImportTableResponse -> ImportTableDescription
importTableDescription :: ImportTableDescription
  }
  deriving (ImportTableResponse -> ImportTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportTableResponse -> ImportTableResponse -> Bool
$c/= :: ImportTableResponse -> ImportTableResponse -> Bool
== :: ImportTableResponse -> ImportTableResponse -> Bool
$c== :: ImportTableResponse -> ImportTableResponse -> Bool
Prelude.Eq, ReadPrec [ImportTableResponse]
ReadPrec ImportTableResponse
Int -> ReadS ImportTableResponse
ReadS [ImportTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportTableResponse]
$creadListPrec :: ReadPrec [ImportTableResponse]
readPrec :: ReadPrec ImportTableResponse
$creadPrec :: ReadPrec ImportTableResponse
readList :: ReadS [ImportTableResponse]
$creadList :: ReadS [ImportTableResponse]
readsPrec :: Int -> ReadS ImportTableResponse
$creadsPrec :: Int -> ReadS ImportTableResponse
Prelude.Read, Int -> ImportTableResponse -> ShowS
[ImportTableResponse] -> ShowS
ImportTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportTableResponse] -> ShowS
$cshowList :: [ImportTableResponse] -> ShowS
show :: ImportTableResponse -> String
$cshow :: ImportTableResponse -> String
showsPrec :: Int -> ImportTableResponse -> ShowS
$cshowsPrec :: Int -> ImportTableResponse -> ShowS
Prelude.Show, forall x. Rep ImportTableResponse x -> ImportTableResponse
forall x. ImportTableResponse -> Rep ImportTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportTableResponse x -> ImportTableResponse
$cfrom :: forall x. ImportTableResponse -> Rep ImportTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportTableResponse' 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:
--
-- 'httpStatus', 'importTableResponse_httpStatus' - The response's http status code.
--
-- 'importTableDescription', 'importTableResponse_importTableDescription' - Represents the properties of the table created for the import, and
-- parameters of the import. The import parameters include import status,
-- how many items were processed, and how many errors were encountered.
newImportTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'importTableDescription'
  ImportTableDescription ->
  ImportTableResponse
newImportTableResponse :: Int -> ImportTableDescription -> ImportTableResponse
newImportTableResponse
  Int
pHttpStatus_
  ImportTableDescription
pImportTableDescription_ =
    ImportTableResponse'
      { $sel:httpStatus:ImportTableResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:importTableDescription:ImportTableResponse' :: ImportTableDescription
importTableDescription = ImportTableDescription
pImportTableDescription_
      }

-- | The response's http status code.
importTableResponse_httpStatus :: Lens.Lens' ImportTableResponse Prelude.Int
importTableResponse_httpStatus :: Lens' ImportTableResponse Int
importTableResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTableResponse' {Int
httpStatus :: Int
$sel:httpStatus:ImportTableResponse' :: ImportTableResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ImportTableResponse
s@ImportTableResponse' {} Int
a -> ImportTableResponse
s {$sel:httpStatus:ImportTableResponse' :: Int
httpStatus = Int
a} :: ImportTableResponse)

-- | Represents the properties of the table created for the import, and
-- parameters of the import. The import parameters include import status,
-- how many items were processed, and how many errors were encountered.
importTableResponse_importTableDescription :: Lens.Lens' ImportTableResponse ImportTableDescription
importTableResponse_importTableDescription :: Lens' ImportTableResponse ImportTableDescription
importTableResponse_importTableDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTableResponse' {ImportTableDescription
importTableDescription :: ImportTableDescription
$sel:importTableDescription:ImportTableResponse' :: ImportTableResponse -> ImportTableDescription
importTableDescription} -> ImportTableDescription
importTableDescription) (\s :: ImportTableResponse
s@ImportTableResponse' {} ImportTableDescription
a -> ImportTableResponse
s {$sel:importTableDescription:ImportTableResponse' :: ImportTableDescription
importTableDescription = ImportTableDescription
a} :: ImportTableResponse)

instance Prelude.NFData ImportTableResponse where
  rnf :: ImportTableResponse -> ()
rnf ImportTableResponse' {Int
ImportTableDescription
importTableDescription :: ImportTableDescription
httpStatus :: Int
$sel:importTableDescription:ImportTableResponse' :: ImportTableResponse -> ImportTableDescription
$sel:httpStatus:ImportTableResponse' :: ImportTableResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ImportTableDescription
importTableDescription