{-# 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.SageMaker.UpdateWorkforce
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to update your workforce. You can use this operation
-- to require that workers use specific IP addresses to work on tasks and
-- to update your OpenID Connect (OIDC) Identity Provider (IdP) workforce
-- configuration.
--
-- The worker portal is now supported in VPC and public internet.
--
-- Use @SourceIpConfig@ to restrict worker access to tasks to a specific
-- range of IP addresses. You specify allowed IP addresses by creating a
-- list of up to ten
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html CIDRs>.
-- By default, a workforce isn\'t restricted to specific IP addresses. If
-- you specify a range of IP addresses, workers who attempt to access tasks
-- using any IP address outside the specified range are denied and get a
-- @Not Found@ error message on the worker portal.
--
-- To restrict access to all the workers in public internet, add the
-- @SourceIpConfig@ CIDR value as \"0.0.0.0\/0\".
--
-- Amazon SageMaker does not support Source Ip restriction for worker
-- portals in VPC.
--
-- Use @OidcConfig@ to update the configuration of a workforce created
-- using your own OIDC IdP.
--
-- You can only update your OIDC IdP configuration when there are no work
-- teams associated with your workforce. You can delete work teams using
-- the operation.
--
-- After restricting access to a range of IP addresses or updating your
-- OIDC IdP configuration with this operation, you can view details about
-- your update workforce using the operation.
--
-- This operation only applies to private workforces.
module Amazonka.SageMaker.UpdateWorkforce
  ( -- * Creating a Request
    UpdateWorkforce (..),
    newUpdateWorkforce,

    -- * Request Lenses
    updateWorkforce_oidcConfig,
    updateWorkforce_sourceIpConfig,
    updateWorkforce_workforceVpcConfig,
    updateWorkforce_workforceName,

    -- * Destructuring the Response
    UpdateWorkforceResponse (..),
    newUpdateWorkforceResponse,

    -- * Response Lenses
    updateWorkforceResponse_httpStatus,
    updateWorkforceResponse_workforce,
  )
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.SageMaker.Types

-- | /See:/ 'newUpdateWorkforce' smart constructor.
data UpdateWorkforce = UpdateWorkforce'
  { -- | Use this parameter to update your OIDC Identity Provider (IdP)
    -- configuration for a workforce made using your own IdP.
    UpdateWorkforce -> Maybe OidcConfig
oidcConfig :: Prelude.Maybe OidcConfig,
    -- | A list of one to ten worker IP address ranges
    -- (<https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html CIDRs>)
    -- that can be used to access tasks assigned to this workforce.
    --
    -- Maximum: Ten CIDR values
    UpdateWorkforce -> Maybe SourceIpConfig
sourceIpConfig :: Prelude.Maybe SourceIpConfig,
    -- | Use this parameter to update your VPC configuration for a workforce.
    UpdateWorkforce -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig :: Prelude.Maybe WorkforceVpcConfigRequest,
    -- | The name of the private workforce that you want to update. You can find
    -- your workforce name by using the operation.
    UpdateWorkforce -> Text
workforceName :: Prelude.Text
  }
  deriving (UpdateWorkforce -> UpdateWorkforce -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkforce -> UpdateWorkforce -> Bool
$c/= :: UpdateWorkforce -> UpdateWorkforce -> Bool
== :: UpdateWorkforce -> UpdateWorkforce -> Bool
$c== :: UpdateWorkforce -> UpdateWorkforce -> Bool
Prelude.Eq, Int -> UpdateWorkforce -> ShowS
[UpdateWorkforce] -> ShowS
UpdateWorkforce -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkforce] -> ShowS
$cshowList :: [UpdateWorkforce] -> ShowS
show :: UpdateWorkforce -> String
$cshow :: UpdateWorkforce -> String
showsPrec :: Int -> UpdateWorkforce -> ShowS
$cshowsPrec :: Int -> UpdateWorkforce -> ShowS
Prelude.Show, forall x. Rep UpdateWorkforce x -> UpdateWorkforce
forall x. UpdateWorkforce -> Rep UpdateWorkforce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorkforce x -> UpdateWorkforce
$cfrom :: forall x. UpdateWorkforce -> Rep UpdateWorkforce x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkforce' 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:
--
-- 'oidcConfig', 'updateWorkforce_oidcConfig' - Use this parameter to update your OIDC Identity Provider (IdP)
-- configuration for a workforce made using your own IdP.
--
-- 'sourceIpConfig', 'updateWorkforce_sourceIpConfig' - A list of one to ten worker IP address ranges
-- (<https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html CIDRs>)
-- that can be used to access tasks assigned to this workforce.
--
-- Maximum: Ten CIDR values
--
-- 'workforceVpcConfig', 'updateWorkforce_workforceVpcConfig' - Use this parameter to update your VPC configuration for a workforce.
--
-- 'workforceName', 'updateWorkforce_workforceName' - The name of the private workforce that you want to update. You can find
-- your workforce name by using the operation.
newUpdateWorkforce ::
  -- | 'workforceName'
  Prelude.Text ->
  UpdateWorkforce
newUpdateWorkforce :: Text -> UpdateWorkforce
newUpdateWorkforce Text
pWorkforceName_ =
  UpdateWorkforce'
    { $sel:oidcConfig:UpdateWorkforce' :: Maybe OidcConfig
oidcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceIpConfig:UpdateWorkforce' :: Maybe SourceIpConfig
sourceIpConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:workforceVpcConfig:UpdateWorkforce' :: Maybe WorkforceVpcConfigRequest
workforceVpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:workforceName:UpdateWorkforce' :: Text
workforceName = Text
pWorkforceName_
    }

-- | Use this parameter to update your OIDC Identity Provider (IdP)
-- configuration for a workforce made using your own IdP.
updateWorkforce_oidcConfig :: Lens.Lens' UpdateWorkforce (Prelude.Maybe OidcConfig)
updateWorkforce_oidcConfig :: Lens' UpdateWorkforce (Maybe OidcConfig)
updateWorkforce_oidcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkforce' {Maybe OidcConfig
oidcConfig :: Maybe OidcConfig
$sel:oidcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe OidcConfig
oidcConfig} -> Maybe OidcConfig
oidcConfig) (\s :: UpdateWorkforce
s@UpdateWorkforce' {} Maybe OidcConfig
a -> UpdateWorkforce
s {$sel:oidcConfig:UpdateWorkforce' :: Maybe OidcConfig
oidcConfig = Maybe OidcConfig
a} :: UpdateWorkforce)

-- | A list of one to ten worker IP address ranges
-- (<https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html CIDRs>)
-- that can be used to access tasks assigned to this workforce.
--
-- Maximum: Ten CIDR values
updateWorkforce_sourceIpConfig :: Lens.Lens' UpdateWorkforce (Prelude.Maybe SourceIpConfig)
updateWorkforce_sourceIpConfig :: Lens' UpdateWorkforce (Maybe SourceIpConfig)
updateWorkforce_sourceIpConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkforce' {Maybe SourceIpConfig
sourceIpConfig :: Maybe SourceIpConfig
$sel:sourceIpConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe SourceIpConfig
sourceIpConfig} -> Maybe SourceIpConfig
sourceIpConfig) (\s :: UpdateWorkforce
s@UpdateWorkforce' {} Maybe SourceIpConfig
a -> UpdateWorkforce
s {$sel:sourceIpConfig:UpdateWorkforce' :: Maybe SourceIpConfig
sourceIpConfig = Maybe SourceIpConfig
a} :: UpdateWorkforce)

-- | Use this parameter to update your VPC configuration for a workforce.
updateWorkforce_workforceVpcConfig :: Lens.Lens' UpdateWorkforce (Prelude.Maybe WorkforceVpcConfigRequest)
updateWorkforce_workforceVpcConfig :: Lens' UpdateWorkforce (Maybe WorkforceVpcConfigRequest)
updateWorkforce_workforceVpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkforce' {Maybe WorkforceVpcConfigRequest
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
$sel:workforceVpcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig} -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig) (\s :: UpdateWorkforce
s@UpdateWorkforce' {} Maybe WorkforceVpcConfigRequest
a -> UpdateWorkforce
s {$sel:workforceVpcConfig:UpdateWorkforce' :: Maybe WorkforceVpcConfigRequest
workforceVpcConfig = Maybe WorkforceVpcConfigRequest
a} :: UpdateWorkforce)

-- | The name of the private workforce that you want to update. You can find
-- your workforce name by using the operation.
updateWorkforce_workforceName :: Lens.Lens' UpdateWorkforce Prelude.Text
updateWorkforce_workforceName :: Lens' UpdateWorkforce Text
updateWorkforce_workforceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkforce' {Text
workforceName :: Text
$sel:workforceName:UpdateWorkforce' :: UpdateWorkforce -> Text
workforceName} -> Text
workforceName) (\s :: UpdateWorkforce
s@UpdateWorkforce' {} Text
a -> UpdateWorkforce
s {$sel:workforceName:UpdateWorkforce' :: Text
workforceName = Text
a} :: UpdateWorkforce)

instance Core.AWSRequest UpdateWorkforce where
  type
    AWSResponse UpdateWorkforce =
      UpdateWorkforceResponse
  request :: (Service -> Service) -> UpdateWorkforce -> Request UpdateWorkforce
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 UpdateWorkforce
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateWorkforce)))
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 ->
          Int -> Workforce -> UpdateWorkforceResponse
UpdateWorkforceResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Workforce")
      )

instance Prelude.Hashable UpdateWorkforce where
  hashWithSalt :: Int -> UpdateWorkforce -> Int
hashWithSalt Int
_salt UpdateWorkforce' {Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
$sel:workforceName:UpdateWorkforce' :: UpdateWorkforce -> Text
$sel:workforceVpcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:sourceIpConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe OidcConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OidcConfig
oidcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceIpConfig
sourceIpConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkforceVpcConfigRequest
workforceVpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workforceName

instance Prelude.NFData UpdateWorkforce where
  rnf :: UpdateWorkforce -> ()
rnf UpdateWorkforce' {Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
$sel:workforceName:UpdateWorkforce' :: UpdateWorkforce -> Text
$sel:workforceVpcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:sourceIpConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe OidcConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OidcConfig
oidcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceIpConfig
sourceIpConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkforceVpcConfigRequest
workforceVpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workforceName

instance Data.ToHeaders UpdateWorkforce where
  toHeaders :: UpdateWorkforce -> 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
"SageMaker.UpdateWorkforce" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateWorkforce where
  toJSON :: UpdateWorkforce -> Value
toJSON UpdateWorkforce' {Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
$sel:workforceName:UpdateWorkforce' :: UpdateWorkforce -> Text
$sel:workforceVpcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:sourceIpConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:UpdateWorkforce' :: UpdateWorkforce -> Maybe OidcConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OidcConfig" 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 OidcConfig
oidcConfig,
            (Key
"SourceIpConfig" 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 SourceIpConfig
sourceIpConfig,
            (Key
"WorkforceVpcConfig" 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 WorkforceVpcConfigRequest
workforceVpcConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"WorkforceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workforceName)
          ]
      )

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

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

-- | /See:/ 'newUpdateWorkforceResponse' smart constructor.
data UpdateWorkforceResponse = UpdateWorkforceResponse'
  { -- | The response's http status code.
    UpdateWorkforceResponse -> Int
httpStatus :: Prelude.Int,
    -- | A single private workforce. You can create one private work force in
    -- each Amazon Web Services Region. By default, any workforce-related API
    -- operation used in a specific region will apply to the workforce created
    -- in that region. To learn how to create a private workforce, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-workforce-create-private.html Create a Private Workforce>.
    UpdateWorkforceResponse -> Workforce
workforce :: Workforce
  }
  deriving (UpdateWorkforceResponse -> UpdateWorkforceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkforceResponse -> UpdateWorkforceResponse -> Bool
$c/= :: UpdateWorkforceResponse -> UpdateWorkforceResponse -> Bool
== :: UpdateWorkforceResponse -> UpdateWorkforceResponse -> Bool
$c== :: UpdateWorkforceResponse -> UpdateWorkforceResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWorkforceResponse]
ReadPrec UpdateWorkforceResponse
Int -> ReadS UpdateWorkforceResponse
ReadS [UpdateWorkforceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkforceResponse]
$creadListPrec :: ReadPrec [UpdateWorkforceResponse]
readPrec :: ReadPrec UpdateWorkforceResponse
$creadPrec :: ReadPrec UpdateWorkforceResponse
readList :: ReadS [UpdateWorkforceResponse]
$creadList :: ReadS [UpdateWorkforceResponse]
readsPrec :: Int -> ReadS UpdateWorkforceResponse
$creadsPrec :: Int -> ReadS UpdateWorkforceResponse
Prelude.Read, Int -> UpdateWorkforceResponse -> ShowS
[UpdateWorkforceResponse] -> ShowS
UpdateWorkforceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkforceResponse] -> ShowS
$cshowList :: [UpdateWorkforceResponse] -> ShowS
show :: UpdateWorkforceResponse -> String
$cshow :: UpdateWorkforceResponse -> String
showsPrec :: Int -> UpdateWorkforceResponse -> ShowS
$cshowsPrec :: Int -> UpdateWorkforceResponse -> ShowS
Prelude.Show, forall x. Rep UpdateWorkforceResponse x -> UpdateWorkforceResponse
forall x. UpdateWorkforceResponse -> Rep UpdateWorkforceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWorkforceResponse x -> UpdateWorkforceResponse
$cfrom :: forall x. UpdateWorkforceResponse -> Rep UpdateWorkforceResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkforceResponse' 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:
--
-- 'httpStatus', 'updateWorkforceResponse_httpStatus' - The response's http status code.
--
-- 'workforce', 'updateWorkforceResponse_workforce' - A single private workforce. You can create one private work force in
-- each Amazon Web Services Region. By default, any workforce-related API
-- operation used in a specific region will apply to the workforce created
-- in that region. To learn how to create a private workforce, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-workforce-create-private.html Create a Private Workforce>.
newUpdateWorkforceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workforce'
  Workforce ->
  UpdateWorkforceResponse
newUpdateWorkforceResponse :: Int -> Workforce -> UpdateWorkforceResponse
newUpdateWorkforceResponse Int
pHttpStatus_ Workforce
pWorkforce_ =
  UpdateWorkforceResponse'
    { $sel:httpStatus:UpdateWorkforceResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:workforce:UpdateWorkforceResponse' :: Workforce
workforce = Workforce
pWorkforce_
    }

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

-- | A single private workforce. You can create one private work force in
-- each Amazon Web Services Region. By default, any workforce-related API
-- operation used in a specific region will apply to the workforce created
-- in that region. To learn how to create a private workforce, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-workforce-create-private.html Create a Private Workforce>.
updateWorkforceResponse_workforce :: Lens.Lens' UpdateWorkforceResponse Workforce
updateWorkforceResponse_workforce :: Lens' UpdateWorkforceResponse Workforce
updateWorkforceResponse_workforce = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkforceResponse' {Workforce
workforce :: Workforce
$sel:workforce:UpdateWorkforceResponse' :: UpdateWorkforceResponse -> Workforce
workforce} -> Workforce
workforce) (\s :: UpdateWorkforceResponse
s@UpdateWorkforceResponse' {} Workforce
a -> UpdateWorkforceResponse
s {$sel:workforce:UpdateWorkforceResponse' :: Workforce
workforce = Workforce
a} :: UpdateWorkforceResponse)

instance Prelude.NFData UpdateWorkforceResponse where
  rnf :: UpdateWorkforceResponse -> ()
rnf UpdateWorkforceResponse' {Int
Workforce
workforce :: Workforce
httpStatus :: Int
$sel:workforce:UpdateWorkforceResponse' :: UpdateWorkforceResponse -> Workforce
$sel:httpStatus:UpdateWorkforceResponse' :: UpdateWorkforceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Workforce
workforce