module Stratosphere.ApiGatewayV2.RoutingRule.MatchHeadersProperty (
        module Exports, MatchHeadersProperty(..), mkMatchHeadersProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.ApiGatewayV2.RoutingRule.MatchHeaderValueProperty as Exports
import Stratosphere.ResourceProperties
data MatchHeadersProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-apigatewayv2-routingrule-matchheaders.html>
    MatchHeadersProperty {MatchHeadersProperty -> ()
haddock_workaround_ :: (),
                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-apigatewayv2-routingrule-matchheaders.html#cfn-apigatewayv2-routingrule-matchheaders-anyof>
                          MatchHeadersProperty -> [MatchHeaderValueProperty]
anyOf :: [MatchHeaderValueProperty]}
  deriving stock (MatchHeadersProperty -> MatchHeadersProperty -> Bool
(MatchHeadersProperty -> MatchHeadersProperty -> Bool)
-> (MatchHeadersProperty -> MatchHeadersProperty -> Bool)
-> Eq MatchHeadersProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchHeadersProperty -> MatchHeadersProperty -> Bool
== :: MatchHeadersProperty -> MatchHeadersProperty -> Bool
$c/= :: MatchHeadersProperty -> MatchHeadersProperty -> Bool
/= :: MatchHeadersProperty -> MatchHeadersProperty -> Bool
Prelude.Eq, Int -> MatchHeadersProperty -> ShowS
[MatchHeadersProperty] -> ShowS
MatchHeadersProperty -> String
(Int -> MatchHeadersProperty -> ShowS)
-> (MatchHeadersProperty -> String)
-> ([MatchHeadersProperty] -> ShowS)
-> Show MatchHeadersProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchHeadersProperty -> ShowS
showsPrec :: Int -> MatchHeadersProperty -> ShowS
$cshow :: MatchHeadersProperty -> String
show :: MatchHeadersProperty -> String
$cshowList :: [MatchHeadersProperty] -> ShowS
showList :: [MatchHeadersProperty] -> ShowS
Prelude.Show)
mkMatchHeadersProperty ::
  [MatchHeaderValueProperty] -> MatchHeadersProperty
mkMatchHeadersProperty :: [MatchHeaderValueProperty] -> MatchHeadersProperty
mkMatchHeadersProperty [MatchHeaderValueProperty]
anyOf
  = MatchHeadersProperty {haddock_workaround_ :: ()
haddock_workaround_ = (), anyOf :: [MatchHeaderValueProperty]
anyOf = [MatchHeaderValueProperty]
anyOf}
instance ToResourceProperties MatchHeadersProperty where
  toResourceProperties :: MatchHeadersProperty -> ResourceProperties
toResourceProperties MatchHeadersProperty {[MatchHeaderValueProperty]
()
haddock_workaround_ :: MatchHeadersProperty -> ()
anyOf :: MatchHeadersProperty -> [MatchHeaderValueProperty]
haddock_workaround_ :: ()
anyOf :: [MatchHeaderValueProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::ApiGatewayV2::RoutingRule.MatchHeaders",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False, properties :: Object
properties = [Key
"AnyOf" Key -> [MatchHeaderValueProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MatchHeaderValueProperty]
anyOf]}
instance JSON.ToJSON MatchHeadersProperty where
  toJSON :: MatchHeadersProperty -> Value
toJSON MatchHeadersProperty {[MatchHeaderValueProperty]
()
haddock_workaround_ :: MatchHeadersProperty -> ()
anyOf :: MatchHeadersProperty -> [MatchHeaderValueProperty]
haddock_workaround_ :: ()
anyOf :: [MatchHeaderValueProperty]
..}
    = [(Key, Value)] -> Value
JSON.object [Key
"AnyOf" Key -> [MatchHeaderValueProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= [MatchHeaderValueProperty]
anyOf]
instance Property "AnyOf" MatchHeadersProperty where
  type PropertyType "AnyOf" MatchHeadersProperty = [MatchHeaderValueProperty]
  set :: PropertyType "AnyOf" MatchHeadersProperty
-> MatchHeadersProperty -> MatchHeadersProperty
set PropertyType "AnyOf" MatchHeadersProperty
newValue MatchHeadersProperty {[MatchHeaderValueProperty]
()
haddock_workaround_ :: MatchHeadersProperty -> ()
anyOf :: MatchHeadersProperty -> [MatchHeaderValueProperty]
haddock_workaround_ :: ()
anyOf :: [MatchHeaderValueProperty]
..}
    = MatchHeadersProperty {anyOf :: [MatchHeaderValueProperty]
anyOf = [MatchHeaderValueProperty]
PropertyType "AnyOf" MatchHeadersProperty
newValue, ()
haddock_workaround_ :: ()
haddock_workaround_ :: ()
..}