{-# 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.PinpointSmsVoiceV2.DeletePool
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an existing pool. Deleting a pool disassociates all origination
-- identities from that pool.
--
-- If the pool status isn\'t active or if deletion protection is enabled,
-- an Error is returned.
--
-- A pool is a collection of phone numbers and SenderIds. A pool can
-- include one or more phone numbers and SenderIds that are associated with
-- your Amazon Web Services account.
module Amazonka.PinpointSmsVoiceV2.DeletePool
  ( -- * Creating a Request
    DeletePool (..),
    newDeletePool,

    -- * Request Lenses
    deletePool_poolId,

    -- * Destructuring the Response
    DeletePoolResponse (..),
    newDeletePoolResponse,

    -- * Response Lenses
    deletePoolResponse_createdTimestamp,
    deletePoolResponse_messageType,
    deletePoolResponse_optOutListName,
    deletePoolResponse_poolArn,
    deletePoolResponse_poolId,
    deletePoolResponse_selfManagedOptOutsEnabled,
    deletePoolResponse_sharedRoutesEnabled,
    deletePoolResponse_status,
    deletePoolResponse_twoWayChannelArn,
    deletePoolResponse_twoWayEnabled,
    deletePoolResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.PinpointSmsVoiceV2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeletePool' smart constructor.
data DeletePool = DeletePool'
  { -- | The PoolId or PoolArn of the pool to delete. You can use DescribePools
    -- to find the values for PoolId and PoolArn .
    DeletePool -> Text
poolId :: Prelude.Text
  }
  deriving (DeletePool -> DeletePool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePool -> DeletePool -> Bool
$c/= :: DeletePool -> DeletePool -> Bool
== :: DeletePool -> DeletePool -> Bool
$c== :: DeletePool -> DeletePool -> Bool
Prelude.Eq, ReadPrec [DeletePool]
ReadPrec DeletePool
Int -> ReadS DeletePool
ReadS [DeletePool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePool]
$creadListPrec :: ReadPrec [DeletePool]
readPrec :: ReadPrec DeletePool
$creadPrec :: ReadPrec DeletePool
readList :: ReadS [DeletePool]
$creadList :: ReadS [DeletePool]
readsPrec :: Int -> ReadS DeletePool
$creadsPrec :: Int -> ReadS DeletePool
Prelude.Read, Int -> DeletePool -> ShowS
[DeletePool] -> ShowS
DeletePool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePool] -> ShowS
$cshowList :: [DeletePool] -> ShowS
show :: DeletePool -> String
$cshow :: DeletePool -> String
showsPrec :: Int -> DeletePool -> ShowS
$cshowsPrec :: Int -> DeletePool -> ShowS
Prelude.Show, forall x. Rep DeletePool x -> DeletePool
forall x. DeletePool -> Rep DeletePool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePool x -> DeletePool
$cfrom :: forall x. DeletePool -> Rep DeletePool x
Prelude.Generic)

-- |
-- Create a value of 'DeletePool' 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:
--
-- 'poolId', 'deletePool_poolId' - The PoolId or PoolArn of the pool to delete. You can use DescribePools
-- to find the values for PoolId and PoolArn .
newDeletePool ::
  -- | 'poolId'
  Prelude.Text ->
  DeletePool
newDeletePool :: Text -> DeletePool
newDeletePool Text
pPoolId_ =
  DeletePool' {$sel:poolId:DeletePool' :: Text
poolId = Text
pPoolId_}

-- | The PoolId or PoolArn of the pool to delete. You can use DescribePools
-- to find the values for PoolId and PoolArn .
deletePool_poolId :: Lens.Lens' DeletePool Prelude.Text
deletePool_poolId :: Lens' DeletePool Text
deletePool_poolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePool' {Text
poolId :: Text
$sel:poolId:DeletePool' :: DeletePool -> Text
poolId} -> Text
poolId) (\s :: DeletePool
s@DeletePool' {} Text
a -> DeletePool
s {$sel:poolId:DeletePool' :: Text
poolId = Text
a} :: DeletePool)

