{-# 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.WorkMail.GetImpersonationRoleEffect
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests whether the given impersonation role can impersonate a target
-- user.
module Amazonka.WorkMail.GetImpersonationRoleEffect
  ( -- * Creating a Request
    GetImpersonationRoleEffect (..),
    newGetImpersonationRoleEffect,

    -- * Request Lenses
    getImpersonationRoleEffect_organizationId,
    getImpersonationRoleEffect_impersonationRoleId,
    getImpersonationRoleEffect_targetUser,

    -- * Destructuring the Response
    GetImpersonationRoleEffectResponse (..),
    newGetImpersonationRoleEffectResponse,

    -- * Response Lenses
    getImpersonationRoleEffectResponse_effect,
    getImpersonationRoleEffectResponse_matchedRules,
    getImpersonationRoleEffectResponse_type,
    getImpersonationRoleEffectResponse_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.WorkMail.Types

-- | /See:/ 'newGetImpersonationRoleEffect' smart constructor.
data GetImpersonationRoleEffect = GetImpersonationRoleEffect'
  { -- | The WorkMail organization where the impersonation role is defined.
    GetImpersonationRoleEffect -> Text
organizationId :: Prelude.Text,
    -- | The impersonation role ID to test.
    GetImpersonationRoleEffect -> Text
impersonationRoleId :: Prelude.Text,
    -- | The WorkMail organization user chosen to test the impersonation role.
    -- The following identity formats are available:
    --
    -- -   User ID: @12345678-1234-1234-1234-123456789012@ or
    --     @S-1-1-12-1234567890-123456789-123456789-1234@
    --
    -- -   Email address: @user\@domain.tld@
    --
    -- -   User name: @user@
    GetImpersonationRoleEffect -> Text
targetUser :: Prelude.Text
  }
  deriving (GetImpersonationRoleEffect -> GetImpersonationRoleEffect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImpersonationRoleEffect -> GetImpersonationRoleEffect -> Bool
$c/= :: GetImpersonationRoleEffect -> GetImpersonationRoleEffect -> Bool
== :: GetImpersonationRoleEffect -> GetImpersonationRoleEffect -> Bool
$c== :: GetImpersonationRoleEffect -> GetImpersonationRoleEffect -> Bool
Prelude.Eq, ReadPrec [GetImpersonationRoleEffect]
ReadPrec GetImpersonationRoleEffect
Int -> ReadS GetImpersonationRoleEffect
ReadS [GetImpersonationRoleEffect]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImpersonationRoleEffect]
$creadListPrec :: ReadPrec [GetImpersonationRoleEffect]
readPrec :: ReadPrec GetImpersonationRoleEffect
$creadPrec :: ReadPrec GetImpersonationRoleEffect
readList :: ReadS [GetImpersonationRoleEffect]
$creadList :: ReadS [GetImpersonationRoleEffect]
readsPrec :: Int -> ReadS GetImpersonationRoleEffect
$creadsPrec :: Int -> ReadS GetImpersonationRoleEffect
Prelude.Read, Int -> GetImpersonationRoleEffect -> ShowS
[GetImpersonationRoleEffect] -> ShowS
GetImpersonationRoleEffect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImpersonationRoleEffect] -> ShowS
$cshowList :: [GetImpersonationRoleEffect] -> ShowS
show :: GetImpersonationRoleEffect -> String
$cshow :: GetImpersonationRoleEffect -> String
showsPrec :: Int -> GetImpersonationRoleEffect -> ShowS
$cshowsPrec :: Int -> GetImpersonationRoleEffect -> ShowS
Prelude.Show, forall x.
Rep GetImpersonationRoleEffect x -> GetImpersonationRoleEffect
forall x.
GetImpersonationRoleEffect -> Rep GetImpersonationRoleEffect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetImpersonationRoleEffect x -> GetImpersonationRoleEffect
$cfrom :: forall x.
GetImpersonationRoleEffect -> Rep GetImpersonationRoleEffect x
Prelude.Generic)

-- |
-- Create a value of 'GetImpersonationRoleEffect' 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:
--
-- 'organizationId', 'getImpersonationRoleEffect_organizationId' - The WorkMail organization where the impersonation role is defined.
--
-- 'impersonationRoleId', 'getImpersonationRoleEffect_impersonationRoleId' - The impersonation role ID to test.
--
-- 'targetUser', 'getImpersonationRoleEffect_targetUser' - The WorkMail organization user chosen to test the impersonation role.
-- The following identity formats are available:
--
-- -   User ID: @12345678-1234-1234-1234-123456789012@ or
--     @S-1-1-12-1234567890-123456789-123456789-1234@
--
-- -   Email address: @user\@domain.tld@
--
-- -   User name: @user@
newGetImpersonationRoleEffect ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'impersonationRoleId'
  Prelude.Text ->
  -- | 'targetUser'
  Prelude.Text ->
  GetImpersonationRoleEffect
