{-# 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.Config.DescribeDeliveryChannelStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the current status of the specified delivery channel. If a
-- delivery channel is not specified, this action returns the current
-- status of all delivery channels associated with the account.
--
-- Currently, you can specify only one delivery channel per region in your
-- account.
module Amazonka.Config.DescribeDeliveryChannelStatus
  ( -- * Creating a Request
    DescribeDeliveryChannelStatus (..),
    newDescribeDeliveryChannelStatus,

    -- * Request Lenses
    describeDeliveryChannelStatus_deliveryChannelNames,

    -- * Destructuring the Response
    DescribeDeliveryChannelStatusResponse (..),
    newDescribeDeliveryChannelStatusResponse,

    -- * Response Lenses
    describeDeliveryChannelStatusResponse_deliveryChannelsStatus,
    describeDeliveryChannelStatusResponse_httpStatus,
  )
where

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

-- | The input for the DeliveryChannelStatus action.
--
-- /See:/ 'newDescribeDeliveryChannelStatus' smart constructor.
data DescribeDeliveryChannelStatus = DescribeDeliveryChannelStatus'
  { -- | A list of delivery channel names.
    DescribeDeliveryChannelStatus -> Maybe [Text]
deliveryChannelNames :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeDeliveryChannelStatus
-> DescribeDeliveryChannelStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDeliveryChannelStatus
-> DescribeDeliveryChannelStatus -> Bool
$c/= :: DescribeDeliveryChannelStatus
-> DescribeDeliveryChannelStatus -> Bool
== :: DescribeDeliveryChannelStatus
-> DescribeDeliveryChannelStatus -> Bool
$c== :: DescribeDeliveryChannelStatus
-> DescribeDeliveryChannelStatus -> Bool
Prelude.Eq, ReadPrec [DescribeDeliveryChannelStatus]
ReadPrec DescribeDeliveryChannelStatus
Int -> ReadS DescribeDeliveryChannelStatus
ReadS [DescribeDeliveryChannelStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDeliveryChannelStatus]
$creadListPrec :: ReadPrec [DescribeDeliveryChannelStatus]
readPrec :: ReadPrec DescribeDeliveryChannelStatus
$creadPrec :: ReadPrec DescribeDeliveryChannelStatus
readList :: ReadS [DescribeDeliveryChannelStatus]
$creadList :: ReadS [DescribeDeliveryChannelStatus]
readsPrec :: Int -> ReadS DescribeDeliveryChannelStatus
$creadsPrec :: Int -> ReadS DescribeDeliveryChannelStatus
Prelude.Read, Int -> DescribeDeliveryChannelStatus -> ShowS
[DescribeDeliveryChannelStatus] -> ShowS
DescribeDeliveryChannelStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDeliveryChannelStatus] -> ShowS
$cshowList :: [DescribeDeliveryChannelStatus] -> ShowS
show :: DescribeDeliveryChannelStatus -> String
$cshow :: DescribeDeliveryChannelStatus -> String
showsPrec :: Int -> DescribeDeliveryChannelStatus -> ShowS
$cshowsPrec :: Int -> DescribeDeliveryChannelStatus -> ShowS
Prelude.Show, forall x.
Rep DescribeDeliveryChannelStatus x
-> DescribeDeliveryChannelStatus
forall x.
DescribeDeliveryChannelStatus
-> Rep DescribeDeliveryChannelStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDeliveryChannelStatus x
-> DescribeDeliveryChannelStatus
$cfrom :: forall x.
DescribeDeliveryChannelStatus
-> Rep DescribeDeliveryChannelStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDeliveryChannelStatus' 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:
--
-- 'deliveryChannelNames', 'describeDeliveryChannelStatus_deliveryChannelNames' - A list of delivery channel names.
newDescribeDeliveryChannelStatus ::
  DescribeDeliveryChannelStatus
newDescribeDeliveryChannelStatus :: DescribeDeliveryChannelStatus
newDescribeDeliveryChannelStatus =
  DescribeDeliveryChannelStatus'
    { $sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: Maybe [Text]
deliveryChannelNames =
        forall a. Maybe a
Prelude.Nothing
    }

-- | A list of delivery channel names.
describeDeliveryChannelStatus_deliveryChannelNames :: Lens.Lens' DescribeDeliveryChannelStatus (Prelude.Maybe [Prelude.Text])
describeDeliveryChannelStatus_deliveryChannelNames :: Lens' DescribeDeliveryChannelStatus (Maybe [Text])
describeDeliveryChannelStatus_deliveryChannelNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeliveryChannelStatus' {Maybe [Text]
deliveryChannelNames :: Maybe [Text]
$sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: DescribeDeliveryChannelStatus -> Maybe [Text]
deliveryChannelNames} -> Maybe [Text]
deliveryChannelNames) (\s :: DescribeDeliveryChannelStatus
s@DescribeDeliveryChannelStatus' {} Maybe [Text]
a -> DescribeDeliveryChannelStatus
s {$sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: Maybe [Text]
deliveryChannelNames = Maybe [Text]
a} :: DescribeDeliveryChannelStatus) 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

