module Stratosphere.AppMesh.GatewayRoute.HttpGatewayRouteProperty (
        module Exports, HttpGatewayRouteProperty(..),
        mkHttpGatewayRouteProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.AppMesh.GatewayRoute.HttpGatewayRouteActionProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.GatewayRoute.HttpGatewayRouteMatchProperty as Exports
import Stratosphere.ResourceProperties
data HttpGatewayRouteProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-gatewayroute-httpgatewayroute.html>
    HttpGatewayRouteProperty {HttpGatewayRouteProperty -> ()
haddock_workaround_ :: (),
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-gatewayroute-httpgatewayroute.html#cfn-appmesh-gatewayroute-httpgatewayroute-action>
                              HttpGatewayRouteProperty -> HttpGatewayRouteActionProperty
action :: HttpGatewayRouteActionProperty,
                              -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-gatewayroute-httpgatewayroute.html#cfn-appmesh-gatewayroute-httpgatewayroute-match>
                              HttpGatewayRouteProperty -> HttpGatewayRouteMatchProperty
match :: HttpGatewayRouteMatchProperty}
  deriving stock (HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool
(HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool)
-> (HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool)
-> Eq HttpGatewayRouteProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool
== :: HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool
$c/= :: HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool
/= :: HttpGatewayRouteProperty -> HttpGatewayRouteProperty -> Bool
Prelude.Eq, Int -> HttpGatewayRouteProperty -> ShowS
[HttpGatewayRouteProperty] -> ShowS
HttpGatewayRouteProperty -> String
(Int -> HttpGatewayRouteProperty -> ShowS)
-> (HttpGatewayRouteProperty -> String)
-> ([HttpGatewayRouteProperty] -> ShowS)
-> Show HttpGatewayRouteProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpGatewayRouteProperty -> ShowS
showsPrec :: Int -> HttpGatewayRouteProperty -> ShowS
$cshow :: HttpGatewayRouteProperty -> String
show :: HttpGatewayRouteProperty -> String
$cshowList :: [HttpGatewayRouteProperty] -> ShowS
showList :: [HttpGatewayRouteProperty] -> ShowS
Prelude.Show)
mkHttpGatewayRouteProperty ::
  HttpGatewayRouteActionProperty
  -> HttpGatewayRouteMatchProperty -> HttpGatewayRouteProperty
mkHttpGatewayRouteProperty :: HttpGatewayRouteActionProperty
-> HttpGatewayRouteMatchProperty -> HttpGatewayRouteProperty
mkHttpGatewayRouteProperty HttpGatewayRouteActionProperty
action HttpGatewayRouteMatchProperty
match
  = HttpGatewayRouteProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), action :: HttpGatewayRouteActionProperty
action = HttpGatewayRouteActionProperty
action, match :: HttpGatewayRouteMatchProperty
match = HttpGatewayRouteMatchProperty
match}
instance ToResourceProperties HttpGatewayRouteProperty where
  toResourceProperties :: HttpGatewayRouteProperty -> ResourceProperties
toResourceProperties HttpGatewayRouteProperty {()
HttpGatewayRouteActionProperty
HttpGatewayRouteMatchProperty
haddock_workaround_ :: HttpGatewayRouteProperty -> ()
action :: HttpGatewayRouteProperty -> HttpGatewayRouteActionProperty
match :: HttpGatewayRouteProperty -> HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
match :: HttpGatewayRouteMatchProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::AppMesh::GatewayRoute.HttpGatewayRoute",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"Action" Key -> HttpGatewayRouteActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= HttpGatewayRouteActionProperty
action, Key
"Match" Key -> HttpGatewayRouteMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= HttpGatewayRouteMatchProperty
match]}
instance JSON.ToJSON HttpGatewayRouteProperty where
  toJSON :: HttpGatewayRouteProperty -> Value
toJSON HttpGatewayRouteProperty {()
HttpGatewayRouteActionProperty
HttpGatewayRouteMatchProperty
haddock_workaround_ :: HttpGatewayRouteProperty -> ()
action :: HttpGatewayRouteProperty -> HttpGatewayRouteActionProperty
match :: HttpGatewayRouteProperty -> HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
match :: HttpGatewayRouteMatchProperty
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"Action" Key -> HttpGatewayRouteActionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= HttpGatewayRouteActionProperty
action, Key
"Match" Key -> HttpGatewayRouteMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= HttpGatewayRouteMatchProperty
match]
instance Property "Action" HttpGatewayRouteProperty where
  type PropertyType "Action" HttpGatewayRouteProperty = HttpGatewayRouteActionProperty
  set :: PropertyType "Action" HttpGatewayRouteProperty
-> HttpGatewayRouteProperty -> HttpGatewayRouteProperty
set PropertyType "Action" HttpGatewayRouteProperty
newValue HttpGatewayRouteProperty {()
HttpGatewayRouteActionProperty
HttpGatewayRouteMatchProperty
haddock_workaround_ :: HttpGatewayRouteProperty -> ()
action :: HttpGatewayRouteProperty -> HttpGatewayRouteActionProperty
match :: HttpGatewayRouteProperty -> HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
match :: HttpGatewayRouteMatchProperty
..}
    = HttpGatewayRouteProperty {action :: HttpGatewayRouteActionProperty
action = PropertyType "Action" HttpGatewayRouteProperty
HttpGatewayRouteActionProperty
newValue, ()
HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
match :: HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
match :: HttpGatewayRouteMatchProperty
..}
instance Property "Match" HttpGatewayRouteProperty where
  type PropertyType "Match" HttpGatewayRouteProperty = HttpGatewayRouteMatchProperty
  set :: PropertyType "Match" HttpGatewayRouteProperty
-> HttpGatewayRouteProperty -> HttpGatewayRouteProperty
set PropertyType "Match" HttpGatewayRouteProperty
newValue HttpGatewayRouteProperty {()
HttpGatewayRouteActionProperty
HttpGatewayRouteMatchProperty
haddock_workaround_ :: HttpGatewayRouteProperty -> ()
action :: HttpGatewayRouteProperty -> HttpGatewayRouteActionProperty
match :: HttpGatewayRouteProperty -> HttpGatewayRouteMatchProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
match :: HttpGatewayRouteMatchProperty
..}
    = HttpGatewayRouteProperty {match :: HttpGatewayRouteMatchProperty
match = PropertyType "Match" HttpGatewayRouteProperty
HttpGatewayRouteMatchProperty
newValue, ()
HttpGatewayRouteActionProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
haddock_workaround_ :: ()
action :: HttpGatewayRouteActionProperty
..}