{-# 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.CreateReceiptFilter
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new IP address filter.
--
-- For information about setting up IP address filters, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/receiving-email-ip-filters.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.CreateReceiptFilter
  ( -- * Creating a Request
    CreateReceiptFilter (..),
    newCreateReceiptFilter,

    -- * Request Lenses
    createReceiptFilter_filter,

    -- * Destructuring the Response
    CreateReceiptFilterResponse (..),
    newCreateReceiptFilterResponse,

    -- * Response Lenses
    createReceiptFilterResponse_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 create a new 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:/ 'newCreateReceiptFilter' smart constructor.
data CreateReceiptFilter = CreateReceiptFilter'
  { -- | A data structure that describes the IP address filter to create, which
    -- consists of a name, an IP address range, and whether to allow or block
    -- mail from it.
    CreateReceiptFilter -> ReceiptFilter
filter' :: ReceiptFilter
  }
  deriving (CreateReceiptFilter -> CreateReceiptFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReceiptFilter -> CreateReceiptFilter -> Bool
$c/= :: CreateReceiptFilter -> CreateReceiptFilter -> Bool
== :: CreateReceiptFilter -> CreateReceiptFilter -> Bool
$c== :: CreateReceiptFilter -> CreateReceiptFilter -> Bool
Prelude.Eq, ReadPrec [CreateReceiptFilter]
ReadPrec CreateReceiptFilter
Int -> ReadS CreateReceiptFilter
ReadS [CreateReceiptFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReceiptFilter]
$creadListPrec :: ReadPrec [CreateReceiptFilter]
readPrec :: ReadPrec CreateReceiptFilter
$creadPrec :: ReadPrec CreateReceiptFilter
readList :: ReadS [CreateReceiptFilter]
$creadList :: ReadS [CreateReceiptFilter]
readsPrec :: Int -> ReadS CreateReceiptFilter
$creadsPrec :: Int -> ReadS CreateReceiptFilter
Prelude.Read, Int -> CreateReceiptFilter -> ShowS
[CreateReceiptFilter] -> ShowS
CreateReceiptFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReceiptFilter] -> ShowS
$cshowList :: [CreateReceiptFilter] -> ShowS
show :: CreateReceiptFilter -> String
$cshow :: CreateReceiptFilter -> String
showsPrec :: Int -> CreateReceiptFilter -> ShowS
$cshowsPrec :: Int -> CreateReceiptFilter -> ShowS
Prelude.Show, forall x. Rep CreateReceiptFilter x -> CreateReceiptFilter
forall x. CreateReceiptFilter -> Rep CreateReceiptFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateReceiptFilter x -> CreateReceiptFilter
$cfrom :: forall x. CreateReceiptFilter -> Rep CreateReceiptFilter x
Prelude.Generic)

-- |
-- Create a value of 'CreateReceiptFilter' 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:
--
-- 'filter'', 'createReceiptFilter_filter' - A data structure that describes the IP address filter to create, which
-- consists of a name, an IP address range, and whether to allow or block
-- mail from it.
newCreateReceiptFilter ::
  -- | 'filter''
  ReceiptFilter ->
  CreateReceiptFilter
newCreateReceiptFilter :: ReceiptFilter -> CreateReceiptFilter
newCreateReceiptFilter ReceiptFilter
pFilter_ =
  CreateReceiptFilter' {$sel:filter':CreateReceiptFilter' :: ReceiptFilter
filter' = ReceiptFilter
pFilter_}

-- | A data structure that describes the IP address filter to create, which
-- consists of a name, an IP address range, and whether to allow or block
-- mail from it.
createReceiptFilter_filter :: Lens.Lens' CreateReceiptFilter ReceiptFilter
createReceiptFilter_filter :: Lens' CreateReceiptFilter ReceiptFilter
createReceiptFilter_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReceiptFilter' {ReceiptFilter
filter' :: ReceiptFilter
$sel:filter':CreateReceiptFilter' :: CreateReceiptFilter -> ReceiptFilter
filter'} -> ReceiptFilter
filter') (\s :: CreateReceiptFilter
s@CreateReceiptFilter' {} ReceiptFilter
a -> CreateReceiptFilter
s {$sel:filter':CreateReceiptFilter' :: ReceiptFilter
filter' = ReceiptFilter
a} :: CreateReceiptFilter)

instance Core.AWSRequest CreateReceiptFilter where
  type
    AWSResponse CreateReceiptFilter =
      CreateReceiptFilterResponse
  request :: (Service -> Service)
-> CreateReceiptFilter -> Request CreateReceiptFilter
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 CreateReceiptFilter
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateReceiptFilter)))
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
"CreateReceiptFilterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> CreateReceiptFilterResponse
CreateReceiptFilterResponse'
            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 CreateReceiptFilter where
  hashWithSalt :: Int -> CreateReceiptFilter -> Int
hashWithSalt Int
_salt CreateReceiptFilter' {ReceiptFilter
filter' :: ReceiptFilter
$sel:filter':CreateReceiptFilter' :: CreateReceiptFilter -> ReceiptFilter
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ReceiptFilter
filter'

instance Prelude.NFData CreateReceiptFilter where
  rnf :: CreateReceiptFilter -> ()
rnf CreateReceiptFilter' {ReceiptFilter
filter' :: ReceiptFilter
$sel:filter':CreateReceiptFilter' :: CreateReceiptFilter -> ReceiptFilter
..} = forall a. NFData a => a -> ()
Prelude.rnf ReceiptFilter
filter'

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

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

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

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

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

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

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