{-# 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.SSMContacts.ListContactChannels
-- 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 all contact channels for the specified contact.
--
-- This operation returns paginated results.
module Amazonka.SSMContacts.ListContactChannels
  ( -- * Creating a Request
    ListContactChannels (..),
    newListContactChannels,

    -- * Request Lenses
    listContactChannels_maxResults,
    listContactChannels_nextToken,
    listContactChannels_contactId,

    -- * Destructuring the Response
    ListContactChannelsResponse (..),
    newListContactChannelsResponse,

    -- * Response Lenses
    listContactChannelsResponse_nextToken,
    listContactChannelsResponse_httpStatus,
    listContactChannelsResponse_contactChannels,
  )
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.SSMContacts.Types

-- | /See:/ 'newListContactChannels' smart constructor.
data ListContactChannels = ListContactChannels'
  { -- | The maximum number of contact channels per page.
    ListContactChannels -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token to continue to the next page of results.
    ListContactChannels -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the contact.
    ListContactChannels -> Text
contactId :: Prelude.Text
  }
  deriving (ListContactChannels -> ListContactChannels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactChannels -> ListContactChannels -> Bool
$c/= :: ListContactChannels -> ListContactChannels -> Bool
== :: ListContactChannels -> ListContactChannels -> Bool
$c== :: ListContactChannels -> ListContactChannels -> Bool
Prelude.Eq, ReadPrec [ListContactChannels]
ReadPrec ListContactChannels
Int -> ReadS ListContactChannels
ReadS [ListContactChannels]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactChannels]
$creadListPrec :: ReadPrec [ListContactChannels]
readPrec :: ReadPrec ListContactChannels
$creadPrec :: ReadPrec ListContactChannels
readList :: ReadS [ListContactChannels]
$creadList :: ReadS [ListContactChannels]
readsPrec :: Int -> ReadS ListContactChannels
$creadsPrec :: Int -> ReadS ListContactChannels
Prelude.Read, Int -> ListContactChannels -> ShowS
[ListContactChannels] -> ShowS
ListContactChannels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactChannels] -> ShowS
$cshowList :: [ListContactChannels] -> ShowS
show :: ListContactChannels -> String
$cshow :: ListContactChannels -> String
showsPrec :: Int -> ListContactChannels -> ShowS
$cshowsPrec :: Int -> ListContactChannels -> ShowS
Prelude.Show, forall x. Rep ListContactChannels x -> ListContactChannels
forall x. ListContactChannels -> Rep ListContactChannels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContactChannels x -> ListContactChannels
$cfrom :: forall x. ListContactChannels -> Rep ListContactChannels x
Prelude.Generic)

-- |
-- Create a value of 'ListContactChannels' 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:
--
-- 'maxResults', 'listContactChannels_maxResults' - The maximum number of contact channels per page.
--
-- 'nextToken', 'listContactChannels_nextToken' - The pagination token to continue to the next page of results.
--
-- 'contactId', 'listContactChannels_contactId' - The Amazon Resource Name (ARN) of the contact.
newListContactChannels ::
  -- | 'contactId'
  Prelude.Text ->
  ListContactChannels
newListContactChannels :: Text -> ListContactChannels
newListContactChannels Text
pContactId_ =
  ListContactChannels'
    { $sel:maxResults:ListContactChannels' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContactChannels' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:contactId:ListContactChannels' :: Text
contactId = Text
pContactId_
    }

-- | The maximum number of contact channels per page.
listContactChannels_maxResults :: Lens.Lens' ListContactChannels (Prelude.Maybe Prelude.Natural)
listContactChannels_maxResults :: Lens' ListContactChannels (Maybe Natural)
listContactChannels_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactChannels' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListContactChannels' :: ListContactChannels -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListContactChannels
s@ListContactChannels' {} Maybe Natural
a -> ListContactChannels
s {$sel:maxResults:ListContactChannels' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListContactChannels)

-- | The pagination token to continue to the next page of results.
listContactChannels_nextToken :: Lens.Lens' ListContactChannels (Prelude.Maybe Prelude.Text)
listContactChannels_nextToken :: Lens' ListContactChannels (Maybe Text)
listContactChannels_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactChannels' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactChannels' :: ListContactChannels -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactChannels
s@ListContactChannels' {} Maybe Text
a -> ListContactChannels
s {$sel:nextToken:ListContactChannels' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactChannels)

-- | The Amazon Resource Name (ARN) of the contact.
listContactChannels_contactId :: Lens.Lens' ListContactChannels Prelude.Text
listContactChannels_contactId :: Lens' ListContactChannels Text
listContactChannels_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactChannels' {Text
contactId :: Text
$sel:contactId:ListContactChannels' :: ListContactChannels -> Text
contactId} -> Text
contactId) (\s :: ListContactChannels
s@ListContactChannels' {} Text
a -> ListContactChannels
s {$sel:contactId:ListContactChannels' :: Text
contactId = Text
a} :: ListContactChannels)

instance Core.AWSPager ListContactChannels where
  page :: ListContactChannels
-> AWSResponse ListContactChannels -> Maybe ListContactChannels
page ListContactChannels
rq AWSResponse ListContactChannels
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContactChannels
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactChannelsResponse (Maybe Text)
listContactChannelsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListContactChannels
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListContactChannelsResponse [ContactChannel]
listContactChannelsResponse_contactChannels
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListContactChannels
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListContactChannels (Maybe Text)
listContactChannels_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListContactChannels
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListContactChannelsResponse (Maybe Text)
listContactChannelsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListContactChannels where
  type
    AWSResponse ListContactChannels =
      ListContactChannelsResponse
  request :: (Service -> Service)
-> ListContactChannels -> Request ListContactChannels
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 ListContactChannels
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListContactChannels)))
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
-> Int -> [ContactChannel] -> ListContactChannelsResponse
ListContactChannelsResponse'
            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
"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))
            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
"ContactChannels"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListContactChannels where
  hashWithSalt :: Int -> ListContactChannels -> Int
hashWithSalt Int
_salt ListContactChannels' {Maybe Natural
Maybe Text
Text
contactId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:contactId:ListContactChannels' :: ListContactChannels -> Text
$sel:nextToken:ListContactChannels' :: ListContactChannels -> Maybe Text
$sel:maxResults:ListContactChannels' :: ListContactChannels -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactId

instance Prelude.NFData ListContactChannels where
  rnf :: ListContactChannels -> ()
rnf ListContactChannels' {Maybe Natural
Maybe Text
Text
contactId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:contactId:ListContactChannels' :: ListContactChannels -> Text
$sel:nextToken:ListContactChannels' :: ListContactChannels -> Maybe Text
$sel:maxResults:ListContactChannels' :: ListContactChannels -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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 Text
contactId

instance Data.ToHeaders ListContactChannels where
  toHeaders :: ListContactChannels -> 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
"SSMContacts.ListContactChannels" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListContactChannels where
  toJSON :: ListContactChannels -> Value
toJSON ListContactChannels' {Maybe Natural
Maybe Text
Text
contactId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:contactId:ListContactChannels' :: ListContactChannels -> Text
$sel:nextToken:ListContactChannels' :: ListContactChannels -> Maybe Text
$sel:maxResults:ListContactChannels' :: ListContactChannels -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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
maxResults,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"ContactId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactId)
          ]
      )

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

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

-- | /See:/ 'newListContactChannelsResponse' smart constructor.
data ListContactChannelsResponse = ListContactChannelsResponse'
  { -- | The pagination token to continue to the next page of results.
    ListContactChannelsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContactChannelsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of contact channels related to the specified contact.
    ListContactChannelsResponse -> [ContactChannel]
contactChannels :: [ContactChannel]
  }
  deriving (ListContactChannelsResponse -> ListContactChannelsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContactChannelsResponse -> ListContactChannelsResponse -> Bool
$c/= :: ListContactChannelsResponse -> ListContactChannelsResponse -> Bool
== :: ListContactChannelsResponse -> ListContactChannelsResponse -> Bool
$c== :: ListContactChannelsResponse -> ListContactChannelsResponse -> Bool
Prelude.Eq, ReadPrec [ListContactChannelsResponse]
ReadPrec ListContactChannelsResponse
Int -> ReadS ListContactChannelsResponse
ReadS [ListContactChannelsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContactChannelsResponse]
$creadListPrec :: ReadPrec [ListContactChannelsResponse]
readPrec :: ReadPrec ListContactChannelsResponse
$creadPrec :: ReadPrec ListContactChannelsResponse
readList :: ReadS [ListContactChannelsResponse]
$creadList :: ReadS [ListContactChannelsResponse]
readsPrec :: Int -> ReadS ListContactChannelsResponse
$creadsPrec :: Int -> ReadS ListContactChannelsResponse
Prelude.Read, Int -> ListContactChannelsResponse -> ShowS
[ListContactChannelsResponse] -> ShowS
ListContactChannelsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContactChannelsResponse] -> ShowS
$cshowList :: [ListContactChannelsResponse] -> ShowS
show :: ListContactChannelsResponse -> String
$cshow :: ListContactChannelsResponse -> String
showsPrec :: Int -> ListContactChannelsResponse -> ShowS
$cshowsPrec :: Int -> ListContactChannelsResponse -> ShowS
Prelude.Show, forall x.
Rep ListContactChannelsResponse x -> ListContactChannelsResponse
forall x.
ListContactChannelsResponse -> Rep ListContactChannelsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListContactChannelsResponse x -> ListContactChannelsResponse
$cfrom :: forall x.
ListContactChannelsResponse -> Rep ListContactChannelsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContactChannelsResponse' 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', 'listContactChannelsResponse_nextToken' - The pagination token to continue to the next page of results.
--
-- 'httpStatus', 'listContactChannelsResponse_httpStatus' - The response's http status code.
--
-- 'contactChannels', 'listContactChannelsResponse_contactChannels' - A list of contact channels related to the specified contact.
newListContactChannelsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContactChannelsResponse
newListContactChannelsResponse :: Int -> ListContactChannelsResponse
newListContactChannelsResponse Int
pHttpStatus_ =
  ListContactChannelsResponse'
    { $sel:nextToken:ListContactChannelsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContactChannelsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:contactChannels:ListContactChannelsResponse' :: [ContactChannel]
contactChannels = forall a. Monoid a => a
Prelude.mempty
    }

-- | The pagination token to continue to the next page of results.
listContactChannelsResponse_nextToken :: Lens.Lens' ListContactChannelsResponse (Prelude.Maybe Prelude.Text)
listContactChannelsResponse_nextToken :: Lens' ListContactChannelsResponse (Maybe Text)
listContactChannelsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactChannelsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContactChannelsResponse' :: ListContactChannelsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContactChannelsResponse
s@ListContactChannelsResponse' {} Maybe Text
a -> ListContactChannelsResponse
s {$sel:nextToken:ListContactChannelsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContactChannelsResponse)

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

-- | A list of contact channels related to the specified contact.
listContactChannelsResponse_contactChannels :: Lens.Lens' ListContactChannelsResponse [ContactChannel]
listContactChannelsResponse_contactChannels :: Lens' ListContactChannelsResponse [ContactChannel]
listContactChannelsResponse_contactChannels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContactChannelsResponse' {[ContactChannel]
contactChannels :: [ContactChannel]
$sel:contactChannels:ListContactChannelsResponse' :: ListContactChannelsResponse -> [ContactChannel]
contactChannels} -> [ContactChannel]
contactChannels) (\s :: ListContactChannelsResponse
s@ListContactChannelsResponse' {} [ContactChannel]
a -> ListContactChannelsResponse
s {$sel:contactChannels:ListContactChannelsResponse' :: [ContactChannel]
contactChannels = [ContactChannel]
a} :: ListContactChannelsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData ListContactChannelsResponse where
  rnf :: ListContactChannelsResponse -> ()
rnf ListContactChannelsResponse' {Int
[ContactChannel]
Maybe Text
contactChannels :: [ContactChannel]
httpStatus :: Int
nextToken :: Maybe Text
$sel:contactChannels:ListContactChannelsResponse' :: ListContactChannelsResponse -> [ContactChannel]
$sel:httpStatus:ListContactChannelsResponse' :: ListContactChannelsResponse -> Int
$sel:nextToken:ListContactChannelsResponse' :: ListContactChannelsResponse -> 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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ContactChannel]
contactChannels