newGetImpersonationRoleEffect :: Text -> Text -> Text -> GetImpersonationRoleEffect
newGetImpersonationRoleEffect
  Text
pOrganizationId_
  Text
pImpersonationRoleId_
  Text
pTargetUser_ =
    GetImpersonationRoleEffect'
      { $sel:organizationId:GetImpersonationRoleEffect' :: Text
organizationId =
          Text
pOrganizationId_,
        $sel:impersonationRoleId:GetImpersonationRoleEffect' :: Text
impersonationRoleId = Text
pImpersonationRoleId_,
        $sel:targetUser:GetImpersonationRoleEffect' :: Text
targetUser = Text
pTargetUser_
      }

-- | The WorkMail organization where the impersonation role is defined.
getImpersonationRoleEffect_organizationId :: Lens.Lens' GetImpersonationRoleEffect Prelude.Text
getImpersonationRoleEffect_organizationId :: Lens' GetImpersonationRoleEffect Text
getImpersonationRoleEffect_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffect' {Text
organizationId :: Text
$sel:organizationId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
organizationId} -> Text
organizationId) (\s :: GetImpersonationRoleEffect
s@GetImpersonationRoleEffect' {} Text
a -> GetImpersonationRoleEffect
s {$sel:organizationId:GetImpersonationRoleEffect' :: Text
organizationId = Text
a} :: GetImpersonationRoleEffect)

-- | The impersonation role ID to test.
getImpersonationRoleEffect_impersonationRoleId :: Lens.Lens' GetImpersonationRoleEffect Prelude.Text
getImpersonationRoleEffect_impersonationRoleId :: Lens' GetImpersonationRoleEffect Text
getImpersonationRoleEffect_impersonationRoleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffect' {Text
impersonationRoleId :: Text
$sel:impersonationRoleId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
impersonationRoleId} -> Text
impersonationRoleId) (\s :: GetImpersonationRoleEffect
s@GetImpersonationRoleEffect' {} Text
a -> GetImpersonationRoleEffect
s {$sel:impersonationRoleId:GetImpersonationRoleEffect' :: Text
impersonationRoleId = Text
a} :: GetImpersonationRoleEffect)

-- | The WorkMail organization user chosen to test the impersonation role.
-- The following identity formats are available:
--
-- -   User ID: @12345678-1234-1234-1234-123456789012@ or
--     @S-1-1-12-1234567890-123456789-123456789-1234@
--
-- -   Email address: @user\@domain.tld@
--
-- -   User name: @user@
getImpersonationRoleEffect_targetUser :: Lens.Lens' GetImpersonationRoleEffect Prelude.Text
getImpersonationRoleEffect_targetUser :: Lens' GetImpersonationRoleEffect Text
getImpersonationRoleEffect_targetUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffect' {Text
targetUser :: Text
$sel:targetUser:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
targetUser} -> Text
targetUser) (\s :: GetImpersonationRoleEffect
s@GetImpersonationRoleEffect' {} Text
a -> GetImpersonationRoleEffect
s {$sel:targetUser:GetImpersonationRoleEffect' :: Text
targetUser = Text
a} :: GetImpersonationRoleEffect)

instance Core.AWSRequest GetImpersonationRoleEffect where
  type
    AWSResponse GetImpersonationRoleEffect =
      GetImpersonationRoleEffectResponse
  request :: (Service -> Service)
-> GetImpersonationRoleEffect -> Request GetImpersonationRoleEffect
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetImpersonationRoleEffect
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetImpersonationRoleEffect)))
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 ->
          Maybe AccessEffect
-> Maybe [ImpersonationMatchedRule]
-> Maybe ImpersonationRoleType
-> Int
-> GetImpersonationRoleEffectResponse
GetImpersonationRoleEffectResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Effect")
            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
"MatchedRules" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"Type")
            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 GetImpersonationRoleEffect where
  hashWithSalt :: Int -> GetImpersonationRoleEffect -> Int
hashWithSalt Int
_salt GetImpersonationRoleEffect' {Text
targetUser :: Text
impersonationRoleId :: Text
organizationId :: Text
$sel:targetUser:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:impersonationRoleId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:organizationId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
impersonationRoleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetUser

instance Prelude.NFData GetImpersonationRoleEffect where
  rnf :: GetImpersonationRoleEffect -> ()
rnf GetImpersonationRoleEffect' {Text
targetUser :: Text
impersonationRoleId :: Text
organizationId :: Text
$sel:targetUser:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:impersonationRoleId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:organizationId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
impersonationRoleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetUser

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

instance Data.ToJSON GetImpersonationRoleEffect where
  toJSON :: GetImpersonationRoleEffect -> Value
