{-# 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.SamlConfiguration
-- 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.SamlConfiguration 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.AssertionAttributes
import Amazonka.Grafana.Types.IdpMetadata
import Amazonka.Grafana.Types.RoleValues
import qualified Amazonka.Prelude as Prelude

-- | A structure containing information about how this workspace works with
-- SAML.
--
-- /See:/ 'newSamlConfiguration' smart constructor.
data SamlConfiguration = SamlConfiguration'
  { -- | Lists which organizations defined in the SAML assertion are allowed to
    -- use the Amazon Managed Grafana workspace. If this is empty, all
    -- organizations in the assertion attribute have access.
    SamlConfiguration -> Maybe [Text]
allowedOrganizations :: Prelude.Maybe [Prelude.Text],
    -- | A structure that defines which attributes in the SAML assertion are to
    -- be used to define information about the users authenticated by that IdP
    -- to use the workspace.
    SamlConfiguration -> Maybe AssertionAttributes
assertionAttributes :: Prelude.Maybe AssertionAttributes,
    -- | How long a sign-on session by a SAML user is valid, before the user has
    -- to sign on again.
    SamlConfiguration -> Maybe Int
loginValidityDuration :: Prelude.Maybe Prelude.Int,
    -- | A structure containing arrays that map group names in the SAML assertion
    -- to the Grafana @Admin@ and @Editor@ roles in the workspace.
    SamlConfiguration -> Maybe RoleValues
roleValues :: Prelude.Maybe RoleValues,
    -- | A structure containing the identity provider (IdP) metadata used to
    -- integrate the identity provider with this workspace.
    SamlConfiguration -> IdpMetadata
idpMetadata :: IdpMetadata
  }
  deriving (SamlConfiguration -> SamlConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamlConfiguration -> SamlConfiguration -> Bool
$c/= :: SamlConfiguration -> SamlConfiguration -> Bool
== :: SamlConfiguration -> SamlConfiguration -> Bool
$c== :: SamlConfiguration -> SamlConfiguration -> Bool
Prelude.Eq, ReadPrec [SamlConfiguration]
ReadPrec SamlConfiguration
Int -> ReadS SamlConfiguration
ReadS [SamlConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SamlConfiguration]
$creadListPrec :: ReadPrec [SamlConfiguration]
readPrec :: ReadPrec SamlConfiguration
$creadPrec :: ReadPrec SamlConfiguration
readList :: ReadS [SamlConfiguration]
$creadList :: ReadS [SamlConfiguration]
readsPrec :: Int -> ReadS SamlConfiguration
$creadsPrec :: Int -> ReadS SamlConfiguration
Prelude.Read, Int -> SamlConfiguration -> ShowS
[SamlConfiguration] -> ShowS
SamlConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamlConfiguration] -> ShowS
$cshowList :: [SamlConfiguration] -> ShowS
show :: SamlConfiguration -> String
$cshow :: SamlConfiguration -> String
showsPrec :: Int -> SamlConfiguration -> ShowS
$cshowsPrec :: Int -> SamlConfiguration -> ShowS
Prelude.Show, forall x. Rep SamlConfiguration x -> SamlConfiguration
forall x. SamlConfiguration -> Rep SamlConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SamlConfiguration x -> SamlConfiguration
$cfrom :: forall x. SamlConfiguration -> Rep SamlConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'SamlConfiguration' 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:
--
-- 'allowedOrganizations', 'samlConfiguration_allowedOrganizations' - Lists which organizations defined in the SAML assertion are allowed to
-- use the Amazon Managed Grafana workspace. If this is empty, all
-- organizations in the assertion attribute have access.
--
-- 'assertionAttributes', 'samlConfiguration_assertionAttributes' - A structure that defines which attributes in the SAML assertion are to
-- be used to define information about the users authenticated by that IdP
-- to use the workspace.
--
-- 'loginValidityDuration', 'samlConfiguration_loginValidityDuration' - How long a sign-on session by a SAML user is valid, before the user has
-- to sign on again.
--
-- 'roleValues', 'samlConfiguration_roleValues' - A structure containing arrays that map group names in the SAML assertion
-- to the Grafana @Admin@ and @Editor@ roles in the workspace.
--
-- 'idpMetadata', 'samlConfiguration_idpMetadata' - A structure containing the identity provider (IdP) metadata used to
-- integrate the identity provider with this workspace.
newSamlConfiguration ::
  -- | 'idpMetadata'
  IdpMetadata ->
  SamlConfiguration
newSamlConfiguration :: IdpMetadata -> SamlConfiguration
newSamlConfiguration IdpMetadata
pIdpMetadata_ =
  SamlConfiguration'
    { $sel:allowedOrganizations:SamlConfiguration' :: Maybe [Text]
allowedOrganizations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:assertionAttributes:SamlConfiguration' :: Maybe AssertionAttributes
assertionAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:loginValidityDuration:SamlConfiguration' :: Maybe Int
loginValidityDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:roleValues:SamlConfiguration' :: Maybe RoleValues
roleValues = forall a. Maybe a
Prelude.Nothing,
      $sel:idpMetadata:SamlConfiguration' :: IdpMetadata
idpMetadata = IdpMetadata
pIdpMetadata_
    }

-- | Lists which organizations defined in the SAML assertion are allowed to
-- use the Amazon Managed Grafana workspace. If this is empty, all
-- organizations in the assertion attribute have access.
samlConfiguration_allowedOrganizations :: Lens.Lens' SamlConfiguration (Prelude.Maybe [Prelude.Text])
samlConfiguration_allowedOrganizations :: Lens' SamlConfiguration (Maybe [Text])
samlConfiguration_allowedOrganizations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SamlConfiguration' {Maybe [Text]
allowedOrganizations :: Maybe [Text]
$sel:allowedOrganizations:SamlConfiguration' :: SamlConfiguration -> Maybe [Text]
allowedOrganizations} -> Maybe [Text]
allowedOrganizations) (\s :: SamlConfiguration
s@SamlConfiguration' {} Maybe [Text]
a -> SamlConfiguration
s {$sel:allowedOrganizations:SamlConfiguration' :: Maybe [Text]
allowedOrganizations = Maybe [Text]
a} :: SamlConfiguration) 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

-- | A structure that defines which attributes in the SAML assertion are to
-- be used to define information about the users authenticated by that IdP
-- to use the workspace.
samlConfiguration_assertionAttributes :: Lens.Lens' SamlConfiguration (Prelude.Maybe AssertionAttributes)
samlConfiguration_assertionAttributes :: Lens' SamlConfiguration (Maybe AssertionAttributes)
samlConfiguration_assertionAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SamlConfiguration' {Maybe AssertionAttributes
assertionAttributes :: Maybe AssertionAttributes
$sel:assertionAttributes:SamlConfiguration' :: SamlConfiguration -> Maybe AssertionAttributes
assertionAttributes} -> Maybe AssertionAttributes
assertionAttributes) (\s :: SamlConfiguration
s@SamlConfiguration' {} Maybe AssertionAttributes
a -> SamlConfiguration
s {$sel:assertionAttributes:SamlConfiguration' :: Maybe AssertionAttributes
assertionAttributes = Maybe AssertionAttributes
a} :: SamlConfiguration)

-- | How long a sign-on session by a SAML user is valid, before the user has
-- to sign on again.
samlConfiguration_loginValidityDuration :: Lens.Lens' SamlConfiguration (Prelude.Maybe Prelude.Int)
samlConfiguration_loginValidityDuration :: Lens' SamlConfiguration (Maybe Int)
samlConfiguration_loginValidityDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SamlConfiguration' {Maybe Int
loginValidityDuration :: Maybe Int
$sel:loginValidityDuration:SamlConfiguration' :: SamlConfiguration -> Maybe Int
loginValidityDuration} -> Maybe Int
loginValidityDuration) (\s :: SamlConfiguration
s@SamlConfiguration' {} Maybe Int
a -> SamlConfiguration
s {$sel:loginValidityDuration:SamlConfiguration' :: Maybe Int
loginValidityDuration = Maybe Int
a} :: SamlConfiguration)

-- | A structure containing arrays that map group names in the SAML assertion
-- to the Grafana @Admin@ and @Editor@ roles in the workspace.
samlConfiguration_roleValues :: Lens.Lens' SamlConfiguration (Prelude.Maybe RoleValues)
samlConfiguration_roleValues :: Lens' SamlConfiguration (Maybe RoleValues)
samlConfiguration_roleValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SamlConfiguration' {Maybe RoleValues
roleValues :: Maybe RoleValues
$sel:roleValues:SamlConfiguration' :: SamlConfiguration -> Maybe RoleValues
roleValues} -> Maybe RoleValues
roleValues) (\s :: SamlConfiguration
s@SamlConfiguration' {} Maybe RoleValues
a -> SamlConfiguration
s {$sel:roleValues:SamlConfiguration' :: Maybe RoleValues
roleValues = Maybe RoleValues
a} :: SamlConfiguration)

-- | A structure containing the identity provider (IdP) metadata used to
-- integrate the identity provider with this workspace.
samlConfiguration_idpMetadata :: Lens.Lens' SamlConfiguration IdpMetadata
samlConfiguration_idpMetadata :: Lens' SamlConfiguration IdpMetadata
samlConfiguration_idpMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SamlConfiguration' {IdpMetadata
idpMetadata :: IdpMetadata
$sel:idpMetadata:SamlConfiguration' :: SamlConfiguration -> IdpMetadata
idpMetadata} -> IdpMetadata
idpMetadata) (\s :: SamlConfiguration
s@SamlConfiguration' {} IdpMetadata
a -> SamlConfiguration
s {$sel:idpMetadata:SamlConfiguration' :: IdpMetadata
idpMetadata = IdpMetadata
a} :: SamlConfiguration)

instance Data.FromJSON SamlConfiguration where
  parseJSON :: Value -> Parser SamlConfiguration
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SamlConfiguration"
      ( \Object
x ->
          Maybe [Text]
-> Maybe AssertionAttributes
-> Maybe Int
-> Maybe RoleValues
-> IdpMetadata
-> SamlConfiguration
SamlConfiguration'
            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
"allowedOrganizations"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"assertionAttributes")
            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
"loginValidityDuration")
            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
"roleValues")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"idpMetadata")
      )

instance Prelude.Hashable SamlConfiguration where
  hashWithSalt :: Int -> SamlConfiguration -> Int
hashWithSalt Int
_salt SamlConfiguration' {Maybe Int
Maybe [Text]
Maybe AssertionAttributes
Maybe RoleValues
IdpMetadata
idpMetadata :: IdpMetadata
roleValues :: Maybe RoleValues
loginValidityDuration :: Maybe Int
assertionAttributes :: Maybe AssertionAttributes
allowedOrganizations :: Maybe [Text]
$sel:idpMetadata:SamlConfiguration' :: SamlConfiguration -> IdpMetadata
$sel:roleValues:SamlConfiguration' :: SamlConfiguration -> Maybe RoleValues
$sel:loginValidityDuration:SamlConfiguration' :: SamlConfiguration -> Maybe Int
$sel:assertionAttributes:SamlConfiguration' :: SamlConfiguration -> Maybe AssertionAttributes
$sel:allowedOrganizations:SamlConfiguration' :: SamlConfiguration -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
allowedOrganizations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AssertionAttributes
assertionAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
loginValidityDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RoleValues
roleValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IdpMetadata
idpMetadata

instance Prelude.NFData SamlConfiguration where
  rnf :: SamlConfiguration -> ()
rnf SamlConfiguration' {Maybe Int
Maybe [Text]
Maybe AssertionAttributes
Maybe RoleValues
IdpMetadata
idpMetadata :: IdpMetadata
roleValues :: Maybe RoleValues
loginValidityDuration :: Maybe Int
assertionAttributes :: Maybe AssertionAttributes
allowedOrganizations :: Maybe [Text]
$sel:idpMetadata:SamlConfiguration' :: SamlConfiguration -> IdpMetadata
$sel:roleValues:SamlConfiguration' :: SamlConfiguration -> Maybe RoleValues
$sel:loginValidityDuration:SamlConfiguration' :: SamlConfiguration -> Maybe Int
$sel:assertionAttributes:SamlConfiguration' :: SamlConfiguration -> Maybe AssertionAttributes
$sel:allowedOrganizations:SamlConfiguration' :: SamlConfiguration -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
allowedOrganizations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AssertionAttributes
assertionAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
loginValidityDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RoleValues
roleValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IdpMetadata
idpMetadata

instance Data.ToJSON SamlConfiguration where
  toJSON :: SamlConfiguration -> Value
toJSON SamlConfiguration' {Maybe Int
Maybe [Text]
Maybe AssertionAttributes
Maybe RoleValues
IdpMetadata
idpMetadata :: IdpMetadata
roleValues :: Maybe RoleValues
loginValidityDuration :: Maybe Int
assertionAttributes :: Maybe AssertionAttributes
allowedOrganizations :: Maybe [Text]
$sel:idpMetadata:SamlConfiguration' :: SamlConfiguration -> IdpMetadata
$sel:roleValues:SamlConfiguration' :: SamlConfiguration -> Maybe RoleValues
$sel:loginValidityDuration:SamlConfiguration' :: SamlConfiguration -> Maybe Int
$sel:assertionAttributes:SamlConfiguration' :: SamlConfiguration -> Maybe AssertionAttributes
$sel:allowedOrganizations:SamlConfiguration' :: SamlConfiguration -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"allowedOrganizations" 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 [Text]
allowedOrganizations,
            (Key
"assertionAttributes" 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 AssertionAttributes
assertionAttributes,
            (Key
"loginValidityDuration" 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 Int
loginValidityDuration,
            (Key
"roleValues" 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 RoleValues
roleValues,
            forall a. a -> Maybe a
Prelude.Just (Key
"idpMetadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IdpMetadata
idpMetadata)
          ]
      )