instance
  Core.AWSRequest
    DescribeDeliveryChannelStatus
  where
  type
    AWSResponse DescribeDeliveryChannelStatus =
      DescribeDeliveryChannelStatusResponse
  request :: (Service -> Service)
-> DescribeDeliveryChannelStatus
-> Request DescribeDeliveryChannelStatus
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 DescribeDeliveryChannelStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDeliveryChannelStatus)))
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 [DeliveryChannelStatus]
-> Int -> DescribeDeliveryChannelStatusResponse
DescribeDeliveryChannelStatusResponse'
            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
"DeliveryChannelsStatus"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    DescribeDeliveryChannelStatus
  where
  hashWithSalt :: Int -> DescribeDeliveryChannelStatus -> Int
hashWithSalt Int
_salt DescribeDeliveryChannelStatus' {Maybe [Text]
deliveryChannelNames :: Maybe [Text]
$sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: DescribeDeliveryChannelStatus -> Maybe [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
deliveryChannelNames

instance Prelude.NFData DescribeDeliveryChannelStatus where
  rnf :: DescribeDeliveryChannelStatus -> ()
rnf DescribeDeliveryChannelStatus' {Maybe [Text]
deliveryChannelNames :: Maybe [Text]
$sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: DescribeDeliveryChannelStatus -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
deliveryChannelNames

instance Data.ToHeaders DescribeDeliveryChannelStatus where
  toHeaders :: DescribeDeliveryChannelStatus -> 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
"StarlingDoveService.DescribeDeliveryChannelStatus" ::
                          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 DescribeDeliveryChannelStatus where
  toJSON :: DescribeDeliveryChannelStatus -> Value
toJSON DescribeDeliveryChannelStatus' {Maybe [Text]
deliveryChannelNames :: Maybe [Text]
$sel:deliveryChannelNames:DescribeDeliveryChannelStatus' :: DescribeDeliveryChannelStatus -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeliveryChannelNames" 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]
deliveryChannelNames
          ]
      )

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

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

