{-# 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.Grafana.Types.AuthenticationDescription
-- 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.Grafana.Types.AuthenticationDescription where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Grafana.Types.AuthenticationProviderTypes
import Amazonka.Grafana.Types.AwsSsoAuthentication
import Amazonka.Grafana.Types.SamlAuthentication
import qualified Amazonka.Prelude as Prelude

-- | A structure containing information about the user authentication methods
-- used by the workspace.
--
-- /See:/ 'newAuthenticationDescription' smart constructor.
data AuthenticationDescription = AuthenticationDescription'
  { -- | A structure containing information about how this workspace works with
    -- IAM Identity Center.
    AuthenticationDescription -> Maybe AwsSsoAuthentication
awsSso :: Prelude.Maybe AwsSsoAuthentication,
    -- | A structure containing information about how this workspace works with
    -- SAML, including what attributes within the assertion are to be mapped to
    -- user information in the workspace.
    AuthenticationDescription -> Maybe SamlAuthentication
saml :: Prelude.Maybe SamlAuthentication,
    -- | Specifies whether this workspace uses IAM Identity Center, SAML, or both
    -- methods to authenticate users to use the Grafana console in the Amazon
    -- Managed Grafana workspace.
    AuthenticationDescription -> [AuthenticationProviderTypes]
providers :: [AuthenticationProviderTypes]
  }
  deriving (AuthenticationDescription -> AuthenticationDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationDescription -> AuthenticationDescription -> Bool
$c/= :: AuthenticationDescription -> AuthenticationDescription -> Bool
== :: AuthenticationDescription -> AuthenticationDescription -> Bool
$c== :: AuthenticationDescription -> AuthenticationDescription -> Bool
Prelude.Eq, ReadPrec [AuthenticationDescription]
ReadPrec AuthenticationDescription
Int -> ReadS AuthenticationDescription
ReadS [AuthenticationDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthenticationDescription]
$creadListPrec :: ReadPrec [AuthenticationDescription]
readPrec :: ReadPrec AuthenticationDescription
$creadPrec :: ReadPrec AuthenticationDescription
readList :: ReadS [AuthenticationDescription]
$creadList :: ReadS [AuthenticationDescription]
readsPrec :: Int -> ReadS AuthenticationDescription
$creadsPrec :: Int -> ReadS AuthenticationDescription
Prelude.Read, Int -> AuthenticationDescription -> ShowS
[AuthenticationDescription] -> ShowS
AuthenticationDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationDescription] -> ShowS
$cshowList :: [AuthenticationDescription] -> ShowS
show :: AuthenticationDescription -> String
$cshow :: AuthenticationDescription -> String
showsPrec :: Int -> AuthenticationDescription -> ShowS
$cshowsPrec :: Int -> AuthenticationDescription -> ShowS
Prelude.Show, forall x.
Rep AuthenticationDescription x -> AuthenticationDescription
forall x.
AuthenticationDescription -> Rep AuthenticationDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticationDescription x -> AuthenticationDescription
$cfrom :: forall x.
AuthenticationDescription -> Rep AuthenticationDescription x
Prelude.Generic)

-- |
-- Create a value of 'AuthenticationDescription' 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:
--
-- 'awsSso', 'authenticationDescription_awsSso' - A structure containing information about how this workspace works with
-- IAM Identity Center.
--
-- 'saml', 'authenticationDescription_saml' - A structure containing information about how this workspace works with
-- SAML, including what attributes within the assertion are to be mapped to
-- user information in the workspace.
--
-- 'providers', 'authenticationDescription_providers' - Specifies whether this workspace uses IAM Identity Center, SAML, or both
-- methods to authenticate users to use the Grafana console in the Amazon
-- Managed Grafana workspace.
newAuthenticationDescription ::
  AuthenticationDescription
newAuthenticationDescription :: AuthenticationDescription
newAuthenticationDescription =
  AuthenticationDescription'
    { $sel:awsSso:AuthenticationDescription' :: Maybe AwsSsoAuthentication
awsSso =
        forall a. Maybe a
Prelude.Nothing,
      $sel:saml:AuthenticationDescription' :: Maybe SamlAuthentication
saml = forall a. Maybe a
Prelude.Nothing,
      $sel:providers:AuthenticationDescription' :: [AuthenticationProviderTypes]
providers = forall a. Monoid a => a
Prelude.mempty
    }

