{-# 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.WellArchitected.UpdateWorkload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update an existing workload.
module Amazonka.WellArchitected.UpdateWorkload
  ( -- * Creating a Request
    UpdateWorkload (..),
    newUpdateWorkload,

    -- * Request Lenses
    updateWorkload_accountIds,
    updateWorkload_applications,
    updateWorkload_architecturalDesign,
    updateWorkload_awsRegions,
    updateWorkload_description,
    updateWorkload_discoveryConfig,
    updateWorkload_environment,
    updateWorkload_improvementStatus,
    updateWorkload_industry,
    updateWorkload_industryType,
    updateWorkload_isReviewOwnerUpdateAcknowledged,
    updateWorkload_nonAwsRegions,
    updateWorkload_notes,
    updateWorkload_pillarPriorities,
    updateWorkload_reviewOwner,
    updateWorkload_workloadName,
    updateWorkload_workloadId,

    -- * Destructuring the Response
    UpdateWorkloadResponse (..),
    newUpdateWorkloadResponse,

    -- * Response Lenses
    updateWorkloadResponse_workload,
    updateWorkloadResponse_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.WellArchitected.Types

-- | Input to update a workload.
--
-- /See:/ 'newUpdateWorkload' smart constructor.
data UpdateWorkload = UpdateWorkload'
  { UpdateWorkload -> Maybe [Text]
accountIds :: Prelude.Maybe [Prelude.Text],
    -- | List of AppRegistry application ARNs to associate to the workload.
    UpdateWorkload -> Maybe [Text]
applications :: Prelude.Maybe [Prelude.Text],
    UpdateWorkload -> Maybe Text
architecturalDesign :: Prelude.Maybe Prelude.Text,
    UpdateWorkload -> Maybe [Text]
awsRegions :: Prelude.Maybe [Prelude.Text],
    UpdateWorkload -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Well-Architected discovery configuration settings to associate to the
    -- workload.
    UpdateWorkload -> Maybe WorkloadDiscoveryConfig
discoveryConfig :: Prelude.Maybe WorkloadDiscoveryConfig,
    UpdateWorkload -> Maybe WorkloadEnvironment
environment :: Prelude.Maybe WorkloadEnvironment,
    UpdateWorkload -> Maybe WorkloadImprovementStatus
improvementStatus :: Prelude.Maybe WorkloadImprovementStatus,
    UpdateWorkload -> Maybe Text
industry :: Prelude.Maybe Prelude.Text,
    UpdateWorkload -> Maybe Text
industryType :: Prelude.Maybe Prelude.Text,
    -- | Flag indicating whether the workload owner has acknowledged that the
    -- /Review owner/ field is required.
    --
    -- If a __Review owner__ is not added to the workload within 60 days of
    -- acknowledgement, access to the workload is restricted until an owner is
    -- added.
    UpdateWorkload -> Maybe Bool
isReviewOwnerUpdateAcknowledged :: Prelude.Maybe Prelude.Bool,
    UpdateWorkload -> Maybe [Text]
nonAwsRegions :: Prelude.Maybe [Prelude.Text],
    UpdateWorkload -> Maybe Text
notes :: Prelude.Maybe Prelude.Text,
    UpdateWorkload -> Maybe [Text]
pillarPriorities :: Prelude.Maybe [Prelude.Text],
    UpdateWorkload -> Maybe Text
reviewOwner :: Prelude.Maybe Prelude.Text,
    UpdateWorkload -> Maybe Text
workloadName :: Prelude.Maybe Prelude.Text,
    UpdateWorkload -> Text
workloadId :: Prelude.Text
  }
  deriving (UpdateWorkload -> UpdateWorkload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkload -> UpdateWorkload -> Bool
$c/= :: UpdateWorkload -> UpdateWorkload -> Bool
== :: UpdateWorkload -> UpdateWorkload -> Bool
$c== :: UpdateWorkload -> UpdateWorkload -> Bool
Prelude.Eq, ReadPrec [UpdateWorkload]
ReadPrec UpdateWorkload
Int -> ReadS UpdateWorkload
ReadS [UpdateWorkload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkload]
$creadListPrec :: ReadPrec [UpdateWorkload]
readPrec :: ReadPrec UpdateWorkload
$creadPrec :: ReadPrec UpdateWorkload
readList :: ReadS [UpdateWorkload]
$creadList :: ReadS [UpdateWorkload]
readsPrec :: Int -> ReadS UpdateWorkload
$creadsPrec :: Int -> ReadS UpdateWorkload
Prelude.Read, Int -> UpdateWorkload -> ShowS
[UpdateWorkload] -> ShowS
UpdateWorkload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkload] -> ShowS
$cshowList :: [UpdateWorkload] -> ShowS
show :: UpdateWorkload -> String
$cshow :: UpdateWorkload -> String
showsPrec :: Int -> UpdateWorkload -> ShowS
$cshowsPrec :: Int -> UpdateWorkload -> ShowS
Prelude.Show, forall x. Rep UpdateWorkload x -> UpdateWorkload
forall x. UpdateWorkload -> Rep UpdateWorkload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorkload x -> UpdateWorkload
$cfrom :: forall x. UpdateWorkload -> Rep UpdateWorkload x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkload' 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:
--
-- 'accountIds', 'updateWorkload_accountIds' - Undocumented member.
--
-- 'applications', 'updateWorkload_applications' - List of AppRegistry application ARNs to associate to the workload.
--
-- 'architecturalDesign', 'updateWorkload_architecturalDesign' - Undocumented member.
--
-- 'awsRegions', 'updateWorkload_awsRegions' - Undocumented member.
--
-- 'description', 'updateWorkload_description' - Undocumented member.
--
-- 'discoveryConfig', 'updateWorkload_discoveryConfig' - Well-Architected discovery configuration settings to associate to the
-- workload.
--
-- 'environment', 'updateWorkload_environment' - Undocumented member.
--
-- 'improvementStatus', 'updateWorkload_improvementStatus' - Undocumented member.
--
-- 'industry', 'updateWorkload_industry' - Undocumented member.
--
-- 'industryType', 'updateWorkload_industryType' - Undocumented member.
--
-- 'isReviewOwnerUpdateAcknowledged', 'updateWorkload_isReviewOwnerUpdateAcknowledged' - Flag indicating whether the workload owner has acknowledged that the
-- /Review owner/ field is required.
--
-- If a __Review owner__ is not added to the workload within 60 days of
-- acknowledgement, access to the workload is restricted until an owner is
-- added.
--
-- 'nonAwsRegions', 'updateWorkload_nonAwsRegions' - Undocumented member.
--
-- 'notes', 'updateWorkload_notes' - Undocumented member.
--
-- 'pillarPriorities', 'updateWorkload_pillarPriorities' - Undocumented member.
--
-- 'reviewOwner', 'updateWorkload_reviewOwner' - Undocumented member.
--
-- 'workloadName', 'updateWorkload_workloadName' - Undocumented member.
--
-- 'workloadId', 'updateWorkload_workloadId' - Undocumented member.
newUpdateWorkload ::
  -- | 'workloadId'
  Prelude.Text ->
  UpdateWorkload
newUpdateWorkload :: Text -> UpdateWorkload
newUpdateWorkload Text
pWorkloadId_ =
  UpdateWorkload'
    { $sel:accountIds:UpdateWorkload' :: Maybe [Text]
accountIds = forall a. Maybe a
Prelude.Nothing,
      $sel:applications:UpdateWorkload' :: Maybe [Text]
applications = forall a. Maybe a
Prelude.Nothing,
      $sel:architecturalDesign:UpdateWorkload' :: Maybe Text
architecturalDesign = forall a. Maybe a
Prelude.Nothing,
      $sel:awsRegions:UpdateWorkload' :: Maybe [Text]
awsRegions = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateWorkload' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:discoveryConfig:UpdateWorkload' :: Maybe WorkloadDiscoveryConfig
discoveryConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:environment:UpdateWorkload' :: Maybe WorkloadEnvironment
environment = forall a. Maybe a
Prelude.Nothing,
      $sel:improvementStatus:UpdateWorkload' :: Maybe WorkloadImprovementStatus
improvementStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:industry:UpdateWorkload' :: Maybe Text
industry = forall a. Maybe a
Prelude.Nothing,
      $sel:industryType:UpdateWorkload' :: Maybe Text
industryType = forall a. Maybe a
Prelude.Nothing,
      $sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: Maybe Bool
isReviewOwnerUpdateAcknowledged = forall a. Maybe a
Prelude.Nothing,
      $sel:nonAwsRegions:UpdateWorkload' :: Maybe [Text]
nonAwsRegions = forall a. Maybe a
Prelude.Nothing,
      $sel:notes:UpdateWorkload' :: Maybe Text
notes = forall a. Maybe a
Prelude.Nothing,
      $sel:pillarPriorities:UpdateWorkload' :: Maybe [Text]
pillarPriorities = forall a. Maybe a
Prelude.Nothing,
      $sel:reviewOwner:UpdateWorkload' :: Maybe Text
reviewOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:workloadName:UpdateWorkload' :: Maybe Text
workloadName = forall a. Maybe a
Prelude.Nothing,
      $sel:workloadId:UpdateWorkload' :: Text
workloadId = Text
pWorkloadId_
    }

-- | Undocumented member.
updateWorkload_accountIds :: Lens.Lens' UpdateWorkload (Prelude.Maybe [Prelude.Text])
updateWorkload_accountIds :: Lens' UpdateWorkload (Maybe [Text])
updateWorkload_accountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe [Text]
accountIds :: Maybe [Text]
$sel:accountIds:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
accountIds} -> Maybe [Text]
accountIds) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe [Text]
a -> UpdateWorkload
s {$sel:accountIds:UpdateWorkload' :: Maybe [Text]
accountIds = Maybe [Text]
a} :: UpdateWorkload) 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

-- | List of AppRegistry application ARNs to associate to the workload.
updateWorkload_applications :: Lens.Lens' UpdateWorkload (Prelude.Maybe [Prelude.Text])
updateWorkload_applications :: Lens' UpdateWorkload (Maybe [Text])
updateWorkload_applications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe [Text]
applications :: Maybe [Text]
$sel:applications:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
applications} -> Maybe [Text]
applications) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe [Text]
a -> UpdateWorkload
s {$sel:applications:UpdateWorkload' :: Maybe [Text]
applications = Maybe [Text]
a} :: UpdateWorkload) 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

-- | Undocumented member.
updateWorkload_architecturalDesign :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_architecturalDesign :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_architecturalDesign = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
architecturalDesign :: Maybe Text
$sel:architecturalDesign:UpdateWorkload' :: UpdateWorkload -> Maybe Text
architecturalDesign} -> Maybe Text
architecturalDesign) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:architecturalDesign:UpdateWorkload' :: Maybe Text
architecturalDesign = Maybe Text
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_awsRegions :: Lens.Lens' UpdateWorkload (Prelude.Maybe [Prelude.Text])
updateWorkload_awsRegions :: Lens' UpdateWorkload (Maybe [Text])
updateWorkload_awsRegions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe [Text]
awsRegions :: Maybe [Text]
$sel:awsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
awsRegions} -> Maybe [Text]
awsRegions) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe [Text]
a -> UpdateWorkload
s {$sel:awsRegions:UpdateWorkload' :: Maybe [Text]
awsRegions = Maybe [Text]
a} :: UpdateWorkload) 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