instance Core.AWSRequest DeletePool where
  type AWSResponse DeletePool = DeletePoolResponse
  request :: (Service -> Service) -> DeletePool -> Request DeletePool
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 DeletePool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeletePool)))
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 POSIX
-> Maybe MessageType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe PoolStatus
-> Maybe Text
-> Maybe Bool
-> Int
-> DeletePoolResponse
DeletePoolResponse'
            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
"CreatedTimestamp")
            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
"MessageType")
            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
"OptOutListName")
            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
"PoolArn")
            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
"PoolId")
            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
"SelfManagedOptOutsEnabled")
            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
"SharedRoutesEnabled")
            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
"Status")
            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
"TwoWayChannelArn")
            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
"TwoWayEnabled")
            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 DeletePool where
  hashWithSalt :: Int -> DeletePool -> Int
hashWithSalt Int
_salt DeletePool' {Text
poolId :: Text
$sel:poolId:DeletePool' :: DeletePool -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
poolId

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

instance Data.ToHeaders DeletePool where
  toHeaders :: DeletePool -> 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
"PinpointSMSVoiceV2.DeletePool" ::
                          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 DeletePool where
  toJSON :: DeletePool -> Value
toJSON DeletePool' {Text
poolId :: Text
$sel:poolId:DeletePool' :: DeletePool -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"PoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
poolId)]
      )

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

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

-- | /See:/ 'newDeletePoolResponse' smart constructor.
data DeletePoolResponse = DeletePoolResponse'
  { -- | The time when the pool was created, in
    -- <https://www.epochconverter.com/ UNIX epoch time> format.
    DeletePoolResponse -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The message type that was associated with the deleted pool.
    DeletePoolResponse -> Maybe MessageType
messageType :: Prelude.Maybe MessageType,
    -- | The name of the OptOutList that was associated with the deleted pool.
    DeletePoolResponse -> Maybe Text
optOutListName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the pool that was deleted.
    DeletePoolResponse -> Maybe Text
poolArn :: Prelude.Maybe Prelude.Text,
    -- | The PoolId of the pool that was deleted.
    DeletePoolResponse -> Maybe Text
poolId :: Prelude.Maybe Prelude.Text,
    -- | By default this is set to false. When an end recipient sends a message
    -- that begins with HELP or STOP to one of your dedicated numbers, Amazon
    -- Pinpoint automatically replies with a customizable message and adds the
    -- end recipient to the OptOutList. When set to true you\'re responsible
    -- for responding to HELP and STOP requests. You\'re also responsible for
    -- tracking and honoring opt-out requests.
    DeletePoolResponse -> Maybe Bool
selfManagedOptOutsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether shared routes are enabled for the pool.
    DeletePoolResponse -> Maybe Bool
sharedRoutesEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The current status of the pool.
    --
    -- -   CREATING: The pool is currently being created and isn\'t yet
    --     available for use.
    --
    -- -   ACTIVE: The pool is active and available for use.
    --
    -- -   DELETING: The pool is being deleted.
    DeletePoolResponse -> Maybe PoolStatus
status :: Prelude.Maybe PoolStatus,
    -- | The Amazon Resource Name (ARN) of the TwoWayChannel.
    DeletePoolResponse -> Maybe Text
twoWayChannelArn :: Prelude.Maybe Prelude.Text,
    -- | By default this is set to false. When set to true you can receive
    -- incoming text messages from your end recipients.
    DeletePoolResponse -> Maybe Bool
twoWayEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    DeletePoolResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeletePoolResponse -> DeletePoolResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePoolResponse -> DeletePoolResponse -> Bool
$c/= :: DeletePoolResponse -> DeletePoolResponse -> Bool
== :: DeletePoolResponse -> DeletePoolResponse -> Bool
$c== :: DeletePoolResponse -> DeletePoolResponse -> Bool
Prelude.Eq, ReadPrec [DeletePoolResponse]
ReadPrec DeletePoolResponse
Int -> ReadS DeletePoolResponse
ReadS [DeletePoolResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePoolResponse]
$creadListPrec :: ReadPrec [DeletePoolResponse]
readPrec :: ReadPrec DeletePoolResponse
$creadPrec :: ReadPrec DeletePoolResponse
readList :: ReadS [DeletePoolResponse]
$creadList :: ReadS [DeletePoolResponse]
readsPrec :: Int -> ReadS DeletePoolResponse
$creadsPrec :: Int -> ReadS DeletePoolResponse
Prelude.Read, Int -> DeletePoolResponse -> ShowS
[DeletePoolResponse] -> ShowS
DeletePoolResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePoolResponse] -> ShowS
$cshowList :: [DeletePoolResponse] -> ShowS
show :: DeletePoolResponse -> String
$cshow :: DeletePoolResponse -> String
showsPrec :: Int -> DeletePoolResponse -> ShowS
$cshowsPrec :: Int -> DeletePoolResponse -> ShowS
Prelude.Show, forall x. Rep DeletePoolResponse x -> DeletePoolResponse
forall x. DeletePoolResponse -> Rep DeletePoolResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePoolResponse x -> DeletePoolResponse
$cfrom :: forall x. DeletePoolResponse -> Rep DeletePoolResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeletePoolResponse' 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:
--
-- 'createdTimestamp', 'deletePoolResponse_createdTimestamp' - The time when the pool was created, in
-- <https://www.epochconverter.com/ UNIX epoch time> format.
--
-- 'messageType', 'deletePoolResponse_messageType' - The message type that was associated with the deleted pool.
--
-- 'optOutListName', 'deletePoolResponse_optOutListName' - The name of the OptOutList that was associated with the deleted pool.
--
-- 'poolArn', 'deletePoolResponse_poolArn' - The Amazon Resource Name (ARN) of the pool that was deleted.
--
-- 'poolId', 'deletePoolResponse_poolId' - The PoolId of the pool that was deleted.
--
-- 'selfManagedOptOutsEnabled', 'deletePoolResponse_selfManagedOptOutsEnabled' - By default this is set to false. When an end recipient sends a message
-- that begins with HELP or STOP to one of your dedicated numbers, Amazon
-- Pinpoint automatically replies with a customizable message and adds the
-- end recipient to the OptOutList. When set to true you\'re responsible
-- for responding to HELP and STOP requests. You\'re also responsible for
-- tracking and honoring opt-out requests.
--
-- 'sharedRoutesEnabled', 'deletePoolResponse_sharedRoutesEnabled' - Indicates whether shared routes are enabled for the pool.
--
-- 'status', 'deletePoolResponse_status' - The current status of the pool.
--
-- -   CREATING: The pool is currently being created and isn\'t yet
--     available for use.
--
-- -   ACTIVE: The pool is active and available for use.
--
-- -   DELETING: The pool is being deleted.
--
-- 'twoWayChannelArn', 'deletePoolResponse_twoWayChannelArn' - The Amazon Resource Name (ARN) of the TwoWayChannel.
--
-- 'twoWayEnabled', 'deletePoolResponse_twoWayEnabled' - By default this is set to false. When set to true you can receive
-- incoming text messages from your end recipients.
--
-- 'httpStatus', 'deletePoolResponse_httpStatus' - The response's http status code.
newDeletePoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeletePoolResponse
newDeletePoolResponse :: Int -> DeletePoolResponse
newDeletePoolResponse Int
pHttpStatus_ =
  DeletePoolResponse'
    { $sel:createdTimestamp:DeletePoolResponse' :: Maybe POSIX
createdTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:messageType:DeletePoolResponse' :: Maybe MessageType
messageType = forall a. Maybe a
Prelude.Nothing,
      $sel:optOutListName:DeletePoolResponse' :: Maybe Text
optOutListName = forall a. Maybe a
Prelude.Nothing,
      $sel:poolArn:DeletePoolResponse' :: Maybe Text
poolArn = forall a. Maybe a
Prelude.Nothing,
      $sel:poolId:DeletePoolResponse' :: Maybe Text
poolId = forall a. Maybe a
Prelude.Nothing,
      $sel:selfManagedOptOutsEnabled:DeletePoolResponse' :: Maybe Bool
selfManagedOptOutsEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:sharedRoutesEnabled:DeletePoolResponse' :: Maybe Bool
sharedRoutesEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DeletePoolResponse' :: Maybe PoolStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:twoWayChannelArn:DeletePoolResponse' :: Maybe Text
twoWayChannelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:twoWayEnabled:DeletePoolResponse' :: Maybe Bool
twoWayEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeletePoolResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time when the pool was created, in
-- <https://www.epochconverter.com/ UNIX epoch time> format.
deletePoolResponse_createdTimestamp :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.UTCTime)
deletePoolResponse_createdTimestamp :: Lens' DeletePoolResponse (Maybe UTCTime)
deletePoolResponse_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:DeletePoolResponse' :: DeletePoolResponse -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe POSIX
a -> DeletePoolResponse
s {$sel:createdTimestamp:DeletePoolResponse' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: DeletePoolResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The message type that was associated with the deleted pool.
deletePoolResponse_messageType :: Lens.Lens' DeletePoolResponse (Prelude.Maybe MessageType)
deletePoolResponse_messageType :: Lens' DeletePoolResponse (Maybe MessageType)
deletePoolResponse_messageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe MessageType
messageType :: Maybe MessageType
$sel:messageType:DeletePoolResponse' :: DeletePoolResponse -> Maybe MessageType
messageType} -> Maybe MessageType
messageType) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe MessageType
a -> DeletePoolResponse
s {$sel:messageType:DeletePoolResponse' :: Maybe MessageType
messageType = Maybe MessageType
a} :: DeletePoolResponse)

