{-# 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.SESV2.GetBlacklistReports
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieve a list of the blacklists that your dedicated IP addresses
-- appear on.
module Amazonka.SESV2.GetBlacklistReports
  ( -- * Creating a Request
    GetBlacklistReports (..),
    newGetBlacklistReports,

    -- * Request Lenses
    getBlacklistReports_blacklistItemNames,

    -- * Destructuring the Response
    GetBlacklistReportsResponse (..),
    newGetBlacklistReportsResponse,

    -- * Response Lenses
    getBlacklistReportsResponse_httpStatus,
    getBlacklistReportsResponse_blacklistReport,
  )
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.SESV2.Types

-- | A request to retrieve a list of the blacklists that your dedicated IP
-- addresses appear on.
--
-- /See:/ 'newGetBlacklistReports' smart constructor.
data GetBlacklistReports = GetBlacklistReports'
  { -- | A list of IP addresses that you want to retrieve blacklist information
    -- about. You can only specify the dedicated IP addresses that you use to
    -- send email using Amazon SES or Amazon Pinpoint.
    GetBlacklistReports -> [Text]
blacklistItemNames :: [Prelude.Text]
  }
  deriving (GetBlacklistReports -> GetBlacklistReports -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBlacklistReports -> GetBlacklistReports -> Bool
$c/= :: GetBlacklistReports -> GetBlacklistReports -> Bool
== :: GetBlacklistReports -> GetBlacklistReports -> Bool
$c== :: GetBlacklistReports -> GetBlacklistReports -> Bool
Prelude.Eq, ReadPrec [GetBlacklistReports]
ReadPrec GetBlacklistReports
Int -> ReadS GetBlacklistReports
ReadS [GetBlacklistReports]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBlacklistReports]
$creadListPrec :: ReadPrec [GetBlacklistReports]
readPrec :: ReadPrec GetBlacklistReports
$creadPrec :: ReadPrec GetBlacklistReports
readList :: ReadS [GetBlacklistReports]
$creadList :: ReadS [GetBlacklistReports]
readsPrec :: Int -> ReadS GetBlacklistReports
$creadsPrec :: Int -> ReadS GetBlacklistReports
Prelude.Read, Int -> GetBlacklistReports -> ShowS
[GetBlacklistReports] -> ShowS
GetBlacklistReports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBlacklistReports] -> ShowS
$cshowList :: [GetBlacklistReports] -> ShowS
show :: GetBlacklistReports -> String
$cshow :: GetBlacklistReports -> String
showsPrec :: Int -> GetBlacklistReports -> ShowS
$cshowsPrec :: Int -> GetBlacklistReports -> ShowS
Prelude.Show, forall x. Rep GetBlacklistReports x -> GetBlacklistReports
forall x. GetBlacklistReports -> Rep GetBlacklistReports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBlacklistReports x -> GetBlacklistReports
$cfrom :: forall x. GetBlacklistReports -> Rep GetBlacklistReports x
Prelude.Generic)

-- |
-- Create a value of 'GetBlacklistReports' 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:
--
-- 'blacklistItemNames', 'getBlacklistReports_blacklistItemNames' - A list of IP addresses that you want to retrieve blacklist information
-- about. You can only specify the dedicated IP addresses that you use to
-- send email using Amazon SES or Amazon Pinpoint.
newGetBlacklistReports ::
  GetBlacklistReports
newGetBlacklistReports :: GetBlacklistReports
newGetBlacklistReports =
  GetBlacklistReports'
    { $sel:blacklistItemNames:GetBlacklistReports' :: [Text]
blacklistItemNames =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of IP addresses that you want to retrieve blacklist information
-- about. You can only specify the dedicated IP addresses that you use to
-- send email using Amazon SES or Amazon Pinpoint.
getBlacklistReports_blacklistItemNames :: Lens.Lens' GetBlacklistReports [Prelude.Text]
getBlacklistReports_blacklistItemNames :: Lens' GetBlacklistReports [Text]
getBlacklistReports_blacklistItemNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBlacklistReports' {[Text]
blacklistItemNames :: [Text]
$sel:blacklistItemNames:GetBlacklistReports' :: GetBlacklistReports -> [Text]
blacklistItemNames} -> [Text]
blacklistItemNames) (\s :: GetBlacklistReports
s@GetBlacklistReports' {} [Text]
a -> GetBlacklistReports
s {$sel:blacklistItemNames:GetBlacklistReports' :: [Text]
blacklistItemNames = [Text]
a} :: GetBlacklistReports) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest GetBlacklistReports where
  type
    AWSResponse GetBlacklistReports =
      GetBlacklistReportsResponse
  request :: (Service -> Service)
-> GetBlacklistReports -> Request GetBlacklistReports
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetBlacklistReports
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBlacklistReports)))
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 ->
          Int -> HashMap Text [BlacklistEntry] -> GetBlacklistReportsResponse
GetBlacklistReportsResponse'
            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))
            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
"BlacklistReport"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable GetBlacklistReports where
  hashWithSalt :: Int -> GetBlacklistReports -> Int
hashWithSalt Int
_salt GetBlacklistReports' {[Text]
blacklistItemNames :: [Text]
$sel:blacklistItemNames:GetBlacklistReports' :: GetBlacklistReports -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
blacklistItemNames

instance Prelude.NFData GetBlacklistReports where
  rnf :: GetBlacklistReports -> ()
rnf GetBlacklistReports' {[Text]
blacklistItemNames :: [Text]
$sel:blacklistItemNames:GetBlacklistReports' :: GetBlacklistReports -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
blacklistItemNames

instance Data.ToHeaders GetBlacklistReports where
  toHeaders :: GetBlacklistReports -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetBlacklistReports where
  toPath :: GetBlacklistReports -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/v2/email/deliverability-dashboard/blacklist-report"

instance Data.ToQuery GetBlacklistReports where
  toQuery :: GetBlacklistReports -> QueryString
toQuery GetBlacklistReports' {[Text]
blacklistItemNames :: [Text]
$sel:blacklistItemNames:GetBlacklistReports' :: GetBlacklistReports -> [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"BlacklistItemNames"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
blacklistItemNames
      ]

-- | An object that contains information about blacklist events.
--
-- /See:/ 'newGetBlacklistReportsResponse' smart constructor.
data GetBlacklistReportsResponse = GetBlacklistReportsResponse'
  { -- | The response's http status code.
    GetBlacklistReportsResponse -> Int
httpStatus :: Prelude.Int,
    -- | An object that contains information about a blacklist that one of your
    -- dedicated IP addresses appears on.
    GetBlacklistReportsResponse -> HashMap Text [BlacklistEntry]
blacklistReport :: Prelude.HashMap Prelude.Text [BlacklistEntry]
  }
  deriving (GetBlacklistReportsResponse -> GetBlacklistReportsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBlacklistReportsResponse -> GetBlacklistReportsResponse -> Bool
$c/= :: GetBlacklistReportsResponse -> GetBlacklistReportsResponse -> Bool
== :: GetBlacklistReportsResponse -> GetBlacklistReportsResponse -> Bool
$c== :: GetBlacklistReportsResponse -> GetBlacklistReportsResponse -> Bool
Prelude.Eq, ReadPrec [GetBlacklistReportsResponse]
ReadPrec GetBlacklistReportsResponse
Int -> ReadS GetBlacklistReportsResponse
ReadS [GetBlacklistReportsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBlacklistReportsResponse]
$creadListPrec :: ReadPrec [GetBlacklistReportsResponse]
readPrec :: ReadPrec GetBlacklistReportsResponse
$creadPrec :: ReadPrec GetBlacklistReportsResponse
readList :: ReadS [GetBlacklistReportsResponse]
$creadList :: ReadS [GetBlacklistReportsResponse]
readsPrec :: Int -> ReadS GetBlacklistReportsResponse
$creadsPrec :: Int -> ReadS GetBlacklistReportsResponse
Prelude.Read, Int -> GetBlacklistReportsResponse -> ShowS
[GetBlacklistReportsResponse] -> ShowS
GetBlacklistReportsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBlacklistReportsResponse] -> ShowS
$cshowList :: [GetBlacklistReportsResponse] -> ShowS
show :: GetBlacklistReportsResponse -> String
$cshow :: GetBlacklistReportsResponse -> String
showsPrec :: Int -> GetBlacklistReportsResponse -> ShowS
$cshowsPrec :: Int -> GetBlacklistReportsResponse -> ShowS
Prelude.Show, forall x.
Rep GetBlacklistReportsResponse x -> GetBlacklistReportsResponse
forall x.
GetBlacklistReportsResponse -> Rep GetBlacklistReportsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBlacklistReportsResponse x -> GetBlacklistReportsResponse
$cfrom :: forall x.
GetBlacklistReportsResponse -> Rep GetBlacklistReportsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBlacklistReportsResponse' 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', 'getBlacklistReportsResponse_httpStatus' - The response's http status code.
--
-- 'blacklistReport', 'getBlacklistReportsResponse_blacklistReport' - An object that contains information about a blacklist that one of your
-- dedicated IP addresses appears on.
newGetBlacklistReportsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBlacklistReportsResponse
newGetBlacklistReportsResponse :: Int -> GetBlacklistReportsResponse
newGetBlacklistReportsResponse Int
pHttpStatus_ =
  GetBlacklistReportsResponse'
    { $sel:httpStatus:GetBlacklistReportsResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:blacklistReport:GetBlacklistReportsResponse' :: HashMap Text [BlacklistEntry]
blacklistReport = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | An object that contains information about a blacklist that one of your
-- dedicated IP addresses appears on.
getBlacklistReportsResponse_blacklistReport :: Lens.Lens' GetBlacklistReportsResponse (Prelude.HashMap Prelude.Text [BlacklistEntry])
getBlacklistReportsResponse_blacklistReport :: Lens' GetBlacklistReportsResponse (HashMap Text [BlacklistEntry])
getBlacklistReportsResponse_blacklistReport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBlacklistReportsResponse' {HashMap Text [BlacklistEntry]
blacklistReport :: HashMap Text [BlacklistEntry]
$sel:blacklistReport:GetBlacklistReportsResponse' :: GetBlacklistReportsResponse -> HashMap Text [BlacklistEntry]
blacklistReport} -> HashMap Text [BlacklistEntry]
blacklistReport) (\s :: GetBlacklistReportsResponse
s@GetBlacklistReportsResponse' {} HashMap Text [BlacklistEntry]
a -> GetBlacklistReportsResponse
s {$sel:blacklistReport:GetBlacklistReportsResponse' :: HashMap Text [BlacklistEntry]
blacklistReport = HashMap Text [BlacklistEntry]
a} :: GetBlacklistReportsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetBlacklistReportsResponse where
  rnf :: GetBlacklistReportsResponse -> ()
rnf GetBlacklistReportsResponse' {Int
HashMap Text [BlacklistEntry]
blacklistReport :: HashMap Text [BlacklistEntry]
httpStatus :: Int
$sel:blacklistReport:GetBlacklistReportsResponse' :: GetBlacklistReportsResponse -> HashMap Text [BlacklistEntry]
$sel:httpStatus:GetBlacklistReportsResponse' :: GetBlacklistReportsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text [BlacklistEntry]
blacklistReport