{-# 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.DeleteOptOutList
-- 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 opt-out list. All opted out phone numbers in the
-- opt-out list are deleted.
--
-- If the specified opt-out list name doesn\'t exist or is in-use by an
-- origination phone number or pool, an Error is returned.
module Amazonka.PinpointSmsVoiceV2.DeleteOptOutList
  ( -- * Creating a Request
    DeleteOptOutList (..),
    newDeleteOptOutList,

    -- * Request Lenses
    deleteOptOutList_optOutListName,

    -- * Destructuring the Response
    DeleteOptOutListResponse (..),
    newDeleteOptOutListResponse,

    -- * Response Lenses
    deleteOptOutListResponse_createdTimestamp,
    deleteOptOutListResponse_optOutListArn,
    deleteOptOutListResponse_optOutListName,
    deleteOptOutListResponse_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:/ 'newDeleteOptOutList' smart constructor.
data DeleteOptOutList = DeleteOptOutList'
  { -- | The OptOutListName or OptOutListArn of the OptOutList to delete. You can
    -- use DescribeOptOutLists to find the values for OptOutListName and
    -- OptOutListArn.
    DeleteOptOutList -> Text
optOutListName :: Prelude.Text
  }
  deriving (DeleteOptOutList -> DeleteOptOutList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteOptOutList -> DeleteOptOutList -> Bool
$c/= :: DeleteOptOutList -> DeleteOptOutList -> Bool
== :: DeleteOptOutList -> DeleteOptOutList -> Bool
$c== :: DeleteOptOutList -> DeleteOptOutList -> Bool
Prelude.Eq, ReadPrec [DeleteOptOutList]
ReadPrec DeleteOptOutList
Int -> ReadS DeleteOptOutList
ReadS [DeleteOptOutList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteOptOutList]
$creadListPrec :: ReadPrec [DeleteOptOutList]
readPrec :: ReadPrec DeleteOptOutList
$creadPrec :: ReadPrec DeleteOptOutList
readList :: ReadS [DeleteOptOutList]
$creadList :: ReadS [DeleteOptOutList]
readsPrec :: Int -> ReadS DeleteOptOutList
$creadsPrec :: Int -> ReadS DeleteOptOutList
Prelude.Read, Int -> DeleteOptOutList -> ShowS
[DeleteOptOutList] -> ShowS
DeleteOptOutList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteOptOutList] -> ShowS
$cshowList :: [DeleteOptOutList] -> ShowS
show :: DeleteOptOutList -> String
$cshow :: DeleteOptOutList -> String
showsPrec :: Int -> DeleteOptOutList -> ShowS
$cshowsPrec :: Int -> DeleteOptOutList -> ShowS
Prelude.Show, forall x. Rep DeleteOptOutList x -> DeleteOptOutList
forall x. DeleteOptOutList -> Rep DeleteOptOutList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteOptOutList x -> DeleteOptOutList
$cfrom :: forall x. DeleteOptOutList -> Rep DeleteOptOutList x
Prelude.Generic)

-- |
-- Create a value of 'DeleteOptOutList' 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:
--
-- 'optOutListName', 'deleteOptOutList_optOutListName' - The OptOutListName or OptOutListArn of the OptOutList to delete. You can
-- use DescribeOptOutLists to find the values for OptOutListName and
-- OptOutListArn.
newDeleteOptOutList ::
  -- | 'optOutListName'
  Prelude.Text ->
  DeleteOptOutList
newDeleteOptOutList :: Text -> DeleteOptOutList
newDeleteOptOutList Text
pOptOutListName_ =
  DeleteOptOutList'
    { $sel:optOutListName:DeleteOptOutList' :: Text
optOutListName =
        Text
pOptOutListName_
    }

-- | The OptOutListName or OptOutListArn of the OptOutList to delete. You can
-- use DescribeOptOutLists to find the values for OptOutListName and
-- OptOutListArn.
deleteOptOutList_optOutListName :: Lens.Lens' DeleteOptOutList Prelude.Text
deleteOptOutList_optOutListName :: Lens' DeleteOptOutList Text
deleteOptOutList_optOutListName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOptOutList' {Text
optOutListName :: Text
$sel:optOutListName:DeleteOptOutList' :: DeleteOptOutList -> Text
optOutListName} -> Text
optOutListName) (\s :: DeleteOptOutList
s@DeleteOptOutList' {} Text
a -> DeleteOptOutList
s {$sel:optOutListName:DeleteOptOutList' :: Text
optOutListName = Text
a} :: DeleteOptOutList)

