{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.IoT.Types.AuthResult
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.IoT.Types.AuthResult where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types.Allowed
import Amazonka.IoT.Types.AuthDecision
import Amazonka.IoT.Types.AuthInfo
import Amazonka.IoT.Types.Denied
import qualified Amazonka.Prelude as Prelude

-- | The authorizer result.
--
-- /See:/ 'newAuthResult' smart constructor.
data AuthResult = AuthResult'
  { -- | The policies and statements that allowed the specified action.
    AuthResult -> Maybe Allowed
allowed :: Prelude.Maybe Allowed,
    -- | The final authorization decision of this scenario. Multiple statements
    -- are taken into account when determining the authorization decision. An
    -- explicit deny statement can override multiple allow statements.
    AuthResult -> Maybe AuthDecision
authDecision :: Prelude.Maybe AuthDecision,
    -- | Authorization information.
    AuthResult -> Maybe AuthInfo
authInfo :: Prelude.Maybe AuthInfo,
    -- | The policies and statements that denied the specified action.
    AuthResult -> Maybe Denied
denied :: Prelude.Maybe Denied,
    -- | Contains any missing context values found while evaluating policy.
    AuthResult -> Maybe [Text]
missingContextValues :: Prelude.Maybe [Prelude.Text]
  }
  deriving (AuthResult -> AuthResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthResult -> AuthResult -> Bool
$c/= :: AuthResult -> AuthResult -> Bool
== :: AuthResult -> AuthResult -> Bool
$c== :: AuthResult -> AuthResult -> Bool
Prelude.Eq, ReadPrec [AuthResult]
ReadPrec AuthResult
Int -> ReadS AuthResult
ReadS [AuthResult]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthResult]
$creadListPrec :: ReadPrec [AuthResult]
readPrec :: ReadPrec AuthResult
$creadPrec :: ReadPrec AuthResult
readList :: ReadS [AuthResult]
$creadList :: ReadS [AuthResult]
readsPrec :: Int -> ReadS AuthResult
$creadsPrec :: Int -> ReadS AuthResult
Prelude.Read, Int -> AuthResult -> ShowS
[AuthResult] -> ShowS
AuthResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthResult] -> ShowS
$cshowList :: [AuthResult] -> ShowS
show :: AuthResult -> String
$cshow :: AuthResult -> String
showsPrec :: Int -> AuthResult -> ShowS
$cshowsPrec :: Int -> AuthResult -> ShowS
Prelude.Show, forall x. Rep AuthResult x -> AuthResult
forall x. AuthResult -> Rep AuthResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthResult x -> AuthResult
$cfrom :: forall x. AuthResult -> Rep AuthResult x
Prelude.Generic)

-- |
-- Create a value of 'AuthResult' 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:
--
-- 'allowed', 'authResult_allowed' - The policies and statements that allowed the specified action.
--
-- 'authDecision', 'authResult_authDecision' - The final authorization decision of this scenario. Multiple statements
-- are taken into account when determining the authorization decision. An
-- explicit deny statement can override multiple allow statements.
--
-- 'authInfo', 'authResult_authInfo' - Authorization information.
--
-- 'denied', 'authResult_denied' - The policies and statements that denied the specified action.
--
-- 'missingContextValues', 'authResult_missingContextValues' - Contains any missing context values found while evaluating policy.
newAuthResult ::
  AuthResult
newAuthResult :: AuthResult
newAuthResult =
  AuthResult'
    { $sel:allowed:AuthResult' :: Maybe Allowed
allowed = forall a. Maybe a
Prelude.Nothing,
      $sel:authDecision:AuthResult' :: Maybe AuthDecision
authDecision = forall a. Maybe a
Prelude.Nothing,
      $sel:authInfo:AuthResult' :: Maybe AuthInfo
authInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:denied:AuthResult' :: Maybe Denied
denied = forall a. Maybe a
Prelude.Nothing,
      $sel:missingContextValues:AuthResult' :: Maybe [Text]
missingContextValues = forall a. Maybe a
Prelude.Nothing
    }

-- | The policies and statements that allowed the specified action.
authResult_allowed :: Lens.Lens' AuthResult (Prelude.Maybe Allowed)
authResult_allowed :: Lens' AuthResult (Maybe Allowed)
authResult_allowed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthResult' {Maybe Allowed
allowed :: Maybe Allowed
$sel:allowed:AuthResult' :: AuthResult -> Maybe Allowed
allowed} -> Maybe Allowed
allowed) (\s :: AuthResult
s@AuthResult' {} Maybe Allowed
a -> AuthResult
s {$sel:allowed:AuthResult' :: Maybe Allowed
allowed = Maybe Allowed
a} :: AuthResult)

-- | The final authorization decision of this scenario. Multiple statements
-- are taken into account when determining the authorization decision. An
-- explicit deny statement can override multiple allow statements.
authResult_authDecision :: Lens.Lens' AuthResult (Prelude.Maybe AuthDecision)
authResult_authDecision :: Lens' AuthResult (Maybe AuthDecision)
authResult_authDecision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthResult' {Maybe AuthDecision
authDecision :: Maybe AuthDecision
$sel:authDecision:AuthResult' :: AuthResult -> Maybe AuthDecision
authDecision} -> Maybe AuthDecision
authDecision) (\s :: AuthResult
s@AuthResult' {} Maybe AuthDecision
a -> AuthResult
s {$sel:authDecision:AuthResult' :: Maybe AuthDecision
authDecision = Maybe AuthDecision
a} :: AuthResult)

-- | Authorization information.
authResult_authInfo :: Lens.Lens' AuthResult (Prelude.Maybe AuthInfo)
authResult_authInfo :: Lens' AuthResult (Maybe AuthInfo)
authResult_authInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthResult' {Maybe AuthInfo
authInfo :: Maybe AuthInfo
$sel:authInfo:AuthResult' :: AuthResult -> Maybe AuthInfo
authInfo} -> Maybe AuthInfo
authInfo) (\s :: AuthResult
s@AuthResult' {} Maybe AuthInfo
a -> AuthResult
s {$sel:authInfo:AuthResult' :: Maybe AuthInfo
authInfo = Maybe AuthInfo
a} :: AuthResult)

-- | The policies and statements that denied the specified action.
authResult_denied :: Lens.Lens' AuthResult (Prelude.Maybe Denied)
authResult_denied :: Lens' AuthResult (Maybe Denied)
authResult_denied = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthResult' {Maybe Denied
denied :: Maybe Denied
$sel:denied:AuthResult' :: AuthResult -> Maybe Denied
denied} -> Maybe Denied
denied) (\s :: AuthResult
s@AuthResult' {} Maybe Denied
a -> AuthResult
s {$sel:denied:AuthResult' :: Maybe Denied
denied = Maybe Denied
a} :: AuthResult)

-- | Contains any missing context values found while evaluating policy.
authResult_missingContextValues :: Lens.Lens' AuthResult (Prelude.Maybe [Prelude.Text])
authResult_missingContextValues :: Lens' AuthResult (Maybe [Text])
authResult_missingContextValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthResult' {Maybe [Text]
missingContextValues :: Maybe [Text]
$sel:missingContextValues:AuthResult' :: AuthResult -> Maybe [Text]
missingContextValues} -> Maybe [Text]
missingContextValues) (\s :: AuthResult
s@AuthResult' {} Maybe [Text]
a -> AuthResult
s {$sel:missingContextValues:AuthResult' :: Maybe [Text]
missingContextValues = Maybe [Text]
a} :: AuthResult) 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

instance Data.FromJSON AuthResult where
  parseJSON :: Value -> Parser AuthResult
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AuthResult"
      ( \Object
x ->
          Maybe Allowed
-> Maybe AuthDecision
-> Maybe AuthInfo
-> Maybe Denied
-> Maybe [Text]
-> AuthResult
AuthResult'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"allowed")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"authDecision")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"authInfo")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"denied")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"missingContextValues"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable AuthResult where
  hashWithSalt :: Int -> AuthResult -> Int
hashWithSalt Int
_salt AuthResult' {Maybe [Text]
Maybe AuthDecision
Maybe AuthInfo
Maybe Denied
Maybe Allowed
missingContextValues :: Maybe [Text]
denied :: Maybe Denied
authInfo :: Maybe AuthInfo
authDecision :: Maybe AuthDecision
allowed :: Maybe Allowed
$sel:missingContextValues:AuthResult' :: AuthResult -> Maybe [Text]
$sel:denied:AuthResult' :: AuthResult -> Maybe Denied
$sel:authInfo:AuthResult' :: AuthResult -> Maybe AuthInfo
$sel:authDecision:AuthResult' :: AuthResult -> Maybe AuthDecision
$sel:allowed:AuthResult' :: AuthResult -> Maybe Allowed
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Allowed
allowed
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthDecision
authDecision
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthInfo
authInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Denied
denied
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
missingContextValues

instance Prelude.NFData AuthResult where
  rnf :: AuthResult -> ()
rnf AuthResult' {Maybe [Text]
Maybe AuthDecision
Maybe AuthInfo
Maybe Denied
Maybe Allowed
missingContextValues :: Maybe [Text]
denied :: Maybe Denied
authInfo :: Maybe AuthInfo
authDecision :: Maybe AuthDecision
allowed :: Maybe Allowed
$sel:missingContextValues:AuthResult' :: AuthResult -> Maybe [Text]
$sel:denied:AuthResult' :: AuthResult -> Maybe Denied
$sel:authInfo:AuthResult' :: AuthResult -> Maybe AuthInfo
$sel:authDecision:AuthResult' :: AuthResult -> Maybe AuthDecision
$sel:allowed:AuthResult' :: AuthResult -> Maybe Allowed
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Allowed
allowed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthDecision
authDecision
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthInfo
authInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Denied
denied
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
missingContextValues