module Stratosphere.AppMesh.GatewayRoute.GatewayRouteVirtualServiceProperty (
        GatewayRouteVirtualServiceProperty(..),
        mkGatewayRouteVirtualServiceProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data GatewayRouteVirtualServiceProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-gatewayroute-gatewayroutevirtualservice.html>
    GatewayRouteVirtualServiceProperty {GatewayRouteVirtualServiceProperty -> ()
haddock_workaround_ :: (),
                                        -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-gatewayroute-gatewayroutevirtualservice.html#cfn-appmesh-gatewayroute-gatewayroutevirtualservice-virtualservicename>
                                        GatewayRouteVirtualServiceProperty -> Value Text
virtualServiceName :: (Value Prelude.Text)}
  deriving stock (GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty -> Bool
(GatewayRouteVirtualServiceProperty
 -> GatewayRouteVirtualServiceProperty -> Bool)
-> (GatewayRouteVirtualServiceProperty
    -> GatewayRouteVirtualServiceProperty -> Bool)
-> Eq GatewayRouteVirtualServiceProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty -> Bool
== :: GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty -> Bool
$c/= :: GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty -> Bool
/= :: GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty -> Bool
Prelude.Eq, Int -> GatewayRouteVirtualServiceProperty -> ShowS
[GatewayRouteVirtualServiceProperty] -> ShowS
GatewayRouteVirtualServiceProperty -> String
(Int -> GatewayRouteVirtualServiceProperty -> ShowS)
-> (GatewayRouteVirtualServiceProperty -> String)
-> ([GatewayRouteVirtualServiceProperty] -> ShowS)
-> Show GatewayRouteVirtualServiceProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GatewayRouteVirtualServiceProperty -> ShowS
showsPrec :: Int -> GatewayRouteVirtualServiceProperty -> ShowS
$cshow :: GatewayRouteVirtualServiceProperty -> String
show :: GatewayRouteVirtualServiceProperty -> String
$cshowList :: [GatewayRouteVirtualServiceProperty] -> ShowS
showList :: [GatewayRouteVirtualServiceProperty] -> ShowS
Prelude.Show)
mkGatewayRouteVirtualServiceProperty ::
  Value Prelude.Text -> GatewayRouteVirtualServiceProperty
mkGatewayRouteVirtualServiceProperty :: Value Text -> GatewayRouteVirtualServiceProperty
mkGatewayRouteVirtualServiceProperty Value Text
virtualServiceName
  = GatewayRouteVirtualServiceProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), virtualServiceName :: Value Text
virtualServiceName = Value Text
virtualServiceName}
instance ToResourceProperties GatewayRouteVirtualServiceProperty where
  toResourceProperties :: GatewayRouteVirtualServiceProperty -> ResourceProperties
toResourceProperties GatewayRouteVirtualServiceProperty {()
Value Text
haddock_workaround_ :: GatewayRouteVirtualServiceProperty -> ()
virtualServiceName :: GatewayRouteVirtualServiceProperty -> Value Text
haddock_workaround_ :: ()
virtualServiceName :: Value Text
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::AppMesh::GatewayRoute.GatewayRouteVirtualService",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"VirtualServiceName" 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
virtualServiceName]}
instance JSON.ToJSON GatewayRouteVirtualServiceProperty where
  toJSON :: GatewayRouteVirtualServiceProperty -> Value
toJSON GatewayRouteVirtualServiceProperty {()
Value Text
haddock_workaround_ :: GatewayRouteVirtualServiceProperty -> ()
virtualServiceName :: GatewayRouteVirtualServiceProperty -> Value Text
haddock_workaround_ :: ()
virtualServiceName :: Value Text
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"VirtualServiceName" 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
virtualServiceName]
instance Property "VirtualServiceName" GatewayRouteVirtualServiceProperty where
  type PropertyType "VirtualServiceName" GatewayRouteVirtualServiceProperty = Value Prelude.Text
  set :: PropertyType
  "VirtualServiceName" GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty
-> GatewayRouteVirtualServiceProperty
set PropertyType
  "VirtualServiceName" GatewayRouteVirtualServiceProperty
newValue GatewayRouteVirtualServiceProperty {()
Value Text
haddock_workaround_ :: GatewayRouteVirtualServiceProperty -> ()
virtualServiceName :: GatewayRouteVirtualServiceProperty -> Value Text
haddock_workaround_ :: ()
virtualServiceName :: Value Text
..}
    = GatewayRouteVirtualServiceProperty
        {virtualServiceName :: Value Text
virtualServiceName = PropertyType
  "VirtualServiceName" GatewayRouteVirtualServiceProperty
Value Text
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}