module Stratosphere.WAFv2.WebACL.ResponseInspectionStatusCodeProperty (
        ResponseInspectionStatusCodeProperty(..),
        mkResponseInspectionStatusCodeProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import Stratosphere.ResourceProperties
import Stratosphere.Value
data ResponseInspectionStatusCodeProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-responseinspectionstatuscode.html>
    ResponseInspectionStatusCodeProperty {ResponseInspectionStatusCodeProperty -> ()
haddock_workaround_ :: (),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-responseinspectionstatuscode.html#cfn-wafv2-webacl-responseinspectionstatuscode-failurecodes>
                                          ResponseInspectionStatusCodeProperty -> ValueList Integer
failureCodes :: (ValueList Prelude.Integer),
                                          -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-wafv2-webacl-responseinspectionstatuscode.html#cfn-wafv2-webacl-responseinspectionstatuscode-successcodes>
                                          ResponseInspectionStatusCodeProperty -> ValueList Integer
successCodes :: (ValueList Prelude.Integer)}
  deriving stock (ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty -> Bool
(ResponseInspectionStatusCodeProperty
 -> ResponseInspectionStatusCodeProperty -> Bool)
-> (ResponseInspectionStatusCodeProperty
    -> ResponseInspectionStatusCodeProperty -> Bool)
-> Eq ResponseInspectionStatusCodeProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty -> Bool
== :: ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty -> Bool
$c/= :: ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty -> Bool
/= :: ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty -> Bool
Prelude.Eq, Int -> ResponseInspectionStatusCodeProperty -> ShowS
[ResponseInspectionStatusCodeProperty] -> ShowS
ResponseInspectionStatusCodeProperty -> String
(Int -> ResponseInspectionStatusCodeProperty -> ShowS)
-> (ResponseInspectionStatusCodeProperty -> String)
-> ([ResponseInspectionStatusCodeProperty] -> ShowS)
-> Show ResponseInspectionStatusCodeProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseInspectionStatusCodeProperty -> ShowS
showsPrec :: Int -> ResponseInspectionStatusCodeProperty -> ShowS
$cshow :: ResponseInspectionStatusCodeProperty -> String
show :: ResponseInspectionStatusCodeProperty -> String
$cshowList :: [ResponseInspectionStatusCodeProperty] -> ShowS
showList :: [ResponseInspectionStatusCodeProperty] -> ShowS
Prelude.Show)
mkResponseInspectionStatusCodeProperty ::
  ValueList Prelude.Integer
  -> ValueList Prelude.Integer
     -> ResponseInspectionStatusCodeProperty
mkResponseInspectionStatusCodeProperty :: ValueList Integer
-> ValueList Integer -> ResponseInspectionStatusCodeProperty
mkResponseInspectionStatusCodeProperty ValueList Integer
failureCodes ValueList Integer
successCodes
  = ResponseInspectionStatusCodeProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), failureCodes :: ValueList Integer
failureCodes = ValueList Integer
failureCodes,
       successCodes :: ValueList Integer
successCodes = ValueList Integer
successCodes}
instance ToResourceProperties ResponseInspectionStatusCodeProperty where
  toResourceProperties :: ResponseInspectionStatusCodeProperty -> ResourceProperties
toResourceProperties ResponseInspectionStatusCodeProperty {()
ValueList Integer
haddock_workaround_ :: ResponseInspectionStatusCodeProperty -> ()
failureCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
successCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
successCodes :: ValueList Integer
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::WAFv2::WebACL.ResponseInspectionStatusCode",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         properties :: Object
properties = [Key
"FailureCodes" Key -> ValueList Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Integer
failureCodes,
                       Key
"SuccessCodes" Key -> ValueList Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Integer
successCodes]}
instance JSON.ToJSON ResponseInspectionStatusCodeProperty where
  toJSON :: ResponseInspectionStatusCodeProperty -> Value
toJSON ResponseInspectionStatusCodeProperty {()
ValueList Integer
haddock_workaround_ :: ResponseInspectionStatusCodeProperty -> ()
failureCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
successCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
successCodes :: ValueList Integer
..}
    = [(Key, Value)] -> Value
JSON.object
        [Key
"FailureCodes" Key -> ValueList Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Integer
failureCodes,
         Key
"SuccessCodes" Key -> ValueList Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueList Integer
successCodes]
instance Property "FailureCodes" ResponseInspectionStatusCodeProperty where
  type PropertyType "FailureCodes" ResponseInspectionStatusCodeProperty = ValueList Prelude.Integer
  set :: PropertyType "FailureCodes" ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty
set PropertyType "FailureCodes" ResponseInspectionStatusCodeProperty
newValue ResponseInspectionStatusCodeProperty {()
ValueList Integer
haddock_workaround_ :: ResponseInspectionStatusCodeProperty -> ()
failureCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
successCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
successCodes :: ValueList Integer
..}
    = ResponseInspectionStatusCodeProperty
        {failureCodes :: ValueList Integer
failureCodes = PropertyType "FailureCodes" ResponseInspectionStatusCodeProperty
ValueList Integer
newValue, ()
ValueList Integer
haddock_workaround_ :: ()
successCodes :: ValueList Integer
haddock_workaround_ :: ()
successCodes :: ValueList Integer
..}
instance Property "SuccessCodes" ResponseInspectionStatusCodeProperty where
  type PropertyType "SuccessCodes" ResponseInspectionStatusCodeProperty = ValueList Prelude.Integer
  set :: PropertyType "SuccessCodes" ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty
-> ResponseInspectionStatusCodeProperty
set PropertyType "SuccessCodes" ResponseInspectionStatusCodeProperty
newValue ResponseInspectionStatusCodeProperty {()
ValueList Integer
haddock_workaround_ :: ResponseInspectionStatusCodeProperty -> ()
failureCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
successCodes :: ResponseInspectionStatusCodeProperty -> ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
successCodes :: ValueList Integer
..}
    = ResponseInspectionStatusCodeProperty
        {successCodes :: ValueList Integer
successCodes = PropertyType "SuccessCodes" ResponseInspectionStatusCodeProperty
ValueList Integer
newValue, ()
ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
haddock_workaround_ :: ()
failureCodes :: ValueList Integer
..}