module Stratosphere.IoTFleetWise.Campaign.TimeBasedSignalFetchConfigProperty (
        TimeBasedSignalFetchConfigProperty(..),
        mkTimeBasedSignalFetchConfigProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data TimeBasedSignalFetchConfigProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotfleetwise-campaign-timebasedsignalfetchconfig.html>
    TimeBasedSignalFetchConfigProperty {TimeBasedSignalFetchConfigProperty -> ()
haddock_workaround_ :: (),
                                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iotfleetwise-campaign-timebasedsignalfetchconfig.html#cfn-iotfleetwise-campaign-timebasedsignalfetchconfig-executionfrequencyms>
                                        TimeBasedSignalFetchConfigProperty -> Value Double
executionFrequencyMs :: (Value Prelude.Double)}
  deriving stock (TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty -> Bool
(TimeBasedSignalFetchConfigProperty
 -> TimeBasedSignalFetchConfigProperty -> Bool)
-> (TimeBasedSignalFetchConfigProperty
    -> TimeBasedSignalFetchConfigProperty -> Bool)
-> Eq TimeBasedSignalFetchConfigProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty -> Bool
== :: TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty -> Bool
$c/= :: TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty -> Bool
/= :: TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty -> Bool
Prelude.Eq, Int -> TimeBasedSignalFetchConfigProperty -> ShowS
[TimeBasedSignalFetchConfigProperty] -> ShowS
TimeBasedSignalFetchConfigProperty -> String
(Int -> TimeBasedSignalFetchConfigProperty -> ShowS)
-> (TimeBasedSignalFetchConfigProperty -> String)
-> ([TimeBasedSignalFetchConfigProperty] -> ShowS)
-> Show TimeBasedSignalFetchConfigProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeBasedSignalFetchConfigProperty -> ShowS
showsPrec :: Int -> TimeBasedSignalFetchConfigProperty -> ShowS
$cshow :: TimeBasedSignalFetchConfigProperty -> String
show :: TimeBasedSignalFetchConfigProperty -> String
$cshowList :: [TimeBasedSignalFetchConfigProperty] -> ShowS
showList :: [TimeBasedSignalFetchConfigProperty] -> ShowS
Prelude.Show)
mkTimeBasedSignalFetchConfigProperty ::
  Value Prelude.Double -> TimeBasedSignalFetchConfigProperty
mkTimeBasedSignalFetchConfigProperty :: Value Double -> TimeBasedSignalFetchConfigProperty
mkTimeBasedSignalFetchConfigProperty Value Double
executionFrequencyMs
  = TimeBasedSignalFetchConfigProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (),
       executionFrequencyMs :: Value Double
executionFrequencyMs = Value Double
executionFrequencyMs}
instance ToResourceProperties TimeBasedSignalFetchConfigProperty where
  toResourceProperties :: TimeBasedSignalFetchConfigProperty -> ResourceProperties
toResourceProperties TimeBasedSignalFetchConfigProperty {()
Value Double
haddock_workaround_ :: TimeBasedSignalFetchConfigProperty -> ()
executionFrequencyMs :: TimeBasedSignalFetchConfigProperty -> Value Double
haddock_workaround_ :: ()
executionFrequencyMs :: Value Double
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::IoTFleetWise::Campaign.TimeBasedSignalFetchConfig",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"ExecutionFrequencyMs" 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..= Value Double
executionFrequencyMs]}
instance JSON.ToJSON TimeBasedSignalFetchConfigProperty where
  toJSON :: TimeBasedSignalFetchConfigProperty -> Value
toJSON TimeBasedSignalFetchConfigProperty {()
Value Double
haddock_workaround_ :: TimeBasedSignalFetchConfigProperty -> ()
executionFrequencyMs :: TimeBasedSignalFetchConfigProperty -> Value Double
haddock_workaround_ :: ()
executionFrequencyMs :: Value Double
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"ExecutionFrequencyMs" 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..= Value Double
executionFrequencyMs]
instance Property "ExecutionFrequencyMs" TimeBasedSignalFetchConfigProperty where
  type PropertyType "ExecutionFrequencyMs" TimeBasedSignalFetchConfigProperty = Value Prelude.Double
  set :: PropertyType
  "ExecutionFrequencyMs" TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty
-> TimeBasedSignalFetchConfigProperty
set PropertyType
  "ExecutionFrequencyMs" TimeBasedSignalFetchConfigProperty
newValue TimeBasedSignalFetchConfigProperty {()
Value Double
haddock_workaround_ :: TimeBasedSignalFetchConfigProperty -> ()
executionFrequencyMs :: TimeBasedSignalFetchConfigProperty -> Value Double
haddock_workaround_ :: ()
executionFrequencyMs :: Value Double
..}
    = TimeBasedSignalFetchConfigProperty
        {executionFrequencyMs :: Value Double
executionFrequencyMs = PropertyType
  "ExecutionFrequencyMs" TimeBasedSignalFetchConfigProperty
Value Double
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}