{-# 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.SupportApp.ListSlackChannelConfigurations
-- 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 Slack channel configurations for an Amazon Web Services
-- account.
module Amazonka.SupportApp.ListSlackChannelConfigurations
  ( -- * Creating a Request
    ListSlackChannelConfigurations (..),
    newListSlackChannelConfigurations,

    -- * Request Lenses
    listSlackChannelConfigurations_nextToken,

    -- * Destructuring the Response
    ListSlackChannelConfigurationsResponse (..),
    newListSlackChannelConfigurationsResponse,

    -- * Response Lenses
    listSlackChannelConfigurationsResponse_nextToken,
    listSlackChannelConfigurationsResponse_httpStatus,
    listSlackChannelConfigurationsResponse_slackChannelConfigurations,
  )
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.SupportApp.Types

-- | /See:/ 'newListSlackChannelConfigurations' smart constructor.
data ListSlackChannelConfigurations = ListSlackChannelConfigurations'
  { -- | If the results of a search are large, the API only returns a portion of
    -- the results and includes a @nextToken@ pagination token in the response.
    -- To retrieve the next batch of results, reissue the search request and
    -- include the returned token. When the API returns the last set of
    -- results, the response doesn\'t include a pagination token value.
    ListSlackChannelConfigurations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSlackChannelConfigurations
-> ListSlackChannelConfigurations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSlackChannelConfigurations
-> ListSlackChannelConfigurations -> Bool
$c/= :: ListSlackChannelConfigurations
-> ListSlackChannelConfigurations -> Bool
== :: ListSlackChannelConfigurations
-> ListSlackChannelConfigurations -> Bool
$c== :: ListSlackChannelConfigurations
-> ListSlackChannelConfigurations -> Bool
Prelude.Eq, ReadPrec [ListSlackChannelConfigurations]
ReadPrec ListSlackChannelConfigurations
Int -> ReadS ListSlackChannelConfigurations
ReadS [ListSlackChannelConfigurations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSlackChannelConfigurations]
$creadListPrec :: ReadPrec [ListSlackChannelConfigurations]
readPrec :: ReadPrec ListSlackChannelConfigurations
$creadPrec :: ReadPrec ListSlackChannelConfigurations
readList :: ReadS [ListSlackChannelConfigurations]
$creadList :: ReadS [ListSlackChannelConfigurations]
readsPrec :: Int -> ReadS ListSlackChannelConfigurations
$creadsPrec :: Int -> ReadS ListSlackChannelConfigurations
Prelude.Read, Int -> ListSlackChannelConfigurations -> ShowS
[ListSlackChannelConfigurations] -> ShowS
ListSlackChannelConfigurations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSlackChannelConfigurations] -> ShowS
$cshowList :: [ListSlackChannelConfigurations] -> ShowS
show :: ListSlackChannelConfigurations -> String
$cshow :: ListSlackChannelConfigurations -> String
showsPrec :: Int -> ListSlackChannelConfigurations -> ShowS
$cshowsPrec :: Int -> ListSlackChannelConfigurations -> ShowS
Prelude.Show, forall x.
Rep ListSlackChannelConfigurations x
-> ListSlackChannelConfigurations
forall x.
ListSlackChannelConfigurations
-> Rep ListSlackChannelConfigurations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSlackChannelConfigurations x
-> ListSlackChannelConfigurations
$cfrom :: forall x.
ListSlackChannelConfigurations
-> Rep ListSlackChannelConfigurations x
Prelude.Generic)

-- |
-- Create a value of 'ListSlackChannelConfigurations' 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', 'listSlackChannelConfigurations_nextToken' - If the results of a search are large, the API only returns a portion of
-- the results and includes a @nextToken@ pagination token in the response.
-- To retrieve the next batch of results, reissue the search request and
-- include the returned token. When the API returns the last set of
-- results, the response doesn\'t include a pagination token value.
newListSlackChannelConfigurations ::
  ListSlackChannelConfigurations
newListSlackChannelConfigurations :: ListSlackChannelConfigurations
newListSlackChannelConfigurations =
  ListSlackChannelConfigurations'
    { $sel:nextToken:ListSlackChannelConfigurations' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing
    }

