module Stratosphere.AppStream.AppBlock.ScriptDetailsProperty (
        module Exports, ScriptDetailsProperty(..), mkScriptDetailsProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.AppStream.AppBlock.S3LocationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ScriptDetailsProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appstream-appblock-scriptdetails.html>
    ScriptDetailsProperty {ScriptDetailsProperty -> ()
haddock_workaround_ :: (),
                           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appstream-appblock-scriptdetails.html#cfn-appstream-appblock-scriptdetails-executableparameters>
                           ScriptDetailsProperty -> Maybe (Value Text)
executableParameters :: (Prelude.Maybe (Value Prelude.Text)),
                           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appstream-appblock-scriptdetails.html#cfn-appstream-appblock-scriptdetails-executablepath>
                           ScriptDetailsProperty -> Value Text
executablePath :: (Value Prelude.Text),
                           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appstream-appblock-scriptdetails.html#cfn-appstream-appblock-scriptdetails-scripts3location>
                           ScriptDetailsProperty -> S3LocationProperty
scriptS3Location :: S3LocationProperty,
                           -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appstream-appblock-scriptdetails.html#cfn-appstream-appblock-scriptdetails-timeoutinseconds>
                           ScriptDetailsProperty -> Value Integer
timeoutInSeconds :: (Value Prelude.Integer)}
  deriving stock (ScriptDetailsProperty -> ScriptDetailsProperty -> Bool
(ScriptDetailsProperty -> ScriptDetailsProperty -> Bool)
-> (ScriptDetailsProperty -> ScriptDetailsProperty -> Bool)
-> Eq ScriptDetailsProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptDetailsProperty -> ScriptDetailsProperty -> Bool
== :: ScriptDetailsProperty -> ScriptDetailsProperty -> Bool
$c/= :: ScriptDetailsProperty -> ScriptDetailsProperty -> Bool
/= :: ScriptDetailsProperty -> ScriptDetailsProperty -> Bool
Prelude.Eq, Int -> ScriptDetailsProperty -> ShowS
[ScriptDetailsProperty] -> ShowS
ScriptDetailsProperty -> String
(Int -> ScriptDetailsProperty -> ShowS)
-> (ScriptDetailsProperty -> String)
-> ([ScriptDetailsProperty] -> ShowS)
-> Show ScriptDetailsProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptDetailsProperty -> ShowS
showsPrec :: Int -> ScriptDetailsProperty -> ShowS
$cshow :: ScriptDetailsProperty -> String
show :: ScriptDetailsProperty -> String
$cshowList :: [ScriptDetailsProperty] -> ShowS
showList :: [ScriptDetailsProperty] -> ShowS
Prelude.Show)
mkScriptDetailsProperty ::
  Value Prelude.Text
  -> S3LocationProperty
     -> Value Prelude.Integer -> ScriptDetailsProperty
mkScriptDetailsProperty :: Value Text
-> S3LocationProperty -> Value Integer -> ScriptDetailsProperty
mkScriptDetailsProperty
  Value Text
executablePath
  S3LocationProperty
scriptS3Location
  Value Integer
timeoutInSeconds
  = ScriptDetailsProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), executablePath :: Value Text
executablePath = Value Text
executablePath,
       scriptS3Location :: S3LocationProperty
scriptS3Location = S3LocationProperty
scriptS3Location,
       timeoutInSeconds :: Value Integer
timeoutInSeconds = Value Integer
timeoutInSeconds,
       executableParameters :: Maybe (Value Text)
executableParameters = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ScriptDetailsProperty where
  toResourceProperties :: ScriptDetailsProperty -> ResourceProperties
toResourceProperties ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::AppStream::AppBlock.ScriptDetails",
         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
"ExecutablePath" 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
executablePath,
                            Key
"ScriptS3Location" Key -> S3LocationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= S3LocationProperty
scriptS3Location,
                            Key
