module Stratosphere.RTBFabric.Link (
        module Exports, Link(..), mkLink
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.RTBFabric.Link.LinkAttributesProperty as Exports
import {-# SOURCE #-} Stratosphere.RTBFabric.Link.LinkLogSettingsProperty as Exports
import {-# SOURCE #-} Stratosphere.RTBFabric.Link.ModuleConfigurationProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Tag
import Stratosphere.Value
data Link
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html>
    Link {Link -> ()
haddock_workaround_ :: (),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-gatewayid>
          Link -> Value Text
gatewayId :: (Value Prelude.Text),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-httpresponderallowed>
          Link -> Maybe (Value Bool)
httpResponderAllowed :: (Prelude.Maybe (Value Prelude.Bool)),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-linkattributes>
          Link -> Maybe LinkAttributesProperty
linkAttributes :: (Prelude.Maybe LinkAttributesProperty),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-linklogsettings>
          Link -> LinkLogSettingsProperty
linkLogSettings :: LinkLogSettingsProperty,
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-moduleconfigurationlist>
          Link -> Maybe [ModuleConfigurationProperty]
moduleConfigurationList :: (Prelude.Maybe [ModuleConfigurationProperty]),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-peergatewayid>
          Link -> Value Text
peerGatewayId :: (Value Prelude.Text),
          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-rtbfabric-link.html#cfn-rtbfabric-link-tags>
          Link -> Maybe [Tag]
tags :: (Prelude.Maybe [Tag])}
  deriving stock (Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
/= :: Link -> Link -> Bool
Prelude.Eq, Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Link -> ShowS
showsPrec :: Int -> Link -> ShowS
$cshow :: Link -> String
show :: Link -> String
$cshowList :: [Link] -> ShowS
showList :: [Link] -> ShowS
Prelude.Show)
mkLink ::
  Value Prelude.Text
  -> LinkLogSettingsProperty -> Value Prelude.Text -> Link
mkLink :: Value Text -> LinkLogSettingsProperty -> Value Text -> Link
mkLink Value Text
gatewayId LinkLogSettingsProperty
linkLogSettings Value Text
peerGatewayId
  = Link
      {haddock_workaround_ :: ()
haddock_workaround_ = (), gatewayId :: Value Text
gatewayId = Value Text
gatewayId,
       linkLogSettings :: LinkLogSettingsProperty
linkLogSettings = LinkLogSettingsProperty
linkLogSettings, peerGatewayId :: Value Text
peerGatewayId = Value Text
peerGatewayId,
       httpResponderAllowed :: Maybe (Value Bool)
httpResponderAllowed = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       linkAttributes :: Maybe LinkAttributesProperty
linkAttributes = Maybe LinkAttributesProperty
forall a. Maybe a
Prelude.Nothing,
       moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
moduleConfigurationList = Maybe [ModuleConfigurationProperty]
forall a. Maybe a
Prelude.Nothing, tags :: Maybe [Tag]
tags = Maybe [Tag]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties Link where
  toResourceProperties :: Link -> ResourceProperties
toResourceProperties Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::RTBFabric::Link", supportsTags :: Bool
supportsTags = Bool
Prelude.True,
         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
"GatewayId" 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
gatewayId,
                            Key
"LinkLogSettings" Key -> LinkLogSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= LinkLogSettingsProperty
linkLogSettings,
                            Key
"PeerGatewayId" 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
peerGatewayId]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HttpResponderAllowed" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
httpResponderAllowed,
                               Key -> LinkAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LinkAttributes" (LinkAttributesProperty -> (Key, Value))
-> Maybe LinkAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LinkAttributesProperty
linkAttributes,
                               Key -> [ModuleConfigurationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ModuleConfigurationList"
                                 ([ModuleConfigurationProperty] -> (Key, Value))
-> Maybe [ModuleConfigurationProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ModuleConfigurationProperty]
moduleConfigurationList,
                               Key -> [Tag] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags]))}
instance JSON.ToJSON Link where
  toJSON :: Link -> Value
toJSON Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
    = [(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
"GatewayId" 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
gatewayId,
               Key
"LinkLogSettings" Key -> LinkLogSettingsProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= LinkLogSettingsProperty
linkLogSettings,
               Key
"PeerGatewayId" 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
peerGatewayId]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HttpResponderAllowed" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
httpResponderAllowed,
                  Key -> LinkAttributesProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"LinkAttributes" (LinkAttributesProperty -> (Key, Value))
-> Maybe LinkAttributesProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LinkAttributesProperty
linkAttributes,
                  Key -> [ModuleConfigurationProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ModuleConfigurationList"
                    ([ModuleConfigurationProperty] -> (Key, Value))
-> Maybe [ModuleConfigurationProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ModuleConfigurationProperty]
moduleConfigurationList,
                  Key -> [Tag] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags])))
instance Property "GatewayId" Link where
  type PropertyType "GatewayId" Link = Value Prelude.Text
  set :: PropertyType "GatewayId" Link -> Link -> Link
set PropertyType "GatewayId" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..} = Link {gatewayId :: Value Text
gatewayId = PropertyType "GatewayId" Link
Value Text
newValue, Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
haddock_workaround_ :: ()
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
instance Property "HttpResponderAllowed" Link where
  type PropertyType "HttpResponderAllowed" Link = Value Prelude.Bool
  set :: PropertyType "HttpResponderAllowed" Link -> Link -> Link
set PropertyType "HttpResponderAllowed" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
    = Link {httpResponderAllowed :: Maybe (Value Bool)
httpResponderAllowed = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "HttpResponderAllowed" Link
Value Bool
newValue, Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
gatewayId :: Value Text
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
instance Property "LinkAttributes" Link where
  type PropertyType "LinkAttributes" Link = LinkAttributesProperty
  set :: PropertyType "LinkAttributes" Link -> Link -> Link
set PropertyType "LinkAttributes" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
    = Link {linkAttributes :: Maybe LinkAttributesProperty
linkAttributes = LinkAttributesProperty -> Maybe LinkAttributesProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "LinkAttributes" Link
LinkAttributesProperty
newValue, Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
instance Property "LinkLogSettings" Link where
  type PropertyType "LinkLogSettings" Link = LinkLogSettingsProperty
  set :: PropertyType "LinkLogSettings" Link -> Link -> Link
set PropertyType "LinkLogSettings" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..} = Link {linkLogSettings :: LinkLogSettingsProperty
linkLogSettings = PropertyType "LinkLogSettings" Link
LinkLogSettingsProperty
newValue, Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
instance Property "ModuleConfigurationList" Link where
  type PropertyType "ModuleConfigurationList" Link = [ModuleConfigurationProperty]
  set :: PropertyType "ModuleConfigurationList" Link -> Link -> Link
set PropertyType "ModuleConfigurationList" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
    = Link {moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
moduleConfigurationList = [ModuleConfigurationProperty]
-> Maybe [ModuleConfigurationProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [ModuleConfigurationProperty]
PropertyType "ModuleConfigurationList" Link
newValue, Maybe [Tag]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
peerGatewayId :: Value Text
tags :: Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..}
instance Property "PeerGatewayId" Link where
  type PropertyType "PeerGatewayId" Link = Value Prelude.Text
  set :: PropertyType "PeerGatewayId" Link -> Link -> Link
set PropertyType "PeerGatewayId" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..} = Link {peerGatewayId :: Value Text
peerGatewayId = PropertyType "PeerGatewayId" Link
Value Text
newValue, Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
tags :: Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
tags :: Maybe [Tag]
..}
instance Property "Tags" Link where
  type PropertyType "Tags" Link = [Tag]
  set :: PropertyType "Tags" Link -> Link -> Link
set PropertyType "Tags" Link
newValue Link {Maybe [Tag]
Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: Link -> ()
gatewayId :: Link -> Value Text
httpResponderAllowed :: Link -> Maybe (Value Bool)
linkAttributes :: Link -> Maybe LinkAttributesProperty
linkLogSettings :: Link -> LinkLogSettingsProperty
moduleConfigurationList :: Link -> Maybe [ModuleConfigurationProperty]
peerGatewayId :: Link -> Value Text
tags :: Link -> Maybe [Tag]
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
tags :: Maybe [Tag]
..} = Link {tags :: Maybe [Tag]
tags = [Tag] -> Maybe [Tag]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [Tag]
PropertyType "Tags" Link
newValue, Maybe [ModuleConfigurationProperty]
Maybe (Value Bool)
Maybe LinkAttributesProperty
()
Value Text
LinkLogSettingsProperty
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
haddock_workaround_ :: ()
gatewayId :: Value Text
httpResponderAllowed :: Maybe (Value Bool)
linkAttributes :: Maybe LinkAttributesProperty
linkLogSettings :: LinkLogSettingsProperty
moduleConfigurationList :: Maybe [ModuleConfigurationProperty]
peerGatewayId :: Value Text
..}