-- | Undocumented member.
updateWorkload_description :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_description :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
description :: Maybe Text
$sel:description:UpdateWorkload' :: UpdateWorkload -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:description:UpdateWorkload' :: Maybe Text
description = Maybe Text
a} :: UpdateWorkload)

-- | Well-Architected discovery configuration settings to associate to the
-- workload.
updateWorkload_discoveryConfig :: Lens.Lens' UpdateWorkload (Prelude.Maybe WorkloadDiscoveryConfig)
updateWorkload_discoveryConfig :: Lens' UpdateWorkload (Maybe WorkloadDiscoveryConfig)
updateWorkload_discoveryConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe WorkloadDiscoveryConfig
discoveryConfig :: Maybe WorkloadDiscoveryConfig
$sel:discoveryConfig:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadDiscoveryConfig
discoveryConfig} -> Maybe WorkloadDiscoveryConfig
discoveryConfig) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe WorkloadDiscoveryConfig
a -> UpdateWorkload
s {$sel:discoveryConfig:UpdateWorkload' :: Maybe WorkloadDiscoveryConfig
discoveryConfig = Maybe WorkloadDiscoveryConfig
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_environment :: Lens.Lens' UpdateWorkload (Prelude.Maybe WorkloadEnvironment)
updateWorkload_environment :: Lens' UpdateWorkload (Maybe WorkloadEnvironment)
updateWorkload_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe WorkloadEnvironment
environment :: Maybe WorkloadEnvironment
$sel:environment:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadEnvironment
environment} -> Maybe WorkloadEnvironment
environment) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe WorkloadEnvironment
a -> UpdateWorkload
s {$sel:environment:UpdateWorkload' :: Maybe WorkloadEnvironment
environment = Maybe WorkloadEnvironment
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_improvementStatus :: Lens.Lens' UpdateWorkload (Prelude.Maybe WorkloadImprovementStatus)
updateWorkload_improvementStatus :: Lens' UpdateWorkload (Maybe WorkloadImprovementStatus)
updateWorkload_improvementStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe WorkloadImprovementStatus
improvementStatus :: Maybe WorkloadImprovementStatus
$sel:improvementStatus:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadImprovementStatus
improvementStatus} -> Maybe WorkloadImprovementStatus
improvementStatus) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe WorkloadImprovementStatus
a -> UpdateWorkload
s {$sel:improvementStatus:UpdateWorkload' :: Maybe WorkloadImprovementStatus
improvementStatus = Maybe WorkloadImprovementStatus
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_industry :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_industry :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_industry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
industry :: Maybe Text
$sel:industry:UpdateWorkload' :: UpdateWorkload -> Maybe Text
industry} -> Maybe Text
industry) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:industry:UpdateWorkload' :: Maybe Text
industry = Maybe Text
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_industryType :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_industryType :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_industryType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
industryType :: Maybe Text
$sel:industryType:UpdateWorkload' :: UpdateWorkload -> Maybe Text
industryType} -> Maybe Text
industryType) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:industryType:UpdateWorkload' :: Maybe Text
industryType = Maybe Text
a} :: UpdateWorkload)

-- | Flag indicating whether the workload owner has acknowledged that the
-- /Review owner/ field is required.
--
-- If a __Review owner__ is not added to the workload within 60 days of
-- acknowledgement, access to the workload is restricted until an owner is
-- added.
updateWorkload_isReviewOwnerUpdateAcknowledged :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Bool)
updateWorkload_isReviewOwnerUpdateAcknowledged :: Lens' UpdateWorkload (Maybe Bool)
updateWorkload_isReviewOwnerUpdateAcknowledged = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Bool
isReviewOwnerUpdateAcknowledged :: Maybe Bool
$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: UpdateWorkload -> Maybe Bool
isReviewOwnerUpdateAcknowledged} -> Maybe Bool
isReviewOwnerUpdateAcknowledged) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Bool
a -> UpdateWorkload
s {$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: Maybe Bool
isReviewOwnerUpdateAcknowledged = Maybe Bool
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_nonAwsRegions :: Lens.Lens' UpdateWorkload (Prelude.Maybe [Prelude.Text])
updateWorkload_nonAwsRegions :: Lens' UpdateWorkload (Maybe [Text])
updateWorkload_nonAwsRegions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe [Text]
nonAwsRegions :: Maybe [Text]
$sel:nonAwsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
nonAwsRegions} -> Maybe [Text]
nonAwsRegions) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe [Text]
a -> UpdateWorkload
s {$sel:nonAwsRegions:UpdateWorkload' :: Maybe [Text]
nonAwsRegions = Maybe [Text]
a} :: UpdateWorkload) 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

-- | Undocumented member.
updateWorkload_notes :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_notes :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_notes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
notes :: Maybe Text
$sel:notes:UpdateWorkload' :: UpdateWorkload -> Maybe Text
notes} -> Maybe Text
notes) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:notes:UpdateWorkload' :: Maybe Text
notes = Maybe Text
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_pillarPriorities :: Lens.Lens' UpdateWorkload (Prelude.Maybe [Prelude.Text])
updateWorkload_pillarPriorities :: Lens' UpdateWorkload (Maybe [Text])
updateWorkload_pillarPriorities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe [Text]
pillarPriorities :: Maybe [Text]
$sel:pillarPriorities:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
pillarPriorities} -> Maybe [Text]
pillarPriorities) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe [Text]
a -> UpdateWorkload
s {$sel:pillarPriorities:UpdateWorkload' :: Maybe [Text]
pillarPriorities = Maybe [Text]
a} :: UpdateWorkload) 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

