{-# 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.ListReceiptFilters
-- 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 IP address filters associated with your AWS account in the
-- current AWS Region.
--
-- 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.ListReceiptFilters
  ( -- * Creating a Request
    ListReceiptFilters (..),
    newListReceiptFilters,

    -- * Destructuring the Response
    ListReceiptFiltersResponse (..),
    newListReceiptFiltersResponse,

    -- * Response Lenses
    listReceiptFiltersResponse_filters,
    listReceiptFiltersResponse_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 list the IP address filters that exist under
-- your AWS account. 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:/ 'newListReceiptFilters' smart constructor.
data ListReceiptFilters = ListReceiptFilters'
  {
  }
  deriving (ListReceiptFilters -> ListReceiptFilters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListReceiptFilters -> ListReceiptFilters -> Bool
$c/= :: ListReceiptFilters -> ListReceiptFilters -> Bool
== :: ListReceiptFilters -> ListReceiptFilters -> Bool
$c== :: ListReceiptFilters -> ListReceiptFilters -> Bool
Prelude.Eq, ReadPrec [ListReceiptFilters]
ReadPrec ListReceiptFilters
Int -> ReadS ListReceiptFilters
ReadS [ListReceiptFilters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListReceiptFilters]
$creadListPrec :: ReadPrec [ListReceiptFilters]
readPrec :: ReadPrec ListReceiptFilters
$creadPrec :: ReadPrec ListReceiptFilters
readList :: ReadS [ListReceiptFilters]
$creadList :: ReadS [ListReceiptFilters]
readsPrec :: Int -> ReadS ListReceiptFilters
$creadsPrec :: Int -> ReadS ListReceiptFilters
Prelude.Read, Int -> ListReceiptFilters -> ShowS
[ListReceiptFilters] -> ShowS
ListReceiptFilters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListReceiptFilters] -> ShowS
$cshowList :: [ListReceiptFilters] -> ShowS
show :: ListReceiptFilters -> String
$cshow :: ListReceiptFilters -> String
showsPrec :: Int -> ListReceiptFilters -> ShowS
$cshowsPrec :: Int -> ListReceiptFilters -> ShowS
Prelude.Show, forall x. Rep ListReceiptFilters x -> ListReceiptFilters
forall x. ListReceiptFilters -> Rep ListReceiptFilters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListReceiptFilters x -> ListReceiptFilters
$cfrom :: forall x. ListReceiptFilters -> Rep ListReceiptFilters x
Prelude.Generic)

-- |
-- Create a value of 'ListReceiptFilters' 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.
newListReceiptFilters ::
  ListReceiptFilters
newListReceiptFilters :: ListReceiptFilters
newListReceiptFilters = ListReceiptFilters
ListReceiptFilters'

instance Core.AWSRequest ListReceiptFilters where
  type
    AWSResponse ListReceiptFilters =
      ListReceiptFiltersResponse
  request :: (Service -> Service)
-> ListReceiptFilters -> Request ListReceiptFilters
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 ListReceiptFilters
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListReceiptFilters)))
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
"ListReceiptFiltersResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [ReceiptFilter] -> Int -> ListReceiptFiltersResponse
ListReceiptFiltersResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Filters"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 ListReceiptFilters where
  hashWithSalt :: Int -> ListReceiptFilters -> Int
hashWithSalt Int
_salt ListReceiptFilters
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData ListReceiptFilters where
  rnf :: ListReceiptFilters -> ()
rnf ListReceiptFilters
_ = ()

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

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

instance Data.ToQuery ListReceiptFilters where
  toQuery :: ListReceiptFilters -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ ByteString
"Action"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListReceiptFilters" :: Prelude.ByteString),
            ByteString
"Version"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString)
          ]
      )

-- | A list of IP address filters that exist under your AWS account.
--
-- /See:/ 'newListReceiptFiltersResponse' smart constructor.
data ListReceiptFiltersResponse = ListReceiptFiltersResponse'
  { -- | A list of IP address filter data structures, which each consist of a
    -- name, an IP address range, and whether to allow or block mail from it.
    ListReceiptFiltersResponse -> Maybe [ReceiptFilter]
filters :: Prelude.Maybe [ReceiptFilter],
    -- | The response's http status code.
    ListReceiptFiltersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListReceiptFiltersResponse -> ListReceiptFiltersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListReceiptFiltersResponse -> ListReceiptFiltersResponse -> Bool
$c/= :: ListReceiptFiltersResponse -> ListReceiptFiltersResponse -> Bool
== :: ListReceiptFiltersResponse -> ListReceiptFiltersResponse -> Bool
$c== :: ListReceiptFiltersResponse -> ListReceiptFiltersResponse -> Bool
Prelude.Eq, ReadPrec [ListReceiptFiltersResponse]
ReadPrec ListReceiptFiltersResponse
Int -> ReadS ListReceiptFiltersResponse
ReadS [ListReceiptFiltersResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListReceiptFiltersResponse]
$creadListPrec :: ReadPrec [ListReceiptFiltersResponse]
readPrec :: ReadPrec ListReceiptFiltersResponse
$creadPrec :: ReadPrec ListReceiptFiltersResponse
readList :: ReadS [ListReceiptFiltersResponse]
$creadList :: ReadS [ListReceiptFiltersResponse]
readsPrec :: Int -> ReadS ListReceiptFiltersResponse
$creadsPrec :: Int -> ReadS ListReceiptFiltersResponse
Prelude.Read, Int -> ListReceiptFiltersResponse -> ShowS
[ListReceiptFiltersResponse] -> ShowS
ListReceiptFiltersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListReceiptFiltersResponse] -> ShowS
$cshowList :: [ListReceiptFiltersResponse] -> ShowS
show :: ListReceiptFiltersResponse -> String
$cshow :: ListReceiptFiltersResponse -> String
showsPrec :: Int -> ListReceiptFiltersResponse -> ShowS
$cshowsPrec :: Int -> ListReceiptFiltersResponse -> ShowS
Prelude.Show, forall x.
Rep ListReceiptFiltersResponse x -> ListReceiptFiltersResponse
forall x.
ListReceiptFiltersResponse -> Rep ListReceiptFiltersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListReceiptFiltersResponse x -> ListReceiptFiltersResponse
$cfrom :: forall x.
ListReceiptFiltersResponse -> Rep ListReceiptFiltersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListReceiptFiltersResponse' 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:
--
-- 'filters', 'listReceiptFiltersResponse_filters' - A list of IP address filter data structures, which each consist of a
-- name, an IP address range, and whether to allow or block mail from it.
--
-- 'httpStatus', 'listReceiptFiltersResponse_httpStatus' - The response's http status code.
newListReceiptFiltersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListReceiptFiltersResponse
newListReceiptFiltersResponse :: Int -> ListReceiptFiltersResponse
newListReceiptFiltersResponse Int
pHttpStatus_ =
  ListReceiptFiltersResponse'
    { $sel:filters:ListReceiptFiltersResponse' :: Maybe [ReceiptFilter]
filters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListReceiptFiltersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of IP address filter data structures, which each consist of a
-- name, an IP address range, and whether to allow or block mail from it.
listReceiptFiltersResponse_filters :: Lens.Lens' ListReceiptFiltersResponse (Prelude.Maybe [ReceiptFilter])
listReceiptFiltersResponse_filters :: Lens' ListReceiptFiltersResponse (Maybe [ReceiptFilter])
listReceiptFiltersResponse_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptFiltersResponse' {Maybe [ReceiptFilter]
filters :: Maybe [ReceiptFilter]
$sel:filters:ListReceiptFiltersResponse' :: ListReceiptFiltersResponse -> Maybe [ReceiptFilter]
filters} -> Maybe [ReceiptFilter]
filters) (\s :: ListReceiptFiltersResponse
s@ListReceiptFiltersResponse' {} Maybe [ReceiptFilter]
a -> ListReceiptFiltersResponse
s {$sel:filters:ListReceiptFiltersResponse' :: Maybe [ReceiptFilter]
filters = Maybe [ReceiptFilter]
a} :: ListReceiptFiltersResponse) 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.
listReceiptFiltersResponse_httpStatus :: Lens.Lens' ListReceiptFiltersResponse Prelude.Int
listReceiptFiltersResponse_httpStatus :: Lens' ListReceiptFiltersResponse Int
listReceiptFiltersResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListReceiptFiltersResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListReceiptFiltersResponse' :: ListReceiptFiltersResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListReceiptFiltersResponse
s@ListReceiptFiltersResponse' {} Int
a -> ListReceiptFiltersResponse
s {$sel:httpStatus:ListReceiptFiltersResponse' :: Int
httpStatus = Int
a} :: ListReceiptFiltersResponse)

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