{-# 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.UpdateCampaign
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a campaign by either deploying a new solution or changing the
-- value of the campaign\'s @minProvisionedTPS@ parameter.
--
-- To update a campaign, the campaign status must be ACTIVE or CREATE
-- FAILED. Check the campaign status using the
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_DescribeCampaign.html DescribeCampaign>
-- operation.
--
-- You can still get recommendations from a campaign while an update is in
-- progress. The campaign will use the previous solution version and
-- campaign configuration to generate recommendations until the latest
-- campaign update status is @Active@.
--
-- For more information on campaigns, see
-- <https://docs.aws.amazon.com/personalize/latest/dg/API_CreateCampaign.html CreateCampaign>.
module Amazonka.Personalize.UpdateCampaign
  ( -- * Creating a Request
    UpdateCampaign (..),
    newUpdateCampaign,

    -- * Request Lenses
    updateCampaign_campaignConfig,
    updateCampaign_minProvisionedTPS,
    updateCampaign_solutionVersionArn,
    updateCampaign_campaignArn,

    -- * Destructuring the Response
    UpdateCampaignResponse (..),
    newUpdateCampaignResponse,

    -- * Response Lenses
    updateCampaignResponse_campaignArn,
    updateCampaignResponse_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:/ 'newUpdateCampaign' smart constructor.
data UpdateCampaign = UpdateCampaign'
  { -- | The configuration details of a campaign.
    UpdateCampaign -> Maybe CampaignConfig
campaignConfig :: Prelude.Maybe CampaignConfig,
    -- | Specifies the requested minimum provisioned transactions
    -- (recommendations) per second that Amazon Personalize will support.
    UpdateCampaign -> Maybe Natural
minProvisionedTPS :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of a new solution version to deploy.
    UpdateCampaign -> Maybe Text
solutionVersionArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the campaign.
    UpdateCampaign -> Text
campaignArn :: Prelude.Text
  }
  deriving (UpdateCampaign -> UpdateCampaign -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCampaign -> UpdateCampaign -> Bool
$c/= :: UpdateCampaign -> UpdateCampaign -> Bool
== :: UpdateCampaign -> UpdateCampaign -> Bool
$c== :: UpdateCampaign -> UpdateCampaign -> Bool
Prelude.Eq, ReadPrec [UpdateCampaign]
ReadPrec UpdateCampaign
Int -> ReadS UpdateCampaign
ReadS [UpdateCampaign]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCampaign]
$creadListPrec :: ReadPrec [UpdateCampaign]
readPrec :: ReadPrec UpdateCampaign
$creadPrec :: ReadPrec UpdateCampaign
readList :: ReadS [UpdateCampaign]
$creadList :: ReadS [UpdateCampaign]
readsPrec :: Int -> ReadS UpdateCampaign
$creadsPrec :: Int -> ReadS UpdateCampaign
Prelude.Read, Int -> UpdateCampaign -> ShowS
[UpdateCampaign] -> ShowS
UpdateCampaign -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCampaign] -> ShowS
$cshowList :: [UpdateCampaign] -> ShowS
show :: UpdateCampaign -> String
$cshow :: UpdateCampaign -> String
showsPrec :: Int -> UpdateCampaign -> ShowS
$cshowsPrec :: Int -> UpdateCampaign -> ShowS
Prelude.Show, forall x. Rep UpdateCampaign x -> UpdateCampaign
forall x. UpdateCampaign -> Rep UpdateCampaign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCampaign x -> UpdateCampaign
$cfrom :: forall x. UpdateCampaign -> Rep UpdateCampaign x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCampaign' 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', 'updateCampaign_campaignConfig' - The configuration details of a campaign.
--
-- 'minProvisionedTPS', 'updateCampaign_minProvisionedTPS' - Specifies the requested minimum provisioned transactions
-- (recommendations) per second that Amazon Personalize will support.
--
-- 'solutionVersionArn', 'updateCampaign_solutionVersionArn' - The ARN of a new solution version to deploy.
--
-- 'campaignArn', 'updateCampaign_campaignArn' - The Amazon Resource Name (ARN) of the campaign.
newUpdateCampaign ::
  -- | 'campaignArn'
  Prelude.Text ->
  UpdateCampaign
newUpdateCampaign :: Text -> UpdateCampaign
newUpdateCampaign Text
pCampaignArn_ =
  UpdateCampaign'
    { $sel:campaignConfig:UpdateCampaign' :: Maybe CampaignConfig
campaignConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:minProvisionedTPS:UpdateCampaign' :: Maybe Natural
minProvisionedTPS = forall a. Maybe a
Prelude.Nothing,
      $sel:solutionVersionArn:UpdateCampaign' :: Maybe Text
solutionVersionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:campaignArn:UpdateCampaign' :: Text
campaignArn = Text
pCampaignArn_
    }

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

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

-- | The ARN of a new solution version to deploy.
updateCampaign_solutionVersionArn :: Lens.Lens' UpdateCampaign (Prelude.Maybe Prelude.Text)
updateCampaign_solutionVersionArn :: Lens' UpdateCampaign (Maybe Text)
updateCampaign_solutionVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaign' {Maybe Text
solutionVersionArn :: Maybe Text
$sel:solutionVersionArn:UpdateCampaign' :: UpdateCampaign -> Maybe Text
solutionVersionArn} -> Maybe Text
solutionVersionArn) (\s :: UpdateCampaign
s@UpdateCampaign' {} Maybe Text
a -> UpdateCampaign
s {$sel:solutionVersionArn:UpdateCampaign' :: Maybe Text
solutionVersionArn = Maybe Text
a} :: UpdateCampaign)

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

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

instance Prelude.NFData UpdateCampaign where
  rnf :: UpdateCampaign -> ()
rnf UpdateCampaign' {Maybe Natural
Maybe Text
Maybe CampaignConfig
Text
campaignArn :: Text
solutionVersionArn :: Maybe Text
minProvisionedTPS :: Maybe Natural
campaignConfig :: Maybe CampaignConfig
$sel:campaignArn:UpdateCampaign' :: UpdateCampaign -> Text
$sel:solutionVersionArn:UpdateCampaign' :: UpdateCampaign -> Maybe Text
$sel:minProvisionedTPS:UpdateCampaign' :: UpdateCampaign -> Maybe Natural
$sel:campaignConfig:UpdateCampaign' :: UpdateCampaign -> 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 Text
solutionVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
campaignArn

instance Data.ToHeaders UpdateCampaign where
  toHeaders :: UpdateCampaign -> 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.UpdateCampaign" ::
                          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 UpdateCampaign where
  toJSON :: UpdateCampaign -> Value
toJSON UpdateCampaign' {Maybe Natural
Maybe Text
Maybe CampaignConfig
Text
campaignArn :: Text
solutionVersionArn :: Maybe Text
minProvisionedTPS :: Maybe Natural
campaignConfig :: Maybe CampaignConfig
$sel:campaignArn:UpdateCampaign' :: UpdateCampaign -> Text
$sel:solutionVersionArn:UpdateCampaign' :: UpdateCampaign -> Maybe Text
$sel:minProvisionedTPS:UpdateCampaign' :: UpdateCampaign -> Maybe Natural
$sel:campaignConfig:UpdateCampaign' :: UpdateCampaign -> 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
"solutionVersionArn" 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
solutionVersionArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"campaignArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
campaignArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateCampaignResponse' 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', 'updateCampaignResponse_campaignArn' - The same campaign ARN as given in the request.
--
-- 'httpStatus', 'updateCampaignResponse_httpStatus' - The response's http status code.
newUpdateCampaignResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCampaignResponse
newUpdateCampaignResponse :: Int -> UpdateCampaignResponse
newUpdateCampaignResponse Int
pHttpStatus_ =
  UpdateCampaignResponse'
    { $sel:campaignArn:UpdateCampaignResponse' :: Maybe Text
campaignArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateCampaignResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The same campaign ARN as given in the request.
updateCampaignResponse_campaignArn :: Lens.Lens' UpdateCampaignResponse (Prelude.Maybe Prelude.Text)
updateCampaignResponse_campaignArn :: Lens' UpdateCampaignResponse (Maybe Text)
updateCampaignResponse_campaignArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaignResponse' {Maybe Text
campaignArn :: Maybe Text
$sel:campaignArn:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe Text
campaignArn} -> Maybe Text
campaignArn) (\s :: UpdateCampaignResponse
s@UpdateCampaignResponse' {} Maybe Text
a -> UpdateCampaignResponse
s {$sel:campaignArn:UpdateCampaignResponse' :: Maybe Text
campaignArn = Maybe Text
a} :: UpdateCampaignResponse)

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

instance Prelude.NFData UpdateCampaignResponse where
  rnf :: UpdateCampaignResponse -> ()
rnf UpdateCampaignResponse' {Int
Maybe Text
httpStatus :: Int
campaignArn :: Maybe Text
$sel:httpStatus:UpdateCampaignResponse' :: UpdateCampaignResponse -> Int
$sel:campaignArn:UpdateCampaignResponse' :: UpdateCampaignResponse -> 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