{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.WAFV2.CreateIPSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an IPSet, which you use to identify web requests that originate
-- from specific IP addresses or ranges of IP addresses. For example, if
-- you\'re receiving a lot of requests from a ranges of IP addresses, you
-- can configure WAF to block them using an IPSet that lists those IP
-- addresses.
module Amazonka.WAFV2.CreateIPSet
  ( -- * Creating a Request
    CreateIPSet (..),
    newCreateIPSet,

    -- * Request Lenses
    createIPSet_description,
    createIPSet_tags,
    createIPSet_name,
    createIPSet_scope,
    createIPSet_iPAddressVersion,
    createIPSet_addresses,

    -- * Destructuring the Response
    CreateIPSetResponse (..),
    newCreateIPSetResponse,

    -- * Response Lenses
    createIPSetResponse_summary,
    createIPSetResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WAFV2.Types

-- | /See:/ 'newCreateIPSet' smart constructor.
data CreateIPSet = CreateIPSet'
  { -- | A description of the IP set that helps with identification.
    CreateIPSet -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An array of key:value pairs to associate with the resource.
    CreateIPSet -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name of the IP set. You cannot change the name of an @IPSet@ after
    -- you create it.
    CreateIPSet -> Text
name :: Prelude.Text,
    -- | Specifies whether this is for an Amazon CloudFront distribution or for a
    -- regional application. A regional application can be an Application Load
    -- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
    -- or an Amazon Cognito user pool.
    --
    -- To work with CloudFront, you must also specify the Region US East (N.
    -- Virginia) as follows:
    --
    -- -   CLI - Specify the Region when you use the CloudFront scope:
    --     @--scope=CLOUDFRONT --region=us-east-1@.
    --
    -- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
    CreateIPSet -> Scope
scope :: Scope,
    -- | The version of the IP addresses, either @IPV4@ or @IPV6@.
    CreateIPSet -> IPAddressVersion
iPAddressVersion :: IPAddressVersion,
    -- | Contains an array of strings that specifies zero or more IP addresses or
    -- blocks of IP addresses. All addresses must be specified using Classless
    -- Inter-Domain Routing (CIDR) notation. WAF supports all IPv4 and IPv6
    -- CIDR ranges except for @\/0@.
    --
    -- Example address strings:
    --
    -- -   To configure WAF to allow, block, or count requests that originated
    --     from the IP address 192.0.2.44, specify @192.0.2.44\/32@.
    --
    -- -   To configure WAF to allow, block, or count requests that originated
    --     from IP addresses from 192.0.2.0 to 192.0.2.255, specify
    --     @192.0.2.0\/24@.
    --
    -- -   To configure WAF to allow, block, or count requests that originated
    --     from the IP address 1111:0000:0000:0000:0000:0000:0000:0111, specify
    --     @1111:0000:0000:0000:0000:0000:0000:0111\/128@.
    --
    -- -   To configure WAF to allow, block, or count requests that originated
    --     from IP addresses 1111:0000:0000:0000:0000:0000:0000:0000 to
    --     1111:0000:0000:0000:ffff:ffff:ffff:ffff, specify
    --     @1111:0000:0000:0000:0000:0000:0000:0000\/64@.
    --
    -- For more information about CIDR notation, see the Wikipedia entry
    -- <https://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing Classless Inter-Domain Routing>.
    --
    -- Example JSON @Addresses@ specifications:
    --
    -- -   Empty array: @\"Addresses\": []@
    --
    -- -   Array with one address: @\"Addresses\": [\"192.0.2.44\/32\"]@
    --
    -- -   Array with three addresses:
    --     @\"Addresses\": [\"192.0.2.44\/32\", \"192.0.2.0\/24\", \"192.0.0.0\/16\"]@
    --
    -- -   INVALID specification: @\"Addresses\": [\"\"]@ INVALID
    CreateIPSet -> [Text]
addresses :: [Prelude.Text]
  }
  deriving (CreateIPSet -> CreateIPSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIPSet -> CreateIPSet -> Bool
$c/= :: CreateIPSet -> CreateIPSet -> Bool
== :: CreateIPSet -> CreateIPSet -> Bool
$c== :: CreateIPSet -> CreateIPSet -> Bool
Prelude.Eq, ReadPrec [CreateIPSet]
ReadPrec CreateIPSet
Int -> ReadS CreateIPSet
ReadS [CreateIPSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIPSet]
$creadListPrec :: ReadPrec [CreateIPSet]
readPrec :: ReadPrec CreateIPSet
$creadPrec :: ReadPrec CreateIPSet
readList :: ReadS [CreateIPSet]
$creadList :: ReadS [CreateIPSet]
readsPrec :: Int -> ReadS CreateIPSet
$creadsPrec :: Int -> ReadS CreateIPSet
Prelude.Read, Int -> CreateIPSet -> ShowS
[CreateIPSet] -> ShowS
CreateIPSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIPSet] -> ShowS
$cshowList :: [CreateIPSet] -> ShowS
show :: CreateIPSet -> String
$cshow :: CreateIPSet -> String
showsPrec :: Int -> CreateIPSet -> ShowS
$cshowsPrec :: Int -> CreateIPSet -> ShowS
Prelude.Show, forall x. Rep CreateIPSet x -> CreateIPSet
forall x. CreateIPSet -> Rep CreateIPSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIPSet x -> CreateIPSet
$cfrom :: forall x. CreateIPSet -> Rep CreateIPSet x
Prelude.Generic)

-- |
-- Create a value of 'CreateIPSet' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'description', 'createIPSet_description' - A description of the IP set that helps with identification.
--
-- 'tags', 'createIPSet_tags' - An array of key:value pairs to associate with the resource.
--
-- 'name', 'createIPSet_name' - The name of the IP set. You cannot change the name of an @IPSet@ after
-- you create it.
--
-- 'scope', 'createIPSet_scope' - Specifies whether this is for an Amazon CloudFront distribution or for a
-- regional application. A regional application can be an Application Load
-- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
-- or an Amazon Cognito user pool.
--
-- To work with CloudFront, you must also specify the Region US East (N.
-- Virginia) as follows:
--
-- -   CLI - Specify the Region when you use the CloudFront scope:
--     @--scope=CLOUDFRONT --region=us-east-1@.
--
-- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
--
-- 'iPAddressVersion', 'createIPSet_iPAddressVersion' - The version of the IP addresses, either @IPV4@ or @IPV6@.
--
-- 'addresses', 'createIPSet_addresses' - Contains an array of strings that specifies zero or more IP addresses or
-- blocks of IP addresses. All addresses must be specified using Classless
-- Inter-Domain Routing (CIDR) notation. WAF supports all IPv4 and IPv6
-- CIDR ranges except for @\/0@.
--
-- Example address strings:
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from the IP address 192.0.2.44, specify @192.0.2.44\/32@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from IP addresses from 192.0.2.0 to 192.0.2.255, specify
--     @192.0.2.0\/24@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from the IP address 1111:0000:0000:0000:0000:0000:0000:0111, specify
--     @1111:0000:0000:0000:0000:0000:0000:0111\/128@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from IP addresses 1111:0000:0000:0000:0000:0000:0000:0000 to
--     1111:0000:0000:0000:ffff:ffff:ffff:ffff, specify
--     @1111:0000:0000:0000:0000:0000:0000:0000\/64@.
--
-- For more information about CIDR notation, see the Wikipedia entry
-- <https://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing Classless Inter-Domain Routing>.
--
-- Example JSON @Addresses@ specifications:
--
-- -   Empty array: @\"Addresses\": []@
--
-- -   Array with one address: @\"Addresses\": [\"192.0.2.44\/32\"]@
--
-- -   Array with three addresses:
--     @\"Addresses\": [\"192.0.2.44\/32\", \"192.0.2.0\/24\", \"192.0.0.0\/16\"]@
--
-- -   INVALID specification: @\"Addresses\": [\"\"]@ INVALID
newCreateIPSet ::
  -- | 'name'
  Prelude.Text ->
  -- | 'scope'
  Scope ->
  -- | 'iPAddressVersion'
  IPAddressVersion ->
  CreateIPSet
newCreateIPSet :: Text -> Scope -> IPAddressVersion -> CreateIPSet
newCreateIPSet Text
pName_ Scope
pScope_ IPAddressVersion
pIPAddressVersion_ =
  CreateIPSet'
    { $sel:description:CreateIPSet' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateIPSet' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateIPSet' :: Text
name = Text
pName_,
      $sel:scope:CreateIPSet' :: Scope
scope = Scope
pScope_,
      $sel:iPAddressVersion:CreateIPSet' :: IPAddressVersion
iPAddressVersion = IPAddressVersion
pIPAddressVersion_,
      $sel:addresses:CreateIPSet' :: [Text]
addresses = forall a. Monoid a => a
Prelude.mempty
    }

-- | A description of the IP set that helps with identification.
createIPSet_description :: Lens.Lens' CreateIPSet (Prelude.Maybe Prelude.Text)
createIPSet_description :: Lens' CreateIPSet (Maybe Text)
createIPSet_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Maybe Text
description :: Maybe Text
$sel:description:CreateIPSet' :: CreateIPSet -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateIPSet
s@CreateIPSet' {} Maybe Text
a -> CreateIPSet
s {$sel:description:CreateIPSet' :: Maybe Text
description = Maybe Text
a} :: CreateIPSet)