-- | Undocumented member.
updateWorkload_reviewOwner :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_reviewOwner :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_reviewOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
reviewOwner :: Maybe Text
$sel:reviewOwner:UpdateWorkload' :: UpdateWorkload -> Maybe Text
reviewOwner} -> Maybe Text
reviewOwner) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:reviewOwner:UpdateWorkload' :: Maybe Text
reviewOwner = Maybe Text
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_workloadName :: Lens.Lens' UpdateWorkload (Prelude.Maybe Prelude.Text)
updateWorkload_workloadName :: Lens' UpdateWorkload (Maybe Text)
updateWorkload_workloadName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Maybe Text
workloadName :: Maybe Text
$sel:workloadName:UpdateWorkload' :: UpdateWorkload -> Maybe Text
workloadName} -> Maybe Text
workloadName) (\s :: UpdateWorkload
s@UpdateWorkload' {} Maybe Text
a -> UpdateWorkload
s {$sel:workloadName:UpdateWorkload' :: Maybe Text
workloadName = Maybe Text
a} :: UpdateWorkload)

-- | Undocumented member.
updateWorkload_workloadId :: Lens.Lens' UpdateWorkload Prelude.Text
updateWorkload_workloadId :: Lens' UpdateWorkload Text
updateWorkload_workloadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkload' {Text
workloadId :: Text
$sel:workloadId:UpdateWorkload' :: UpdateWorkload -> Text
workloadId} -> Text
workloadId) (\s :: UpdateWorkload
s@UpdateWorkload' {} Text
a -> UpdateWorkload
s {$sel:workloadId:UpdateWorkload' :: Text
workloadId = Text
a} :: UpdateWorkload)

instance Core.AWSRequest UpdateWorkload where
  type
    AWSResponse UpdateWorkload =
      UpdateWorkloadResponse
  request :: (Service -> Service) -> UpdateWorkload -> Request UpdateWorkload
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateWorkload
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateWorkload)))
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 Workload -> Int -> UpdateWorkloadResponse
UpdateWorkloadResponse'
            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
"Workload")
            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 UpdateWorkload where
  hashWithSalt :: Int -> UpdateWorkload -> Int
hashWithSalt Int
_salt UpdateWorkload' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe WorkloadDiscoveryConfig
Maybe WorkloadEnvironment
Maybe WorkloadImprovementStatus
Text
workloadId :: Text
workloadName :: Maybe Text
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
isReviewOwnerUpdateAcknowledged :: Maybe Bool
industryType :: Maybe Text
industry :: Maybe Text
improvementStatus :: Maybe WorkloadImprovementStatus
environment :: Maybe WorkloadEnvironment
discoveryConfig :: Maybe WorkloadDiscoveryConfig
description :: Maybe Text
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:workloadId:UpdateWorkload' :: UpdateWorkload -> Text
$sel:workloadName:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:reviewOwner:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:pillarPriorities:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:notes:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:nonAwsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: UpdateWorkload -> Maybe Bool
$sel:industryType:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:industry:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:improvementStatus:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadImprovementStatus
$sel:environment:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadEnvironment
$sel:discoveryConfig:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:description:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:awsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:architecturalDesign:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:applications:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:accountIds:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
accountIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
applications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
architecturalDesign
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
awsRegions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkloadDiscoveryConfig
discoveryConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkloadEnvironment
environment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkloadImprovementStatus
improvementStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
industry
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
industryType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isReviewOwnerUpdateAcknowledged
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
nonAwsRegions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
pillarPriorities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reviewOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
workloadName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadId

instance Prelude.NFData UpdateWorkload where
  rnf :: UpdateWorkload -> ()
rnf UpdateWorkload' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe WorkloadDiscoveryConfig
Maybe WorkloadEnvironment
Maybe WorkloadImprovementStatus
Text
workloadId :: Text
workloadName :: Maybe Text
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
isReviewOwnerUpdateAcknowledged :: Maybe Bool
industryType :: Maybe Text
industry :: Maybe Text
improvementStatus :: Maybe WorkloadImprovementStatus
environment :: Maybe WorkloadEnvironment
discoveryConfig :: Maybe WorkloadDiscoveryConfig
description :: Maybe Text
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:workloadId:UpdateWorkload' :: UpdateWorkload -> Text
$sel:workloadName:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:reviewOwner:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:pillarPriorities:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:notes:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:nonAwsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: UpdateWorkload -> Maybe Bool
$sel:industryType:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:industry:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:improvementStatus:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadImprovementStatus
$sel:environment:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadEnvironment
$sel:discoveryConfig:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:description:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:awsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:architecturalDesign:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:applications:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:accountIds:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
accountIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
applications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
architecturalDesign
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
awsRegions
      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 Maybe WorkloadDiscoveryConfig
discoveryConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkloadEnvironment
environment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkloadImprovementStatus
improvementStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
industry
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
industryType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isReviewOwnerUpdateAcknowledged
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
nonAwsRegions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
pillarPriorities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reviewOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workloadName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workloadId

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

instance Data.ToJSON UpdateWorkload where
  toJSON :: UpdateWorkload -> Value