-- | The output for the DescribeDeliveryChannelStatus action.
--
-- /See:/ 'newDescribeDeliveryChannelStatusResponse' smart constructor.
data DescribeDeliveryChannelStatusResponse = DescribeDeliveryChannelStatusResponse'
  { -- | A list that contains the status of a specified delivery channel.
    DescribeDeliveryChannelStatusResponse
-> Maybe [DeliveryChannelStatus]
deliveryChannelsStatus :: Prelude.Maybe [DeliveryChannelStatus],
    -- | The response's http status code.
    DescribeDeliveryChannelStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDeliveryChannelStatusResponse
-> DescribeDeliveryChannelStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDeliveryChannelStatusResponse
-> DescribeDeliveryChannelStatusResponse -> Bool
$c/= :: DescribeDeliveryChannelStatusResponse
-> DescribeDeliveryChannelStatusResponse -> Bool
== :: DescribeDeliveryChannelStatusResponse
-> DescribeDeliveryChannelStatusResponse -> Bool
$c== :: DescribeDeliveryChannelStatusResponse
-> DescribeDeliveryChannelStatusResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDeliveryChannelStatusResponse]
ReadPrec DescribeDeliveryChannelStatusResponse
Int -> ReadS DescribeDeliveryChannelStatusResponse
ReadS [DescribeDeliveryChannelStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDeliveryChannelStatusResponse]
$creadListPrec :: ReadPrec [DescribeDeliveryChannelStatusResponse]
readPrec :: ReadPrec DescribeDeliveryChannelStatusResponse
$creadPrec :: ReadPrec DescribeDeliveryChannelStatusResponse
readList :: ReadS [DescribeDeliveryChannelStatusResponse]
$creadList :: ReadS [DescribeDeliveryChannelStatusResponse]
readsPrec :: Int -> ReadS DescribeDeliveryChannelStatusResponse
$creadsPrec :: Int -> ReadS DescribeDeliveryChannelStatusResponse
Prelude.Read, Int -> DescribeDeliveryChannelStatusResponse -> ShowS
[DescribeDeliveryChannelStatusResponse] -> ShowS
DescribeDeliveryChannelStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDeliveryChannelStatusResponse] -> ShowS
$cshowList :: [DescribeDeliveryChannelStatusResponse] -> ShowS
show :: DescribeDeliveryChannelStatusResponse -> String
$cshow :: DescribeDeliveryChannelStatusResponse -> String
showsPrec :: Int -> DescribeDeliveryChannelStatusResponse -> ShowS
$cshowsPrec :: Int -> DescribeDeliveryChannelStatusResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDeliveryChannelStatusResponse x
-> DescribeDeliveryChannelStatusResponse
forall x.
DescribeDeliveryChannelStatusResponse
-> Rep DescribeDeliveryChannelStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDeliveryChannelStatusResponse x
-> DescribeDeliveryChannelStatusResponse
$cfrom :: forall x.
DescribeDeliveryChannelStatusResponse
-> Rep DescribeDeliveryChannelStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDeliveryChannelStatusResponse' 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:
--
-- 'deliveryChannelsStatus', 'describeDeliveryChannelStatusResponse_deliveryChannelsStatus' - A list that contains the status of a specified delivery channel.
--
-- 'httpStatus', 'describeDeliveryChannelStatusResponse_httpStatus' - The response's http status code.
newDescribeDeliveryChannelStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDeliveryChannelStatusResponse
newDescribeDeliveryChannelStatusResponse :: Int -> DescribeDeliveryChannelStatusResponse
newDescribeDeliveryChannelStatusResponse Int
pHttpStatus_ =
  DescribeDeliveryChannelStatusResponse'
    { $sel:deliveryChannelsStatus:DescribeDeliveryChannelStatusResponse' :: Maybe [DeliveryChannelStatus]
deliveryChannelsStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDeliveryChannelStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list that contains the status of a specified delivery channel.
describeDeliveryChannelStatusResponse_deliveryChannelsStatus :: Lens.Lens' DescribeDeliveryChannelStatusResponse (Prelude.Maybe [DeliveryChannelStatus])
describeDeliveryChannelStatusResponse_deliveryChannelsStatus :: Lens'
  DescribeDeliveryChannelStatusResponse
  (Maybe [DeliveryChannelStatus])
describeDeliveryChannelStatusResponse_deliveryChannelsStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeliveryChannelStatusResponse' {Maybe [DeliveryChannelStatus]
deliveryChannelsStatus :: Maybe [DeliveryChannelStatus]
$sel:deliveryChannelsStatus:DescribeDeliveryChannelStatusResponse' :: DescribeDeliveryChannelStatusResponse
-> Maybe [DeliveryChannelStatus]
deliveryChannelsStatus} -> Maybe [DeliveryChannelStatus]
deliveryChannelsStatus) (\s :: DescribeDeliveryChannelStatusResponse
s@DescribeDeliveryChannelStatusResponse' {} Maybe [DeliveryChannelStatus]
a -> DescribeDeliveryChannelStatusResponse
s {$sel:deliveryChannelsStatus:DescribeDeliveryChannelStatusResponse' :: Maybe [DeliveryChannelStatus]
deliveryChannelsStatus = Maybe [DeliveryChannelStatus]
a} :: DescribeDeliveryChannelStatusResponse) 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

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

instance
  Prelude.NFData
    DescribeDeliveryChannelStatusResponse
  where
  rnf :: DescribeDeliveryChannelStatusResponse -> ()
rnf DescribeDeliveryChannelStatusResponse' {Int
Maybe [DeliveryChannelStatus]
httpStatus :: Int
deliveryChannelsStatus :: Maybe [DeliveryChannelStatus]
$sel:httpStatus:DescribeDeliveryChannelStatusResponse' :: DescribeDeliveryChannelStatusResponse -> Int
$sel:deliveryChannelsStatus:DescribeDeliveryChannelStatusResponse' :: DescribeDeliveryChannelStatusResponse
-> Maybe [DeliveryChannelStatus]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeliveryChannelStatus]
deliveryChannelsStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus