{-# 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.IoTFleetWise.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.
module Amazonka.IoTFleetWise.UpdateCampaign
  ( -- * Creating a Request
    UpdateCampaign (..),
    newUpdateCampaign,

    -- * Request Lenses
    updateCampaign_dataExtraDimensions,
    updateCampaign_description,
    updateCampaign_name,
    updateCampaign_action,

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

    -- * Response Lenses
    updateCampaignResponse_arn,
    updateCampaignResponse_name,
    updateCampaignResponse_status,
    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.IoTFleetWise.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'
  { -- | A list of vehicle attributes to associate with a signal.
    --
    -- Default: An empty array
    UpdateCampaign -> Maybe [Text]
dataExtraDimensions :: Prelude.Maybe [Prelude.Text],
    -- | The description of the campaign.
    UpdateCampaign -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the campaign to update.
    UpdateCampaign -> Text
name :: Prelude.Text,
    -- | Specifies how to update a campaign. The action can be one of the
    -- following:
    --
    -- -   @APPROVE@ - To approve delivering a data collection scheme to
    --     vehicles.
    --
    -- -   @SUSPEND@ - To suspend collecting signal data.
    --
    -- -   @RESUME@ - To resume collecting signal data.
    --
    -- -   @UPDATE@ - To update a campaign.
    UpdateCampaign -> UpdateCampaignAction
action :: UpdateCampaignAction
  }
  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:
--
-- 'dataExtraDimensions', 'updateCampaign_dataExtraDimensions' - A list of vehicle attributes to associate with a signal.
--
-- Default: An empty array
--
-- 'description', 'updateCampaign_description' - The description of the campaign.
--
-- 'name', 'updateCampaign_name' - The name of the campaign to update.
--
-- 'action', 'updateCampaign_action' - Specifies how to update a campaign. The action can be one of the
-- following:
--
-- -   @APPROVE@ - To approve delivering a data collection scheme to
--     vehicles.
--
-- -   @SUSPEND@ - To suspend collecting signal data.
--
-- -   @RESUME@ - To resume collecting signal data.
--
-- -   @UPDATE@ - To update a campaign.
newUpdateCampaign ::
  -- | 'name'
  Prelude.Text ->
  -- | 'action'
  UpdateCampaignAction ->
  UpdateCampaign
newUpdateCampaign :: Text -> UpdateCampaignAction -> UpdateCampaign
newUpdateCampaign Text
pName_ UpdateCampaignAction
pAction_ =
  UpdateCampaign'
    { $sel:dataExtraDimensions:UpdateCampaign' :: Maybe [Text]
dataExtraDimensions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateCampaign' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateCampaign' :: Text
name = Text
pName_,
      $sel:action:UpdateCampaign' :: UpdateCampaignAction
action = UpdateCampaignAction
pAction_
    }

-- | A list of vehicle attributes to associate with a signal.
--
-- Default: An empty array
updateCampaign_dataExtraDimensions :: Lens.Lens' UpdateCampaign (Prelude.Maybe [Prelude.Text])
updateCampaign_dataExtraDimensions :: Lens' UpdateCampaign (Maybe [Text])
updateCampaign_dataExtraDimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaign' {Maybe [Text]
dataExtraDimensions :: Maybe [Text]
$sel:dataExtraDimensions:UpdateCampaign' :: UpdateCampaign -> Maybe [Text]
dataExtraDimensions} -> Maybe [Text]
dataExtraDimensions) (\s :: UpdateCampaign
s@UpdateCampaign' {} Maybe [Text]
a -> UpdateCampaign
s {$sel:dataExtraDimensions:UpdateCampaign' :: Maybe [Text]
dataExtraDimensions = Maybe [Text]
a} :: UpdateCampaign) 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 description of the campaign.
updateCampaign_description :: Lens.Lens' UpdateCampaign (Prelude.Maybe Prelude.Text)
updateCampaign_description :: Lens' UpdateCampaign (Maybe Text)
updateCampaign_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaign' {Maybe Text
description :: Maybe Text
$sel:description:UpdateCampaign' :: UpdateCampaign -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateCampaign
s@UpdateCampaign' {} Maybe Text
a -> UpdateCampaign
s {$sel:description:UpdateCampaign' :: Maybe Text
description = Maybe Text
a} :: UpdateCampaign)

-- | The name of the campaign to update.
updateCampaign_name :: Lens.Lens' UpdateCampaign Prelude.Text
updateCampaign_name :: Lens' UpdateCampaign Text
updateCampaign_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaign' {Text
name :: Text
$sel:name:UpdateCampaign' :: UpdateCampaign -> Text
name} -> Text
name) (\s :: UpdateCampaign
s@UpdateCampaign' {} Text
a -> UpdateCampaign
s {$sel:name:UpdateCampaign' :: Text
name = Text
a} :: UpdateCampaign)

-- | Specifies how to update a campaign. The action can be one of the
-- following:
--
-- -   @APPROVE@ - To approve delivering a data collection scheme to
--     vehicles.
--
-- -   @SUSPEND@ - To suspend collecting signal data.
--
-- -   @RESUME@ - To resume collecting signal data.
--
-- -   @UPDATE@ - To update a campaign.
updateCampaign_action :: Lens.Lens' UpdateCampaign UpdateCampaignAction
updateCampaign_action :: Lens' UpdateCampaign UpdateCampaignAction
updateCampaign_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaign' {UpdateCampaignAction
action :: UpdateCampaignAction
$sel:action:UpdateCampaign' :: UpdateCampaign -> UpdateCampaignAction
action} -> UpdateCampaignAction
action) (\s :: UpdateCampaign
s@UpdateCampaign' {} UpdateCampaignAction
a -> UpdateCampaign
s {$sel:action:UpdateCampaign' :: UpdateCampaignAction
action = UpdateCampaignAction
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
-> Maybe Text
-> Maybe CampaignStatus
-> 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
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            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 [Text]
Maybe Text
Text
UpdateCampaignAction
action :: UpdateCampaignAction
name :: Text
description :: Maybe Text
dataExtraDimensions :: Maybe [Text]
$sel:action:UpdateCampaign' :: UpdateCampaign -> UpdateCampaignAction
$sel:name:UpdateCampaign' :: UpdateCampaign -> Text
$sel:description:UpdateCampaign' :: UpdateCampaign -> Maybe Text
$sel:dataExtraDimensions:UpdateCampaign' :: UpdateCampaign -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
dataExtraDimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateCampaignAction
action

instance Prelude.NFData UpdateCampaign where
  rnf :: UpdateCampaign -> ()
rnf UpdateCampaign' {Maybe [Text]
Maybe Text
Text
UpdateCampaignAction
action :: UpdateCampaignAction
name :: Text
description :: Maybe Text
dataExtraDimensions :: Maybe [Text]
$sel:action:UpdateCampaign' :: UpdateCampaign -> UpdateCampaignAction
$sel:name:UpdateCampaign' :: UpdateCampaign -> Text
$sel:description:UpdateCampaign' :: UpdateCampaign -> Maybe Text
$sel:dataExtraDimensions:UpdateCampaign' :: UpdateCampaign -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
dataExtraDimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateCampaignAction
action

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
"IoTAutobahnControlPlane.UpdateCampaign" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateCampaign where
  toJSON :: UpdateCampaign -> Value
toJSON UpdateCampaign' {Maybe [Text]
Maybe Text
Text
UpdateCampaignAction
action :: UpdateCampaignAction
name :: Text
description :: Maybe Text
dataExtraDimensions :: Maybe [Text]
$sel:action:UpdateCampaign' :: UpdateCampaign -> UpdateCampaignAction
$sel:name:UpdateCampaign' :: UpdateCampaign -> Text
$sel:description:UpdateCampaign' :: UpdateCampaign -> Maybe Text
$sel:dataExtraDimensions:UpdateCampaign' :: UpdateCampaign -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"dataExtraDimensions" 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]
dataExtraDimensions,
            (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,
            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
"action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateCampaignAction
action)
          ]
      )

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 Amazon Resource Name (ARN) of the campaign.
    UpdateCampaignResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The name of the updated campaign.
    UpdateCampaignResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The state of a campaign. The status can be one of:
    --
    -- -   @CREATING@ - Amazon Web Services IoT FleetWise is processing your
    --     request to create the campaign.
    --
    -- -   @WAITING_FOR_APPROVAL@ - After a campaign is created, it enters the
    --     @WAITING_FOR_APPROVAL@ state. To allow Amazon Web Services IoT
    --     FleetWise to deploy the campaign to the target vehicle or fleet, use
    --     the API operation to approve the campaign.
    --
    -- -   @RUNNING@ - The campaign is active.
    --
    -- -   @SUSPENDED@ - The campaign is suspended. To resume the campaign, use
    --     the API operation.
    UpdateCampaignResponse -> Maybe CampaignStatus
status :: Prelude.Maybe CampaignStatus,
    -- | 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:
--
-- 'arn', 'updateCampaignResponse_arn' - The Amazon Resource Name (ARN) of the campaign.
--
-- 'name', 'updateCampaignResponse_name' - The name of the updated campaign.
--
-- 'status', 'updateCampaignResponse_status' - The state of a campaign. The status can be one of:
--
-- -   @CREATING@ - Amazon Web Services IoT FleetWise is processing your
--     request to create the campaign.
--
-- -   @WAITING_FOR_APPROVAL@ - After a campaign is created, it enters the
--     @WAITING_FOR_APPROVAL@ state. To allow Amazon Web Services IoT
--     FleetWise to deploy the campaign to the target vehicle or fleet, use
--     the API operation to approve the campaign.
--
-- -   @RUNNING@ - The campaign is active.
--
-- -   @SUSPENDED@ - The campaign is suspended. To resume the campaign, use
--     the API operation.
--
-- 'httpStatus', 'updateCampaignResponse_httpStatus' - The response's http status code.
newUpdateCampaignResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCampaignResponse
newUpdateCampaignResponse :: Int -> UpdateCampaignResponse
newUpdateCampaignResponse Int
pHttpStatus_ =
  UpdateCampaignResponse'
    { $sel:arn:UpdateCampaignResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateCampaignResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateCampaignResponse' :: Maybe CampaignStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateCampaignResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The name of the updated campaign.
updateCampaignResponse_name :: Lens.Lens' UpdateCampaignResponse (Prelude.Maybe Prelude.Text)
updateCampaignResponse_name :: Lens' UpdateCampaignResponse (Maybe Text)
updateCampaignResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaignResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateCampaignResponse
s@UpdateCampaignResponse' {} Maybe Text
a -> UpdateCampaignResponse
s {$sel:name:UpdateCampaignResponse' :: Maybe Text
name = Maybe Text
a} :: UpdateCampaignResponse)

-- | The state of a campaign. The status can be one of:
--
-- -   @CREATING@ - Amazon Web Services IoT FleetWise is processing your
--     request to create the campaign.
--
-- -   @WAITING_FOR_APPROVAL@ - After a campaign is created, it enters the
--     @WAITING_FOR_APPROVAL@ state. To allow Amazon Web Services IoT
--     FleetWise to deploy the campaign to the target vehicle or fleet, use
--     the API operation to approve the campaign.
--
-- -   @RUNNING@ - The campaign is active.
--
-- -   @SUSPENDED@ - The campaign is suspended. To resume the campaign, use
--     the API operation.
updateCampaignResponse_status :: Lens.Lens' UpdateCampaignResponse (Prelude.Maybe CampaignStatus)
updateCampaignResponse_status :: Lens' UpdateCampaignResponse (Maybe CampaignStatus)
updateCampaignResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCampaignResponse' {Maybe CampaignStatus
status :: Maybe CampaignStatus
$sel:status:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe CampaignStatus
status} -> Maybe CampaignStatus
status) (\s :: UpdateCampaignResponse
s@UpdateCampaignResponse' {} Maybe CampaignStatus
a -> UpdateCampaignResponse
s {$sel:status:UpdateCampaignResponse' :: Maybe CampaignStatus
status = Maybe CampaignStatus
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
Maybe CampaignStatus
httpStatus :: Int
status :: Maybe CampaignStatus
name :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:UpdateCampaignResponse' :: UpdateCampaignResponse -> Int
$sel:status:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe CampaignStatus
$sel:name:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe Text
$sel:arn:UpdateCampaignResponse' :: UpdateCampaignResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CampaignStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus