{-# 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.CreateWorkload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new workload.
--
-- The owner of a workload can share the workload with other Amazon Web
-- Services accounts, IAM users, an organization, and organizational units
-- (OUs) in the same Amazon Web Services Region. Only the owner of a
-- workload can delete it.
--
-- For more information, see
-- <https://docs.aws.amazon.com/wellarchitected/latest/userguide/define-workload.html Defining a Workload>
-- in the /Well-Architected Tool User Guide/.
module Amazonka.WellArchitected.CreateWorkload
  ( -- * Creating a Request
    CreateWorkload (..),
    newCreateWorkload,

    -- * Request Lenses
    createWorkload_accountIds,
    createWorkload_applications,
    createWorkload_architecturalDesign,
    createWorkload_awsRegions,
    createWorkload_discoveryConfig,
    createWorkload_industry,
    createWorkload_industryType,
    createWorkload_nonAwsRegions,
    createWorkload_notes,
    createWorkload_pillarPriorities,
    createWorkload_reviewOwner,
    createWorkload_tags,
    createWorkload_workloadName,
    createWorkload_description,
    createWorkload_environment,
    createWorkload_lenses,
    createWorkload_clientRequestToken,

    -- * Destructuring the Response
    CreateWorkloadResponse (..),
    newCreateWorkloadResponse,

    -- * Response Lenses
    createWorkloadResponse_workloadArn,
    createWorkloadResponse_workloadId,
    createWorkloadResponse_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 for workload creation.
--
-- /See:/ 'newCreateWorkload' smart constructor.
data CreateWorkload = CreateWorkload'
  { CreateWorkload -> Maybe [Text]
accountIds :: Prelude.Maybe [Prelude.Text],
    -- | List of AppRegistry application ARNs associated to the workload.
    CreateWorkload -> Maybe [Text]
applications :: Prelude.Maybe [Prelude.Text],
    CreateWorkload -> Maybe Text
architecturalDesign :: Prelude.Maybe Prelude.Text,
    CreateWorkload -> Maybe [Text]
awsRegions :: Prelude.Maybe [Prelude.Text],
    -- | Well-Architected discovery configuration settings associated to the
    -- workload.
    CreateWorkload -> Maybe WorkloadDiscoveryConfig
discoveryConfig :: Prelude.Maybe WorkloadDiscoveryConfig,
    CreateWorkload -> Maybe Text
industry :: Prelude.Maybe Prelude.Text,
    CreateWorkload -> Maybe Text
industryType :: Prelude.Maybe Prelude.Text,
    CreateWorkload -> Maybe [Text]
nonAwsRegions :: Prelude.Maybe [Prelude.Text],
    CreateWorkload -> Maybe Text
notes :: Prelude.Maybe Prelude.Text,
    CreateWorkload -> Maybe [Text]
pillarPriorities :: Prelude.Maybe [Prelude.Text],
    CreateWorkload -> Maybe Text
reviewOwner :: Prelude.Maybe Prelude.Text,
    -- | The tags to be associated with the workload.
    CreateWorkload -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    CreateWorkload -> Text
workloadName :: Prelude.Text,
    CreateWorkload -> Text
description :: Prelude.Text,
    CreateWorkload -> WorkloadEnvironment
environment :: WorkloadEnvironment,
    CreateWorkload -> [Text]
lenses :: [Prelude.Text],
    CreateWorkload -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (CreateWorkload -> CreateWorkload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkload -> CreateWorkload -> Bool
$c/= :: CreateWorkload -> CreateWorkload -> Bool
== :: CreateWorkload -> CreateWorkload -> Bool
$c== :: CreateWorkload -> CreateWorkload -> Bool
Prelude.Eq, ReadPrec [CreateWorkload]
ReadPrec CreateWorkload
Int -> ReadS CreateWorkload
ReadS [CreateWorkload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkload]
$creadListPrec :: ReadPrec [CreateWorkload]
readPrec :: ReadPrec CreateWorkload
$creadPrec :: ReadPrec CreateWorkload
readList :: ReadS [CreateWorkload]
$creadList :: ReadS [CreateWorkload]
readsPrec :: Int -> ReadS CreateWorkload
$creadsPrec :: Int -> ReadS CreateWorkload
Prelude.Read, Int -> CreateWorkload -> ShowS
[CreateWorkload] -> ShowS
CreateWorkload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkload] -> ShowS
$cshowList :: [CreateWorkload] -> ShowS
show :: CreateWorkload -> String
$cshow :: CreateWorkload -> String
showsPrec :: Int -> CreateWorkload -> ShowS
$cshowsPrec :: Int -> CreateWorkload -> ShowS
Prelude.Show, forall x. Rep CreateWorkload x -> CreateWorkload
forall x. CreateWorkload -> Rep CreateWorkload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkload x -> CreateWorkload
$cfrom :: forall x. CreateWorkload -> Rep CreateWorkload x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkload' 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', 'createWorkload_accountIds' - Undocumented member.
--
-- 'applications', 'createWorkload_applications' - List of AppRegistry application ARNs associated to the workload.
--
-- 'architecturalDesign', 'createWorkload_architecturalDesign' - Undocumented member.
--
-- 'awsRegions', 'createWorkload_awsRegions' - Undocumented member.
--
-- 'discoveryConfig', 'createWorkload_discoveryConfig' - Well-Architected discovery configuration settings associated to the
-- workload.
--
-- 'industry', 'createWorkload_industry' - Undocumented member.
--
-- 'industryType', 'createWorkload_industryType' - Undocumented member.
--
-- 'nonAwsRegions', 'createWorkload_nonAwsRegions' - Undocumented member.
--
-- 'notes', 'createWorkload_notes' - Undocumented member.
--
-- 'pillarPriorities', 'createWorkload_pillarPriorities' - Undocumented member.
--
-- 'reviewOwner', 'createWorkload_reviewOwner' - Undocumented member.
--
-- 'tags', 'createWorkload_tags' - The tags to be associated with the workload.
--
-- 'workloadName', 'createWorkload_workloadName' - Undocumented member.
--
-- 'description', 'createWorkload_description' - Undocumented member.
--
-- 'environment', 'createWorkload_environment' - Undocumented member.
--
-- 'lenses', 'createWorkload_lenses' - Undocumented member.
--
-- 'clientRequestToken', 'createWorkload_clientRequestToken' - Undocumented member.
newCreateWorkload ::
  -- | 'workloadName'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  -- | 'environment'
  WorkloadEnvironment ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateWorkload
newCreateWorkload :: Text -> Text -> WorkloadEnvironment -> Text -> CreateWorkload
newCreateWorkload
  Text
pWorkloadName_
  Text
pDescription_
  WorkloadEnvironment
pEnvironment_
  Text
pClientRequestToken_ =
    CreateWorkload'
      { $sel:accountIds:CreateWorkload' :: Maybe [Text]
accountIds = forall a. Maybe a
Prelude.Nothing,
        $sel:applications:CreateWorkload' :: Maybe [Text]
applications = forall a. Maybe a
Prelude.Nothing,
        $sel:architecturalDesign:CreateWorkload' :: Maybe Text
architecturalDesign = forall a. Maybe a
Prelude.Nothing,
        $sel:awsRegions:CreateWorkload' :: Maybe [Text]
awsRegions = forall a. Maybe a
Prelude.Nothing,
        $sel:discoveryConfig:CreateWorkload' :: Maybe WorkloadDiscoveryConfig
discoveryConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:industry:CreateWorkload' :: Maybe Text
industry = forall a. Maybe a
Prelude.Nothing,
        $sel:industryType:CreateWorkload' :: Maybe Text
industryType = forall a. Maybe a
Prelude.Nothing,
        $sel:nonAwsRegions:CreateWorkload' :: Maybe [Text]
nonAwsRegions = forall a. Maybe a
Prelude.Nothing,
        $sel:notes:CreateWorkload' :: Maybe Text
notes = forall a. Maybe a
Prelude.Nothing,
        $sel:pillarPriorities:CreateWorkload' :: Maybe [Text]
pillarPriorities = forall a. Maybe a
Prelude.Nothing,
        $sel:reviewOwner:CreateWorkload' :: Maybe Text
reviewOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateWorkload' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:workloadName:CreateWorkload' :: Text
workloadName = Text
pWorkloadName_,
        $sel:description:CreateWorkload' :: Text
description = Text
pDescription_,
        $sel:environment:CreateWorkload' :: WorkloadEnvironment
environment = WorkloadEnvironment
pEnvironment_,
        $sel:lenses:CreateWorkload' :: [Text]
lenses = forall a. Monoid a => a
Prelude.mempty,
        $sel:clientRequestToken:CreateWorkload' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

-- | Undocumented member.
createWorkload_accountIds :: Lens.Lens' CreateWorkload (Prelude.Maybe [Prelude.Text])
createWorkload_accountIds :: Lens' CreateWorkload (Maybe [Text])
createWorkload_accountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {Maybe [Text]
accountIds :: Maybe [Text]
$sel:accountIds:CreateWorkload' :: CreateWorkload -> Maybe [Text]
accountIds} -> Maybe [Text]
accountIds) (\s :: CreateWorkload
s@CreateWorkload' {} Maybe [Text]
a -> CreateWorkload
s {$sel:accountIds:CreateWorkload' :: Maybe [Text]
accountIds = Maybe [Text]
a} :: CreateWorkload) 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 associated to the workload.
createWorkload_applications :: Lens.Lens' CreateWorkload (Prelude.Maybe [Prelude.Text])
createWorkload_applications :: Lens' CreateWorkload (Maybe [Text])
createWorkload_applications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {Maybe [Text]
applications :: Maybe [Text]
$sel:applications:CreateWorkload' :: CreateWorkload -> Maybe [Text]
applications} -> Maybe [Text]
applications) (\s :: CreateWorkload
s@CreateWorkload' {} Maybe [Text]
a -> CreateWorkload
s {$sel:applications:CreateWorkload' :: Maybe [Text]
applications = Maybe [Text]
a} :: CreateWorkload) 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.
createWorkload_architecturalDesign :: Lens.Lens' CreateWorkload (Prelude.Maybe Prelude.Text)
createWorkload_architecturalDesign :: Lens' CreateWorkload (Maybe Text)
createWorkload_architecturalDesign = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {Maybe Text
architecturalDesign :: Maybe Text
$sel:architecturalDesign:CreateWorkload' :: CreateWorkload -> Maybe Text
architecturalDesign} -> Maybe Text
architecturalDesign) (\s :: CreateWorkload
s@CreateWorkload' {} Maybe Text
a -> CreateWorkload
s {$sel:architecturalDesign:CreateWorkload' :: Maybe Text
architecturalDesign = Maybe Text
a} :: CreateWorkload)

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

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

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

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

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

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

-- | The tags to be associated with the workload.
createWorkload_tags :: Lens.Lens' CreateWorkload (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createWorkload_tags :: Lens' CreateWorkload (Maybe (HashMap Text Text))
createWorkload_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateWorkload' :: CreateWorkload -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateWorkload
s@CreateWorkload' {} Maybe (HashMap Text Text)
a -> CreateWorkload
s {$sel:tags:CreateWorkload' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateWorkload) 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.
createWorkload_workloadName :: Lens.Lens' CreateWorkload Prelude.Text
createWorkload_workloadName :: Lens' CreateWorkload Text
createWorkload_workloadName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {Text
workloadName :: Text
$sel:workloadName:CreateWorkload' :: CreateWorkload -> Text
workloadName} -> Text
workloadName) (\s :: CreateWorkload
s@CreateWorkload' {} Text
a -> CreateWorkload
s {$sel:workloadName:CreateWorkload' :: Text
workloadName = Text
a} :: CreateWorkload)

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

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

-- | Undocumented member.
createWorkload_lenses :: Lens.Lens' CreateWorkload [Prelude.Text]
createWorkload_lenses :: Lens' CreateWorkload [Text]
createWorkload_lenses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkload' {[Text]
lenses :: [Text]
$sel:lenses:CreateWorkload' :: CreateWorkload -> [Text]
lenses} -> [Text]
lenses) (\s :: CreateWorkload
s@CreateWorkload' {} [Text]
a -> CreateWorkload
s {$sel:lenses:CreateWorkload' :: [Text]
lenses = [Text]
a} :: CreateWorkload) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Core.AWSRequest CreateWorkload where
  type
    AWSResponse CreateWorkload =
      CreateWorkloadResponse
  request :: (Service -> Service) -> CreateWorkload -> Request CreateWorkload
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 CreateWorkload
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWorkload)))
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 -> Int -> CreateWorkloadResponse
CreateWorkloadResponse'
            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
"WorkloadArn")
            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
"WorkloadId")
            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 CreateWorkload where
  hashWithSalt :: Int -> CreateWorkload -> Int
hashWithSalt Int
_salt CreateWorkload' {[Text]
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe WorkloadDiscoveryConfig
Text
WorkloadEnvironment
clientRequestToken :: Text
lenses :: [Text]
environment :: WorkloadEnvironment
description :: Text
workloadName :: Text
tags :: Maybe (HashMap Text Text)
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
industryType :: Maybe Text
industry :: Maybe Text
discoveryConfig :: Maybe WorkloadDiscoveryConfig
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:clientRequestToken:CreateWorkload' :: CreateWorkload -> Text
$sel:lenses:CreateWorkload' :: CreateWorkload -> [Text]
$sel:environment:CreateWorkload' :: CreateWorkload -> WorkloadEnvironment
$sel:description:CreateWorkload' :: CreateWorkload -> Text
$sel:workloadName:CreateWorkload' :: CreateWorkload -> Text
$sel:tags:CreateWorkload' :: CreateWorkload -> Maybe (HashMap Text Text)
$sel:reviewOwner:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:pillarPriorities:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:notes:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:nonAwsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:industryType:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:industry:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:discoveryConfig:CreateWorkload' :: CreateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:awsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:architecturalDesign:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:applications:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:accountIds:CreateWorkload' :: CreateWorkload -> 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 WorkloadDiscoveryConfig
discoveryConfig
      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 [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 (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workloadName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WorkloadEnvironment
environment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
lenses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateWorkload where
  rnf :: CreateWorkload -> ()
rnf CreateWorkload' {[Text]
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe WorkloadDiscoveryConfig
Text
WorkloadEnvironment
clientRequestToken :: Text
lenses :: [Text]
environment :: WorkloadEnvironment
description :: Text
workloadName :: Text
tags :: Maybe (HashMap Text Text)
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
industryType :: Maybe Text
industry :: Maybe Text
discoveryConfig :: Maybe WorkloadDiscoveryConfig
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:clientRequestToken:CreateWorkload' :: CreateWorkload -> Text
$sel:lenses:CreateWorkload' :: CreateWorkload -> [Text]
$sel:environment:CreateWorkload' :: CreateWorkload -> WorkloadEnvironment
$sel:description:CreateWorkload' :: CreateWorkload -> Text
$sel:workloadName:CreateWorkload' :: CreateWorkload -> Text
$sel:tags:CreateWorkload' :: CreateWorkload -> Maybe (HashMap Text Text)
$sel:reviewOwner:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:pillarPriorities:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:notes:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:nonAwsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:industryType:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:industry:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:discoveryConfig:CreateWorkload' :: CreateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:awsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:architecturalDesign:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:applications:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:accountIds:CreateWorkload' :: CreateWorkload -> 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 WorkloadDiscoveryConfig
discoveryConfig
      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 [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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workloadName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WorkloadEnvironment
environment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
lenses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

instance Data.ToHeaders CreateWorkload where
  toHeaders :: CreateWorkload -> 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 CreateWorkload where
  toJSON :: CreateWorkload -> Value
toJSON CreateWorkload' {[Text]
Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Maybe WorkloadDiscoveryConfig
Text
WorkloadEnvironment
clientRequestToken :: Text
lenses :: [Text]
environment :: WorkloadEnvironment
description :: Text
workloadName :: Text
tags :: Maybe (HashMap Text Text)
reviewOwner :: Maybe Text
pillarPriorities :: Maybe [Text]
notes :: Maybe Text
nonAwsRegions :: Maybe [Text]
industryType :: Maybe Text
industry :: Maybe Text
discoveryConfig :: Maybe WorkloadDiscoveryConfig
awsRegions :: Maybe [Text]
architecturalDesign :: Maybe Text
applications :: Maybe [Text]
accountIds :: Maybe [Text]
$sel:clientRequestToken:CreateWorkload' :: CreateWorkload -> Text
$sel:lenses:CreateWorkload' :: CreateWorkload -> [Text]
$sel:environment:CreateWorkload' :: CreateWorkload -> WorkloadEnvironment
$sel:description:CreateWorkload' :: CreateWorkload -> Text
$sel:workloadName:CreateWorkload' :: CreateWorkload -> Text
$sel:tags:CreateWorkload' :: CreateWorkload -> Maybe (HashMap Text Text)
$sel:reviewOwner:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:pillarPriorities:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:notes:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:nonAwsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:industryType:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:industry:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:discoveryConfig:CreateWorkload' :: CreateWorkload -> Maybe WorkloadDiscoveryConfig
$sel:awsRegions:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:architecturalDesign:CreateWorkload' :: CreateWorkload -> Maybe Text
$sel:applications:CreateWorkload' :: CreateWorkload -> Maybe [Text]
$sel:accountIds:CreateWorkload' :: CreateWorkload -> 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
"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
"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
"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
"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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkloadName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workloadName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description),
            forall a. a -> Maybe a
Prelude.Just (Key
"Environment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= WorkloadEnvironment
environment),
            forall a. a -> Maybe a
Prelude.Just (Key
"Lenses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
lenses),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateWorkloadResponse' 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:
--
-- 'workloadArn', 'createWorkloadResponse_workloadArn' - Undocumented member.
--
-- 'workloadId', 'createWorkloadResponse_workloadId' - Undocumented member.
--
-- 'httpStatus', 'createWorkloadResponse_httpStatus' - The response's http status code.
newCreateWorkloadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWorkloadResponse
newCreateWorkloadResponse :: Int -> CreateWorkloadResponse
newCreateWorkloadResponse Int
pHttpStatus_ =
  CreateWorkloadResponse'
    { $sel:workloadArn:CreateWorkloadResponse' :: Maybe Text
workloadArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workloadId:CreateWorkloadResponse' :: Maybe Text
workloadId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWorkloadResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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