-- | An array of key:value pairs to associate with the resource.
createIPSet_tags :: Lens.Lens' CreateIPSet (Prelude.Maybe (Prelude.NonEmpty Tag))
createIPSet_tags :: Lens' CreateIPSet (Maybe (NonEmpty Tag))
createIPSet_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateIPSet
s@CreateIPSet' {} Maybe (NonEmpty Tag)
a -> CreateIPSet
s {$sel:tags:CreateIPSet' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateIPSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the IP set. You cannot change the name of an @IPSet@ after
-- you create it.
createIPSet_name :: Lens.Lens' CreateIPSet Prelude.Text
createIPSet_name :: Lens' CreateIPSet Text
createIPSet_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Text
name :: Text
$sel:name:CreateIPSet' :: CreateIPSet -> Text
name} -> Text
name) (\s :: CreateIPSet
s@CreateIPSet' {} Text
a -> CreateIPSet
s {$sel:name:CreateIPSet' :: Text
name = Text
a} :: CreateIPSet)

-- | Specifies whether this is for an Amazon CloudFront distribution or for a
-- regional application. A regional application can be an Application Load
-- Balancer (ALB), an Amazon API Gateway REST API, an AppSync GraphQL API,
-- or an Amazon Cognito user pool.
--
-- To work with CloudFront, you must also specify the Region US East (N.
-- Virginia) as follows:
--
-- -   CLI - Specify the Region when you use the CloudFront scope:
--     @--scope=CLOUDFRONT --region=us-east-1@.
--
-- -   API and SDKs - For all calls, use the Region endpoint us-east-1.
createIPSet_scope :: Lens.Lens' CreateIPSet Scope
createIPSet_scope :: Lens' CreateIPSet Scope
createIPSet_scope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Scope
scope :: Scope
$sel:scope:CreateIPSet' :: CreateIPSet -> Scope
scope} -> Scope
scope) (\s :: CreateIPSet
s@CreateIPSet' {} Scope
a -> CreateIPSet
s {$sel:scope:CreateIPSet' :: Scope
scope = Scope
a} :: CreateIPSet)

-- | The version of the IP addresses, either @IPV4@ or @IPV6@.
createIPSet_iPAddressVersion :: Lens.Lens' CreateIPSet IPAddressVersion
createIPSet_iPAddressVersion :: Lens' CreateIPSet IPAddressVersion
createIPSet_iPAddressVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {IPAddressVersion
iPAddressVersion :: IPAddressVersion
$sel:iPAddressVersion:CreateIPSet' :: CreateIPSet -> IPAddressVersion
iPAddressVersion} -> IPAddressVersion
iPAddressVersion) (\s :: CreateIPSet
s@CreateIPSet' {} IPAddressVersion
a -> CreateIPSet
s {$sel:iPAddressVersion:CreateIPSet' :: IPAddressVersion
iPAddressVersion = IPAddressVersion
a} :: CreateIPSet)

-- | Contains an array of strings that specifies zero or more IP addresses or
-- blocks of IP addresses. All addresses must be specified using Classless
-- Inter-Domain Routing (CIDR) notation. WAF supports all IPv4 and IPv6
-- CIDR ranges except for @\/0@.
--
-- Example address strings:
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from the IP address 192.0.2.44, specify @192.0.2.44\/32@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from IP addresses from 192.0.2.0 to 192.0.2.255, specify
--     @192.0.2.0\/24@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from the IP address 1111:0000:0000:0000:0000:0000:0000:0111, specify
--     @1111:0000:0000:0000:0000:0000:0000:0111\/128@.
--
-- -   To configure WAF to allow, block, or count requests that originated
--     from IP addresses 1111:0000:0000:0000:0000:0000:0000:0000 to
--     1111:0000:0000:0000:ffff:ffff:ffff:ffff, specify
--     @1111:0000:0000:0000:0000:0000:0000:0000\/64@.
--
-- For more information about CIDR notation, see the Wikipedia entry
-- <https://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing Classless Inter-Domain Routing>.
--
-- Example JSON @Addresses@ specifications:
--
-- -   Empty array: @\"Addresses\": []@
--
-- -   Array with one address: @\"Addresses\": [\"192.0.2.44\/32\"]@
--
-- -   Array with three addresses:
--     @\"Addresses\": [\"192.0.2.44\/32\", \"192.0.2.0\/24\", \"192.0.0.0\/16\"]@
--
-- -   INVALID specification: @\"Addresses\": [\"\"]@ INVALID
createIPSet_addresses :: Lens.Lens' CreateIPSet [Prelude.Text]
createIPSet_addresses :: Lens' CreateIPSet [Text]
createIPSet_addresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {[Text]
addresses :: [Text]
$sel:addresses:CreateIPSet' :: CreateIPSet -> [Text]
addresses} -> [Text]
addresses) (\s :: CreateIPSet
s@CreateIPSet' {} [Text]
a -> CreateIPSet
s {$sel:addresses:CreateIPSet' :: [Text]
addresses = [Text]
a} :: CreateIPSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateIPSet where
  type AWSResponse CreateIPSet = CreateIPSetResponse
  request :: (Service -> Service) -> CreateIPSet -> Request CreateIPSet
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateIPSet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIPSet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe IPSetSummary -> Int -> CreateIPSetResponse
CreateIPSetResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Summary")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateIPSet where
  hashWithSalt :: Int -> CreateIPSet -> Int
hashWithSalt Int
_salt CreateIPSet' {[Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
IPAddressVersion
Scope
addresses :: [Text]
iPAddressVersion :: IPAddressVersion
scope :: Scope
name :: Text
tags :: Maybe (NonEmpty Tag)
description :: Maybe Text
$sel:addresses:CreateIPSet' :: CreateIPSet -> [Text]
$sel:iPAddressVersion:CreateIPSet' :: CreateIPSet -> IPAddressVersion
$sel:scope:CreateIPSet' :: CreateIPSet -> Scope
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (NonEmpty Tag)
$sel:description:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Scope
scope
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IPAddressVersion
iPAddressVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
addresses

instance Prelude.NFData CreateIPSet where
  rnf :: CreateIPSet -> ()
rnf CreateIPSet' {[Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
IPAddressVersion
Scope
addresses :: [Text]
iPAddressVersion :: IPAddressVersion
scope :: Scope
name :: Text
tags :: Maybe (NonEmpty Tag)
description :: Maybe Text
$sel:addresses:CreateIPSet' :: CreateIPSet -> [Text]
$sel:iPAddressVersion:CreateIPSet' :: CreateIPSet -> IPAddressVersion
$sel:scope:CreateIPSet' :: CreateIPSet -> Scope
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (NonEmpty Tag)
$sel:description:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Scope
scope
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IPAddressVersion
iPAddressVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
addresses

instance Data.ToHeaders CreateIPSet where
  toHeaders :: CreateIPSet -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSWAF_20190729.CreateIPSet" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateIPSet where
  toJSON :: CreateIPSet -> Value
toJSON CreateIPSet' {[Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
IPAddressVersion
Scope
addresses :: [Text]
iPAddressVersion :: IPAddressVersion
scope :: Scope
name :: Text
tags :: Maybe (NonEmpty Tag)
description :: Maybe Text
$sel:addresses:CreateIPSet' :: CreateIPSet -> [Text]
$sel:iPAddressVersion:CreateIPSet' :: CreateIPSet -> IPAddressVersion
$sel:scope:CreateIPSet' :: CreateIPSet -> Scope
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (NonEmpty Tag)
$sel:description:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Scope" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Scope
scope),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IPAddressVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IPAddressVersion
iPAddressVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Addresses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
addresses)
          ]
      )

instance Data.ToPath CreateIPSet where
  toPath :: CreateIPSet -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateIPSet where
  toQuery :: CreateIPSet -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateIPSetResponse' smart constructor.
data CreateIPSetResponse = CreateIPSetResponse'
  { -- | High-level information about an IPSet, returned by operations like
    -- create and list. This provides information like the ID, that you can use
    -- to retrieve and manage an @IPSet@, and the ARN, that you provide to the
    -- IPSetReferenceStatement to use the address set in a Rule.
    CreateIPSetResponse -> Maybe IPSetSummary
summary :: Prelude.Maybe IPSetSummary,
    -- | The response's http status code.
    CreateIPSetResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateIPSetResponse -> CreateIPSetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIPSetResponse -> CreateIPSetResponse -> Bool
$c/= :: CreateIPSetResponse -> CreateIPSetResponse -> Bool
== :: CreateIPSetResponse -> CreateIPSetResponse -> Bool
$c== :: CreateIPSetResponse -> CreateIPSetResponse -> Bool
Prelude.Eq, ReadPrec [CreateIPSetResponse]
ReadPrec CreateIPSetResponse
Int -> ReadS CreateIPSetResponse
ReadS [CreateIPSetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIPSetResponse]
$creadListPrec :: ReadPrec [CreateIPSetResponse]
readPrec :: ReadPrec CreateIPSetResponse
$creadPrec :: ReadPrec CreateIPSetResponse
readList :: ReadS [CreateIPSetResponse]
$creadList :: ReadS [CreateIPSetResponse]
readsPrec :: Int -> ReadS CreateIPSetResponse
$creadsPrec :: Int -> ReadS CreateIPSetResponse
Prelude.Read, Int -> CreateIPSetResponse -> ShowS
[CreateIPSetResponse] -> ShowS
CreateIPSetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIPSetResponse] -> ShowS
$cshowList :: [CreateIPSetResponse] -> ShowS
show :: CreateIPSetResponse -> String
$cshow :: CreateIPSetResponse -> String
showsPrec :: Int -> CreateIPSetResponse -> ShowS
$cshowsPrec :: Int -> CreateIPSetResponse -> ShowS
Prelude.Show, forall x. Rep CreateIPSetResponse x -> CreateIPSetResponse
forall x. CreateIPSetResponse -> Rep CreateIPSetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIPSetResponse x -> CreateIPSetResponse
$cfrom :: forall x. CreateIPSetResponse -> Rep CreateIPSetResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateIPSetResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'summary', 'createIPSetResponse_summary' - High-level information about an IPSet, returned by operations like
-- create and list. This provides information like the ID, that you can use
-- to retrieve and manage an @IPSet@, and the ARN, that you provide to the
-- IPSetReferenceStatement to use the address set in a Rule.
--
-- 'httpStatus', 'createIPSetResponse_httpStatus' - The response's http status code.
newCreateIPSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateIPSetResponse
newCreateIPSetResponse :: Int -> CreateIPSetResponse
newCreateIPSetResponse Int
pHttpStatus_ =
  CreateIPSetResponse'
    { $sel:summary:CreateIPSetResponse' :: Maybe IPSetSummary
summary = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateIPSetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | High-level information about an IPSet, returned by operations like
-- create and list. This provides information like the ID, that you can use
-- to retrieve and manage an @IPSet@, and the ARN, that you provide to the
-- IPSetReferenceStatement to use the address set in a Rule.
createIPSetResponse_summary :: Lens.Lens' CreateIPSetResponse (Prelude.Maybe IPSetSummary)
createIPSetResponse_summary :: Lens' CreateIPSetResponse (Maybe IPSetSummary)
createIPSetResponse_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSetResponse' {Maybe IPSetSummary
summary :: Maybe IPSetSummary
$sel:summary:CreateIPSetResponse' :: CreateIPSetResponse -> Maybe IPSetSummary
summary} -> Maybe IPSetSummary
summary) (\s :: CreateIPSetResponse
s@CreateIPSetResponse' {} Maybe IPSetSummary
a -> CreateIPSetResponse
s {$sel:summary:CreateIPSetResponse' :: Maybe IPSetSummary
summary = Maybe IPSetSummary
a} :: CreateIPSetResponse)

-- | The response's http status code.
createIPSetResponse_httpStatus :: Lens.Lens' CreateIPSetResponse Prelude.Int
createIPSetResponse_httpStatus :: Lens' CreateIPSetResponse Int
createIPSetResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSetResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateIPSetResponse' :: CreateIPSetResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateIPSetResponse
s@CreateIPSetResponse' {} Int
a -> CreateIPSetResponse
s {$sel:httpStatus:CreateIPSetResponse' :: Int
httpStatus = Int
a} :: CreateIPSetResponse)

instance Prelude.NFData CreateIPSetResponse where
  rnf :: CreateIPSetResponse -> ()
rnf CreateIPSetResponse' {Int
Maybe IPSetSummary
httpStatus :: Int
summary :: Maybe IPSetSummary
$sel:httpStatus:CreateIPSetResponse' :: CreateIPSetResponse -> Int
$sel:summary:CreateIPSetResponse' :: CreateIPSetResponse -> Maybe IPSetSummary
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe IPSetSummary
summary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus