module Stratosphere.VpcLattice.Rule.HttpMatchProperty (
        module Exports, HttpMatchProperty(..), mkHttpMatchProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.VpcLattice.Rule.HeaderMatchProperty as Exports
import {-# SOURCE #-} Stratosphere.VpcLattice.Rule.PathMatchProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Value
data HttpMatchProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-vpclattice-rule-httpmatch.html>
    HttpMatchProperty {HttpMatchProperty -> ()
haddock_workaround_ :: (),
                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-vpclattice-rule-httpmatch.html#cfn-vpclattice-rule-httpmatch-headermatches>
                       HttpMatchProperty -> Maybe [HeaderMatchProperty]
headerMatches :: (Prelude.Maybe [HeaderMatchProperty]),
                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-vpclattice-rule-httpmatch.html#cfn-vpclattice-rule-httpmatch-method>
                       HttpMatchProperty -> Maybe (Value Text)
method :: (Prelude.Maybe (Value Prelude.Text)),
                       -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-vpclattice-rule-httpmatch.html#cfn-vpclattice-rule-httpmatch-pathmatch>
                       HttpMatchProperty -> Maybe PathMatchProperty
pathMatch :: (Prelude.Maybe PathMatchProperty)}
  deriving stock (HttpMatchProperty -> HttpMatchProperty -> Bool
(HttpMatchProperty -> HttpMatchProperty -> Bool)
-> (HttpMatchProperty -> HttpMatchProperty -> Bool)
-> Eq HttpMatchProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpMatchProperty -> HttpMatchProperty -> Bool
== :: HttpMatchProperty -> HttpMatchProperty -> Bool
$c/= :: HttpMatchProperty -> HttpMatchProperty -> Bool
/= :: HttpMatchProperty -> HttpMatchProperty -> Bool
Prelude.Eq, Int -> HttpMatchProperty -> ShowS
[HttpMatchProperty] -> ShowS
HttpMatchProperty -> String
(Int -> HttpMatchProperty -> ShowS)
-> (HttpMatchProperty -> String)
-> ([HttpMatchProperty] -> ShowS)
-> Show HttpMatchProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpMatchProperty -> ShowS
showsPrec :: Int -> HttpMatchProperty -> ShowS
$cshow :: HttpMatchProperty -> String
show :: HttpMatchProperty -> String
$cshowList :: [HttpMatchProperty] -> ShowS
showList :: [HttpMatchProperty] -> ShowS
Prelude.Show)
mkHttpMatchProperty :: HttpMatchProperty
mkHttpMatchProperty :: HttpMatchProperty
mkHttpMatchProperty
  = HttpMatchProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), headerMatches :: Maybe [HeaderMatchProperty]
headerMatches = Maybe [HeaderMatchProperty]
forall a. Maybe a
Prelude.Nothing,
       method :: Maybe (Value Text)
method = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing, pathMatch :: Maybe PathMatchProperty
pathMatch = Maybe PathMatchProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties HttpMatchProperty where
  toResourceProperties :: HttpMatchProperty -> ResourceProperties
toResourceProperties HttpMatchProperty {Maybe [HeaderMatchProperty]
Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: HttpMatchProperty -> ()
headerMatches :: HttpMatchProperty -> Maybe [HeaderMatchProperty]
method :: HttpMatchProperty -> Maybe (Value Text)
pathMatch :: HttpMatchProperty -> Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::VpcLattice::Rule.HttpMatch",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                           [Key -> [HeaderMatchProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HeaderMatches" ([HeaderMatchProperty] -> (Key, Value))
-> Maybe [HeaderMatchProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [HeaderMatchProperty]
headerMatches,
                            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..=) Key
"Method" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
method,
                            Key -> PathMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"PathMatch" (PathMatchProperty -> (Key, Value))
-> Maybe PathMatchProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PathMatchProperty
pathMatch])}
instance JSON.ToJSON HttpMatchProperty where
  toJSON :: HttpMatchProperty -> Value
toJSON HttpMatchProperty {Maybe [HeaderMatchProperty]
Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: HttpMatchProperty -> ()
headerMatches :: HttpMatchProperty -> Maybe [HeaderMatchProperty]
method :: HttpMatchProperty -> Maybe (Value Text)
pathMatch :: HttpMatchProperty -> Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
              [Key -> [HeaderMatchProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HeaderMatches" ([HeaderMatchProperty] -> (Key, Value))
-> Maybe [HeaderMatchProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [HeaderMatchProperty]
headerMatches,
               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..=) Key
"Method" (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
method,
               Key -> PathMatchProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"PathMatch" (PathMatchProperty -> (Key, Value))
-> Maybe PathMatchProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe PathMatchProperty
pathMatch]))
instance Property "HeaderMatches" HttpMatchProperty where
  type PropertyType "HeaderMatches" HttpMatchProperty = [HeaderMatchProperty]
  set :: PropertyType "HeaderMatches" HttpMatchProperty
-> HttpMatchProperty -> HttpMatchProperty
set PropertyType "HeaderMatches" HttpMatchProperty
newValue HttpMatchProperty {Maybe [HeaderMatchProperty]
Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: HttpMatchProperty -> ()
headerMatches :: HttpMatchProperty -> Maybe [HeaderMatchProperty]
method :: HttpMatchProperty -> Maybe (Value Text)
pathMatch :: HttpMatchProperty -> Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
    = HttpMatchProperty {headerMatches :: Maybe [HeaderMatchProperty]
headerMatches = [HeaderMatchProperty] -> Maybe [HeaderMatchProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [HeaderMatchProperty]
PropertyType "HeaderMatches" HttpMatchProperty
newValue, Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: ()
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
haddock_workaround_ :: ()
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
instance Property "Method" HttpMatchProperty where
  type PropertyType "Method" HttpMatchProperty = Value Prelude.Text
  set :: PropertyType "Method" HttpMatchProperty
-> HttpMatchProperty -> HttpMatchProperty
set PropertyType "Method" HttpMatchProperty
newValue HttpMatchProperty {Maybe [HeaderMatchProperty]
Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: HttpMatchProperty -> ()
headerMatches :: HttpMatchProperty -> Maybe [HeaderMatchProperty]
method :: HttpMatchProperty -> Maybe (Value Text)
pathMatch :: HttpMatchProperty -> Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
    = HttpMatchProperty {method :: Maybe (Value Text)
method = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Method" HttpMatchProperty
Value Text
newValue, Maybe [HeaderMatchProperty]
Maybe PathMatchProperty
()
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
pathMatch :: Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
pathMatch :: Maybe PathMatchProperty
..}
instance Property "PathMatch" HttpMatchProperty where
  type PropertyType "PathMatch" HttpMatchProperty = PathMatchProperty
  set :: PropertyType "PathMatch" HttpMatchProperty
-> HttpMatchProperty -> HttpMatchProperty
set PropertyType "PathMatch" HttpMatchProperty
newValue HttpMatchProperty {Maybe [HeaderMatchProperty]
Maybe (Value Text)
Maybe PathMatchProperty
()
haddock_workaround_ :: HttpMatchProperty -> ()
headerMatches :: HttpMatchProperty -> Maybe [HeaderMatchProperty]
method :: HttpMatchProperty -> Maybe (Value Text)
pathMatch :: HttpMatchProperty -> Maybe PathMatchProperty
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
pathMatch :: Maybe PathMatchProperty
..}
    = HttpMatchProperty {pathMatch :: Maybe PathMatchProperty
pathMatch = PathMatchProperty -> Maybe PathMatchProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "PathMatch" HttpMatchProperty
PathMatchProperty
newValue, Maybe [HeaderMatchProperty]
Maybe (Value Text)
()
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
haddock_workaround_ :: ()
headerMatches :: Maybe [HeaderMatchProperty]
method :: Maybe (Value Text)
..}