{-# 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.SES.DeleteReceiptFilter
-- 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 the specified IP address filter.
--
-- For information about managing IP address filters, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email-managing-ip-filters.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.DeleteReceiptFilter
  ( -- * Creating a Request
    DeleteReceiptFilter (..),
    newDeleteReceiptFilter,

    -- * Request Lenses
    deleteReceiptFilter_filterName,

    -- * Destructuring the Response
    DeleteReceiptFilterResponse (..),
    newDeleteReceiptFilterResponse,

    -- * Response Lenses
    deleteReceiptFilterResponse_httpStatus,
  )
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.SES.Types

-- | Represents a request to delete an IP address filter. You use IP address
-- filters when you receive email with Amazon SES. For more information,
-- see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email-concepts.html Amazon SES Developer Guide>.
--
-- /See:/ 'newDeleteReceiptFilter' smart constructor.
data DeleteReceiptFilter = DeleteReceiptFilter'
  { -- | The name of the IP address filter to delete.
    DeleteReceiptFilter -> Text
filterName :: Prelude.Text
  }
  deriving (DeleteReceiptFilter -> DeleteReceiptFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteReceiptFilter -> DeleteReceiptFilter -> Bool
$c/= :: DeleteReceiptFilter -> DeleteReceiptFilter -> Bool
== :: DeleteReceiptFilter -> DeleteReceiptFilter -> Bool
$c== :: DeleteReceiptFilter -> DeleteReceiptFilter -> Bool
Prelude.Eq, ReadPrec [DeleteReceiptFilter]
ReadPrec DeleteReceiptFilter
Int -> ReadS DeleteReceiptFilter
ReadS [DeleteReceiptFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteReceiptFilter]
$creadListPrec :: ReadPrec [DeleteReceiptFilter]
readPrec :: ReadPrec DeleteReceiptFilter
$creadPrec :: ReadPrec DeleteReceiptFilter
readList :: ReadS [DeleteReceiptFilter]
$creadList :: ReadS [DeleteReceiptFilter]
readsPrec :: Int -> ReadS DeleteReceiptFilter
$creadsPrec :: Int -> ReadS DeleteReceiptFilter
Prelude.Read, Int -> DeleteReceiptFilter -> ShowS
[DeleteReceiptFilter] -> ShowS
DeleteReceiptFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteReceiptFilter] -> ShowS
$cshowList :: [DeleteReceiptFilter] -> ShowS
show :: DeleteReceiptFilter -> String
$cshow :: DeleteReceiptFilter -> String
showsPrec :: Int -> DeleteReceiptFilter -> ShowS
$cshowsPrec :: Int -> DeleteReceiptFilter -> ShowS
Prelude.Show, forall x. Rep DeleteReceiptFilter x -> DeleteReceiptFilter
forall x. DeleteReceiptFilter -> Rep DeleteReceiptFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteReceiptFilter x -> DeleteReceiptFilter
$cfrom :: forall x. DeleteReceiptFilter -> Rep DeleteReceiptFilter x
Prelude.Generic)

-- |
-- Create a value of 'DeleteReceiptFilter' 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:
--
-- 'filterName', 'deleteReceiptFilter_filterName' - The name of the IP address filter to delete.
newDeleteReceiptFilter ::
  -- | 'filterName'
  Prelude.Text ->
  DeleteReceiptFilter
newDeleteReceiptFilter :: Text -> DeleteReceiptFilter
newDeleteReceiptFilter Text
pFilterName_ =
  DeleteReceiptFilter' {$sel:filterName:DeleteReceiptFilter' :: Text
filterName = Text
pFilterName_}

-- | The name of the IP address filter to delete.
deleteReceiptFilter_filterName :: Lens.Lens' DeleteReceiptFilter Prelude.Text
deleteReceiptFilter_filterName :: Lens' DeleteReceiptFilter Text
deleteReceiptFilter_filterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteReceiptFilter' {Text
filterName :: Text
$sel:filterName:DeleteReceiptFilter' :: DeleteReceiptFilter -> Text
filterName} -> Text
filterName) (\s :: DeleteReceiptFilter
s@DeleteReceiptFilter' {} Text
a -> DeleteReceiptFilter
s {$sel:filterName:DeleteReceiptFilter' :: Text
filterName = Text
a} :: DeleteReceiptFilter)

instance Core.AWSRequest DeleteReceiptFilter where
  type
    AWSResponse DeleteReceiptFilter =
      DeleteReceiptFilterResponse
  request :: (Service -> Service)
-> DeleteReceiptFilter -> Request DeleteReceiptFilter
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteReceiptFilter
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteReceiptFilter)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DeleteReceiptFilterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> DeleteReceiptFilterResponse
DeleteReceiptFilterResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteReceiptFilter where
  hashWithSalt :: Int -> DeleteReceiptFilter -> Int
hashWithSalt Int
_salt DeleteReceiptFilter' {Text
filterName :: Text
$sel:filterName:DeleteReceiptFilter' :: DeleteReceiptFilter -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filterName

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

instance Data.ToHeaders DeleteReceiptFilter where
  toHeaders :: DeleteReceiptFilter -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteReceiptFilter where
  toQuery :: DeleteReceiptFilter -> QueryString
toQuery DeleteReceiptFilter' {Text
filterName :: Text
$sel:filterName:DeleteReceiptFilter' :: DeleteReceiptFilter -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteReceiptFilter" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"FilterName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
filterName
      ]

-- | An empty element returned on a successful request.
--
-- /See:/ 'newDeleteReceiptFilterResponse' smart constructor.
data DeleteReceiptFilterResponse = DeleteReceiptFilterResponse'
  { -- | The response's http status code.
    DeleteReceiptFilterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteReceiptFilterResponse -> DeleteReceiptFilterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteReceiptFilterResponse -> DeleteReceiptFilterResponse -> Bool
$c/= :: DeleteReceiptFilterResponse -> DeleteReceiptFilterResponse -> Bool
== :: DeleteReceiptFilterResponse -> DeleteReceiptFilterResponse -> Bool
$c== :: DeleteReceiptFilterResponse -> DeleteReceiptFilterResponse -> Bool
Prelude.Eq, ReadPrec [DeleteReceiptFilterResponse]
ReadPrec DeleteReceiptFilterResponse
Int -> ReadS DeleteReceiptFilterResponse
ReadS [DeleteReceiptFilterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteReceiptFilterResponse]
$creadListPrec :: ReadPrec [DeleteReceiptFilterResponse]
readPrec :: ReadPrec DeleteReceiptFilterResponse
$creadPrec :: ReadPrec DeleteReceiptFilterResponse
readList :: ReadS [DeleteReceiptFilterResponse]
$creadList :: ReadS [DeleteReceiptFilterResponse]
readsPrec :: Int -> ReadS DeleteReceiptFilterResponse
$creadsPrec :: Int -> ReadS DeleteReceiptFilterResponse
Prelude.Read, Int -> DeleteReceiptFilterResponse -> ShowS
[DeleteReceiptFilterResponse] -> ShowS
DeleteReceiptFilterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteReceiptFilterResponse] -> ShowS
$cshowList :: [DeleteReceiptFilterResponse] -> ShowS
show :: DeleteReceiptFilterResponse -> String
$cshow :: DeleteReceiptFilterResponse -> String
showsPrec :: Int -> DeleteReceiptFilterResponse -> ShowS
$cshowsPrec :: Int -> DeleteReceiptFilterResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteReceiptFilterResponse x -> DeleteReceiptFilterResponse
forall x.
DeleteReceiptFilterResponse -> Rep DeleteReceiptFilterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteReceiptFilterResponse x -> DeleteReceiptFilterResponse
$cfrom :: forall x.
DeleteReceiptFilterResponse -> Rep DeleteReceiptFilterResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteReceiptFilterResponse' 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:
--
-- 'httpStatus', 'deleteReceiptFilterResponse_httpStatus' - The response's http status code.
newDeleteReceiptFilterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteReceiptFilterResponse
newDeleteReceiptFilterResponse :: Int -> DeleteReceiptFilterResponse
newDeleteReceiptFilterResponse Int
pHttpStatus_ =
  DeleteReceiptFilterResponse'
    { $sel:httpStatus:DeleteReceiptFilterResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData DeleteReceiptFilterResponse where
  rnf :: DeleteReceiptFilterResponse -> ()
rnf DeleteReceiptFilterResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteReceiptFilterResponse' :: DeleteReceiptFilterResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus