{-# 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.IoTSiteWise.Types.Identity
-- 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.IoTSiteWise.Types.Identity where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTSiteWise.Types.GroupIdentity
import Amazonka.IoTSiteWise.Types.IAMRoleIdentity
import Amazonka.IoTSiteWise.Types.IAMUserIdentity
import Amazonka.IoTSiteWise.Types.UserIdentity
import qualified Amazonka.Prelude as Prelude

-- | Contains an identity that can access an IoT SiteWise Monitor resource.
--
-- Currently, you can\'t use Amazon Web Services APIs to retrieve IAM
-- Identity Center identity IDs. You can find the IAM Identity Center
-- identity IDs in the URL of user and group pages in the
-- <https://console.aws.amazon.com/singlesignon IAM Identity Center console>.
--
-- /See:/ 'newIdentity' smart constructor.
data Identity = Identity'
  { -- | An IAM Identity Center group identity.
    Identity -> Maybe GroupIdentity
group' :: Prelude.Maybe GroupIdentity,
    -- | An IAM role identity.
    Identity -> Maybe IAMRoleIdentity
iamRole :: Prelude.Maybe IAMRoleIdentity,
    -- | An IAM user identity.
    Identity -> Maybe IAMUserIdentity
iamUser :: Prelude.Maybe IAMUserIdentity,
    -- | An IAM Identity Center user identity.
    Identity -> Maybe UserIdentity
user :: Prelude.Maybe UserIdentity
  }
  deriving (Identity -> Identity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c== :: Identity -> Identity -> Bool
Prelude.Eq, ReadPrec [Identity]
ReadPrec Identity
Int -> ReadS Identity
ReadS [Identity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Identity]
$creadListPrec :: ReadPrec [Identity]
readPrec :: ReadPrec Identity
$creadPrec :: ReadPrec Identity
readList :: ReadS [Identity]
$creadList :: ReadS [Identity]
readsPrec :: Int -> ReadS Identity
$creadsPrec :: Int -> ReadS Identity
Prelude.Read, Int -> Identity -> ShowS
[Identity] -> ShowS
Identity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identity] -> ShowS
$cshowList :: [Identity] -> ShowS
show :: Identity -> String
$cshow :: Identity -> String
showsPrec :: Int -> Identity -> ShowS
$cshowsPrec :: Int -> Identity -> ShowS
Prelude.Show, forall x. Rep Identity x -> Identity
forall x. Identity -> Rep Identity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identity x -> Identity
$cfrom :: forall x. Identity -> Rep Identity x
Prelude.Generic)

-- |
-- Create a value of 'Identity' 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:
--
-- 'group'', 'identity_group' - An IAM Identity Center group identity.
--
-- 'iamRole', 'identity_iamRole' - An IAM role identity.
--
-- 'iamUser', 'identity_iamUser' - An IAM user identity.
--
-- 'user', 'identity_user' - An IAM Identity Center user identity.
newIdentity ::
  Identity
newIdentity :: Identity
newIdentity =
  Identity'
    { $sel:group':Identity' :: Maybe GroupIdentity
group' = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRole:Identity' :: Maybe IAMRoleIdentity
iamRole = forall a. Maybe a
Prelude.Nothing,
      $sel:iamUser:Identity' :: Maybe IAMUserIdentity
iamUser = forall a. Maybe a
Prelude.Nothing,
      $sel:user:Identity' :: Maybe UserIdentity
user = forall a. Maybe a
Prelude.Nothing
    }

-- | An IAM Identity Center group identity.
identity_group :: Lens.Lens' Identity (Prelude.Maybe GroupIdentity)
identity_group :: Lens' Identity (Maybe GroupIdentity)
identity_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Identity' {Maybe GroupIdentity
group' :: Maybe GroupIdentity
$sel:group':Identity' :: Identity -> Maybe GroupIdentity
group'} -> Maybe GroupIdentity
group') (\s :: Identity
s@Identity' {} Maybe GroupIdentity
a -> Identity
s {$sel:group':Identity' :: Maybe GroupIdentity
group' = Maybe GroupIdentity
a} :: Identity)

-- | An IAM role identity.
identity_iamRole :: Lens.Lens' Identity (Prelude.Maybe IAMRoleIdentity)
identity_iamRole :: Lens' Identity (Maybe IAMRoleIdentity)
identity_iamRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Identity' {Maybe IAMRoleIdentity
iamRole :: Maybe IAMRoleIdentity
$sel:iamRole:Identity' :: Identity -> Maybe IAMRoleIdentity
iamRole} -> Maybe IAMRoleIdentity
iamRole) (\s :: Identity
s@Identity' {} Maybe IAMRoleIdentity
a -> Identity
s {$sel:iamRole:Identity' :: Maybe IAMRoleIdentity
iamRole = Maybe IAMRoleIdentity
a} :: Identity)

-- | An IAM user identity.
identity_iamUser :: Lens.Lens' Identity (Prelude.Maybe IAMUserIdentity)
identity_iamUser :: Lens' Identity (Maybe IAMUserIdentity)
identity_iamUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Identity' {Maybe IAMUserIdentity
iamUser :: Maybe IAMUserIdentity
$sel:iamUser:Identity' :: Identity -> Maybe IAMUserIdentity
iamUser} -> Maybe IAMUserIdentity
iamUser) (\s :: Identity
s@Identity' {} Maybe IAMUserIdentity
a -> Identity
s {$sel:iamUser:Identity' :: Maybe IAMUserIdentity
iamUser = Maybe IAMUserIdentity
a} :: Identity)

-- | An IAM Identity Center user identity.
identity_user :: Lens.Lens' Identity (Prelude.Maybe UserIdentity)
identity_user :: Lens' Identity (Maybe UserIdentity)
identity_user = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Identity' {Maybe UserIdentity
user :: Maybe UserIdentity
$sel:user:Identity' :: Identity -> Maybe UserIdentity
user} -> Maybe UserIdentity
user) (\s :: Identity
s@Identity' {} Maybe UserIdentity
a -> Identity
s {$sel:user:Identity' :: Maybe UserIdentity
user = Maybe UserIdentity
a} :: Identity)

instance Data.FromJSON Identity where
  parseJSON :: Value -> Parser Identity
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Identity"
      ( \Object
x ->
          Maybe GroupIdentity
-> Maybe IAMRoleIdentity
-> Maybe IAMUserIdentity
-> Maybe UserIdentity
-> Identity
Identity'
            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
"group")
            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
"iamRole")
            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
"iamUser")
            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
"user")
      )

instance Prelude.Hashable Identity where
  hashWithSalt :: Int -> Identity -> Int
hashWithSalt Int
_salt Identity' {Maybe GroupIdentity
Maybe IAMRoleIdentity
Maybe IAMUserIdentity
Maybe UserIdentity
user :: Maybe UserIdentity
iamUser :: Maybe IAMUserIdentity
iamRole :: Maybe IAMRoleIdentity
group' :: Maybe GroupIdentity
$sel:user:Identity' :: Identity -> Maybe UserIdentity
$sel:iamUser:Identity' :: Identity -> Maybe IAMUserIdentity
$sel:iamRole:Identity' :: Identity -> Maybe IAMRoleIdentity
$sel:group':Identity' :: Identity -> Maybe GroupIdentity
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GroupIdentity
group'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IAMRoleIdentity
iamRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IAMUserIdentity
iamUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserIdentity
user

instance Prelude.NFData Identity where
  rnf :: Identity -> ()
rnf Identity' {Maybe GroupIdentity
Maybe IAMRoleIdentity
Maybe IAMUserIdentity
Maybe UserIdentity
user :: Maybe UserIdentity
iamUser :: Maybe IAMUserIdentity
iamRole :: Maybe IAMRoleIdentity
group' :: Maybe GroupIdentity
$sel:user:Identity' :: Identity -> Maybe UserIdentity
$sel:iamUser:Identity' :: Identity -> Maybe IAMUserIdentity
$sel:iamRole:Identity' :: Identity -> Maybe IAMRoleIdentity
$sel:group':Identity' :: Identity -> Maybe GroupIdentity
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GroupIdentity
group'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IAMRoleIdentity
iamRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IAMUserIdentity
iamUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserIdentity
user

instance Data.ToJSON Identity where
  toJSON :: Identity -> Value
toJSON Identity' {Maybe GroupIdentity
Maybe IAMRoleIdentity
Maybe IAMUserIdentity
Maybe UserIdentity
user :: Maybe UserIdentity
iamUser :: Maybe IAMUserIdentity
iamRole :: Maybe IAMRoleIdentity
group' :: Maybe GroupIdentity
$sel:user:Identity' :: Identity -> Maybe UserIdentity
$sel:iamUser:Identity' :: Identity -> Maybe IAMUserIdentity
$sel:iamRole:Identity' :: Identity -> Maybe IAMRoleIdentity
$sel:group':Identity' :: Identity -> Maybe GroupIdentity
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"group" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe GroupIdentity
group',
            (Key
"iamRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe IAMRoleIdentity
iamRole,
            (Key
"iamUser" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe IAMUserIdentity
iamUser,
            (Key
"user" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe UserIdentity
user
          ]
      )