toJSON GetImpersonationRoleEffect' {Text
targetUser :: Text
impersonationRoleId :: Text
organizationId :: Text
$sel:targetUser:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:impersonationRoleId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
$sel:organizationId:GetImpersonationRoleEffect' :: GetImpersonationRoleEffect -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ImpersonationRoleId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
impersonationRoleId),
            forall a. a -> Maybe a
Prelude.Just (Key
"TargetUser" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetUser)
          ]
      )

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

instance Data.ToQuery GetImpersonationRoleEffect where
  toQuery :: GetImpersonationRoleEffect -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetImpersonationRoleEffectResponse' smart constructor.
data GetImpersonationRoleEffectResponse = GetImpersonationRoleEffectResponse'
  { -- | Effect of the impersonation role on the target user based on its rules.
    -- Available effects are @ALLOW@ or @DENY@.
    GetImpersonationRoleEffectResponse -> Maybe AccessEffect
effect :: Prelude.Maybe AccessEffect,
    -- | A list of the rules that match the input and produce the configured
    -- effect.
    GetImpersonationRoleEffectResponse
-> Maybe [ImpersonationMatchedRule]
matchedRules :: Prelude.Maybe [ImpersonationMatchedRule],
    -- | The impersonation role type.
    GetImpersonationRoleEffectResponse -> Maybe ImpersonationRoleType
type' :: Prelude.Maybe ImpersonationRoleType,
    -- | The response's http status code.
    GetImpersonationRoleEffectResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetImpersonationRoleEffectResponse
-> GetImpersonationRoleEffectResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImpersonationRoleEffectResponse
-> GetImpersonationRoleEffectResponse -> Bool
$c/= :: GetImpersonationRoleEffectResponse
-> GetImpersonationRoleEffectResponse -> Bool
== :: GetImpersonationRoleEffectResponse
-> GetImpersonationRoleEffectResponse -> Bool
$c== :: GetImpersonationRoleEffectResponse
-> GetImpersonationRoleEffectResponse -> Bool
Prelude.Eq, ReadPrec [GetImpersonationRoleEffectResponse]
ReadPrec GetImpersonationRoleEffectResponse
Int -> ReadS GetImpersonationRoleEffectResponse
ReadS [GetImpersonationRoleEffectResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImpersonationRoleEffectResponse]
$creadListPrec :: ReadPrec [GetImpersonationRoleEffectResponse]
readPrec :: ReadPrec GetImpersonationRoleEffectResponse
$creadPrec :: ReadPrec GetImpersonationRoleEffectResponse
readList :: ReadS [GetImpersonationRoleEffectResponse]
$creadList :: ReadS [GetImpersonationRoleEffectResponse]
readsPrec :: Int -> ReadS GetImpersonationRoleEffectResponse
$creadsPrec :: Int -> ReadS GetImpersonationRoleEffectResponse
Prelude.Read, Int -> GetImpersonationRoleEffectResponse -> ShowS
[GetImpersonationRoleEffectResponse] -> ShowS
GetImpersonationRoleEffectResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImpersonationRoleEffectResponse] -> ShowS
$cshowList :: [GetImpersonationRoleEffectResponse] -> ShowS
show :: GetImpersonationRoleEffectResponse -> String
$cshow :: GetImpersonationRoleEffectResponse -> String
showsPrec :: Int -> GetImpersonationRoleEffectResponse -> ShowS
$cshowsPrec :: Int -> GetImpersonationRoleEffectResponse -> ShowS
Prelude.Show, forall x.
Rep GetImpersonationRoleEffectResponse x
-> GetImpersonationRoleEffectResponse
forall x.
GetImpersonationRoleEffectResponse
-> Rep GetImpersonationRoleEffectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetImpersonationRoleEffectResponse x
-> GetImpersonationRoleEffectResponse
$cfrom :: forall x.
GetImpersonationRoleEffectResponse
-> Rep GetImpersonationRoleEffectResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetImpersonationRoleEffectResponse' 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:
--
-- 'effect', 'getImpersonationRoleEffectResponse_effect' - Effect of the impersonation role on the target user based on its rules.
-- Available effects are @ALLOW@ or @DENY@.
--
-- 'matchedRules', 'getImpersonationRoleEffectResponse_matchedRules' - A list of the rules that match the input and produce the configured
-- effect.
--
-- 'type'', 'getImpersonationRoleEffectResponse_type' - The impersonation role type.
--
-- 'httpStatus', 'getImpersonationRoleEffectResponse_httpStatus' - The response's http status code.
newGetImpersonationRoleEffectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetImpersonationRoleEffectResponse
newGetImpersonationRoleEffectResponse :: Int -> GetImpersonationRoleEffectResponse
newGetImpersonationRoleEffectResponse Int
pHttpStatus_ =
  GetImpersonationRoleEffectResponse'
    { $sel:effect:GetImpersonationRoleEffectResponse' :: Maybe AccessEffect
effect =
        forall a. Maybe a
Prelude.Nothing,
      $sel:matchedRules:GetImpersonationRoleEffectResponse' :: Maybe [ImpersonationMatchedRule]
matchedRules = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetImpersonationRoleEffectResponse' :: Maybe ImpersonationRoleType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetImpersonationRoleEffectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Effect of the impersonation role on the target user based on its rules.
-- Available effects are @ALLOW@ or @DENY@.
getImpersonationRoleEffectResponse_effect :: Lens.Lens' GetImpersonationRoleEffectResponse (Prelude.Maybe AccessEffect)
getImpersonationRoleEffectResponse_effect :: Lens' GetImpersonationRoleEffectResponse (Maybe AccessEffect)
getImpersonationRoleEffectResponse_effect = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffectResponse' {Maybe AccessEffect
effect :: Maybe AccessEffect
$sel:effect:GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse -> Maybe AccessEffect
effect} -> Maybe AccessEffect
effect) (\s :: GetImpersonationRoleEffectResponse
s@GetImpersonationRoleEffectResponse' {} Maybe AccessEffect
a -> GetImpersonationRoleEffectResponse
s {$sel:effect:GetImpersonationRoleEffectResponse' :: Maybe AccessEffect
effect = Maybe AccessEffect
a} :: GetImpersonationRoleEffectResponse)

-- | A list of the rules that match the input and produce the configured
-- effect.
getImpersonationRoleEffectResponse_matchedRules :: Lens.Lens' GetImpersonationRoleEffectResponse (Prelude.Maybe [ImpersonationMatchedRule])
getImpersonationRoleEffectResponse_matchedRules :: Lens'
  GetImpersonationRoleEffectResponse
  (Maybe [ImpersonationMatchedRule])
getImpersonationRoleEffectResponse_matchedRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffectResponse' {Maybe [ImpersonationMatchedRule]
matchedRules :: Maybe [ImpersonationMatchedRule]
$sel:matchedRules:GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse
-> Maybe [ImpersonationMatchedRule]
matchedRules} -> Maybe [ImpersonationMatchedRule]
matchedRules) (\s :: GetImpersonationRoleEffectResponse
s@GetImpersonationRoleEffectResponse' {} Maybe [ImpersonationMatchedRule]
a -> GetImpersonationRoleEffectResponse
s {$sel:matchedRules:GetImpersonationRoleEffectResponse' :: Maybe [ImpersonationMatchedRule]
matchedRules = Maybe [ImpersonationMatchedRule]
a} :: GetImpersonationRoleEffectResponse) 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 impersonation role type.
getImpersonationRoleEffectResponse_type :: Lens.Lens' GetImpersonationRoleEffectResponse (Prelude.Maybe ImpersonationRoleType)
getImpersonationRoleEffectResponse_type :: Lens'
  GetImpersonationRoleEffectResponse (Maybe ImpersonationRoleType)
getImpersonationRoleEffectResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImpersonationRoleEffectResponse' {Maybe ImpersonationRoleType
type' :: Maybe ImpersonationRoleType
$sel:type':GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse -> Maybe ImpersonationRoleType
type'} -> Maybe ImpersonationRoleType
type') (\s :: GetImpersonationRoleEffectResponse
s@GetImpersonationRoleEffectResponse' {} Maybe ImpersonationRoleType
a -> GetImpersonationRoleEffectResponse
s {$sel:type':GetImpersonationRoleEffectResponse' :: Maybe ImpersonationRoleType
type' = Maybe ImpersonationRoleType
a} :: GetImpersonationRoleEffectResponse)

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

instance
  Prelude.NFData
    GetImpersonationRoleEffectResponse
  where
  rnf :: GetImpersonationRoleEffectResponse -> ()
rnf GetImpersonationRoleEffectResponse' {Int
Maybe [ImpersonationMatchedRule]
Maybe AccessEffect
Maybe ImpersonationRoleType
httpStatus :: Int
type' :: Maybe ImpersonationRoleType
matchedRules :: Maybe [ImpersonationMatchedRule]
effect :: Maybe AccessEffect
$sel:httpStatus:GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse -> Int
$sel:type':GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse -> Maybe ImpersonationRoleType
$sel:matchedRules:GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse
-> Maybe [ImpersonationMatchedRule]
$sel:effect:GetImpersonationRoleEffectResponse' :: GetImpersonationRoleEffectResponse -> Maybe AccessEffect
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccessEffect
effect
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImpersonationMatchedRule]
matchedRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImpersonationRoleType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus