{-# 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.WAFRegional.CreateWebACLMigrationStack
-- 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 AWS CloudFormation WAFV2 template for the specified web ACL
-- in the specified Amazon S3 bucket. Then, in CloudFormation, you create a
-- stack from the template, to create the web ACL and its resources in AWS
-- WAFV2. Use this to migrate your AWS WAF Classic web ACL to the latest
-- version of AWS WAF.
--
-- This is part of a larger migration procedure for web ACLs from AWS WAF
-- Classic to the latest version of AWS WAF. For the full procedure,
-- including caveats and manual steps to complete the migration and switch
-- over to the new web ACL, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-migrating-from-classic.html Migrating your AWS WAF Classic resources to AWS WAF>
-- in the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html AWS WAF Developer Guide>.
module Amazonka.WAFRegional.CreateWebACLMigrationStack
  ( -- * Creating a Request
    CreateWebACLMigrationStack (..),
    newCreateWebACLMigrationStack,

    -- * Request Lenses
    createWebACLMigrationStack_webACLId,
    createWebACLMigrationStack_s3BucketName,
    createWebACLMigrationStack_ignoreUnsupportedType,

    -- * Destructuring the Response
    CreateWebACLMigrationStackResponse (..),
    newCreateWebACLMigrationStackResponse,

    -- * Response Lenses
    createWebACLMigrationStackResponse_httpStatus,
    createWebACLMigrationStackResponse_s3ObjectUrl,
  )
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.WAFRegional.Types

-- | /See:/ 'newCreateWebACLMigrationStack' smart constructor.
data CreateWebACLMigrationStack = CreateWebACLMigrationStack'
  { -- | The UUID of the WAF Classic web ACL that you want to migrate to WAF v2.
    CreateWebACLMigrationStack -> Text
webACLId :: Prelude.Text,
    -- | The name of the Amazon S3 bucket to store the CloudFormation template
    -- in. The S3 bucket must be configured as follows for the migration:
    --
    -- -   The bucket name must start with @aws-waf-migration-@. For example,
    --     @aws-waf-migration-my-web-acl@.
    --
    -- -   The bucket must be in the Region where you are deploying the
    --     template. For example, for a web ACL in us-west-2, you must use an
    --     Amazon S3 bucket in us-west-2 and you must deploy the template stack
    --     to us-west-2.
    --
    -- -   The bucket policies must permit the migration process to write data.
    --     For listings of the bucket policies, see the Examples section.
    CreateWebACLMigrationStack -> Text
s3BucketName :: Prelude.Text,
    -- | Indicates whether to exclude entities that can\'t be migrated or to stop
    -- the migration. Set this to true to ignore unsupported entities in the
    -- web ACL during the migration. Otherwise, if AWS WAF encounters
    -- unsupported entities, it stops the process and throws an exception.
    CreateWebACLMigrationStack -> Bool
ignoreUnsupportedType :: Prelude.Bool
  }
  deriving (CreateWebACLMigrationStack -> CreateWebACLMigrationStack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWebACLMigrationStack -> CreateWebACLMigrationStack -> Bool
$c/= :: CreateWebACLMigrationStack -> CreateWebACLMigrationStack -> Bool
== :: CreateWebACLMigrationStack -> CreateWebACLMigrationStack -> Bool
$c== :: CreateWebACLMigrationStack -> CreateWebACLMigrationStack -> Bool
Prelude.Eq, ReadPrec [CreateWebACLMigrationStack]
ReadPrec CreateWebACLMigrationStack
Int -> ReadS CreateWebACLMigrationStack
ReadS [CreateWebACLMigrationStack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWebACLMigrationStack]
$creadListPrec :: ReadPrec [CreateWebACLMigrationStack]
readPrec :: ReadPrec CreateWebACLMigrationStack
$creadPrec :: ReadPrec CreateWebACLMigrationStack
readList :: ReadS [CreateWebACLMigrationStack]
$creadList :: ReadS [CreateWebACLMigrationStack]
readsPrec :: Int -> ReadS CreateWebACLMigrationStack
$creadsPrec :: Int -> ReadS CreateWebACLMigrationStack
Prelude.Read, Int -> CreateWebACLMigrationStack -> ShowS
[CreateWebACLMigrationStack] -> ShowS
CreateWebACLMigrationStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWebACLMigrationStack] -> ShowS
$cshowList :: [CreateWebACLMigrationStack] -> ShowS
show :: CreateWebACLMigrationStack -> String
$cshow :: CreateWebACLMigrationStack -> String
showsPrec :: Int -> CreateWebACLMigrationStack -> ShowS
$cshowsPrec :: Int -> CreateWebACLMigrationStack -> ShowS
Prelude.Show, forall x.
Rep CreateWebACLMigrationStack x -> CreateWebACLMigrationStack
forall x.
CreateWebACLMigrationStack -> Rep CreateWebACLMigrationStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWebACLMigrationStack x -> CreateWebACLMigrationStack
$cfrom :: forall x.
CreateWebACLMigrationStack -> Rep CreateWebACLMigrationStack x
Prelude.Generic)

-- |
-- Create a value of 'CreateWebACLMigrationStack' 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:
--
-- 'webACLId', 'createWebACLMigrationStack_webACLId' - The UUID of the WAF Classic web ACL that you want to migrate to WAF v2.
--
-- 's3BucketName', 'createWebACLMigrationStack_s3BucketName' - The name of the Amazon S3 bucket to store the CloudFormation template
-- in. The S3 bucket must be configured as follows for the migration:
--
-- -   The bucket name must start with @aws-waf-migration-@. For example,
--     @aws-waf-migration-my-web-acl@.
--
-- -   The bucket must be in the Region where you are deploying the
--     template. For example, for a web ACL in us-west-2, you must use an
--     Amazon S3 bucket in us-west-2 and you must deploy the template stack
--     to us-west-2.
--
-- -   The bucket policies must permit the migration process to write data.
--     For listings of the bucket policies, see the Examples section.
--
-- 'ignoreUnsupportedType', 'createWebACLMigrationStack_ignoreUnsupportedType' - Indicates whether to exclude entities that can\'t be migrated or to stop
-- the migration. Set this to true to ignore unsupported entities in the
-- web ACL during the migration. Otherwise, if AWS WAF encounters
-- unsupported entities, it stops the process and throws an exception.
newCreateWebACLMigrationStack ::
  -- | 'webACLId'
  Prelude.Text ->
  -- | 's3BucketName'
  Prelude.Text ->
  -- | 'ignoreUnsupportedType'
  Prelude.Bool ->
  CreateWebACLMigrationStack
newCreateWebACLMigrationStack :: Text -> Text -> Bool -> CreateWebACLMigrationStack
newCreateWebACLMigrationStack
  Text
pWebACLId_
  Text
pS3BucketName_
  Bool
pIgnoreUnsupportedType_ =
    CreateWebACLMigrationStack'
      { $sel:webACLId:CreateWebACLMigrationStack' :: Text
webACLId = Text
pWebACLId_,
        $sel:s3BucketName:CreateWebACLMigrationStack' :: Text
s3BucketName = Text
pS3BucketName_,
        $sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: Bool
ignoreUnsupportedType = Bool
pIgnoreUnsupportedType_
      }

-- | The UUID of the WAF Classic web ACL that you want to migrate to WAF v2.
createWebACLMigrationStack_webACLId :: Lens.Lens' CreateWebACLMigrationStack Prelude.Text
createWebACLMigrationStack_webACLId :: Lens' CreateWebACLMigrationStack Text
createWebACLMigrationStack_webACLId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACLMigrationStack' {Text
webACLId :: Text
$sel:webACLId:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
webACLId} -> Text
webACLId) (\s :: CreateWebACLMigrationStack
s@CreateWebACLMigrationStack' {} Text
a -> CreateWebACLMigrationStack
s {$sel:webACLId:CreateWebACLMigrationStack' :: Text
webACLId = Text
a} :: CreateWebACLMigrationStack)

-- | The name of the Amazon S3 bucket to store the CloudFormation template
-- in. The S3 bucket must be configured as follows for the migration:
--
-- -   The bucket name must start with @aws-waf-migration-@. For example,
--     @aws-waf-migration-my-web-acl@.
--
-- -   The bucket must be in the Region where you are deploying the
--     template. For example, for a web ACL in us-west-2, you must use an
--     Amazon S3 bucket in us-west-2 and you must deploy the template stack
--     to us-west-2.
--
-- -   The bucket policies must permit the migration process to write data.
--     For listings of the bucket policies, see the Examples section.
createWebACLMigrationStack_s3BucketName :: Lens.Lens' CreateWebACLMigrationStack Prelude.Text
createWebACLMigrationStack_s3BucketName :: Lens' CreateWebACLMigrationStack Text
createWebACLMigrationStack_s3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACLMigrationStack' {Text
s3BucketName :: Text
$sel:s3BucketName:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
s3BucketName} -> Text
s3BucketName) (\s :: CreateWebACLMigrationStack
s@CreateWebACLMigrationStack' {} Text
a -> CreateWebACLMigrationStack
s {$sel:s3BucketName:CreateWebACLMigrationStack' :: Text
s3BucketName = Text
a} :: CreateWebACLMigrationStack)

-- | Indicates whether to exclude entities that can\'t be migrated or to stop
-- the migration. Set this to true to ignore unsupported entities in the
-- web ACL during the migration. Otherwise, if AWS WAF encounters
-- unsupported entities, it stops the process and throws an exception.
createWebACLMigrationStack_ignoreUnsupportedType :: Lens.Lens' CreateWebACLMigrationStack Prelude.Bool
createWebACLMigrationStack_ignoreUnsupportedType :: Lens' CreateWebACLMigrationStack Bool
createWebACLMigrationStack_ignoreUnsupportedType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACLMigrationStack' {Bool
ignoreUnsupportedType :: Bool
$sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Bool
ignoreUnsupportedType} -> Bool
ignoreUnsupportedType) (\s :: CreateWebACLMigrationStack
s@CreateWebACLMigrationStack' {} Bool
a -> CreateWebACLMigrationStack
s {$sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: Bool
ignoreUnsupportedType = Bool
a} :: CreateWebACLMigrationStack)

instance Core.AWSRequest CreateWebACLMigrationStack where
  type
    AWSResponse CreateWebACLMigrationStack =
      CreateWebACLMigrationStackResponse
  request :: (Service -> Service)
-> CreateWebACLMigrationStack -> Request CreateWebACLMigrationStack
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 CreateWebACLMigrationStack
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateWebACLMigrationStack)))
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 ->
          Int -> Text -> CreateWebACLMigrationStackResponse
CreateWebACLMigrationStackResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"S3ObjectUrl")
      )

instance Prelude.Hashable CreateWebACLMigrationStack where
  hashWithSalt :: Int -> CreateWebACLMigrationStack -> Int
hashWithSalt Int
_salt CreateWebACLMigrationStack' {Bool
Text
ignoreUnsupportedType :: Bool
s3BucketName :: Text
webACLId :: Text
$sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Bool
$sel:s3BucketName:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
$sel:webACLId:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
webACLId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
s3BucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
ignoreUnsupportedType

instance Prelude.NFData CreateWebACLMigrationStack where
  rnf :: CreateWebACLMigrationStack -> ()
rnf CreateWebACLMigrationStack' {Bool
Text
ignoreUnsupportedType :: Bool
s3BucketName :: Text
webACLId :: Text
$sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Bool
$sel:s3BucketName:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
$sel:webACLId:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
webACLId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
s3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
ignoreUnsupportedType

instance Data.ToHeaders CreateWebACLMigrationStack where
  toHeaders :: CreateWebACLMigrationStack -> 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_Regional_20161128.CreateWebACLMigrationStack" ::
                          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 CreateWebACLMigrationStack where
  toJSON :: CreateWebACLMigrationStack -> Value
toJSON CreateWebACLMigrationStack' {Bool
Text
ignoreUnsupportedType :: Bool
s3BucketName :: Text
webACLId :: Text
$sel:ignoreUnsupportedType:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Bool
$sel:s3BucketName:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
$sel:webACLId:CreateWebACLMigrationStack' :: CreateWebACLMigrationStack -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"WebACLId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
webACLId),
            forall a. a -> Maybe a
Prelude.Just (Key
"S3BucketName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
s3BucketName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"IgnoreUnsupportedType"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
ignoreUnsupportedType
              )
          ]
      )

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

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

-- | /See:/ 'newCreateWebACLMigrationStackResponse' smart constructor.
data CreateWebACLMigrationStackResponse = CreateWebACLMigrationStackResponse'
  { -- | The response's http status code.
    CreateWebACLMigrationStackResponse -> Int
httpStatus :: Prelude.Int,
    -- | The URL of the template created in Amazon S3.
    CreateWebACLMigrationStackResponse -> Text
s3ObjectUrl :: Prelude.Text
  }
  deriving (CreateWebACLMigrationStackResponse
-> CreateWebACLMigrationStackResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWebACLMigrationStackResponse
-> CreateWebACLMigrationStackResponse -> Bool
$c/= :: CreateWebACLMigrationStackResponse
-> CreateWebACLMigrationStackResponse -> Bool
== :: CreateWebACLMigrationStackResponse
-> CreateWebACLMigrationStackResponse -> Bool
$c== :: CreateWebACLMigrationStackResponse
-> CreateWebACLMigrationStackResponse -> Bool
Prelude.Eq, ReadPrec [CreateWebACLMigrationStackResponse]
ReadPrec CreateWebACLMigrationStackResponse
Int -> ReadS CreateWebACLMigrationStackResponse
ReadS [CreateWebACLMigrationStackResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWebACLMigrationStackResponse]
$creadListPrec :: ReadPrec [CreateWebACLMigrationStackResponse]
readPrec :: ReadPrec CreateWebACLMigrationStackResponse
$creadPrec :: ReadPrec CreateWebACLMigrationStackResponse
readList :: ReadS [CreateWebACLMigrationStackResponse]
$creadList :: ReadS [CreateWebACLMigrationStackResponse]
readsPrec :: Int -> ReadS CreateWebACLMigrationStackResponse
$creadsPrec :: Int -> ReadS CreateWebACLMigrationStackResponse
Prelude.Read, Int -> CreateWebACLMigrationStackResponse -> ShowS
[CreateWebACLMigrationStackResponse] -> ShowS
CreateWebACLMigrationStackResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWebACLMigrationStackResponse] -> ShowS
$cshowList :: [CreateWebACLMigrationStackResponse] -> ShowS
show :: CreateWebACLMigrationStackResponse -> String
$cshow :: CreateWebACLMigrationStackResponse -> String
showsPrec :: Int -> CreateWebACLMigrationStackResponse -> ShowS
$cshowsPrec :: Int -> CreateWebACLMigrationStackResponse -> ShowS
Prelude.Show, forall x.
Rep CreateWebACLMigrationStackResponse x
-> CreateWebACLMigrationStackResponse
forall x.
CreateWebACLMigrationStackResponse
-> Rep CreateWebACLMigrationStackResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWebACLMigrationStackResponse x
-> CreateWebACLMigrationStackResponse
$cfrom :: forall x.
CreateWebACLMigrationStackResponse
-> Rep CreateWebACLMigrationStackResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWebACLMigrationStackResponse' 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:
--
-- 'httpStatus', 'createWebACLMigrationStackResponse_httpStatus' - The response's http status code.
--
-- 's3ObjectUrl', 'createWebACLMigrationStackResponse_s3ObjectUrl' - The URL of the template created in Amazon S3.
newCreateWebACLMigrationStackResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 's3ObjectUrl'
  Prelude.Text ->
  CreateWebACLMigrationStackResponse
newCreateWebACLMigrationStackResponse :: Int -> Text -> CreateWebACLMigrationStackResponse
newCreateWebACLMigrationStackResponse
  Int
pHttpStatus_
  Text
pS3ObjectUrl_ =
    CreateWebACLMigrationStackResponse'
      { $sel:httpStatus:CreateWebACLMigrationStackResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:s3ObjectUrl:CreateWebACLMigrationStackResponse' :: Text
s3ObjectUrl = Text
pS3ObjectUrl_
      }

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

-- | The URL of the template created in Amazon S3.
createWebACLMigrationStackResponse_s3ObjectUrl :: Lens.Lens' CreateWebACLMigrationStackResponse Prelude.Text
createWebACLMigrationStackResponse_s3ObjectUrl :: Lens' CreateWebACLMigrationStackResponse Text
createWebACLMigrationStackResponse_s3ObjectUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebACLMigrationStackResponse' {Text
s3ObjectUrl :: Text
$sel:s3ObjectUrl:CreateWebACLMigrationStackResponse' :: CreateWebACLMigrationStackResponse -> Text
s3ObjectUrl} -> Text
s3ObjectUrl) (\s :: CreateWebACLMigrationStackResponse
s@CreateWebACLMigrationStackResponse' {} Text
a -> CreateWebACLMigrationStackResponse
s {$sel:s3ObjectUrl:CreateWebACLMigrationStackResponse' :: Text
s3ObjectUrl = Text
a} :: CreateWebACLMigrationStackResponse)

instance
  Prelude.NFData
    CreateWebACLMigrationStackResponse
  where
  rnf :: CreateWebACLMigrationStackResponse -> ()
rnf CreateWebACLMigrationStackResponse' {Int
Text
s3ObjectUrl :: Text
httpStatus :: Int
$sel:s3ObjectUrl:CreateWebACLMigrationStackResponse' :: CreateWebACLMigrationStackResponse -> Text
$sel:httpStatus:CreateWebACLMigrationStackResponse' :: CreateWebACLMigrationStackResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
s3ObjectUrl