{-# 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.ListIdentityPolicies
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of sending authorization policies that are attached to
-- the given identity (an email address or a domain). This API returns only
-- a list. If you want the actual policy content, you can use
-- @GetIdentityPolicies@.
--
-- This API is for the identity owner only. If you have not verified the
-- identity, this API will return an error.
--
-- Sending authorization is a feature that enables an identity owner to
-- authorize other senders to use its identities. For information about
-- using sending authorization, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/sending-authorization.html Amazon SES Developer Guide>.
--
-- You can execute this operation no more than once per second.
module Amazonka.SES.ListIdentityPolicies
  ( -- * Creating a Request
    ListIdentityPolicies (..),
    newListIdentityPolicies,

    -- * Request Lenses
    listIdentityPolicies_identity,

    -- * Destructuring the Response
    ListIdentityPoliciesResponse (..),
    newListIdentityPoliciesResponse,

    -- * Response Lenses
    listIdentityPoliciesResponse_httpStatus,
    listIdentityPoliciesResponse_policyNames,
  )
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 return a list of sending authorization policies
-- that are attached to an identity. Sending authorization is an Amazon SES
-- feature that enables you to authorize other senders to use your
-- identities. For information, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/sending-authorization.html Amazon SES Developer Guide>.
--
-- /See:/ 'newListIdentityPolicies' smart constructor.
data ListIdentityPolicies = ListIdentityPolicies'
  { -- | The identity that is associated with the policy for which the policies
    -- will be listed. You can specify an identity by using its name or by
    -- using its Amazon Resource Name (ARN). Examples: @user\@example.com@,
    -- @example.com@,
    -- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
    --
    -- To successfully call this API, you must own the identity.
    ListIdentityPolicies -> Text
identity :: Prelude.Text
  }
  deriving (ListIdentityPolicies -> ListIdentityPolicies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIdentityPolicies -> ListIdentityPolicies -> Bool
$c/= :: ListIdentityPolicies -> ListIdentityPolicies -> Bool
== :: ListIdentityPolicies -> ListIdentityPolicies -> Bool
$c== :: ListIdentityPolicies -> ListIdentityPolicies -> Bool
Prelude.Eq, ReadPrec [ListIdentityPolicies]
ReadPrec ListIdentityPolicies
Int -> ReadS ListIdentityPolicies
ReadS [ListIdentityPolicies]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIdentityPolicies]
$creadListPrec :: ReadPrec [ListIdentityPolicies]
readPrec :: ReadPrec ListIdentityPolicies
$creadPrec :: ReadPrec ListIdentityPolicies
readList :: ReadS [ListIdentityPolicies]
$creadList :: ReadS [ListIdentityPolicies]
readsPrec :: Int -> ReadS ListIdentityPolicies
$creadsPrec :: Int -> ReadS ListIdentityPolicies
Prelude.Read, Int -> ListIdentityPolicies -> ShowS
[ListIdentityPolicies] -> ShowS
ListIdentityPolicies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIdentityPolicies] -> ShowS
$cshowList :: [ListIdentityPolicies] -> ShowS
show :: ListIdentityPolicies -> String
$cshow :: ListIdentityPolicies -> String
showsPrec :: Int -> ListIdentityPolicies -> ShowS
$cshowsPrec :: Int -> ListIdentityPolicies -> ShowS
Prelude.Show, forall x. Rep ListIdentityPolicies x -> ListIdentityPolicies
forall x. ListIdentityPolicies -> Rep ListIdentityPolicies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIdentityPolicies x -> ListIdentityPolicies
$cfrom :: forall x. ListIdentityPolicies -> Rep ListIdentityPolicies x
Prelude.Generic)

-- |
-- Create a value of 'ListIdentityPolicies' 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:
--
-- 'identity', 'listIdentityPolicies_identity' - The identity that is associated with the policy for which the policies
-- will be listed. You can specify an identity by using its name or by
-- using its Amazon Resource Name (ARN). Examples: @user\@example.com@,
-- @example.com@,
-- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
--
-- To successfully call this API, you must own the identity.
newListIdentityPolicies ::
  -- | 'identity'
  Prelude.Text ->
  ListIdentityPolicies
newListIdentityPolicies :: Text -> ListIdentityPolicies
newListIdentityPolicies Text
pIdentity_ =
  ListIdentityPolicies' {$sel:identity:ListIdentityPolicies' :: Text
identity = Text
pIdentity_}

-- | The identity that is associated with the policy for which the policies
-- will be listed. You can specify an identity by using its name or by
-- using its Amazon Resource Name (ARN). Examples: @user\@example.com@,
-- @example.com@,
-- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
--
-- To successfully call this API, you must own the identity.
listIdentityPolicies_identity :: Lens.Lens' ListIdentityPolicies Prelude.Text
listIdentityPolicies_identity :: Lens' ListIdentityPolicies Text
listIdentityPolicies_identity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentityPolicies' {Text
identity :: Text
$sel:identity:ListIdentityPolicies' :: ListIdentityPolicies -> Text
identity} -> Text
identity) (\s :: ListIdentityPolicies
s@ListIdentityPolicies' {} Text
a -> ListIdentityPolicies
s {$sel:identity:ListIdentityPolicies' :: Text
identity = Text
a} :: ListIdentityPolicies)

instance Core.AWSRequest ListIdentityPolicies where
  type
    AWSResponse ListIdentityPolicies =
      ListIdentityPoliciesResponse
  request :: (Service -> Service)
-> ListIdentityPolicies -> Request ListIdentityPolicies
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 ListIdentityPolicies
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListIdentityPolicies)))
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
"ListIdentityPoliciesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> [Text] -> ListIdentityPoliciesResponse
ListIdentityPoliciesResponse'
            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.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PolicyNames"
                            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 a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                        )
      )

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

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

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

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

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

-- | A list of names of sending authorization policies that apply to an
-- identity.
--
-- /See:/ 'newListIdentityPoliciesResponse' smart constructor.
data ListIdentityPoliciesResponse = ListIdentityPoliciesResponse'
  { -- | The response's http status code.
    ListIdentityPoliciesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of names of policies that apply to the specified identity.
    ListIdentityPoliciesResponse -> [Text]
policyNames :: [Prelude.Text]
  }
  deriving (ListIdentityPoliciesResponse
-> ListIdentityPoliciesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIdentityPoliciesResponse
-> ListIdentityPoliciesResponse -> Bool
$c/= :: ListIdentityPoliciesResponse
-> ListIdentityPoliciesResponse -> Bool
== :: ListIdentityPoliciesResponse
-> ListIdentityPoliciesResponse -> Bool
$c== :: ListIdentityPoliciesResponse
-> ListIdentityPoliciesResponse -> Bool
Prelude.Eq, ReadPrec [ListIdentityPoliciesResponse]
ReadPrec ListIdentityPoliciesResponse
Int -> ReadS ListIdentityPoliciesResponse
ReadS [ListIdentityPoliciesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIdentityPoliciesResponse]
$creadListPrec :: ReadPrec [ListIdentityPoliciesResponse]
readPrec :: ReadPrec ListIdentityPoliciesResponse
$creadPrec :: ReadPrec ListIdentityPoliciesResponse
readList :: ReadS [ListIdentityPoliciesResponse]
$creadList :: ReadS [ListIdentityPoliciesResponse]
readsPrec :: Int -> ReadS ListIdentityPoliciesResponse
$creadsPrec :: Int -> ReadS ListIdentityPoliciesResponse
Prelude.Read, Int -> ListIdentityPoliciesResponse -> ShowS
[ListIdentityPoliciesResponse] -> ShowS
ListIdentityPoliciesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIdentityPoliciesResponse] -> ShowS
$cshowList :: [ListIdentityPoliciesResponse] -> ShowS
show :: ListIdentityPoliciesResponse -> String
$cshow :: ListIdentityPoliciesResponse -> String
showsPrec :: Int -> ListIdentityPoliciesResponse -> ShowS
$cshowsPrec :: Int -> ListIdentityPoliciesResponse -> ShowS
Prelude.Show, forall x.
Rep ListIdentityPoliciesResponse x -> ListIdentityPoliciesResponse
forall x.
ListIdentityPoliciesResponse -> Rep ListIdentityPoliciesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListIdentityPoliciesResponse x -> ListIdentityPoliciesResponse
$cfrom :: forall x.
ListIdentityPoliciesResponse -> Rep ListIdentityPoliciesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListIdentityPoliciesResponse' 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', 'listIdentityPoliciesResponse_httpStatus' - The response's http status code.
--
-- 'policyNames', 'listIdentityPoliciesResponse_policyNames' - A list of names of policies that apply to the specified identity.
newListIdentityPoliciesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListIdentityPoliciesResponse
newListIdentityPoliciesResponse :: Int -> ListIdentityPoliciesResponse
newListIdentityPoliciesResponse Int
pHttpStatus_ =
  ListIdentityPoliciesResponse'
    { $sel:httpStatus:ListIdentityPoliciesResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:policyNames:ListIdentityPoliciesResponse' :: [Text]
policyNames = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | A list of names of policies that apply to the specified identity.
listIdentityPoliciesResponse_policyNames :: Lens.Lens' ListIdentityPoliciesResponse [Prelude.Text]
listIdentityPoliciesResponse_policyNames :: Lens' ListIdentityPoliciesResponse [Text]
listIdentityPoliciesResponse_policyNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentityPoliciesResponse' {[Text]
policyNames :: [Text]
$sel:policyNames:ListIdentityPoliciesResponse' :: ListIdentityPoliciesResponse -> [Text]
policyNames} -> [Text]
policyNames) (\s :: ListIdentityPoliciesResponse
s@ListIdentityPoliciesResponse' {} [Text]
a -> ListIdentityPoliciesResponse
s {$sel:policyNames:ListIdentityPoliciesResponse' :: [Text]
policyNames = [Text]
a} :: ListIdentityPoliciesResponse) 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 ListIdentityPoliciesResponse where
  rnf :: ListIdentityPoliciesResponse -> ()
rnf ListIdentityPoliciesResponse' {Int
[Text]
policyNames :: [Text]
httpStatus :: Int
$sel:policyNames:ListIdentityPoliciesResponse' :: ListIdentityPoliciesResponse -> [Text]
$sel:httpStatus:ListIdentityPoliciesResponse' :: ListIdentityPoliciesResponse -> 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 [Text]
policyNames