{-# 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.CreateWorkforce
-- 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 create a workforce. This operation will return an
-- error if a workforce already exists in the Amazon Web Services Region
-- that you specify. You can only create one workforce in each Amazon Web
-- Services Region per Amazon Web Services account.
--
-- If you want to create a new workforce in an Amazon Web Services Region
-- where a workforce already exists, use the API operation to delete the
-- existing workforce and then use @CreateWorkforce@ to create a new
-- workforce.
--
-- To create a private workforce using Amazon Cognito, you must specify a
-- Cognito user pool in @CognitoConfig@. You can also create an Amazon
-- Cognito workforce using the Amazon SageMaker console. For more
-- information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-workforce-create-private.html Create a Private Workforce (Amazon Cognito)>.
--
-- To create a private workforce using your own OIDC Identity Provider
-- (IdP), specify your IdP configuration in @OidcConfig@. Your OIDC IdP
-- must support /groups/ because groups are used by Ground Truth and Amazon
-- A2I to create work teams. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-workforce-create-private-oidc.html Create a Private Workforce (OIDC IdP)>.
module Amazonka.SageMaker.CreateWorkforce
  ( -- * Creating a Request
    CreateWorkforce (..),
    newCreateWorkforce,

    -- * Request Lenses
    createWorkforce_cognitoConfig,
    createWorkforce_oidcConfig,
    createWorkforce_sourceIpConfig,
    createWorkforce_tags,
    createWorkforce_workforceVpcConfig,
    createWorkforce_workforceName,

    -- * Destructuring the Response
    CreateWorkforceResponse (..),
    newCreateWorkforceResponse,

    -- * Response Lenses
    createWorkforceResponse_httpStatus,
    createWorkforceResponse_workforceArn,
  )
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:/ 'newCreateWorkforce' smart constructor.
data CreateWorkforce = CreateWorkforce'
  { -- | Use this parameter to configure an Amazon Cognito private workforce. A
    -- single Cognito workforce is created using and corresponds to a single
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools.html Amazon Cognito user pool>.
    --
    -- Do not use @OidcConfig@ if you specify values for @CognitoConfig@.
    CreateWorkforce -> Maybe CognitoConfig
cognitoConfig :: Prelude.Maybe CognitoConfig,
    -- | Use this parameter to configure a private workforce using your own OIDC
    -- Identity Provider.
    --
    -- Do not use @CognitoConfig@ if you specify values for @OidcConfig@.
    CreateWorkforce -> Maybe OidcConfig
oidcConfig :: Prelude.Maybe OidcConfig,
    CreateWorkforce -> Maybe SourceIpConfig
sourceIpConfig :: Prelude.Maybe SourceIpConfig,
    -- | An array of key-value pairs that contain metadata to help you categorize
    -- and organize our workforce. Each tag consists of a key and a value, both
    -- of which you define.
    CreateWorkforce -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Use this parameter to configure a workforce using VPC.
    CreateWorkforce -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig :: Prelude.Maybe WorkforceVpcConfigRequest,
    -- | The name of the private workforce.
    CreateWorkforce -> Text
workforceName :: Prelude.Text
  }
  deriving (CreateWorkforce -> CreateWorkforce -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkforce -> CreateWorkforce -> Bool
$c/= :: CreateWorkforce -> CreateWorkforce -> Bool
== :: CreateWorkforce -> CreateWorkforce -> Bool
$c== :: CreateWorkforce -> CreateWorkforce -> Bool
Prelude.Eq, Int -> CreateWorkforce -> ShowS
[CreateWorkforce] -> ShowS
CreateWorkforce -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkforce] -> ShowS
$cshowList :: [CreateWorkforce] -> ShowS
show :: CreateWorkforce -> String
$cshow :: CreateWorkforce -> String
showsPrec :: Int -> CreateWorkforce -> ShowS
$cshowsPrec :: Int -> CreateWorkforce -> ShowS
Prelude.Show, forall x. Rep CreateWorkforce x -> CreateWorkforce
forall x. CreateWorkforce -> Rep CreateWorkforce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkforce x -> CreateWorkforce
$cfrom :: forall x. CreateWorkforce -> Rep CreateWorkforce x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkforce' 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:
--
-- 'cognitoConfig', 'createWorkforce_cognitoConfig' - Use this parameter to configure an Amazon Cognito private workforce. A
-- single Cognito workforce is created using and corresponds to a single
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools.html Amazon Cognito user pool>.
--
-- Do not use @OidcConfig@ if you specify values for @CognitoConfig@.
--
-- 'oidcConfig', 'createWorkforce_oidcConfig' - Use this parameter to configure a private workforce using your own OIDC
-- Identity Provider.
--
-- Do not use @CognitoConfig@ if you specify values for @OidcConfig@.
--
-- 'sourceIpConfig', 'createWorkforce_sourceIpConfig' - Undocumented member.
--
-- 'tags', 'createWorkforce_tags' - An array of key-value pairs that contain metadata to help you categorize
-- and organize our workforce. Each tag consists of a key and a value, both
-- of which you define.
--
-- 'workforceVpcConfig', 'createWorkforce_workforceVpcConfig' - Use this parameter to configure a workforce using VPC.
--
-- 'workforceName', 'createWorkforce_workforceName' - The name of the private workforce.
newCreateWorkforce ::
  -- | 'workforceName'
  Prelude.Text ->
  CreateWorkforce
newCreateWorkforce :: Text -> CreateWorkforce
newCreateWorkforce Text
pWorkforceName_ =
  CreateWorkforce'
    { $sel:cognitoConfig:CreateWorkforce' :: Maybe CognitoConfig
cognitoConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:oidcConfig:CreateWorkforce' :: Maybe OidcConfig
oidcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceIpConfig:CreateWorkforce' :: Maybe SourceIpConfig
sourceIpConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateWorkforce' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:workforceVpcConfig:CreateWorkforce' :: Maybe WorkforceVpcConfigRequest
workforceVpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:workforceName:CreateWorkforce' :: Text
workforceName = Text
pWorkforceName_
    }

-- | Use this parameter to configure an Amazon Cognito private workforce. A
-- single Cognito workforce is created using and corresponds to a single
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools.html Amazon Cognito user pool>.
--
-- Do not use @OidcConfig@ if you specify values for @CognitoConfig@.
createWorkforce_cognitoConfig :: Lens.Lens' CreateWorkforce (Prelude.Maybe CognitoConfig)
createWorkforce_cognitoConfig :: Lens' CreateWorkforce (Maybe CognitoConfig)
createWorkforce_cognitoConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Maybe CognitoConfig
cognitoConfig :: Maybe CognitoConfig
$sel:cognitoConfig:CreateWorkforce' :: CreateWorkforce -> Maybe CognitoConfig
cognitoConfig} -> Maybe CognitoConfig
cognitoConfig) (\s :: CreateWorkforce
s@CreateWorkforce' {} Maybe CognitoConfig
a -> CreateWorkforce
s {$sel:cognitoConfig:CreateWorkforce' :: Maybe CognitoConfig
cognitoConfig = Maybe CognitoConfig
a} :: CreateWorkforce)