-- | The name of the OptOutList that was associated with the deleted pool.
deletePoolResponse_optOutListName :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Text)
deletePoolResponse_optOutListName :: Lens' DeletePoolResponse (Maybe Text)
deletePoolResponse_optOutListName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Text
optOutListName :: Maybe Text
$sel:optOutListName:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
optOutListName} -> Maybe Text
optOutListName) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Text
a -> DeletePoolResponse
s {$sel:optOutListName:DeletePoolResponse' :: Maybe Text
optOutListName = Maybe Text
a} :: DeletePoolResponse)

-- | The Amazon Resource Name (ARN) of the pool that was deleted.
deletePoolResponse_poolArn :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Text)
deletePoolResponse_poolArn :: Lens' DeletePoolResponse (Maybe Text)
deletePoolResponse_poolArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Text
poolArn :: Maybe Text
$sel:poolArn:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
poolArn} -> Maybe Text
poolArn) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Text
a -> DeletePoolResponse
s {$sel:poolArn:DeletePoolResponse' :: Maybe Text
poolArn = Maybe Text
a} :: DeletePoolResponse)

-- | The PoolId of the pool that was deleted.
deletePoolResponse_poolId :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Text)
deletePoolResponse_poolId :: Lens' DeletePoolResponse (Maybe Text)
deletePoolResponse_poolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Text
poolId :: Maybe Text
$sel:poolId:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
poolId} -> Maybe Text
poolId) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Text
a -> DeletePoolResponse
s {$sel:poolId:DeletePoolResponse' :: Maybe Text
poolId = Maybe Text
a} :: DeletePoolResponse)

-- | By default this is set to false. When an end recipient sends a message
-- that begins with HELP or STOP to one of your dedicated numbers, Amazon
-- Pinpoint automatically replies with a customizable message and adds the
-- end recipient to the OptOutList. When set to true you\'re responsible
-- for responding to HELP and STOP requests. You\'re also responsible for
-- tracking and honoring opt-out requests.
deletePoolResponse_selfManagedOptOutsEnabled :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Bool)
deletePoolResponse_selfManagedOptOutsEnabled :: Lens' DeletePoolResponse (Maybe Bool)
deletePoolResponse_selfManagedOptOutsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Bool
selfManagedOptOutsEnabled :: Maybe Bool
$sel:selfManagedOptOutsEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
selfManagedOptOutsEnabled} -> Maybe Bool
selfManagedOptOutsEnabled) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Bool
a -> DeletePoolResponse
s {$sel:selfManagedOptOutsEnabled:DeletePoolResponse' :: Maybe Bool
selfManagedOptOutsEnabled = Maybe Bool
a} :: DeletePoolResponse)

-- | Indicates whether shared routes are enabled for the pool.
deletePoolResponse_sharedRoutesEnabled :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Bool)
deletePoolResponse_sharedRoutesEnabled :: Lens' DeletePoolResponse (Maybe Bool)
deletePoolResponse_sharedRoutesEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Bool
sharedRoutesEnabled :: Maybe Bool
$sel:sharedRoutesEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
sharedRoutesEnabled} -> Maybe Bool
sharedRoutesEnabled) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Bool
a -> DeletePoolResponse
s {$sel:sharedRoutesEnabled:DeletePoolResponse' :: Maybe Bool
sharedRoutesEnabled = Maybe Bool
a} :: DeletePoolResponse)