instance Core.AWSRequest DeleteOptOutList where
  type
    AWSResponse DeleteOptOutList =
      DeleteOptOutListResponse
  request :: (Service -> Service)
-> DeleteOptOutList -> Request DeleteOptOutList
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 DeleteOptOutList
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteOptOutList)))
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 Text -> Maybe Text -> Int -> DeleteOptOutListResponse
DeleteOptOutListResponse'
            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
"OptOutListArn")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

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

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

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

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

-- | /See:/ 'newDeleteOptOutListResponse' smart constructor.
data DeleteOptOutListResponse = DeleteOptOutListResponse'
  { -- | The time when the OptOutList was created, in
    -- <https://www.epochconverter.com/ UNIX epoch time> format.
    DeleteOptOutListResponse -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Resource Name (ARN) of the OptOutList that was removed.
    DeleteOptOutListResponse -> Maybe Text
optOutListArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the OptOutList that was removed.
    DeleteOptOutListResponse -> Maybe Text
optOutListName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteOptOutListResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteOptOutListResponse -> DeleteOptOutListResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteOptOutListResponse -> DeleteOptOutListResponse -> Bool
$c/= :: DeleteOptOutListResponse -> DeleteOptOutListResponse -> Bool
== :: DeleteOptOutListResponse -> DeleteOptOutListResponse -> Bool
$c== :: DeleteOptOutListResponse -> DeleteOptOutListResponse -> Bool
Prelude.Eq, ReadPrec [DeleteOptOutListResponse]
ReadPrec DeleteOptOutListResponse
Int -> ReadS DeleteOptOutListResponse
ReadS [DeleteOptOutListResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteOptOutListResponse]
$creadListPrec :: ReadPrec [DeleteOptOutListResponse]
readPrec :: ReadPrec DeleteOptOutListResponse
$creadPrec :: ReadPrec DeleteOptOutListResponse
readList :: ReadS [DeleteOptOutListResponse]
$creadList :: ReadS [DeleteOptOutListResponse]
readsPrec :: Int -> ReadS DeleteOptOutListResponse
$creadsPrec :: Int -> ReadS DeleteOptOutListResponse
Prelude.Read, Int -> DeleteOptOutListResponse -> ShowS
[DeleteOptOutListResponse] -> ShowS
DeleteOptOutListResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteOptOutListResponse] -> ShowS
$cshowList :: [DeleteOptOutListResponse] -> ShowS
show :: DeleteOptOutListResponse -> String
$cshow :: DeleteOptOutListResponse -> String
showsPrec :: Int -> DeleteOptOutListResponse -> ShowS
$cshowsPrec :: Int -> DeleteOptOutListResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteOptOutListResponse x -> DeleteOptOutListResponse
forall x.
DeleteOptOutListResponse -> Rep DeleteOptOutListResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteOptOutListResponse x -> DeleteOptOutListResponse
$cfrom :: forall x.
DeleteOptOutListResponse -> Rep DeleteOptOutListResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteOptOutListResponse' 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', 'deleteOptOutListResponse_createdTimestamp' - The time when the OptOutList was created, in
-- <https://www.epochconverter.com/ UNIX epoch time> format.
--
-- 'optOutListArn', 'deleteOptOutListResponse_optOutListArn' - The Amazon Resource Name (ARN) of the OptOutList that was removed.
--
-- 'optOutListName', 'deleteOptOutListResponse_optOutListName' - The name of the OptOutList that was removed.
--
-- 'httpStatus', 'deleteOptOutListResponse_httpStatus' - The response's http status code.
newDeleteOptOutListResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteOptOutListResponse
newDeleteOptOutListResponse :: Int -> DeleteOptOutListResponse
newDeleteOptOutListResponse Int
pHttpStatus_ =
  DeleteOptOutListResponse'
    { $sel:createdTimestamp:DeleteOptOutListResponse' :: Maybe POSIX
createdTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:optOutListArn:DeleteOptOutListResponse' :: Maybe Text
optOutListArn = forall a. Maybe a
Prelude.Nothing,
      $sel:optOutListName:DeleteOptOutListResponse' :: Maybe Text
optOutListName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteOptOutListResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time when the OptOutList was created, in
-- <https://www.epochconverter.com/ UNIX epoch time> format.
deleteOptOutListResponse_createdTimestamp :: Lens.Lens' DeleteOptOutListResponse (Prelude.Maybe Prelude.UTCTime)
deleteOptOutListResponse_createdTimestamp :: Lens' DeleteOptOutListResponse (Maybe UTCTime)
deleteOptOutListResponse_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOptOutListResponse' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: DeleteOptOutListResponse
s@DeleteOptOutListResponse' {} Maybe POSIX
a -> DeleteOptOutListResponse
s {$sel:createdTimestamp:DeleteOptOutListResponse' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: DeleteOptOutListResponse) 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 Amazon Resource Name (ARN) of the OptOutList that was removed.
deleteOptOutListResponse_optOutListArn :: Lens.Lens' DeleteOptOutListResponse (Prelude.Maybe Prelude.Text)
deleteOptOutListResponse_optOutListArn :: Lens' DeleteOptOutListResponse (Maybe Text)
deleteOptOutListResponse_optOutListArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOptOutListResponse' {Maybe Text
optOutListArn :: Maybe Text
$sel:optOutListArn:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Maybe Text
optOutListArn} -> Maybe Text
optOutListArn) (\s :: DeleteOptOutListResponse
s@DeleteOptOutListResponse' {} Maybe Text
a -> DeleteOptOutListResponse
s {$sel:optOutListArn:DeleteOptOutListResponse' :: Maybe Text
optOutListArn = Maybe Text
a} :: DeleteOptOutListResponse)

