module Stratosphere.Connect.TaskTemplate.ConstraintsProperty (
        module Exports, ConstraintsProperty(..), mkConstraintsProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Connect.TaskTemplate.InvisibleFieldInfoProperty as Exports
import {-# SOURCE #-} Stratosphere.Connect.TaskTemplate.ReadOnlyFieldInfoProperty as Exports
import {-# SOURCE #-} Stratosphere.Connect.TaskTemplate.RequiredFieldInfoProperty as Exports
import Stratosphere.ResourceProperties
data ConstraintsProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-tasktemplate-constraints.html>
    ConstraintsProperty {ConstraintsProperty -> ()
haddock_workaround_ :: (),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-tasktemplate-constraints.html#cfn-connect-tasktemplate-constraints-invisiblefields>
                         ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
invisibleFields :: (Prelude.Maybe [InvisibleFieldInfoProperty]),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-tasktemplate-constraints.html#cfn-connect-tasktemplate-constraints-readonlyfields>
                         ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
readOnlyFields :: (Prelude.Maybe [ReadOnlyFieldInfoProperty]),
                         -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-tasktemplate-constraints.html#cfn-connect-tasktemplate-constraints-requiredfields>
                         ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
requiredFields :: (Prelude.Maybe [RequiredFieldInfoProperty])}
  deriving stock (ConstraintsProperty -> ConstraintsProperty -> Bool
(ConstraintsProperty -> ConstraintsProperty -> Bool)
-> (ConstraintsProperty -> ConstraintsProperty -> Bool)
-> Eq ConstraintsProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstraintsProperty -> ConstraintsProperty -> Bool
== :: ConstraintsProperty -> ConstraintsProperty -> Bool
$c/= :: ConstraintsProperty -> ConstraintsProperty -> Bool
/= :: ConstraintsProperty -> ConstraintsProperty -> Bool
Prelude.Eq, Int -> ConstraintsProperty -> ShowS
[ConstraintsProperty] -> ShowS
ConstraintsProperty -> String
(Int -> ConstraintsProperty -> ShowS)
-> (ConstraintsProperty -> String)
-> ([ConstraintsProperty] -> ShowS)
-> Show ConstraintsProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstraintsProperty -> ShowS
showsPrec :: Int -> ConstraintsProperty -> ShowS
$cshow :: ConstraintsProperty -> String
show :: ConstraintsProperty -> String
$cshowList :: [ConstraintsProperty] -> ShowS
showList :: [ConstraintsProperty] -> ShowS
Prelude.Show)
mkConstraintsProperty :: ConstraintsProperty
mkConstraintsProperty :: ConstraintsProperty
mkConstraintsProperty
  = ConstraintsProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), invisibleFields :: Maybe [InvisibleFieldInfoProperty]
invisibleFields = Maybe [InvisibleFieldInfoProperty]
forall a. Maybe a
Prelude.Nothing,
       readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
readOnlyFields = Maybe [ReadOnlyFieldInfoProperty]
forall a. Maybe a
Prelude.Nothing, requiredFields :: Maybe [RequiredFieldInfoProperty]
requiredFields = Maybe [RequiredFieldInfoProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ConstraintsProperty where
  toResourceProperties :: ConstraintsProperty -> ResourceProperties
toResourceProperties ConstraintsProperty {Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ConstraintsProperty -> ()
invisibleFields :: ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Connect::TaskTemplate.Constraints",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> [InvisibleFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"InvisibleFields" ([InvisibleFieldInfoProperty] -> (Key, Value))
-> Maybe [InvisibleFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [InvisibleFieldInfoProperty]
invisibleFields,
                            Key -> [ReadOnlyFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ReadOnlyFields" ([ReadOnlyFieldInfoProperty] -> (Key, Value))
-> Maybe [ReadOnlyFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ReadOnlyFieldInfoProperty]
readOnlyFields,
                            Key -> [RequiredFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RequiredFields" ([RequiredFieldInfoProperty] -> (Key, Value))
-> Maybe [RequiredFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [RequiredFieldInfoProperty]
requiredFields])}
instance JSON.ToJSON ConstraintsProperty where
  toJSON :: ConstraintsProperty -> Value
toJSON ConstraintsProperty {Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ConstraintsProperty -> ()
invisibleFields :: ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> [InvisibleFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"InvisibleFields" ([InvisibleFieldInfoProperty] -> (Key, Value))
-> Maybe [InvisibleFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [InvisibleFieldInfoProperty]
invisibleFields,
               Key -> [ReadOnlyFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ReadOnlyFields" ([ReadOnlyFieldInfoProperty] -> (Key, Value))
-> Maybe [ReadOnlyFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ReadOnlyFieldInfoProperty]
readOnlyFields,
               Key -> [RequiredFieldInfoProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RequiredFields" ([RequiredFieldInfoProperty] -> (Key, Value))
-> Maybe [RequiredFieldInfoProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [RequiredFieldInfoProperty]
requiredFields]))
instance Property "InvisibleFields" ConstraintsProperty where
  type PropertyType "InvisibleFields" ConstraintsProperty = [InvisibleFieldInfoProperty]
  set :: PropertyType "InvisibleFields" ConstraintsProperty
-> ConstraintsProperty -> ConstraintsProperty
set PropertyType "InvisibleFields" ConstraintsProperty
newValue ConstraintsProperty {Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ConstraintsProperty -> ()
invisibleFields :: ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
    = ConstraintsProperty {invisibleFields :: Maybe [InvisibleFieldInfoProperty]
invisibleFields = [InvisibleFieldInfoProperty] -> Maybe [InvisibleFieldInfoProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [InvisibleFieldInfoProperty]
PropertyType "InvisibleFields" ConstraintsProperty
newValue, Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ()
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
instance Property "ReadOnlyFields" ConstraintsProperty where
  type PropertyType "ReadOnlyFields" ConstraintsProperty = [ReadOnlyFieldInfoProperty]
  set :: PropertyType "ReadOnlyFields" ConstraintsProperty
-> ConstraintsProperty -> ConstraintsProperty
set PropertyType "ReadOnlyFields" ConstraintsProperty
newValue ConstraintsProperty {Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ConstraintsProperty -> ()
invisibleFields :: ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
    = ConstraintsProperty {readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
readOnlyFields = [ReadOnlyFieldInfoProperty] -> Maybe [ReadOnlyFieldInfoProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [ReadOnlyFieldInfoProperty]
PropertyType "ReadOnlyFields" ConstraintsProperty
newValue, Maybe [InvisibleFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
instance Property "RequiredFields" ConstraintsProperty where
  type PropertyType "RequiredFields" ConstraintsProperty = [RequiredFieldInfoProperty]
  set :: PropertyType "RequiredFields" ConstraintsProperty
-> ConstraintsProperty -> ConstraintsProperty
set PropertyType "RequiredFields" ConstraintsProperty
newValue ConstraintsProperty {Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
Maybe [RequiredFieldInfoProperty]
()
haddock_workaround_ :: ConstraintsProperty -> ()
invisibleFields :: ConstraintsProperty -> Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: ConstraintsProperty -> Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: ConstraintsProperty -> Maybe [RequiredFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
requiredFields :: Maybe [RequiredFieldInfoProperty]
..}
    = ConstraintsProperty {requiredFields :: Maybe [RequiredFieldInfoProperty]
requiredFields = [RequiredFieldInfoProperty] -> Maybe [RequiredFieldInfoProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [RequiredFieldInfoProperty]
PropertyType "RequiredFields" ConstraintsProperty
newValue, Maybe [InvisibleFieldInfoProperty]
Maybe [ReadOnlyFieldInfoProperty]
()
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
haddock_workaround_ :: ()
invisibleFields :: Maybe [InvisibleFieldInfoProperty]
readOnlyFields :: Maybe [ReadOnlyFieldInfoProperty]
..}