"TimeoutInSeconds" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
timeoutInSeconds]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [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..=) Key
"ExecutableParameters"
                                 (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
executableParameters]))}
instance JSON.ToJSON ScriptDetailsProperty where
  toJSON :: ScriptDetailsProperty -> Value
toJSON ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = [(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
"ExecutablePath" 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
executablePath,
               Key
"ScriptS3Location" Key -> S3LocationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= S3LocationProperty
scriptS3Location,
               Key
"TimeoutInSeconds" Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Integer
timeoutInSeconds]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [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..=) Key
"ExecutableParameters"
                    (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
executableParameters])))
instance Property "ExecutableParameters" ScriptDetailsProperty where
  type PropertyType "ExecutableParameters" ScriptDetailsProperty = Value Prelude.Text
  set :: PropertyType "ExecutableParameters" ScriptDetailsProperty
-> ScriptDetailsProperty -> ScriptDetailsProperty
set PropertyType "ExecutableParameters" ScriptDetailsProperty
newValue ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = ScriptDetailsProperty
        {executableParameters :: Maybe (Value Text)
executableParameters = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ExecutableParameters" ScriptDetailsProperty
Value Text
newValue, ()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ()
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
haddock_workaround_ :: ()
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
instance Property "ExecutablePath" ScriptDetailsProperty where
  type PropertyType "ExecutablePath" ScriptDetailsProperty = Value Prelude.Text
  set :: PropertyType "ExecutablePath" ScriptDetailsProperty
-> ScriptDetailsProperty -> ScriptDetailsProperty
set PropertyType "ExecutablePath" ScriptDetailsProperty
newValue ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = ScriptDetailsProperty {executablePath :: Value Text
executablePath = PropertyType "ExecutablePath" ScriptDetailsProperty
Value Text
newValue, Maybe (Value Text)
()
Value Integer
S3LocationProperty
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
instance Property "ScriptS3Location" ScriptDetailsProperty where
  type PropertyType "ScriptS3Location" ScriptDetailsProperty = S3LocationProperty
  set :: PropertyType "ScriptS3Location" ScriptDetailsProperty
-> ScriptDetailsProperty -> ScriptDetailsProperty
set PropertyType "ScriptS3Location" ScriptDetailsProperty
newValue ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = ScriptDetailsProperty {scriptS3Location :: S3LocationProperty
scriptS3Location = PropertyType "ScriptS3Location" ScriptDetailsProperty
S3LocationProperty
newValue, Maybe (Value Text)
()
Value Integer
Value Text
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
timeoutInSeconds :: Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
timeoutInSeconds :: Value Integer
..}
instance Property "TimeoutInSeconds" ScriptDetailsProperty where
  type PropertyType "TimeoutInSeconds" ScriptDetailsProperty = Value Prelude.Integer
  set :: PropertyType "TimeoutInSeconds" ScriptDetailsProperty
-> ScriptDetailsProperty -> ScriptDetailsProperty
set PropertyType "TimeoutInSeconds" ScriptDetailsProperty
newValue ScriptDetailsProperty {Maybe (Value Text)
()
Value Integer
Value Text
S3LocationProperty
haddock_workaround_ :: ScriptDetailsProperty -> ()
executableParameters :: ScriptDetailsProperty -> Maybe (Value Text)
executablePath :: ScriptDetailsProperty -> Value Text
scriptS3Location :: ScriptDetailsProperty -> S3LocationProperty
timeoutInSeconds :: ScriptDetailsProperty -> Value Integer
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
timeoutInSeconds :: Value Integer
..}
    = ScriptDetailsProperty {timeoutInSeconds :: Value Integer
timeoutInSeconds = PropertyType "TimeoutInSeconds" ScriptDetailsProperty
Value Integer
newValue, Maybe (Value Text)
()
Value Text
S3LocationProperty
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
haddock_workaround_ :: ()
executableParameters :: Maybe (Value Text)
executablePath :: Value Text
scriptS3Location :: S3LocationProperty
..}