{-# 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.ListImports
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists completed imports within the past 90 days.
module Amazonka.DynamoDB.ListImports
  ( -- * Creating a Request
    ListImports (..),
    newListImports,

    -- * Request Lenses
    listImports_nextToken,
    listImports_pageSize,
    listImports_tableArn,

    -- * Destructuring the Response
    ListImportsResponse (..),
    newListImportsResponse,

    -- * Response Lenses
    listImportsResponse_importSummaryList,
    listImportsResponse_nextToken,
    listImportsResponse_httpStatus,
  )
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:/ 'newListImports' smart constructor.
data ListImports = ListImports'
  { -- | An optional string that, if supplied, must be copied from the output of
    -- a previous call to @ListImports@. When provided in this manner, the API
    -- fetches the next page of results.
    ListImports -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The number of @ImportSummary @objects returned in a single page.
    ListImports -> Maybe Natural
pageSize :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) associated with the table that was
    -- imported to.
    ListImports -> Maybe Text
tableArn :: Prelude.Maybe Prelude.Text
  }
  deriving (ListImports -> ListImports -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImports -> ListImports -> Bool
$c/= :: ListImports -> ListImports -> Bool
== :: ListImports -> ListImports -> Bool
$c== :: ListImports -> ListImports -> Bool
Prelude.Eq, ReadPrec [ListImports]
ReadPrec ListImports
Int -> ReadS ListImports
ReadS [ListImports]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImports]
$creadListPrec :: ReadPrec [ListImports]
readPrec :: ReadPrec ListImports
$creadPrec :: ReadPrec ListImports
readList :: ReadS [ListImports]
$creadList :: ReadS [ListImports]
readsPrec :: Int -> ReadS ListImports
$creadsPrec :: Int -> ReadS ListImports
Prelude.Read, Int -> ListImports -> ShowS
[ListImports] -> ShowS
ListImports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImports] -> ShowS
$cshowList :: [ListImports] -> ShowS
show :: ListImports -> String
$cshow :: ListImports -> String
showsPrec :: Int -> ListImports -> ShowS
$cshowsPrec :: Int -> ListImports -> ShowS
Prelude.Show, forall x. Rep ListImports x -> ListImports
forall x. ListImports -> Rep ListImports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImports x -> ListImports
$cfrom :: forall x. ListImports -> Rep ListImports x
Prelude.Generic)

-- |
-- Create a value of 'ListImports' 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:
--
-- 'nextToken', 'listImports_nextToken' - An optional string that, if supplied, must be copied from the output of
-- a previous call to @ListImports@. When provided in this manner, the API
-- fetches the next page of results.
--
-- 'pageSize', 'listImports_pageSize' - The number of @ImportSummary @objects returned in a single page.
--
-- 'tableArn', 'listImports_tableArn' - The Amazon Resource Name (ARN) associated with the table that was
-- imported to.
newListImports ::
  ListImports
newListImports :: ListImports
newListImports =
  ListImports'
    { $sel:nextToken:ListImports' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListImports' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:tableArn:ListImports' :: Maybe Text
tableArn = forall a. Maybe a
Prelude.Nothing
    }

-- | An optional string that, if supplied, must be copied from the output of
-- a previous call to @ListImports@. When provided in this manner, the API
-- fetches the next page of results.
listImports_nextToken :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_nextToken :: Lens' ListImports (Maybe Text)
listImports_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:nextToken:ListImports' :: Maybe Text
nextToken = Maybe Text
a} :: ListImports)

-- | The number of @ImportSummary @objects returned in a single page.
listImports_pageSize :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Natural)
listImports_pageSize :: Lens' ListImports (Maybe Natural)
listImports_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Natural
pageSize :: Maybe Natural
$sel:pageSize:ListImports' :: ListImports -> Maybe Natural
pageSize} -> Maybe Natural
pageSize) (\s :: ListImports
s@ListImports' {} Maybe Natural
a -> ListImports
s {$sel:pageSize:ListImports' :: Maybe Natural
pageSize = Maybe Natural
a} :: ListImports)

-- | The Amazon Resource Name (ARN) associated with the table that was
-- imported to.
listImports_tableArn :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_tableArn :: Lens' ListImports (Maybe Text)
listImports_tableArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
tableArn :: Maybe Text
$sel:tableArn:ListImports' :: ListImports -> Maybe Text
tableArn} -> Maybe Text
tableArn) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:tableArn:ListImports' :: Maybe Text
tableArn = Maybe Text
a} :: ListImports)

instance Core.AWSRequest ListImports where
  type AWSResponse ListImports = ListImportsResponse
  request :: (Service -> Service) -> ListImports -> Request ListImports
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 ListImports
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListImports)))
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 [ImportSummary] -> Maybe Text -> Int -> ListImportsResponse
ListImportsResponse'
            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
"ImportSummaryList"
                            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
"NextToken")
            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 ListImports where
  hashWithSalt :: Int -> ListImports -> Int
hashWithSalt Int
_salt ListImports' {Maybe Natural
Maybe Text
tableArn :: Maybe Text
pageSize :: Maybe Natural
nextToken :: Maybe Text
$sel:tableArn:ListImports' :: ListImports -> Maybe Text
$sel:pageSize:ListImports' :: ListImports -> Maybe Natural
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableArn

instance Prelude.NFData ListImports where
  rnf :: ListImports -> ()
rnf ListImports' {Maybe Natural
Maybe Text
tableArn :: Maybe Text
pageSize :: Maybe Natural
nextToken :: Maybe Text
$sel:tableArn:ListImports' :: ListImports -> Maybe Text
$sel:pageSize:ListImports' :: ListImports -> Maybe Natural
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableArn

instance Data.ToHeaders ListImports where
  toHeaders :: ListImports -> 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.ListImports" ::
                          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 ListImports where
  toJSON :: ListImports -> Value
toJSON ListImports' {Maybe Natural
Maybe Text
tableArn :: Maybe Text
pageSize :: Maybe Natural
nextToken :: Maybe Text
$sel:tableArn:ListImports' :: ListImports -> Maybe Text
$sel:pageSize:ListImports' :: ListImports -> Maybe Natural
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"NextToken" 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
nextToken,
            (Key
"PageSize" 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 Natural
pageSize,
            (Key
"TableArn" 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
tableArn
          ]
      )

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

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

-- | /See:/ 'newListImportsResponse' smart constructor.
data ListImportsResponse = ListImportsResponse'
  { -- | A list of @ImportSummary@ objects.
    ListImportsResponse -> Maybe [ImportSummary]
importSummaryList :: Prelude.Maybe [ImportSummary],
    -- | If this value is returned, there are additional results to be displayed.
    -- To retrieve them, call @ListImports@ again, with @NextToken@ set to this
    -- value.
    ListImportsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListImportsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListImportsResponse -> ListImportsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportsResponse -> ListImportsResponse -> Bool
$c/= :: ListImportsResponse -> ListImportsResponse -> Bool
== :: ListImportsResponse -> ListImportsResponse -> Bool
$c== :: ListImportsResponse -> ListImportsResponse -> Bool
Prelude.Eq, ReadPrec [ListImportsResponse]
ReadPrec ListImportsResponse
Int -> ReadS ListImportsResponse
ReadS [ListImportsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportsResponse]
$creadListPrec :: ReadPrec [ListImportsResponse]
readPrec :: ReadPrec ListImportsResponse
$creadPrec :: ReadPrec ListImportsResponse
readList :: ReadS [ListImportsResponse]
$creadList :: ReadS [ListImportsResponse]
readsPrec :: Int -> ReadS ListImportsResponse
$creadsPrec :: Int -> ReadS ListImportsResponse
Prelude.Read, Int -> ListImportsResponse -> ShowS
[ListImportsResponse] -> ShowS
ListImportsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportsResponse] -> ShowS
$cshowList :: [ListImportsResponse] -> ShowS
show :: ListImportsResponse -> String
$cshow :: ListImportsResponse -> String
showsPrec :: Int -> ListImportsResponse -> ShowS
$cshowsPrec :: Int -> ListImportsResponse -> ShowS
Prelude.Show, forall x. Rep ListImportsResponse x -> ListImportsResponse
forall x. ListImportsResponse -> Rep ListImportsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImportsResponse x -> ListImportsResponse
$cfrom :: forall x. ListImportsResponse -> Rep ListImportsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListImportsResponse' 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:
--
-- 'importSummaryList', 'listImportsResponse_importSummaryList' - A list of @ImportSummary@ objects.
--
-- 'nextToken', 'listImportsResponse_nextToken' - If this value is returned, there are additional results to be displayed.
-- To retrieve them, call @ListImports@ again, with @NextToken@ set to this
-- value.
--
-- 'httpStatus', 'listImportsResponse_httpStatus' - The response's http status code.
newListImportsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImportsResponse
newListImportsResponse :: Int -> ListImportsResponse
newListImportsResponse Int
pHttpStatus_ =
  ListImportsResponse'
    { $sel:importSummaryList:ListImportsResponse' :: Maybe [ImportSummary]
importSummaryList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListImportsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @ImportSummary@ objects.
listImportsResponse_importSummaryList :: Lens.Lens' ListImportsResponse (Prelude.Maybe [ImportSummary])
listImportsResponse_importSummaryList :: Lens' ListImportsResponse (Maybe [ImportSummary])
listImportsResponse_importSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe [ImportSummary]
importSummaryList :: Maybe [ImportSummary]
$sel:importSummaryList:ListImportsResponse' :: ListImportsResponse -> Maybe [ImportSummary]
importSummaryList} -> Maybe [ImportSummary]
importSummaryList) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe [ImportSummary]
a -> ListImportsResponse
s {$sel:importSummaryList:ListImportsResponse' :: Maybe [ImportSummary]
importSummaryList = Maybe [ImportSummary]
a} :: ListImportsResponse) 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

-- | If this value is returned, there are additional results to be displayed.
-- To retrieve them, call @ListImports@ again, with @NextToken@ set to this
-- value.
listImportsResponse_nextToken :: Lens.Lens' ListImportsResponse (Prelude.Maybe Prelude.Text)
listImportsResponse_nextToken :: Lens' ListImportsResponse (Maybe Text)
listImportsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportsResponse' :: ListImportsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe Text
a -> ListImportsResponse
s {$sel:nextToken:ListImportsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportsResponse)

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

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