-- | If the results of a search are large, the API only returns a portion of
-- the results and includes a @nextToken@ pagination token in the response.
-- To retrieve the next batch of results, reissue the search request and
-- include the returned token. When the API returns the last set of
-- results, the response doesn\'t include a pagination token value.
listSlackChannelConfigurations_nextToken :: Lens.Lens' ListSlackChannelConfigurations (Prelude.Maybe Prelude.Text)
listSlackChannelConfigurations_nextToken :: Lens' ListSlackChannelConfigurations (Maybe Text)
listSlackChannelConfigurations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSlackChannelConfigurations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSlackChannelConfigurations' :: ListSlackChannelConfigurations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSlackChannelConfigurations
s@ListSlackChannelConfigurations' {} Maybe Text
a -> ListSlackChannelConfigurations
s {$sel:nextToken:ListSlackChannelConfigurations' :: Maybe Text
nextToken = Maybe Text
a} :: ListSlackChannelConfigurations)

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

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

instance
  Prelude.NFData
    ListSlackChannelConfigurations
  where
  rnf :: ListSlackChannelConfigurations -> ()
rnf ListSlackChannelConfigurations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSlackChannelConfigurations' :: ListSlackChannelConfigurations -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance
  Data.ToHeaders
    ListSlackChannelConfigurations
  where
  toHeaders :: ListSlackChannelConfigurations -> 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.ToJSON ListSlackChannelConfigurations where
  toJSON :: ListSlackChannelConfigurations -> Value
toJSON ListSlackChannelConfigurations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSlackChannelConfigurations' :: ListSlackChannelConfigurations -> 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]
      )

instance Data.ToPath ListSlackChannelConfigurations where
  toPath :: ListSlackChannelConfigurations -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/control/list-slack-channel-configurations"

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

-- | /See:/ 'newListSlackChannelConfigurationsResponse' smart constructor.
data ListSlackChannelConfigurationsResponse = ListSlackChannelConfigurationsResponse'
  { -- | The point where pagination should resume when the response returns only
    -- partial results.
    ListSlackChannelConfigurationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListSlackChannelConfigurationsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The configurations for a Slack channel.
    ListSlackChannelConfigurationsResponse
-> [SlackChannelConfiguration]
slackChannelConfigurations :: [SlackChannelConfiguration]
  }
  deriving (ListSlackChannelConfigurationsResponse
-> ListSlackChannelConfigurationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSlackChannelConfigurationsResponse
-> ListSlackChannelConfigurationsResponse -> Bool
$c/= :: ListSlackChannelConfigurationsResponse
-> ListSlackChannelConfigurationsResponse -> Bool
== :: ListSlackChannelConfigurationsResponse
-> ListSlackChannelConfigurationsResponse -> Bool
$c== :: ListSlackChannelConfigurationsResponse
-> ListSlackChannelConfigurationsResponse -> Bool
Prelude.Eq, ReadPrec [ListSlackChannelConfigurationsResponse]
ReadPrec ListSlackChannelConfigurationsResponse
Int -> ReadS ListSlackChannelConfigurationsResponse
ReadS [ListSlackChannelConfigurationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSlackChannelConfigurationsResponse]
$creadListPrec :: ReadPrec [ListSlackChannelConfigurationsResponse]
readPrec :: ReadPrec ListSlackChannelConfigurationsResponse
$creadPrec :: ReadPrec ListSlackChannelConfigurationsResponse
readList :: ReadS [ListSlackChannelConfigurationsResponse]
$creadList :: ReadS [ListSlackChannelConfigurationsResponse]
readsPrec :: Int -> ReadS ListSlackChannelConfigurationsResponse
$creadsPrec :: Int -> ReadS ListSlackChannelConfigurationsResponse
Prelude.Read, Int -> ListSlackChannelConfigurationsResponse -> ShowS
[ListSlackChannelConfigurationsResponse] -> ShowS
ListSlackChannelConfigurationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSlackChannelConfigurationsResponse] -> ShowS
$cshowList :: [ListSlackChannelConfigurationsResponse] -> ShowS
show :: ListSlackChannelConfigurationsResponse -> String
$cshow :: ListSlackChannelConfigurationsResponse -> String
showsPrec :: Int -> ListSlackChannelConfigurationsResponse -> ShowS
$cshowsPrec :: Int -> ListSlackChannelConfigurationsResponse -> ShowS
Prelude.Show, forall x.
Rep ListSlackChannelConfigurationsResponse x
-> ListSlackChannelConfigurationsResponse
forall x.
ListSlackChannelConfigurationsResponse
-> Rep ListSlackChannelConfigurationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSlackChannelConfigurationsResponse x
-> ListSlackChannelConfigurationsResponse
$cfrom :: forall x.
ListSlackChannelConfigurationsResponse
-> Rep ListSlackChannelConfigurationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSlackChannelConfigurationsResponse' 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', 'listSlackChannelConfigurationsResponse_nextToken' - The point where pagination should resume when the response returns only
-- partial results.
--
-- 'httpStatus', 'listSlackChannelConfigurationsResponse_httpStatus' - The response's http status code.
--
-- 'slackChannelConfigurations', 'listSlackChannelConfigurationsResponse_slackChannelConfigurations' - The configurations for a Slack channel.
newListSlackChannelConfigurationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSlackChannelConfigurationsResponse
newListSlackChannelConfigurationsResponse :: Int -> ListSlackChannelConfigurationsResponse
newListSlackChannelConfigurationsResponse
  Int
pHttpStatus_ =
    ListSlackChannelConfigurationsResponse'
      { $sel:nextToken:ListSlackChannelConfigurationsResponse' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListSlackChannelConfigurationsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:slackChannelConfigurations:ListSlackChannelConfigurationsResponse' :: [SlackChannelConfiguration]
slackChannelConfigurations =
          forall a. Monoid a => a
Prelude.mempty
      }

-- | The point where pagination should resume when the response returns only
-- partial results.
listSlackChannelConfigurationsResponse_nextToken :: Lens.Lens' ListSlackChannelConfigurationsResponse (Prelude.Maybe Prelude.Text)
listSlackChannelConfigurationsResponse_nextToken :: Lens' ListSlackChannelConfigurationsResponse (Maybe Text)
listSlackChannelConfigurationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSlackChannelConfigurationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSlackChannelConfigurationsResponse' :: ListSlackChannelConfigurationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSlackChannelConfigurationsResponse
s@ListSlackChannelConfigurationsResponse' {} Maybe Text
a -> ListSlackChannelConfigurationsResponse
s {$sel:nextToken:ListSlackChannelConfigurationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSlackChannelConfigurationsResponse)

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

-- | The configurations for a Slack channel.
listSlackChannelConfigurationsResponse_slackChannelConfigurations :: Lens.Lens' ListSlackChannelConfigurationsResponse [SlackChannelConfiguration]
listSlackChannelConfigurationsResponse_slackChannelConfigurations :: Lens'
  ListSlackChannelConfigurationsResponse [SlackChannelConfiguration]
listSlackChannelConfigurationsResponse_slackChannelConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSlackChannelConfigurationsResponse' {[SlackChannelConfiguration]
slackChannelConfigurations :: [SlackChannelConfiguration]
$sel:slackChannelConfigurations:ListSlackChannelConfigurationsResponse' :: ListSlackChannelConfigurationsResponse
-> [SlackChannelConfiguration]
slackChannelConfigurations} -> [SlackChannelConfiguration]
slackChannelConfigurations) (\s :: ListSlackChannelConfigurationsResponse
s@ListSlackChannelConfigurationsResponse' {} [SlackChannelConfiguration]
a -> ListSlackChannelConfigurationsResponse
s {$sel:slackChannelConfigurations:ListSlackChannelConfigurationsResponse' :: [SlackChannelConfiguration]
slackChannelConfigurations = [SlackChannelConfiguration]
a} :: ListSlackChannelConfigurationsResponse) 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
    ListSlackChannelConfigurationsResponse
  where
  rnf :: ListSlackChannelConfigurationsResponse -> ()
rnf ListSlackChannelConfigurationsResponse' {Int
[SlackChannelConfiguration]
Maybe Text
slackChannelConfigurations :: [SlackChannelConfiguration]
httpStatus :: Int
nextToken :: Maybe Text
$sel:slackChannelConfigurations:ListSlackChannelConfigurationsResponse' :: ListSlackChannelConfigurationsResponse
-> [SlackChannelConfiguration]
$sel:httpStatus:ListSlackChannelConfigurationsResponse' :: ListSlackChannelConfigurationsResponse -> Int
$sel:nextToken:ListSlackChannelConfigurationsResponse' :: ListSlackChannelConfigurationsResponse -> 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 [SlackChannelConfiguration]
slackChannelConfigurations