-- | A structure containing information about how this workspace works with
-- IAM Identity Center.
authenticationDescription_awsSso :: Lens.Lens' AuthenticationDescription (Prelude.Maybe AwsSsoAuthentication)
authenticationDescription_awsSso :: Lens' AuthenticationDescription (Maybe AwsSsoAuthentication)
authenticationDescription_awsSso = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthenticationDescription' {Maybe AwsSsoAuthentication
awsSso :: Maybe AwsSsoAuthentication
$sel:awsSso:AuthenticationDescription' :: AuthenticationDescription -> Maybe AwsSsoAuthentication
awsSso} -> Maybe AwsSsoAuthentication
awsSso) (\s :: AuthenticationDescription
s@AuthenticationDescription' {} Maybe AwsSsoAuthentication
a -> AuthenticationDescription
s {$sel:awsSso:AuthenticationDescription' :: Maybe AwsSsoAuthentication
awsSso = Maybe AwsSsoAuthentication
a} :: AuthenticationDescription)

-- | A structure containing information about how this workspace works with
-- SAML, including what attributes within the assertion are to be mapped to
-- user information in the workspace.
authenticationDescription_saml :: Lens.Lens' AuthenticationDescription (Prelude.Maybe SamlAuthentication)
authenticationDescription_saml :: Lens' AuthenticationDescription (Maybe SamlAuthentication)
authenticationDescription_saml = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthenticationDescription' {Maybe SamlAuthentication
saml :: Maybe SamlAuthentication
$sel:saml:AuthenticationDescription' :: AuthenticationDescription -> Maybe SamlAuthentication
saml} -> Maybe SamlAuthentication
saml) (\s :: AuthenticationDescription
s@AuthenticationDescription' {} Maybe SamlAuthentication
a -> AuthenticationDescription
s {$sel:saml:AuthenticationDescription' :: Maybe SamlAuthentication
saml = Maybe SamlAuthentication
a} :: AuthenticationDescription)

-- | Specifies whether this workspace uses IAM Identity Center, SAML, or both
-- methods to authenticate users to use the Grafana console in the Amazon
-- Managed Grafana workspace.
authenticationDescription_providers :: Lens.Lens' AuthenticationDescription [AuthenticationProviderTypes]
authenticationDescription_providers :: Lens' AuthenticationDescription [AuthenticationProviderTypes]
authenticationDescription_providers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthenticationDescription' {[AuthenticationProviderTypes]
providers :: [AuthenticationProviderTypes]
$sel:providers:AuthenticationDescription' :: AuthenticationDescription -> [AuthenticationProviderTypes]
providers} -> [AuthenticationProviderTypes]
providers) (\s :: AuthenticationDescription
s@AuthenticationDescription' {} [AuthenticationProviderTypes]
a -> AuthenticationDescription
s {$sel:providers:AuthenticationDescription' :: [AuthenticationProviderTypes]
providers = [AuthenticationProviderTypes]
a} :: AuthenticationDescription) 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 Data.FromJSON AuthenticationDescription where
  parseJSON :: Value -> Parser AuthenticationDescription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AuthenticationDescription"
      ( \Object
x ->
          Maybe AwsSsoAuthentication
-> Maybe SamlAuthentication
-> [AuthenticationProviderTypes]
-> AuthenticationDescription
AuthenticationDescription'
            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
"awsSso")
            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
"saml")
            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
"providers" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable AuthenticationDescription where
  hashWithSalt :: Int -> AuthenticationDescription -> Int
hashWithSalt Int
_salt AuthenticationDescription' {[AuthenticationProviderTypes]
Maybe AwsSsoAuthentication
Maybe SamlAuthentication
providers :: [AuthenticationProviderTypes]
saml :: Maybe SamlAuthentication
awsSso :: Maybe AwsSsoAuthentication
$sel:providers:AuthenticationDescription' :: AuthenticationDescription -> [AuthenticationProviderTypes]
$sel:saml:AuthenticationDescription' :: AuthenticationDescription -> Maybe SamlAuthentication
$sel:awsSso:AuthenticationDescription' :: AuthenticationDescription -> Maybe AwsSsoAuthentication
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AwsSsoAuthentication
awsSso
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SamlAuthentication
saml
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AuthenticationProviderTypes]
providers

instance Prelude.NFData AuthenticationDescription where
  rnf :: AuthenticationDescription -> ()
rnf AuthenticationDescription' {[AuthenticationProviderTypes]
Maybe AwsSsoAuthentication
Maybe SamlAuthentication
providers :: [AuthenticationProviderTypes]
saml :: Maybe SamlAuthentication
awsSso :: Maybe AwsSsoAuthentication
$sel:providers:AuthenticationDescription' :: AuthenticationDescription -> [AuthenticationProviderTypes]
$sel:saml:AuthenticationDescription' :: AuthenticationDescription -> Maybe SamlAuthentication
$sel:awsSso:AuthenticationDescription' :: AuthenticationDescription -> Maybe AwsSsoAuthentication
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsSsoAuthentication
awsSso
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SamlAuthentication
saml
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AuthenticationProviderTypes]
providers