toJSON UpdateWorkload' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe WorkloadDiscoveryConfig
Maybe WorkloadEnvironment
Maybe WorkloadImprovementStatus
Text
workloadId :: Text
workloadName :: Maybe Text
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
isReviewOwnerUpdateAcknowledged :: Maybe Bool
industryType :: Maybe Text
industry :: Maybe Text
improvementStatus :: Maybe WorkloadImprovementStatus
environment :: Maybe WorkloadEnvironment
discoveryConfig :: Maybe WorkloadDiscoveryConfig
description :: Maybe Text
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:workloadId:UpdateWorkload' :: UpdateWorkload -> Text
$sel:workloadName:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:reviewOwner:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:pillarPriorities:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:notes:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:nonAwsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: UpdateWorkload -> Maybe Bool
$sel:industryType:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:industry:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:improvementStatus:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadImprovementStatus
$sel:environment:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadEnvironment
$sel:discoveryConfig:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:description:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:awsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:architecturalDesign:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:applications:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:accountIds:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountIds" 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]
accountIds,
            (Key
"Applications" 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]
applications,
            (Key
"ArchitecturalDesign" 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
architecturalDesign,
            (Key
"AwsRegions" 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]
awsRegions,
            (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
"DiscoveryConfig" 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 WorkloadDiscoveryConfig
discoveryConfig,
            (Key
"Environment" 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 WorkloadEnvironment
environment,
            (Key
"ImprovementStatus" 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 WorkloadImprovementStatus
improvementStatus,
            (Key
"Industry" 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
industry,
            (Key
"IndustryType" 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
industryType,
            (Key
"IsReviewOwnerUpdateAcknowledged" 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 Bool
isReviewOwnerUpdateAcknowledged,
            (Key
"NonAwsRegions" 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]
nonAwsRegions,
            (Key
"Notes" 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
notes,
            (Key
"PillarPriorities" 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]
pillarPriorities,
            (Key
"ReviewOwner" 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
reviewOwner,
            (Key
"WorkloadName" 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
workloadName
          ]
      )

instance Data.ToPath UpdateWorkload where
  toPath :: UpdateWorkload -> ByteString
toPath UpdateWorkload' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe WorkloadDiscoveryConfig
Maybe WorkloadEnvironment
Maybe WorkloadImprovementStatus
Text
workloadId :: Text
workloadName :: Maybe Text
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
isReviewOwnerUpdateAcknowledged :: Maybe Bool
industryType :: Maybe Text
industry :: Maybe Text
improvementStatus :: Maybe WorkloadImprovementStatus
environment :: Maybe WorkloadEnvironment
discoveryConfig :: Maybe WorkloadDiscoveryConfig
description :: Maybe Text
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:workloadId:UpdateWorkload' :: UpdateWorkload -> Text
$sel:workloadName:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:reviewOwner:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:pillarPriorities:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:notes:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:nonAwsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:isReviewOwnerUpdateAcknowledged:UpdateWorkload' :: UpdateWorkload -> Maybe Bool
$sel:industryType:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:industry:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:improvementStatus:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadImprovementStatus
$sel:environment:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadEnvironment
$sel:discoveryConfig:UpdateWorkload' :: UpdateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:description:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:awsRegions:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:architecturalDesign:UpdateWorkload' :: UpdateWorkload -> Maybe Text
$sel:applications:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
$sel:accountIds:UpdateWorkload' :: UpdateWorkload -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/workloads/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
workloadId]

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

-- | Output of an update workload call.
--
-- /See:/ 'newUpdateWorkloadResponse' smart constructor.
data UpdateWorkloadResponse = UpdateWorkloadResponse'
  { UpdateWorkloadResponse -> Maybe Workload
workload :: Prelude.Maybe Workload,
    -- | The response's http status code.
    UpdateWorkloadResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateWorkloadResponse -> UpdateWorkloadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkloadResponse -> UpdateWorkloadResponse -> Bool
$c/= :: UpdateWorkloadResponse -> UpdateWorkloadResponse -> Bool
== :: UpdateWorkloadResponse -> UpdateWorkloadResponse -> Bool
$c== :: UpdateWorkloadResponse -> UpdateWorkloadResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWorkloadResponse]
ReadPrec UpdateWorkloadResponse
Int -> ReadS UpdateWorkloadResponse
ReadS [UpdateWorkloadResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkloadResponse]
$creadListPrec :: ReadPrec [UpdateWorkloadResponse]
readPrec :: ReadPrec UpdateWorkloadResponse
$creadPrec :: ReadPrec UpdateWorkloadResponse
readList :: ReadS [UpdateWorkloadResponse]
$creadList :: ReadS [UpdateWorkloadResponse]
readsPrec :: Int -> ReadS UpdateWorkloadResponse
$creadsPrec :: Int -> ReadS UpdateWorkloadResponse
Prelude.Read, Int -> UpdateWorkloadResponse -> ShowS
[UpdateWorkloadResponse] -> ShowS
UpdateWorkloadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkloadResponse] -> ShowS
$cshowList :: [UpdateWorkloadResponse] -> ShowS
show :: UpdateWorkloadResponse -> String
$cshow :: UpdateWorkloadResponse -> String
showsPrec :: Int -> UpdateWorkloadResponse -> ShowS
$cshowsPrec :: Int -> UpdateWorkloadResponse -> ShowS
Prelude.Show, forall x. Rep UpdateWorkloadResponse x -> UpdateWorkloadResponse
forall x. UpdateWorkloadResponse -> Rep UpdateWorkloadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorkloadResponse x -> UpdateWorkloadResponse
$cfrom :: forall x. UpdateWorkloadResponse -> Rep UpdateWorkloadResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkloadResponse' 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:
--
-- 'workload', 'updateWorkloadResponse_workload' - Undocumented member.
--
-- 'httpStatus', 'updateWorkloadResponse_httpStatus' - The response's http status code.
newUpdateWorkloadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateWorkloadResponse
newUpdateWorkloadResponse :: Int -> UpdateWorkloadResponse
newUpdateWorkloadResponse Int
pHttpStatus_ =
  UpdateWorkloadResponse'
    { $sel:workload:UpdateWorkloadResponse' :: Maybe Workload
workload = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateWorkloadResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateWorkloadResponse_workload :: Lens.Lens' UpdateWorkloadResponse (Prelude.Maybe Workload)
updateWorkloadResponse_workload :: Lens' UpdateWorkloadResponse (Maybe Workload)
updateWorkloadResponse_workload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkloadResponse' {Maybe Workload
workload :: Maybe Workload
$sel:workload:UpdateWorkloadResponse' :: UpdateWorkloadResponse -> Maybe Workload
workload} -> Maybe Workload
workload) (\s :: UpdateWorkloadResponse
s@UpdateWorkloadResponse' {} Maybe Workload
a -> UpdateWorkloadResponse
s {$sel:workload:UpdateWorkloadResponse' :: Maybe Workload
workload = Maybe Workload
a} :: UpdateWorkloadResponse)

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

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