module Stratosphere.MediaConnect.Bridge (
        module Exports, Bridge(..), mkBridge
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.MediaConnect.Bridge.BridgeOutputProperty as Exports
import {-# SOURCE #-} Stratosphere.MediaConnect.Bridge.BridgeSourceProperty as Exports
import {-# SOURCE #-} Stratosphere.MediaConnect.Bridge.EgressGatewayBridgeProperty as Exports
import {-# SOURCE #-} Stratosphere.MediaConnect.Bridge.FailoverConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.MediaConnect.Bridge.IngressGatewayBridgeProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data Bridge
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html>
    Bridge {Bridge -> ()
haddock_workaround_ :: (),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-egressgatewaybridge>
            Bridge -> Maybe EgressGatewayBridgeProperty
egressGatewayBridge :: (Prelude.Maybe EgressGatewayBridgeProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-ingressgatewaybridge>
            Bridge -> Maybe IngressGatewayBridgeProperty
ingressGatewayBridge :: (Prelude.Maybe IngressGatewayBridgeProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-name>
            Bridge -> Value Text
name :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-outputs>
            Bridge -> Maybe [BridgeOutputProperty]
outputs :: (Prelude.Maybe [BridgeOutputProperty]),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-placementarn>
            Bridge -> Value Text
placementArn :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-sourcefailoverconfig>
            Bridge -> Maybe FailoverConfigProperty
sourceFailoverConfig :: (Prelude.Maybe FailoverConfigProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-mediaconnect-bridge.html#cfn-mediaconnect-bridge-sources>
            Bridge -> [BridgeSourceProperty]
sources :: [BridgeSourceProperty]}
  deriving stock (Bridge -> Bridge -> Bool
(Bridge -> Bridge -> Bool)
-> (Bridge -> Bridge -> Bool) -> Eq Bridge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bridge -> Bridge -> Bool
== :: Bridge -> Bridge -> Bool
$c/= :: Bridge -> Bridge -> Bool
/= :: Bridge -> Bridge -> Bool
Prelude.Eq, Int -> Bridge -> ShowS
[Bridge] -> ShowS
Bridge -> String
(Int -> Bridge -> ShowS)
-> (Bridge -> String) -> ([Bridge] -> ShowS) -> Show Bridge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bridge -> ShowS
showsPrec :: Int -> Bridge -> ShowS
$cshow :: Bridge -> String
show :: Bridge -> String
$cshowList :: [Bridge] -> ShowS
showList :: [Bridge] -> ShowS
Prelude.Show)
mkBridge ::
  Value Prelude.Text
  -> Value Prelude.Text -> [BridgeSourceProperty] -> Bridge
mkBridge :: Value Text -> Value Text -> [BridgeSourceProperty] -> Bridge
mkBridge Value Text
name Value Text
placementArn [BridgeSourceProperty]
sources
  = Bridge
      {haddock_workaround_ :: ()
haddock_workaround_ = (), name :: Value Text
name = Value Text
name,
       placementArn :: Value Text
placementArn = Value Text
placementArn, sources :: [BridgeSourceProperty]
sources = [BridgeSourceProperty]
sources,
       egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
egressGatewayBridge = Maybe EgressGatewayBridgeProperty
forall a. Maybe a
Prelude.Nothing,
       ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
ingressGatewayBridge = Maybe IngressGatewayBridgeProperty
forall a. Maybe a
Prelude.Nothing, outputs :: Maybe [BridgeOutputProperty]
outputs = Maybe [BridgeOutputProperty]
forall a. Maybe a
Prelude.Nothing,
       sourceFailoverConfig :: Maybe FailoverConfigProperty
sourceFailoverConfig = Maybe FailoverConfigProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties Bridge where
  toResourceProperties :: Bridge -> ResourceProperties
toResourceProperties Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::MediaConnect::Bridge",
         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
"Name" 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
name, Key
"PlacementArn" 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
placementArn,
                            Key
"Sources" Key -> [BridgeSourceProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [BridgeSourceProperty]
sources]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> EgressGatewayBridgeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"EgressGatewayBridge" (EgressGatewayBridgeProperty -> (Key, Value))
-> Maybe EgressGatewayBridgeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EgressGatewayBridgeProperty
egressGatewayBridge,
                               Key -> IngressGatewayBridgeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"IngressGatewayBridge" (IngressGatewayBridgeProperty -> (Key, Value))
-> Maybe IngressGatewayBridgeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe IngressGatewayBridgeProperty
ingressGatewayBridge,
                               Key -> [BridgeOutputProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Outputs" ([BridgeOutputProperty] -> (Key, Value))
-> Maybe [BridgeOutputProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BridgeOutputProperty]
outputs,
                               Key -> FailoverConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"SourceFailoverConfig"
                                 (FailoverConfigProperty -> (Key, Value))
-> Maybe FailoverConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FailoverConfigProperty
sourceFailoverConfig]))}
instance JSON.ToJSON Bridge where
  toJSON :: Bridge -> Value
toJSON Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = [(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
"Name" 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
name, Key
"PlacementArn" 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
placementArn,
               Key
"Sources" Key -> [BridgeSourceProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [BridgeSourceProperty]
sources]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> EgressGatewayBridgeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"EgressGatewayBridge" (EgressGatewayBridgeProperty -> (Key, Value))
-> Maybe EgressGatewayBridgeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EgressGatewayBridgeProperty
egressGatewayBridge,
                  Key -> IngressGatewayBridgeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"IngressGatewayBridge" (IngressGatewayBridgeProperty -> (Key, Value))
-> Maybe IngressGatewayBridgeProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe IngressGatewayBridgeProperty
ingressGatewayBridge,
                  Key -> [BridgeOutputProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Outputs" ([BridgeOutputProperty] -> (Key, Value))
-> Maybe [BridgeOutputProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BridgeOutputProperty]
outputs,
                  Key -> FailoverConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"SourceFailoverConfig"
                    (FailoverConfigProperty -> (Key, Value))
-> Maybe FailoverConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FailoverConfigProperty
sourceFailoverConfig])))
instance Property "EgressGatewayBridge" Bridge where
  type PropertyType "EgressGatewayBridge" Bridge = EgressGatewayBridgeProperty
  set :: PropertyType "EgressGatewayBridge" Bridge -> Bridge -> Bridge
set PropertyType "EgressGatewayBridge" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = Bridge {egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
egressGatewayBridge = EgressGatewayBridgeProperty -> Maybe EgressGatewayBridgeProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "EgressGatewayBridge" Bridge
EgressGatewayBridgeProperty
newValue, [BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
instance Property "IngressGatewayBridge" Bridge where
  type PropertyType "IngressGatewayBridge" Bridge = IngressGatewayBridgeProperty
  set :: PropertyType "IngressGatewayBridge" Bridge -> Bridge -> Bridge
set PropertyType "IngressGatewayBridge" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = Bridge {ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
ingressGatewayBridge = IngressGatewayBridgeProperty -> Maybe IngressGatewayBridgeProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "IngressGatewayBridge" Bridge
IngressGatewayBridgeProperty
newValue, [BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
instance Property "Name" Bridge where
  type PropertyType "Name" Bridge = Value Prelude.Text
  set :: PropertyType "Name" Bridge -> Bridge -> Bridge
set PropertyType "Name" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..} = Bridge {name :: Value Text
name = PropertyType "Name" Bridge
Value Text
newValue, [BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
instance Property "Outputs" Bridge where
  type PropertyType "Outputs" Bridge = [BridgeOutputProperty]
  set :: PropertyType "Outputs" Bridge -> Bridge -> Bridge
set PropertyType "Outputs" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = Bridge {outputs :: Maybe [BridgeOutputProperty]
outputs = [BridgeOutputProperty] -> Maybe [BridgeOutputProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [BridgeOutputProperty]
PropertyType "Outputs" Bridge
newValue, [BridgeSourceProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
instance Property "PlacementArn" Bridge where
  type PropertyType "PlacementArn" Bridge = Value Prelude.Text
  set :: PropertyType "PlacementArn" Bridge -> Bridge -> Bridge
set PropertyType "PlacementArn" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..} = Bridge {placementArn :: Value Text
placementArn = PropertyType "PlacementArn" Bridge
Value Text
newValue, [BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
instance Property "SourceFailoverConfig" Bridge where
  type PropertyType "SourceFailoverConfig" Bridge = FailoverConfigProperty
  set :: PropertyType "SourceFailoverConfig" Bridge -> Bridge -> Bridge
set PropertyType "SourceFailoverConfig" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..}
    = Bridge {sourceFailoverConfig :: Maybe FailoverConfigProperty
sourceFailoverConfig = FailoverConfigProperty -> Maybe FailoverConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "SourceFailoverConfig" Bridge
FailoverConfigProperty
newValue, [BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sources :: [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sources :: [BridgeSourceProperty]
..}
instance Property "Sources" Bridge where
  type PropertyType "Sources" Bridge = [BridgeSourceProperty]
  set :: PropertyType "Sources" Bridge -> Bridge -> Bridge
set PropertyType "Sources" Bridge
newValue Bridge {[BridgeSourceProperty]
Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: Bridge -> ()
egressGatewayBridge :: Bridge -> Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Bridge -> Maybe IngressGatewayBridgeProperty
name :: Bridge -> Value Text
outputs :: Bridge -> Maybe [BridgeOutputProperty]
placementArn :: Bridge -> Value Text
sourceFailoverConfig :: Bridge -> Maybe FailoverConfigProperty
sources :: Bridge -> [BridgeSourceProperty]
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
sources :: [BridgeSourceProperty]
..} = Bridge {sources :: [BridgeSourceProperty]
sources = [BridgeSourceProperty]
PropertyType "Sources" Bridge
newValue, Maybe [BridgeOutputProperty]
Maybe EgressGatewayBridgeProperty
Maybe IngressGatewayBridgeProperty
Maybe FailoverConfigProperty
()
Value Text
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
haddock_workaround_ :: ()
egressGatewayBridge :: Maybe EgressGatewayBridgeProperty
ingressGatewayBridge :: Maybe IngressGatewayBridgeProperty
name :: Value Text
outputs :: Maybe [BridgeOutputProperty]
placementArn :: Value Text
sourceFailoverConfig :: Maybe FailoverConfigProperty
..}