{-# 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.Personalize.CreateCampaign
-- 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 a campaign that deploys a solution version. When a client calls
-- the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_RS_GetRecommendations.html GetRecommendations>
-- and
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_RS_GetPersonalizedRanking.html GetPersonalizedRanking>
-- APIs, a campaign is specified in the request.
--
-- __Minimum Provisioned TPS and Auto-Scaling__
--
-- A transaction is a single @GetRecommendations@ or
-- @GetPersonalizedRanking@ call. Transactions per second (TPS) is the
-- throughput and unit of billing for Amazon Personalize. The minimum
-- provisioned TPS (@minProvisionedTPS@) specifies the baseline throughput
-- provisioned by Amazon Personalize, and thus, the minimum billing charge.
--
-- If your TPS increases beyond @minProvisionedTPS@, Amazon Personalize
-- auto-scales the provisioned capacity up and down, but never below
-- @minProvisionedTPS@. There\'s a short time delay while the capacity is
-- increased that might cause loss of transactions.
--
-- The actual TPS used is calculated as the average requests\/second within
-- a 5-minute window. You pay for maximum of either the minimum provisioned
-- TPS or the actual TPS. We recommend starting with a low
-- @minProvisionedTPS@, track your usage using Amazon CloudWatch metrics,
-- and then increase the @minProvisionedTPS@ as necessary.
--
-- __Status__
--
-- A campaign can be in one of the following states:
--
-- -   CREATE PENDING > CREATE IN_PROGRESS > ACTIVE -or- CREATE FAILED
--
-- -   DELETE PENDING > DELETE IN_PROGRESS
--
-- To get the campaign status, call
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeCampaign.html DescribeCampaign>.
--
-- Wait until the @status@ of the campaign is @ACTIVE@ before asking the
-- campaign for recommendations.
--
-- __Related APIs__
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_ListCampaigns.html ListCampaigns>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeCampaign.html DescribeCampaign>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_UpdateCampaign.html UpdateCampaign>
--
-- -   <https://docs.aws.amazon.com/personalize/latest/dg/API_DeleteCampaign.html DeleteCampaign>
module Amazonka.Personalize.CreateCampaign
  ( -- * Creating a Request
    CreateCampaign (..),
    newCreateCampaign,

    -- * Request Lenses
    createCampaign_campaignConfig,
    createCampaign_minProvisionedTPS,
    createCampaign_tags,
    createCampaign_name,
    createCampaign_solutionVersionArn,

    -- * Destructuring the Response
    CreateCampaignResponse (..),
    newCreateCampaignResponse,

    -- * Response Lenses
    createCampaignResponse_campaignArn,
    createCampaignResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateCampaign' smart constructor.
data CreateCampaign = CreateCampaign'
  { -- | The configuration details of a campaign.
    CreateCampaign -> Maybe CampaignConfig
campaignConfig :: Prelude.Maybe CampaignConfig,
    -- | Specifies the requested minimum provisioned transactions
    -- (recommendations) per second that Amazon Personalize will support.
    CreateCampaign -> Maybe Natural
minProvisionedTPS :: Prelude.Maybe Prelude.Natural,
    -- | A list of
    -- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
    -- to apply to the campaign.
    CreateCampaign -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A name for the new campaign. The campaign name must be unique within
    -- your account.
    CreateCampaign -> Text
name :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the solution version to deploy.
    CreateCampaign -> Text
solutionVersionArn :: Prelude.Text
  }
  deriving (CreateCampaign -> CreateCampaign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCampaign -> CreateCampaign -> Bool
$c/= :: CreateCampaign -> CreateCampaign -> Bool
== :: CreateCampaign -> CreateCampaign -> Bool
$c== :: CreateCampaign -> CreateCampaign -> Bool
Prelude.Eq, ReadPrec [CreateCampaign]
ReadPrec CreateCampaign
Int -> ReadS CreateCampaign
ReadS [CreateCampaign]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCampaign]
$creadListPrec :: ReadPrec [CreateCampaign]
readPrec :: ReadPrec CreateCampaign
$creadPrec :: ReadPrec CreateCampaign
readList :: ReadS [CreateCampaign]
$creadList :: ReadS [CreateCampaign]
readsPrec :: Int -> ReadS CreateCampaign
$creadsPrec :: Int -> ReadS CreateCampaign
Prelude.Read, Int -> CreateCampaign -> ShowS
[CreateCampaign] -> ShowS
CreateCampaign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCampaign] -> ShowS
$cshowList :: [CreateCampaign] -> ShowS
show :: CreateCampaign -> String
$cshow :: CreateCampaign -> String
showsPrec :: Int -> CreateCampaign -> ShowS
$cshowsPrec :: Int -> CreateCampaign -> ShowS
Prelude.Show, forall x. Rep CreateCampaign x -> CreateCampaign
forall x. CreateCampaign -> Rep CreateCampaign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCampaign x -> CreateCampaign
$cfrom :: forall x. CreateCampaign -> Rep CreateCampaign x
Prelude.Generic)

-- |
-- Create a value of 'CreateCampaign' 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:
--
-- 'campaignConfig', 'createCampaign_campaignConfig' - The configuration details of a campaign.
--
-- 'minProvisionedTPS', 'createCampaign_minProvisionedTPS' - Specifies the requested minimum provisioned transactions
-- (recommendations) per second that Amazon Personalize will support.
--
-- 'tags', 'createCampaign_tags' - A list of
-- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
-- to apply to the campaign.
--
-- 'name', 'createCampaign_name' - A name for the new campaign. The campaign name must be unique within
-- your account.
--
-- 'solutionVersionArn', 'createCampaign_solutionVersionArn' - The Amazon Resource Name (ARN) of the solution version to deploy.
newCreateCampaign ::
  -- | 'name'
  Prelude.Text ->
  -- | 'solutionVersionArn'
  Prelude.Text ->
  CreateCampaign
newCreateCampaign :: Text -> Text -> CreateCampaign
newCreateCampaign Text
pName_ Text
pSolutionVersionArn_ =
  CreateCampaign'
    { $sel:campaignConfig:CreateCampaign' :: Maybe CampaignConfig
campaignConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:minProvisionedTPS:CreateCampaign' :: Maybe Natural
minProvisionedTPS = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateCampaign' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateCampaign' :: Text
name = Text
pName_,
      $sel:solutionVersionArn:CreateCampaign' :: Text
solutionVersionArn = Text
pSolutionVersionArn_
    }

-- | The configuration details of a campaign.
createCampaign_campaignConfig :: Lens.Lens' CreateCampaign (Prelude.Maybe CampaignConfig)
createCampaign_campaignConfig :: Lens' CreateCampaign (Maybe CampaignConfig)
createCampaign_campaignConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaign' {Maybe CampaignConfig
campaignConfig :: Maybe CampaignConfig
$sel:campaignConfig:CreateCampaign' :: CreateCampaign -> Maybe CampaignConfig
campaignConfig} -> Maybe CampaignConfig
campaignConfig) (\s :: CreateCampaign
s@CreateCampaign' {} Maybe CampaignConfig
a -> CreateCampaign
s {$sel:campaignConfig:CreateCampaign' :: Maybe CampaignConfig
campaignConfig = Maybe CampaignConfig
a} :: CreateCampaign)

-- | Specifies the requested minimum provisioned transactions
-- (recommendations) per second that Amazon Personalize will support.
createCampaign_minProvisionedTPS :: Lens.Lens' CreateCampaign (Prelude.Maybe Prelude.Natural)
createCampaign_minProvisionedTPS :: Lens' CreateCampaign (Maybe Natural)
createCampaign_minProvisionedTPS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaign' {Maybe Natural
minProvisionedTPS :: Maybe Natural
$sel:minProvisionedTPS:CreateCampaign' :: CreateCampaign -> Maybe Natural
minProvisionedTPS} -> Maybe Natural
minProvisionedTPS) (\s :: CreateCampaign
s@CreateCampaign' {} Maybe Natural
a -> CreateCampaign
s {$sel:minProvisionedTPS:CreateCampaign' :: Maybe Natural
minProvisionedTPS = Maybe Natural
a} :: CreateCampaign)

-- | A list of
-- <https://docs.aws.amazon.com/personalize/latest/dev/tagging-resources.html tags>
-- to apply to the campaign.
createCampaign_tags :: Lens.Lens' CreateCampaign (Prelude.Maybe [Tag])
createCampaign_tags :: Lens' CreateCampaign (Maybe [Tag])
createCampaign_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaign' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCampaign' :: CreateCampaign -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCampaign
s@CreateCampaign' {} Maybe [Tag]
a -> CreateCampaign
s {$sel:tags:CreateCampaign' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCampaign) 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

-- | A name for the new campaign. The campaign name must be unique within
-- your account.
createCampaign_name :: Lens.Lens' CreateCampaign Prelude.Text
createCampaign_name :: Lens' CreateCampaign Text
createCampaign_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaign' {Text
name :: Text
$sel:name:CreateCampaign' :: CreateCampaign -> Text
name} -> Text
name) (\s :: CreateCampaign
s@CreateCampaign' {} Text
a -> CreateCampaign
s {$sel:name:CreateCampaign' :: Text
name = Text
a} :: CreateCampaign)

-- | The Amazon Resource Name (ARN) of the solution version to deploy.
createCampaign_solutionVersionArn :: Lens.Lens' CreateCampaign Prelude.Text
createCampaign_solutionVersionArn :: Lens' CreateCampaign Text
createCampaign_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaign' {Text
solutionVersionArn :: Text
$sel:solutionVersionArn:CreateCampaign' :: CreateCampaign -> Text
solutionVersionArn} -> Text
solutionVersionArn) (\s :: CreateCampaign
s@CreateCampaign' {} Text
a -> CreateCampaign
s {$sel:solutionVersionArn:CreateCampaign' :: Text
solutionVersionArn = Text
a} :: CreateCampaign)

instance Core.AWSRequest CreateCampaign where
  type
    AWSResponse CreateCampaign =
      CreateCampaignResponse
  request :: (Service -> Service) -> CreateCampaign -> Request CreateCampaign
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 CreateCampaign
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCampaign)))
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 Text -> Int -> CreateCampaignResponse
CreateCampaignResponse'
            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
"campaignArn")
            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 CreateCampaign where
  hashWithSalt :: Int -> CreateCampaign -> Int
hashWithSalt Int
_salt CreateCampaign' {Maybe Natural
Maybe [Tag]
Maybe CampaignConfig
Text
solutionVersionArn :: Text
name :: Text
tags :: Maybe [Tag]
minProvisionedTPS :: Maybe Natural
campaignConfig :: Maybe CampaignConfig
$sel:solutionVersionArn:CreateCampaign' :: CreateCampaign -> Text
$sel:name:CreateCampaign' :: CreateCampaign -> Text
$sel:tags:CreateCampaign' :: CreateCampaign -> Maybe [Tag]
$sel:minProvisionedTPS:CreateCampaign' :: CreateCampaign -> Maybe Natural
$sel:campaignConfig:CreateCampaign' :: CreateCampaign -> Maybe CampaignConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CampaignConfig
campaignConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minProvisionedTPS
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
solutionVersionArn

instance Prelude.NFData CreateCampaign where
  rnf :: CreateCampaign -> ()
rnf CreateCampaign' {Maybe Natural
Maybe [Tag]
Maybe CampaignConfig
Text
solutionVersionArn :: Text
name :: Text
tags :: Maybe [Tag]
minProvisionedTPS :: Maybe Natural
campaignConfig :: Maybe CampaignConfig
$sel:solutionVersionArn:CreateCampaign' :: CreateCampaign -> Text
$sel:name:CreateCampaign' :: CreateCampaign -> Text
$sel:tags:CreateCampaign' :: CreateCampaign -> Maybe [Tag]
$sel:minProvisionedTPS:CreateCampaign' :: CreateCampaign -> Maybe Natural
$sel:campaignConfig:CreateCampaign' :: CreateCampaign -> Maybe CampaignConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CampaignConfig
campaignConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minProvisionedTPS
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [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 Text
solutionVersionArn

instance Data.ToHeaders CreateCampaign where
  toHeaders :: CreateCampaign -> 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
"AmazonPersonalize.CreateCampaign" ::
                          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 CreateCampaign where
  toJSON :: CreateCampaign -> Value
toJSON CreateCampaign' {Maybe Natural
Maybe [Tag]
Maybe CampaignConfig
Text
solutionVersionArn :: Text
name :: Text
tags :: Maybe [Tag]
minProvisionedTPS :: Maybe Natural
campaignConfig :: Maybe CampaignConfig
$sel:solutionVersionArn:CreateCampaign' :: CreateCampaign -> Text
$sel:name:CreateCampaign' :: CreateCampaign -> Text
$sel:tags:CreateCampaign' :: CreateCampaign -> Maybe [Tag]
$sel:minProvisionedTPS:CreateCampaign' :: CreateCampaign -> Maybe Natural
$sel:campaignConfig:CreateCampaign' :: CreateCampaign -> Maybe CampaignConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"campaignConfig" 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 CampaignConfig
campaignConfig,
            (Key
"minProvisionedTPS" 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 Natural
minProvisionedTPS,
            (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 [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
"solutionVersionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
solutionVersionArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateCampaignResponse' 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:
--
-- 'campaignArn', 'createCampaignResponse_campaignArn' - The Amazon Resource Name (ARN) of the campaign.
--
-- 'httpStatus', 'createCampaignResponse_httpStatus' - The response's http status code.
newCreateCampaignResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCampaignResponse
newCreateCampaignResponse :: Int -> CreateCampaignResponse
newCreateCampaignResponse Int
pHttpStatus_ =
  CreateCampaignResponse'
    { $sel:campaignArn:CreateCampaignResponse' :: Maybe Text
campaignArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCampaignResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the campaign.
createCampaignResponse_campaignArn :: Lens.Lens' CreateCampaignResponse (Prelude.Maybe Prelude.Text)
createCampaignResponse_campaignArn :: Lens' CreateCampaignResponse (Maybe Text)
createCampaignResponse_campaignArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCampaignResponse' {Maybe Text
campaignArn :: Maybe Text
$sel:campaignArn:CreateCampaignResponse' :: CreateCampaignResponse -> Maybe Text
campaignArn} -> Maybe Text
campaignArn) (\s :: CreateCampaignResponse
s@CreateCampaignResponse' {} Maybe Text
a -> CreateCampaignResponse
s {$sel:campaignArn:CreateCampaignResponse' :: Maybe Text
campaignArn = Maybe Text
a} :: CreateCampaignResponse)

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

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