module Stratosphere.Grafana.Workspace.SamlConfigurationProperty (
module Exports, SamlConfigurationProperty(..),
mkSamlConfigurationProperty
) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Grafana.Workspace.AssertionAttributesProperty as Exports
import {-# SOURCE #-} Stratosphere.Grafana.Workspace.IdpMetadataProperty as Exports
import {-# SOURCE #-} Stratosphere.Grafana.Workspace.RoleValuesProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data SamlConfigurationProperty
=
SamlConfigurationProperty {SamlConfigurationProperty -> ()
haddock_workaround_ :: (),
SamlConfigurationProperty -> Maybe (ValueList Text)
allowedOrganizations :: (Prelude.Maybe (ValueList Prelude.Text)),
SamlConfigurationProperty -> Maybe AssertionAttributesProperty
assertionAttributes :: (Prelude.Maybe AssertionAttributesProperty),
SamlConfigurationProperty -> IdpMetadataProperty
idpMetadata :: IdpMetadataProperty,
SamlConfigurationProperty -> Maybe (Value Double)
loginValidityDuration :: (Prelude.Maybe (Value Prelude.Double)),
SamlConfigurationProperty -> Maybe RoleValuesProperty
roleValues :: (Prelude.Maybe RoleValuesProperty)}
deriving stock (SamlConfigurationProperty -> SamlConfigurationProperty -> Bool
(SamlConfigurationProperty -> SamlConfigurationProperty -> Bool)
-> (SamlConfigurationProperty -> SamlConfigurationProperty -> Bool)
-> Eq SamlConfigurationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamlConfigurationProperty -> SamlConfigurationProperty -> Bool
== :: SamlConfigurationProperty -> SamlConfigurationProperty -> Bool
$c/= :: SamlConfigurationProperty -> SamlConfigurationProperty -> Bool
/= :: SamlConfigurationProperty -> SamlConfigurationProperty -> Bool
Prelude.Eq, Int -> SamlConfigurationProperty -> ShowS
[SamlConfigurationProperty] -> ShowS
SamlConfigurationProperty -> String
(Int -> SamlConfigurationProperty -> ShowS)
-> (SamlConfigurationProperty -> String)
-> ([SamlConfigurationProperty] -> ShowS)
-> Show SamlConfigurationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SamlConfigurationProperty -> ShowS
showsPrec :: Int -> SamlConfigurationProperty -> ShowS
$cshow :: SamlConfigurationProperty -> String
show :: SamlConfigurationProperty -> String
$cshowList :: [SamlConfigurationProperty] -> ShowS
showList :: [SamlConfigurationProperty] -> ShowS
Prelude.Show)
mkSamlConfigurationProperty ::
IdpMetadataProperty -> SamlConfigurationProperty
mkSamlConfigurationProperty :: IdpMetadataProperty -> SamlConfigurationProperty
mkSamlConfigurationProperty IdpMetadataProperty
idpMetadata
= SamlConfigurationProperty
{haddock_workaround_ :: ()
haddock_workaround_ = (), idpMetadata :: IdpMetadataProperty
idpMetadata = IdpMetadataProperty
idpMetadata,
allowedOrganizations :: Maybe (ValueList Text)
allowedOrganizations = Maybe (ValueList Text)
forall a. Maybe a
Prelude.Nothing,
assertionAttributes :: Maybe AssertionAttributesProperty
assertionAttributes = Maybe AssertionAttributesProperty
forall a. Maybe a
Prelude.Nothing,
loginValidityDuration :: Maybe (Value Double)
loginValidityDuration = Maybe (Value Double)
forall a. Maybe a
Prelude.Nothing,
roleValues :: Maybe RoleValuesProperty
roleValues = Maybe RoleValuesProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties SamlConfigurationProperty where
toResourceProperties :: SamlConfigurationProperty -> ResourceProperties
toResourceProperties SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= ResourceProperties
{awsType :: Text
awsType = Text
"AWS::Grafana::Workspace.SamlConfiguration",
supportsTags :: Bool
supportsTags = Bool
Prelude.False,
properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
[Key
"IdpMetadata" Key -> IdpMetadataProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= IdpMetadataProperty
idpMetadata]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AllowedOrganizations" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
allowedOrganizations,
Key -> AssertionAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AssertionAttributes" (AssertionAttributesProperty -> (Key, Value))
-> Maybe AssertionAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AssertionAttributesProperty
assertionAttributes,
Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LoginValidityDuration"
(Value Double -> (Key, Value))
-> Maybe (Value Double) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Double)
loginValidityDuration,
Key -> RoleValuesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RoleValues" (RoleValuesProperty -> (Key, Value))
-> Maybe RoleValuesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RoleValuesProperty
roleValues]))}
instance JSON.ToJSON SamlConfigurationProperty where
toJSON :: SamlConfigurationProperty -> Value
toJSON SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= [(Key, Value)] -> Value
JSON.object
([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
[Key
"IdpMetadata" Key -> IdpMetadataProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= IdpMetadataProperty
idpMetadata]
([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
[Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AllowedOrganizations" (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
allowedOrganizations,
Key -> AssertionAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AssertionAttributes" (AssertionAttributesProperty -> (Key, Value))
-> Maybe AssertionAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AssertionAttributesProperty
assertionAttributes,
Key -> Value Double -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LoginValidityDuration"
(Value Double -> (Key, Value))
-> Maybe (Value Double) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Double)
loginValidityDuration,
Key -> RoleValuesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RoleValues" (RoleValuesProperty -> (Key, Value))
-> Maybe RoleValuesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RoleValuesProperty
roleValues])))
instance Property "AllowedOrganizations" SamlConfigurationProperty where
type PropertyType "AllowedOrganizations" SamlConfigurationProperty = ValueList Prelude.Text
set :: PropertyType "AllowedOrganizations" SamlConfigurationProperty
-> SamlConfigurationProperty -> SamlConfigurationProperty
set PropertyType "AllowedOrganizations" SamlConfigurationProperty
newValue SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= SamlConfigurationProperty
{allowedOrganizations :: Maybe (ValueList Text)
allowedOrganizations = ValueList Text -> Maybe (ValueList Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "AllowedOrganizations" SamlConfigurationProperty
ValueList Text
newValue, Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: ()
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
haddock_workaround_ :: ()
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
instance Property "AssertionAttributes" SamlConfigurationProperty where
type PropertyType "AssertionAttributes" SamlConfigurationProperty = AssertionAttributesProperty
set :: PropertyType "AssertionAttributes" SamlConfigurationProperty
-> SamlConfigurationProperty -> SamlConfigurationProperty
set PropertyType "AssertionAttributes" SamlConfigurationProperty
newValue SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= SamlConfigurationProperty
{assertionAttributes :: Maybe AssertionAttributesProperty
assertionAttributes = AssertionAttributesProperty -> Maybe AssertionAttributesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "AssertionAttributes" SamlConfigurationProperty
AssertionAttributesProperty
newValue, Maybe (ValueList Text)
Maybe (Value Double)
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
instance Property "IdpMetadata" SamlConfigurationProperty where
type PropertyType "IdpMetadata" SamlConfigurationProperty = IdpMetadataProperty
set :: PropertyType "IdpMetadata" SamlConfigurationProperty
-> SamlConfigurationProperty -> SamlConfigurationProperty
set PropertyType "IdpMetadata" SamlConfigurationProperty
newValue SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= SamlConfigurationProperty {idpMetadata :: IdpMetadataProperty
idpMetadata = PropertyType "IdpMetadata" SamlConfigurationProperty
IdpMetadataProperty
newValue, Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
instance Property "LoginValidityDuration" SamlConfigurationProperty where
type PropertyType "LoginValidityDuration" SamlConfigurationProperty = Value Prelude.Double
set :: PropertyType "LoginValidityDuration" SamlConfigurationProperty
-> SamlConfigurationProperty -> SamlConfigurationProperty
set PropertyType "LoginValidityDuration" SamlConfigurationProperty
newValue SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= SamlConfigurationProperty
{loginValidityDuration :: Maybe (Value Double)
loginValidityDuration = Value Double -> Maybe (Value Double)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "LoginValidityDuration" SamlConfigurationProperty
Value Double
newValue, Maybe (ValueList Text)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
roleValues :: Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
roleValues :: Maybe RoleValuesProperty
..}
instance Property "RoleValues" SamlConfigurationProperty where
type PropertyType "RoleValues" SamlConfigurationProperty = RoleValuesProperty
set :: PropertyType "RoleValues" SamlConfigurationProperty
-> SamlConfigurationProperty -> SamlConfigurationProperty
set PropertyType "RoleValues" SamlConfigurationProperty
newValue SamlConfigurationProperty {Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
Maybe RoleValuesProperty
()
IdpMetadataProperty
haddock_workaround_ :: SamlConfigurationProperty -> ()
allowedOrganizations :: SamlConfigurationProperty -> Maybe (ValueList Text)
assertionAttributes :: SamlConfigurationProperty -> Maybe AssertionAttributesProperty
idpMetadata :: SamlConfigurationProperty -> IdpMetadataProperty
loginValidityDuration :: SamlConfigurationProperty -> Maybe (Value Double)
roleValues :: SamlConfigurationProperty -> Maybe RoleValuesProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
roleValues :: Maybe RoleValuesProperty
..}
= SamlConfigurationProperty
{roleValues :: Maybe RoleValuesProperty
roleValues = RoleValuesProperty -> Maybe RoleValuesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RoleValues" SamlConfigurationProperty
RoleValuesProperty
newValue, Maybe (ValueList Text)
Maybe (Value Double)
Maybe AssertionAttributesProperty
()
IdpMetadataProperty
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
haddock_workaround_ :: ()
allowedOrganizations :: Maybe (ValueList Text)
assertionAttributes :: Maybe AssertionAttributesProperty
idpMetadata :: IdpMetadataProperty
loginValidityDuration :: Maybe (Value Double)
..}