module Stratosphere.Connect.QuickConnect.UserQuickConnectConfigProperty (
        UserQuickConnectConfigProperty(..),
        mkUserQuickConnectConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data UserQuickConnectConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-quickconnect-userquickconnectconfig.html>
    UserQuickConnectConfigProperty {UserQuickConnectConfigProperty -> ()
haddock_workaround_ :: (),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-quickconnect-userquickconnectconfig.html#cfn-connect-quickconnect-userquickconnectconfig-contactflowarn>
                                    UserQuickConnectConfigProperty -> Value Text
contactFlowArn :: (Value Prelude.Text),
                                    -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-connect-quickconnect-userquickconnectconfig.html#cfn-connect-quickconnect-userquickconnectconfig-userarn>
                                    UserQuickConnectConfigProperty -> Value Text
userArn :: (Value Prelude.Text)}
  deriving stock (UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> Bool
(UserQuickConnectConfigProperty
 -> UserQuickConnectConfigProperty -> Bool)
-> (UserQuickConnectConfigProperty
    -> UserQuickConnectConfigProperty -> Bool)
-> Eq UserQuickConnectConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> Bool
== :: UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> Bool
$c/= :: UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> Bool
/= :: UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> Bool
Prelude.Eq, Int -> UserQuickConnectConfigProperty -> ShowS
[UserQuickConnectConfigProperty] -> ShowS
UserQuickConnectConfigProperty -> String
(Int -> UserQuickConnectConfigProperty -> ShowS)
-> (UserQuickConnectConfigProperty -> String)
-> ([UserQuickConnectConfigProperty] -> ShowS)
-> Show UserQuickConnectConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserQuickConnectConfigProperty -> ShowS
showsPrec :: Int -> UserQuickConnectConfigProperty -> ShowS
$cshow :: UserQuickConnectConfigProperty -> String
show :: UserQuickConnectConfigProperty -> String
$cshowList :: [UserQuickConnectConfigProperty] -> ShowS
showList :: [UserQuickConnectConfigProperty] -> ShowS
Prelude.Show)
mkUserQuickConnectConfigProperty ::
  Value Prelude.Text
  -> Value Prelude.Text -> UserQuickConnectConfigProperty
mkUserQuickConnectConfigProperty :: Value Text -> Value Text -> UserQuickConnectConfigProperty
mkUserQuickConnectConfigProperty Value Text
contactFlowArn Value Text
userArn
  = UserQuickConnectConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), contactFlowArn :: Value Text
contactFlowArn = Value Text
contactFlowArn,
       userArn :: Value Text
userArn = Value Text
userArn}
instance ToResourceProperties UserQuickConnectConfigProperty where
  toResourceProperties :: UserQuickConnectConfigProperty -> ResourceProperties
toResourceProperties UserQuickConnectConfigProperty {()
Value Text
haddock_workaround_ :: UserQuickConnectConfigProperty -> ()
contactFlowArn :: UserQuickConnectConfigProperty -> Value Text
userArn :: UserQuickConnectConfigProperty -> Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
userArn :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Connect::QuickConnect.UserQuickConnectConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ContactFlowArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
contactFlowArn,
                       Key
"UserArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
userArn]}
instance JSON.ToJSON UserQuickConnectConfigProperty where
  toJSON :: UserQuickConnectConfigProperty -> Value
toJSON UserQuickConnectConfigProperty {()
Value Text
haddock_workaround_ :: UserQuickConnectConfigProperty -> ()
contactFlowArn :: UserQuickConnectConfigProperty -> Value Text
userArn :: UserQuickConnectConfigProperty -> Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
userArn :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"ContactFlowArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
contactFlowArn,
         Key
"UserArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
userArn]
instance Property "ContactFlowArn" UserQuickConnectConfigProperty where
  type PropertyType "ContactFlowArn" UserQuickConnectConfigProperty = Value Prelude.Text
  set :: PropertyType "ContactFlowArn" UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> UserQuickConnectConfigProperty
set PropertyType "ContactFlowArn" UserQuickConnectConfigProperty
newValue UserQuickConnectConfigProperty {()
Value Text
haddock_workaround_ :: UserQuickConnectConfigProperty -> ()
contactFlowArn :: UserQuickConnectConfigProperty -> Value Text
userArn :: UserQuickConnectConfigProperty -> Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
userArn :: Value Text
..}
    = UserQuickConnectConfigProperty {contactFlowArn :: Value Text
contactFlowArn = PropertyType "ContactFlowArn" UserQuickConnectConfigProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
userArn :: Value Text
haddock_workaround_ :: ()
userArn :: Value Text
..}
instance Property "UserArn" UserQuickConnectConfigProperty where
  type PropertyType "UserArn" UserQuickConnectConfigProperty = Value Prelude.Text
  set :: PropertyType "UserArn" UserQuickConnectConfigProperty
-> UserQuickConnectConfigProperty -> UserQuickConnectConfigProperty
set PropertyType "UserArn" UserQuickConnectConfigProperty
newValue UserQuickConnectConfigProperty {()
Value Text
haddock_workaround_ :: UserQuickConnectConfigProperty -> ()
contactFlowArn :: UserQuickConnectConfigProperty -> Value Text
userArn :: UserQuickConnectConfigProperty -> Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
userArn :: Value Text
..}
    = UserQuickConnectConfigProperty {userArn :: Value Text
userArn = PropertyType "UserArn" UserQuickConnectConfigProperty
Value Text
newValue, ()
Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
haddock_workaround_ :: ()
contactFlowArn :: Value Text
..}