module Stratosphere.Lex.Bot.AudioAndDTMFInputSpecificationProperty (
        module Exports, AudioAndDTMFInputSpecificationProperty(..),
        mkAudioAndDTMFInputSpecificationProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Lex.Bot.AudioSpecificationProperty as Exports
import {-# SOURCE #-} Stratosphere.Lex.Bot.DTMFSpecificationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data AudioAndDTMFInputSpecificationProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-audioanddtmfinputspecification.html>
    AudioAndDTMFInputSpecificationProperty {AudioAndDTMFInputSpecificationProperty -> ()
haddock_workaround_ :: (),
                                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-audioanddtmfinputspecification.html#cfn-lex-bot-audioanddtmfinputspecification-audiospecification>
                                            AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
audioSpecification :: (Prelude.Maybe AudioSpecificationProperty),
                                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-audioanddtmfinputspecification.html#cfn-lex-bot-audioanddtmfinputspecification-dtmfspecification>
                                            AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
dTMFSpecification :: (Prelude.Maybe DTMFSpecificationProperty),
                                            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-lex-bot-audioanddtmfinputspecification.html#cfn-lex-bot-audioanddtmfinputspecification-starttimeoutms>
                                            AudioAndDTMFInputSpecificationProperty -> Value Integer
startTimeoutMs :: (Value Prelude.Integer)}
  deriving stock (AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty -> Bool
(AudioAndDTMFInputSpecificationProperty
 -> AudioAndDTMFInputSpecificationProperty -> Bool)
-> (AudioAndDTMFInputSpecificationProperty
    -> AudioAndDTMFInputSpecificationProperty -> Bool)
-> Eq AudioAndDTMFInputSpecificationProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty -> Bool
== :: AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty -> Bool
$c/= :: AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty -> Bool
/= :: AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty -> Bool
Prelude.Eq, Int -> AudioAndDTMFInputSpecificationProperty -> ShowS
[AudioAndDTMFInputSpecificationProperty] -> ShowS
AudioAndDTMFInputSpecificationProperty -> String
(Int -> AudioAndDTMFInputSpecificationProperty -> ShowS)
-> (AudioAndDTMFInputSpecificationProperty -> String)
-> ([AudioAndDTMFInputSpecificationProperty] -> ShowS)
-> Show AudioAndDTMFInputSpecificationProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioAndDTMFInputSpecificationProperty -> ShowS
showsPrec :: Int -> AudioAndDTMFInputSpecificationProperty -> ShowS
$cshow :: AudioAndDTMFInputSpecificationProperty -> String
show :: AudioAndDTMFInputSpecificationProperty -> String
$cshowList :: [AudioAndDTMFInputSpecificationProperty] -> ShowS
showList :: [AudioAndDTMFInputSpecificationProperty] -> ShowS
Prelude.Show)
mkAudioAndDTMFInputSpecificationProperty ::
  Value Prelude.Integer -> AudioAndDTMFInputSpecificationProperty
mkAudioAndDTMFInputSpecificationProperty :: Value Integer -> AudioAndDTMFInputSpecificationProperty
mkAudioAndDTMFInputSpecificationProperty Value Integer
startTimeoutMs
  = AudioAndDTMFInputSpecificationProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), startTimeoutMs :: Value Integer
startTimeoutMs = Value Integer
startTimeoutMs,
       audioSpecification :: Maybe AudioSpecificationProperty
audioSpecification = Maybe AudioSpecificationProperty
forall a. Maybe a
Prelude.Nothing,
       dTMFSpecification :: Maybe DTMFSpecificationProperty
dTMFSpecification = Maybe DTMFSpecificationProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties AudioAndDTMFInputSpecificationProperty where
  toResourceProperties :: AudioAndDTMFInputSpecificationProperty -> ResourceProperties
toResourceProperties AudioAndDTMFInputSpecificationProperty {Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: AudioAndDTMFInputSpecificationProperty -> ()
audioSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
dTMFSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
startTimeoutMs :: AudioAndDTMFInputSpecificationProperty -> Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Lex::Bot.AudioAndDTMFInputSpecification",
         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
"StartTimeoutMs" 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
startTimeoutMs]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> AudioSpecificationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AudioSpecification" (AudioSpecificationProperty -> (Key, Value))
-> Maybe AudioSpecificationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AudioSpecificationProperty
audioSpecification,
                               Key -> DTMFSpecificationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DTMFSpecification" (DTMFSpecificationProperty -> (Key, Value))
-> Maybe DTMFSpecificationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DTMFSpecificationProperty
dTMFSpecification]))}
instance JSON.ToJSON AudioAndDTMFInputSpecificationProperty where
  toJSON :: AudioAndDTMFInputSpecificationProperty -> Value
toJSON AudioAndDTMFInputSpecificationProperty {Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: AudioAndDTMFInputSpecificationProperty -> ()
audioSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
dTMFSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
startTimeoutMs :: AudioAndDTMFInputSpecificationProperty -> Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: 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
"StartTimeoutMs" 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
startTimeoutMs]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> AudioSpecificationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"AudioSpecification" (AudioSpecificationProperty -> (Key, Value))
-> Maybe AudioSpecificationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AudioSpecificationProperty
audioSpecification,
                  Key -> DTMFSpecificationProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DTMFSpecification" (DTMFSpecificationProperty -> (Key, Value))
-> Maybe DTMFSpecificationProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DTMFSpecificationProperty
dTMFSpecification])))
instance Property "AudioSpecification" AudioAndDTMFInputSpecificationProperty where
  type PropertyType "AudioSpecification" AudioAndDTMFInputSpecificationProperty = AudioSpecificationProperty
  set :: PropertyType
  "AudioSpecification" AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
set PropertyType
  "AudioSpecification" AudioAndDTMFInputSpecificationProperty
newValue AudioAndDTMFInputSpecificationProperty {Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: AudioAndDTMFInputSpecificationProperty -> ()
audioSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
dTMFSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
startTimeoutMs :: AudioAndDTMFInputSpecificationProperty -> Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
..}
    = AudioAndDTMFInputSpecificationProperty
        {audioSpecification :: Maybe AudioSpecificationProperty
audioSpecification = AudioSpecificationProperty -> Maybe AudioSpecificationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "AudioSpecification" AudioAndDTMFInputSpecificationProperty
AudioSpecificationProperty
newValue, Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: ()
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
haddock_workaround_ :: ()
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
..}
instance Property "DTMFSpecification" AudioAndDTMFInputSpecificationProperty where
  type PropertyType "DTMFSpecification" AudioAndDTMFInputSpecificationProperty = DTMFSpecificationProperty
  set :: PropertyType
  "DTMFSpecification" AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
set PropertyType
  "DTMFSpecification" AudioAndDTMFInputSpecificationProperty
newValue AudioAndDTMFInputSpecificationProperty {Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: AudioAndDTMFInputSpecificationProperty -> ()
audioSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
dTMFSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
startTimeoutMs :: AudioAndDTMFInputSpecificationProperty -> Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
..}
    = AudioAndDTMFInputSpecificationProperty
        {dTMFSpecification :: Maybe DTMFSpecificationProperty
dTMFSpecification = DTMFSpecificationProperty -> Maybe DTMFSpecificationProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType
  "DTMFSpecification" AudioAndDTMFInputSpecificationProperty
DTMFSpecificationProperty
newValue, Maybe AudioSpecificationProperty
()
Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
startTimeoutMs :: Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
startTimeoutMs :: Value Integer
..}
instance Property "StartTimeoutMs" AudioAndDTMFInputSpecificationProperty where
  type PropertyType "StartTimeoutMs" AudioAndDTMFInputSpecificationProperty = Value Prelude.Integer
  set :: PropertyType
  "StartTimeoutMs" AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
-> AudioAndDTMFInputSpecificationProperty
set PropertyType
  "StartTimeoutMs" AudioAndDTMFInputSpecificationProperty
newValue AudioAndDTMFInputSpecificationProperty {Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
Value Integer
haddock_workaround_ :: AudioAndDTMFInputSpecificationProperty -> ()
audioSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe AudioSpecificationProperty
dTMFSpecification :: AudioAndDTMFInputSpecificationProperty
-> Maybe DTMFSpecificationProperty
startTimeoutMs :: AudioAndDTMFInputSpecificationProperty -> Value Integer
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
startTimeoutMs :: Value Integer
..}
    = AudioAndDTMFInputSpecificationProperty
        {startTimeoutMs :: Value Integer
startTimeoutMs = PropertyType
  "StartTimeoutMs" AudioAndDTMFInputSpecificationProperty
Value Integer
newValue, Maybe AudioSpecificationProperty
Maybe DTMFSpecificationProperty
()
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
haddock_workaround_ :: ()
audioSpecification :: Maybe AudioSpecificationProperty
dTMFSpecification :: Maybe DTMFSpecificationProperty
..}