-- | Use this parameter to configure a private workforce using your own OIDC
-- Identity Provider.
--
-- Do not use @CognitoConfig@ if you specify values for @OidcConfig@.
createWorkforce_oidcConfig :: Lens.Lens' CreateWorkforce (Prelude.Maybe OidcConfig)
createWorkforce_oidcConfig :: Lens' CreateWorkforce (Maybe OidcConfig)
createWorkforce_oidcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Maybe OidcConfig
oidcConfig :: Maybe OidcConfig
$sel:oidcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe OidcConfig
oidcConfig} -> Maybe OidcConfig
oidcConfig) (\s :: CreateWorkforce
s@CreateWorkforce' {} Maybe OidcConfig
a -> CreateWorkforce
s {$sel:oidcConfig:CreateWorkforce' :: Maybe OidcConfig
oidcConfig = Maybe OidcConfig
a} :: CreateWorkforce)

-- | Undocumented member.
createWorkforce_sourceIpConfig :: Lens.Lens' CreateWorkforce (Prelude.Maybe SourceIpConfig)
createWorkforce_sourceIpConfig :: Lens' CreateWorkforce (Maybe SourceIpConfig)
createWorkforce_sourceIpConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Maybe SourceIpConfig
sourceIpConfig :: Maybe SourceIpConfig
$sel:sourceIpConfig:CreateWorkforce' :: CreateWorkforce -> Maybe SourceIpConfig
sourceIpConfig} -> Maybe SourceIpConfig
sourceIpConfig) (\s :: CreateWorkforce
s@CreateWorkforce' {} Maybe SourceIpConfig
a -> CreateWorkforce
s {$sel:sourceIpConfig:CreateWorkforce' :: Maybe SourceIpConfig
sourceIpConfig = Maybe SourceIpConfig
a} :: CreateWorkforce)

-- | An array of key-value pairs that contain metadata to help you categorize
-- and organize our workforce. Each tag consists of a key and a value, both
-- of which you define.
createWorkforce_tags :: Lens.Lens' CreateWorkforce (Prelude.Maybe [Tag])
createWorkforce_tags :: Lens' CreateWorkforce (Maybe [Tag])
createWorkforce_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateWorkforce' :: CreateWorkforce -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateWorkforce
s@CreateWorkforce' {} Maybe [Tag]
a -> CreateWorkforce
s {$sel:tags:CreateWorkforce' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateWorkforce) 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

-- | Use this parameter to configure a workforce using VPC.
createWorkforce_workforceVpcConfig :: Lens.Lens' CreateWorkforce (Prelude.Maybe WorkforceVpcConfigRequest)
createWorkforce_workforceVpcConfig :: Lens' CreateWorkforce (Maybe WorkforceVpcConfigRequest)
createWorkforce_workforceVpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Maybe WorkforceVpcConfigRequest
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
$sel:workforceVpcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig} -> Maybe WorkforceVpcConfigRequest
workforceVpcConfig) (\s :: CreateWorkforce
s@CreateWorkforce' {} Maybe WorkforceVpcConfigRequest
a -> CreateWorkforce
s {$sel:workforceVpcConfig:CreateWorkforce' :: Maybe WorkforceVpcConfigRequest
workforceVpcConfig = Maybe WorkforceVpcConfigRequest
a} :: CreateWorkforce)

-- | The name of the private workforce.
createWorkforce_workforceName :: Lens.Lens' CreateWorkforce Prelude.Text
createWorkforce_workforceName :: Lens' CreateWorkforce Text
createWorkforce_workforceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforce' {Text
workforceName :: Text
$sel:workforceName:CreateWorkforce' :: CreateWorkforce -> Text
workforceName} -> Text
workforceName) (\s :: CreateWorkforce
s@CreateWorkforce' {} Text
a -> CreateWorkforce
s {$sel:workforceName:CreateWorkforce' :: Text
workforceName = Text
a} :: CreateWorkforce)

instance Core.AWSRequest CreateWorkforce where
  type
    AWSResponse CreateWorkforce =
      CreateWorkforceResponse
  request :: (Service -> Service) -> CreateWorkforce -> Request CreateWorkforce
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 CreateWorkforce
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWorkforce)))
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 -> Text -> CreateWorkforceResponse
CreateWorkforceResponse'
            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
"WorkforceArn")
      )

instance Prelude.Hashable CreateWorkforce where
  hashWithSalt :: Int -> CreateWorkforce -> Int
hashWithSalt Int
_salt CreateWorkforce' {Maybe [Tag]
Maybe CognitoConfig
Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
tags :: Maybe [Tag]
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
cognitoConfig :: Maybe CognitoConfig
$sel:workforceName:CreateWorkforce' :: CreateWorkforce -> Text
$sel:workforceVpcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:tags:CreateWorkforce' :: CreateWorkforce -> Maybe [Tag]
$sel:sourceIpConfig:CreateWorkforce' :: CreateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe OidcConfig
$sel:cognitoConfig:CreateWorkforce' :: CreateWorkforce -> Maybe CognitoConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CognitoConfig
cognitoConfig
      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 [Tag]
tags
      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 CreateWorkforce where
  rnf :: CreateWorkforce -> ()
rnf CreateWorkforce' {Maybe [Tag]
Maybe CognitoConfig
Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
tags :: Maybe [Tag]
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
cognitoConfig :: Maybe CognitoConfig
$sel:workforceName:CreateWorkforce' :: CreateWorkforce -> Text
$sel:workforceVpcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:tags:CreateWorkforce' :: CreateWorkforce -> Maybe [Tag]
$sel:sourceIpConfig:CreateWorkforce' :: CreateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe OidcConfig
$sel:cognitoConfig:CreateWorkforce' :: CreateWorkforce -> Maybe CognitoConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CognitoConfig
cognitoConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Tag]
tags
      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 CreateWorkforce where
  toHeaders :: CreateWorkforce -> 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.CreateWorkforce" :: 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 CreateWorkforce where
  toJSON :: CreateWorkforce -> Value
toJSON CreateWorkforce' {Maybe [Tag]
Maybe CognitoConfig
Maybe OidcConfig
Maybe SourceIpConfig
Maybe WorkforceVpcConfigRequest
Text
workforceName :: Text
workforceVpcConfig :: Maybe WorkforceVpcConfigRequest
tags :: Maybe [Tag]
sourceIpConfig :: Maybe SourceIpConfig
oidcConfig :: Maybe OidcConfig
cognitoConfig :: Maybe CognitoConfig
$sel:workforceName:CreateWorkforce' :: CreateWorkforce -> Text
$sel:workforceVpcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe WorkforceVpcConfigRequest
$sel:tags:CreateWorkforce' :: CreateWorkforce -> Maybe [Tag]
$sel:sourceIpConfig:CreateWorkforce' :: CreateWorkforce -> Maybe SourceIpConfig
$sel:oidcConfig:CreateWorkforce' :: CreateWorkforce -> Maybe OidcConfig
$sel:cognitoConfig:CreateWorkforce' :: CreateWorkforce -> Maybe CognitoConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CognitoConfig" 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 CognitoConfig
cognitoConfig,
            (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
"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 [Tag]
tags,
            (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 CreateWorkforce where
  toPath :: CreateWorkforce -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateWorkforceResponse' smart constructor.
data CreateWorkforceResponse = CreateWorkforceResponse'
  { -- | The response's http status code.
    CreateWorkforceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the workforce.
    CreateWorkforceResponse -> Text
workforceArn :: Prelude.Text
  }
  deriving (CreateWorkforceResponse -> CreateWorkforceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkforceResponse -> CreateWorkforceResponse -> Bool
$c/= :: CreateWorkforceResponse -> CreateWorkforceResponse -> Bool
== :: CreateWorkforceResponse -> CreateWorkforceResponse -> Bool
$c== :: CreateWorkforceResponse -> CreateWorkforceResponse -> Bool
Prelude.Eq, ReadPrec [CreateWorkforceResponse]
ReadPrec CreateWorkforceResponse
Int -> ReadS CreateWorkforceResponse
ReadS [CreateWorkforceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkforceResponse]
$creadListPrec :: ReadPrec [CreateWorkforceResponse]
readPrec :: ReadPrec CreateWorkforceResponse
$creadPrec :: ReadPrec CreateWorkforceResponse
readList :: ReadS [CreateWorkforceResponse]
$creadList :: ReadS [CreateWorkforceResponse]
readsPrec :: Int -> ReadS CreateWorkforceResponse
$creadsPrec :: Int -> ReadS CreateWorkforceResponse
Prelude.Read, Int -> CreateWorkforceResponse -> ShowS
[CreateWorkforceResponse] -> ShowS
CreateWorkforceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkforceResponse] -> ShowS
$cshowList :: [CreateWorkforceResponse] -> ShowS
show :: CreateWorkforceResponse -> String
$cshow :: CreateWorkforceResponse -> String
showsPrec :: Int -> CreateWorkforceResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkforceResponse -> ShowS
Prelude.Show, forall x. Rep CreateWorkforceResponse x -> CreateWorkforceResponse
forall x. CreateWorkforceResponse -> Rep CreateWorkforceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkforceResponse x -> CreateWorkforceResponse
$cfrom :: forall x. CreateWorkforceResponse -> Rep CreateWorkforceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkforceResponse' 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', 'createWorkforceResponse_httpStatus' - The response's http status code.
--
-- 'workforceArn', 'createWorkforceResponse_workforceArn' - The Amazon Resource Name (ARN) of the workforce.
newCreateWorkforceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workforceArn'
  Prelude.Text ->
  CreateWorkforceResponse
newCreateWorkforceResponse :: Int -> Text -> CreateWorkforceResponse
newCreateWorkforceResponse
  Int
pHttpStatus_
  Text
pWorkforceArn_ =
    CreateWorkforceResponse'
      { $sel:httpStatus:CreateWorkforceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:workforceArn:CreateWorkforceResponse' :: Text
workforceArn = Text
pWorkforceArn_
      }

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

-- | The Amazon Resource Name (ARN) of the workforce.
createWorkforceResponse_workforceArn :: Lens.Lens' CreateWorkforceResponse Prelude.Text
createWorkforceResponse_workforceArn :: Lens' CreateWorkforceResponse Text
createWorkforceResponse_workforceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkforceResponse' {Text
workforceArn :: Text
$sel:workforceArn:CreateWorkforceResponse' :: CreateWorkforceResponse -> Text
workforceArn} -> Text
workforceArn) (\s :: CreateWorkforceResponse
s@CreateWorkforceResponse' {} Text
a -> CreateWorkforceResponse
s {$sel:workforceArn:CreateWorkforceResponse' :: Text
workforceArn = Text
a} :: CreateWorkforceResponse)

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