-- | The name of the OptOutList that was removed.
deleteOptOutListResponse_optOutListName :: Lens.Lens' DeleteOptOutListResponse (Prelude.Maybe Prelude.Text)
deleteOptOutListResponse_optOutListName :: Lens' DeleteOptOutListResponse (Maybe Text)
deleteOptOutListResponse_optOutListName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOptOutListResponse' {Maybe Text
optOutListName :: Maybe Text
$sel:optOutListName:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Maybe Text
optOutListName} -> Maybe Text
optOutListName) (\s :: DeleteOptOutListResponse
s@DeleteOptOutListResponse' {} Maybe Text
a -> DeleteOptOutListResponse
s {$sel:optOutListName:DeleteOptOutListResponse' :: Maybe Text
optOutListName = Maybe Text
a} :: DeleteOptOutListResponse)

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

instance Prelude.NFData DeleteOptOutListResponse where
  rnf :: DeleteOptOutListResponse -> ()
rnf DeleteOptOutListResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
optOutListName :: Maybe Text
optOutListArn :: Maybe Text
createdTimestamp :: Maybe POSIX
$sel:httpStatus:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Int
$sel:optOutListName:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Maybe Text
$sel:optOutListArn:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> Maybe Text
$sel:createdTimestamp:DeleteOptOutListResponse' :: DeleteOptOutListResponse -> 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 Text
optOutListArn
      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 Int
httpStatus