-- | The current status of the pool.
--
-- -   CREATING: The pool is currently being created and isn\'t yet
--     available for use.
--
-- -   ACTIVE: The pool is active and available for use.
--
-- -   DELETING: The pool is being deleted.
deletePoolResponse_status :: Lens.Lens' DeletePoolResponse (Prelude.Maybe PoolStatus)
deletePoolResponse_status :: Lens' DeletePoolResponse (Maybe PoolStatus)
deletePoolResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe PoolStatus
status :: Maybe PoolStatus
$sel:status:DeletePoolResponse' :: DeletePoolResponse -> Maybe PoolStatus
status} -> Maybe PoolStatus
status) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe PoolStatus
a -> DeletePoolResponse
s {$sel:status:DeletePoolResponse' :: Maybe PoolStatus
status = Maybe PoolStatus
a} :: DeletePoolResponse)

-- | The Amazon Resource Name (ARN) of the TwoWayChannel.
deletePoolResponse_twoWayChannelArn :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Text)
deletePoolResponse_twoWayChannelArn :: Lens' DeletePoolResponse (Maybe Text)
deletePoolResponse_twoWayChannelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Text
twoWayChannelArn :: Maybe Text
$sel:twoWayChannelArn:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
twoWayChannelArn} -> Maybe Text
twoWayChannelArn) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Text
a -> DeletePoolResponse
s {$sel:twoWayChannelArn:DeletePoolResponse' :: Maybe Text
twoWayChannelArn = Maybe Text
a} :: DeletePoolResponse)

-- | By default this is set to false. When set to true you can receive
-- incoming text messages from your end recipients.
deletePoolResponse_twoWayEnabled :: Lens.Lens' DeletePoolResponse (Prelude.Maybe Prelude.Bool)
deletePoolResponse_twoWayEnabled :: Lens' DeletePoolResponse (Maybe Bool)
deletePoolResponse_twoWayEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePoolResponse' {Maybe Bool
twoWayEnabled :: Maybe Bool
$sel:twoWayEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
twoWayEnabled} -> Maybe Bool
twoWayEnabled) (\s :: DeletePoolResponse
s@DeletePoolResponse' {} Maybe Bool
a -> DeletePoolResponse
s {$sel:twoWayEnabled:DeletePoolResponse' :: Maybe Bool
twoWayEnabled = Maybe Bool
a} :: DeletePoolResponse)

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

instance Prelude.NFData DeletePoolResponse where
  rnf :: DeletePoolResponse -> ()
rnf DeletePoolResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
Maybe MessageType
Maybe PoolStatus
httpStatus :: Int
twoWayEnabled :: Maybe Bool
twoWayChannelArn :: Maybe Text
status :: Maybe PoolStatus
sharedRoutesEnabled :: Maybe Bool
selfManagedOptOutsEnabled :: Maybe Bool
poolId :: Maybe Text
poolArn :: Maybe Text
optOutListName :: Maybe Text
messageType :: Maybe MessageType
createdTimestamp :: Maybe POSIX
$sel:httpStatus:DeletePoolResponse' :: DeletePoolResponse -> Int
$sel:twoWayEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
$sel:twoWayChannelArn:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
$sel:status:DeletePoolResponse' :: DeletePoolResponse -> Maybe PoolStatus
$sel:sharedRoutesEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
$sel:selfManagedOptOutsEnabled:DeletePoolResponse' :: DeletePoolResponse -> Maybe Bool
$sel:poolId:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
$sel:poolArn:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
$sel:optOutListName:DeletePoolResponse' :: DeletePoolResponse -> Maybe Text
$sel:messageType:DeletePoolResponse' :: DeletePoolResponse -> Maybe MessageType
$sel:createdTimestamp:DeletePoolResponse' :: DeletePoolResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageType
messageType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optOutListName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
poolArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
poolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
selfManagedOptOutsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
sharedRoutesEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PoolStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
twoWayChannelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
twoWayEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus