{-# 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.SESV2.ListContacts
-- 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 the contacts present in a specific contact list.
module Amazonka.SESV2.ListContacts
  ( -- * Creating a Request
    ListContacts (..),
    newListContacts,

    -- * Request Lenses
    listContacts_filter,
    listContacts_nextToken,
    listContacts_pageSize,
    listContacts_contactListName,

    -- * Destructuring the Response
    ListContactsResponse (..),
    newListContactsResponse,

    -- * Response Lenses
    listContactsResponse_contacts,
    listContactsResponse_nextToken,
    listContactsResponse_httpStatus,
  )
where

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
import Amazonka.SESV2.Types

-- | /See:/ 'newListContacts' smart constructor.
data ListContacts = ListContacts'
  { -- | A filter that can be applied to a list of contacts.
    ListContacts -> Maybe ListContactsFilter
filter' :: Prelude.Maybe ListContactsFilter,
    -- | A string token indicating that there might be additional contacts
    -- available to be listed. Use the token provided in the Response to use in
    -- the subsequent call to ListContacts with the same parameters to retrieve
    -- the next page of contacts.
    ListContacts -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The number of contacts that may be returned at once, which is dependent
    -- on if there are more or less contacts than the value of the PageSize.
    -- Use this parameter to paginate results. If additional contacts exist
    -- beyond the specified limit, the @NextToken@ element is sent in the
    -- response. Use the @NextToken@ value in subsequent requests to retrieve
    -- additional contacts.
    ListContacts -> Maybe Int
pageSize :: Prelude.Maybe Prelude.Int,
    -- | The name of the contact list.
    ListContacts -> Text
contactListName :: Prelude.Text
  }
  deriving (ListContacts -> ListContacts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContacts -> ListContacts -> Bool
$c/= :: ListContacts -> ListContacts -> Bool
== :: ListContacts -> ListContacts -> Bool
$c== :: ListContacts -> ListContacts -> Bool
Prelude.Eq, ReadPrec [ListContacts]
ReadPrec ListContacts
Int -> ReadS ListContacts
ReadS [ListContacts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContacts]
$creadListPrec :: ReadPrec [ListContacts]
readPrec :: ReadPrec ListContacts
$creadPrec :: ReadPrec ListContacts
readList :: ReadS [ListContacts]
$creadList :: ReadS [ListContacts]
readsPrec :: Int -> ReadS ListContacts
$creadsPrec :: Int -> ReadS ListContacts
Prelude.Read, Int -> ListContacts -> ShowS
[ListContacts] -> ShowS
ListContacts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContacts] -> ShowS
$cshowList :: [ListContacts] -> ShowS
show :: ListContacts -> String
$cshow :: ListContacts -> String
showsPrec :: Int -> ListContacts -> ShowS
$cshowsPrec :: Int -> ListContacts -> ShowS
Prelude.Show, forall x. Rep ListContacts x -> ListContacts
forall x. ListContacts -> Rep ListContacts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContacts x -> ListContacts
$cfrom :: forall x. ListContacts -> Rep ListContacts x
Prelude.Generic)

-- |
-- Create a value of 'ListContacts' 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:
--
-- 'filter'', 'listContacts_filter' - A filter that can be applied to a list of contacts.
--
-- 'nextToken', 'listContacts_nextToken' - A string token indicating that there might be additional contacts
-- available to be listed. Use the token provided in the Response to use in
-- the subsequent call to ListContacts with the same parameters to retrieve
-- the next page of contacts.
--
-- 'pageSize', 'listContacts_pageSize' - The number of contacts that may be returned at once, which is dependent
-- on if there are more or less contacts than the value of the PageSize.
-- Use this parameter to paginate results. If additional contacts exist
-- beyond the specified limit, the @NextToken@ element is sent in the
-- response. Use the @NextToken@ value in subsequent requests to retrieve
-- additional contacts.
--
-- 'contactListName', 'listContacts_contactListName' - The name of the contact list.
newListContacts ::
  -- | 'contactListName'
  Prelude.Text ->
  ListContacts
newListContacts :: Text -> ListContacts
newListContacts Text
pContactListName_ =
  ListContacts'
    { $sel:filter':ListContacts' :: Maybe ListContactsFilter
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContacts' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListContacts' :: Maybe Int
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:contactListName:ListContacts' :: Text
contactListName = Text
pContactListName_
    }

-- | A filter that can be applied to a list of contacts.
listContacts_filter :: Lens.Lens' ListContacts (Prelude.Maybe ListContactsFilter)
listContacts_filter :: Lens' ListContacts (Maybe ListContactsFilter)
listContacts_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe ListContactsFilter
filter' :: Maybe ListContactsFilter
$sel:filter':ListContacts' :: ListContacts -> Maybe ListContactsFilter
filter'} -> Maybe ListContactsFilter
filter') (\s :: ListContacts
s@ListContacts' {} Maybe ListContactsFilter
a -> ListContacts
s {$sel:filter':ListContacts' :: Maybe ListContactsFilter
filter' = Maybe ListContactsFilter
a} :: ListContacts)

-- | A string token indicating that there might be additional contacts
-- available to be listed. Use the token provided in the Response to use in
-- the subsequent call to ListContacts with the same parameters to retrieve
-- the next page of contacts.
listContacts_nextToken :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Text)
listContacts_nextToken :: Lens' ListContacts (Maybe Text)
listContacts_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContacts
s@ListContacts' {} Maybe Text
a -> ListContacts
s {$sel:nextToken:ListContacts' :: Maybe Text
nextToken = Maybe Text
a} :: ListContacts)

-- | The number of contacts that may be returned at once, which is dependent
-- on if there are more or less contacts than the value of the PageSize.
-- Use this parameter to paginate results. If additional contacts exist
-- beyond the specified limit, the @NextToken@ element is sent in the
-- response. Use the @NextToken@ value in subsequent requests to retrieve
-- additional contacts.
listContacts_pageSize :: Lens.Lens' ListContacts (Prelude.Maybe Prelude.Int)
listContacts_pageSize :: Lens' ListContacts (Maybe Int)
listContacts_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Maybe Int
pageSize :: Maybe Int
$sel:pageSize:ListContacts' :: ListContacts -> Maybe Int
pageSize} -> Maybe Int
pageSize) (\s :: ListContacts
s@ListContacts' {} Maybe Int
a -> ListContacts
s {$sel:pageSize:ListContacts' :: Maybe Int
pageSize = Maybe Int
a} :: ListContacts)

-- | The name of the contact list.
listContacts_contactListName :: Lens.Lens' ListContacts Prelude.Text
listContacts_contactListName :: Lens' ListContacts Text
listContacts_contactListName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContacts' {Text
contactListName :: Text
$sel:contactListName:ListContacts' :: ListContacts -> Text
contactListName} -> Text
contactListName) (\s :: ListContacts
s@ListContacts' {} Text
a -> ListContacts
s {$sel:contactListName:ListContacts' :: Text
contactListName = Text
a} :: ListContacts)

instance Core.AWSRequest ListContacts where
  type AWSResponse ListContacts = ListContactsResponse
  request :: (Service -> Service) -> ListContacts -> Request ListContacts
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListContacts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListContacts)))
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 [Contact] -> Maybe Text -> Int -> ListContactsResponse
ListContactsResponse'
            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
"Contacts" 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 ListContacts where
  hashWithSalt :: Int -> ListContacts -> Int
hashWithSalt Int
_salt ListContacts' {Maybe Int
Maybe Text
Maybe ListContactsFilter
Text
contactListName :: Text
pageSize :: Maybe Int
nextToken :: Maybe Text
filter' :: Maybe ListContactsFilter
$sel:contactListName:ListContacts' :: ListContacts -> Text
$sel:pageSize:ListContacts' :: ListContacts -> Maybe Int
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:filter':ListContacts' :: ListContacts -> Maybe ListContactsFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ListContactsFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactListName

instance Prelude.NFData ListContacts where
  rnf :: ListContacts -> ()
rnf ListContacts' {Maybe Int
Maybe Text
Maybe ListContactsFilter
Text
contactListName :: Text
pageSize :: Maybe Int
nextToken :: Maybe Text
filter' :: Maybe ListContactsFilter
$sel:contactListName:ListContacts' :: ListContacts -> Text
$sel:pageSize:ListContacts' :: ListContacts -> Maybe Int
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:filter':ListContacts' :: ListContacts -> Maybe ListContactsFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ListContactsFilter
filter'
      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 Maybe Int
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactListName

instance Data.ToHeaders ListContacts where
  toHeaders :: ListContacts -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath ListContacts where
  toPath :: ListContacts -> ByteString
toPath ListContacts' {Maybe Int
Maybe Text
Maybe ListContactsFilter
Text
contactListName :: Text
pageSize :: Maybe Int
nextToken :: Maybe Text
filter' :: Maybe ListContactsFilter
$sel:contactListName:ListContacts' :: ListContacts -> Text
$sel:pageSize:ListContacts' :: ListContacts -> Maybe Int
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:filter':ListContacts' :: ListContacts -> Maybe ListContactsFilter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v2/email/contact-lists/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
contactListName,
        ByteString
"/contacts"
      ]

instance Data.ToQuery ListContacts where
  toQuery :: ListContacts -> QueryString
toQuery ListContacts' {Maybe Int
Maybe Text
Maybe ListContactsFilter
Text
contactListName :: Text
pageSize :: Maybe Int
nextToken :: Maybe Text
filter' :: Maybe ListContactsFilter
$sel:contactListName:ListContacts' :: ListContacts -> Text
$sel:pageSize:ListContacts' :: ListContacts -> Maybe Int
$sel:nextToken:ListContacts' :: ListContacts -> Maybe Text
$sel:filter':ListContacts' :: ListContacts -> Maybe ListContactsFilter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"PageSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
pageSize
      ]

-- | /See:/ 'newListContactsResponse' smart constructor.
data ListContactsResponse = ListContactsResponse'
  { -- | The contacts present in a specific contact list.
    ListContactsResponse -> Maybe [Contact]
contacts :: Prelude.Maybe [Contact],
    -- | A string token indicating that there might be additional contacts
    -- available to be listed. Copy this token to a subsequent call to
    -- @ListContacts@ with the same parameters to retrieve the next page of
    -- contacts.
    ListContactsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContactsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContactsResponse -> ListContactsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactsResponse -> ListContactsResponse -> Bool
$c/= :: ListContactsResponse -> ListContactsResponse -> Bool
== :: ListContactsResponse -> ListContactsResponse -> Bool
$c== :: ListContactsResponse -> ListContactsResponse -> Bool
Prelude.Eq, ReadPrec [ListContactsResponse]
ReadPrec ListContactsResponse
Int -> ReadS ListContactsResponse
ReadS [ListContactsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactsResponse]
$creadListPrec :: ReadPrec [ListContactsResponse]
readPrec :: ReadPrec ListContactsResponse
$creadPrec :: ReadPrec ListContactsResponse
readList :: ReadS [ListContactsResponse]
$creadList :: ReadS [ListContactsResponse]
readsPrec :: Int -> ReadS ListContactsResponse
$creadsPrec :: Int -> ReadS ListContactsResponse
Prelude.Read, Int -> ListContactsResponse -> ShowS
[ListContactsResponse] -> ShowS
ListContactsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactsResponse] -> ShowS
$cshowList :: [ListContactsResponse] -> ShowS
show :: ListContactsResponse -> String
$cshow :: ListContactsResponse -> String
showsPrec :: Int -> ListContactsResponse -> ShowS
$cshowsPrec :: Int -> ListContactsResponse -> ShowS
Prelude.Show, forall x. Rep ListContactsResponse x -> ListContactsResponse
forall x. ListContactsResponse -> Rep ListContactsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContactsResponse x -> ListContactsResponse
$cfrom :: forall x. ListContactsResponse -> Rep ListContactsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContactsResponse' 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:
--
-- 'contacts', 'listContactsResponse_contacts' - The contacts present in a specific contact list.
--
-- 'nextToken', 'listContactsResponse_nextToken' - A string token indicating that there might be additional contacts
-- available to be listed. Copy this token to a subsequent call to
-- @ListContacts@ with the same parameters to retrieve the next page of
-- contacts.
--
-- 'httpStatus', 'listContactsResponse_httpStatus' - The response's http status code.
newListContactsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContactsResponse
newListContactsResponse :: Int -> ListContactsResponse
newListContactsResponse Int
pHttpStatus_ =
  ListContactsResponse'
    { $sel:contacts:ListContactsResponse' :: Maybe [Contact]
contacts = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContactsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContactsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The contacts present in a specific contact list.
listContactsResponse_contacts :: Lens.Lens' ListContactsResponse (Prelude.Maybe [Contact])
listContactsResponse_contacts :: Lens' ListContactsResponse (Maybe [Contact])
listContactsResponse_contacts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactsResponse' {Maybe [Contact]
contacts :: Maybe [Contact]
$sel:contacts:ListContactsResponse' :: ListContactsResponse -> Maybe [Contact]
contacts} -> Maybe [Contact]
contacts) (\s :: ListContactsResponse
s@ListContactsResponse' {} Maybe [Contact]
a -> ListContactsResponse
s {$sel:contacts:ListContactsResponse' :: Maybe [Contact]
contacts = Maybe [Contact]
a} :: ListContactsResponse) 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 string token indicating that there might be additional contacts
-- available to be listed. Copy this token to a subsequent call to
-- @ListContacts@ with the same parameters to retrieve the next page of
-- contacts.
listContactsResponse_nextToken :: Lens.Lens' ListContactsResponse (Prelude.Maybe Prelude.Text)
listContactsResponse_nextToken :: Lens' ListContactsResponse (Maybe Text)
listContactsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactsResponse' :: ListContactsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactsResponse
s@ListContactsResponse' {} Maybe Text
a -> ListContactsResponse
s {$sel:nextToken:ListContactsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactsResponse)

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

instance Prelude.NFData ListContactsResponse where
  rnf :: ListContactsResponse -> ()
rnf ListContactsResponse' {Int
Maybe [Contact]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
contacts :: Maybe [Contact]
$sel:httpStatus:ListContactsResponse' :: ListContactsResponse -> Int
$sel:nextToken:ListContactsResponse' :: ListContactsResponse -> Maybe Text
$sel:contacts:ListContactsResponse' :: ListContactsResponse -> Maybe [Contact]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Contact]
contacts
      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