{-# 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.KafkaConnect.CreateWorkerConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a worker configuration using the specified properties.
module Amazonka.KafkaConnect.CreateWorkerConfiguration
  ( -- * Creating a Request
    CreateWorkerConfiguration (..),
    newCreateWorkerConfiguration,

    -- * Request Lenses
    createWorkerConfiguration_description,
    createWorkerConfiguration_name,
    createWorkerConfiguration_propertiesFileContent,

    -- * Destructuring the Response
    CreateWorkerConfigurationResponse (..),
    newCreateWorkerConfigurationResponse,

    -- * Response Lenses
    createWorkerConfigurationResponse_creationTime,
    createWorkerConfigurationResponse_latestRevision,
    createWorkerConfigurationResponse_name,
    createWorkerConfigurationResponse_workerConfigurationArn,
    createWorkerConfigurationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KafkaConnect.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateWorkerConfiguration' smart constructor.
data CreateWorkerConfiguration = CreateWorkerConfiguration'
  { -- | A summary description of the worker configuration.
    CreateWorkerConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the worker configuration.
    CreateWorkerConfiguration -> Text
name :: Prelude.Text,
    -- | Base64 encoded contents of connect-distributed.properties file.
    CreateWorkerConfiguration -> Sensitive Text
propertiesFileContent :: Data.Sensitive Prelude.Text
  }
  deriving (CreateWorkerConfiguration -> CreateWorkerConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkerConfiguration -> CreateWorkerConfiguration -> Bool
$c/= :: CreateWorkerConfiguration -> CreateWorkerConfiguration -> Bool
== :: CreateWorkerConfiguration -> CreateWorkerConfiguration -> Bool
$c== :: CreateWorkerConfiguration -> CreateWorkerConfiguration -> Bool
Prelude.Eq, Int -> CreateWorkerConfiguration -> ShowS
[CreateWorkerConfiguration] -> ShowS
CreateWorkerConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkerConfiguration] -> ShowS
$cshowList :: [CreateWorkerConfiguration] -> ShowS
show :: CreateWorkerConfiguration -> String
$cshow :: CreateWorkerConfiguration -> String
showsPrec :: Int -> CreateWorkerConfiguration -> ShowS
$cshowsPrec :: Int -> CreateWorkerConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateWorkerConfiguration x -> CreateWorkerConfiguration
forall x.
CreateWorkerConfiguration -> Rep CreateWorkerConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWorkerConfiguration x -> CreateWorkerConfiguration
$cfrom :: forall x.
CreateWorkerConfiguration -> Rep CreateWorkerConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkerConfiguration' 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:
--
-- 'description', 'createWorkerConfiguration_description' - A summary description of the worker configuration.
--
-- 'name', 'createWorkerConfiguration_name' - The name of the worker configuration.
--
-- 'propertiesFileContent', 'createWorkerConfiguration_propertiesFileContent' - Base64 encoded contents of connect-distributed.properties file.
newCreateWorkerConfiguration ::
  -- | 'name'
  Prelude.Text ->
  -- | 'propertiesFileContent'
  Prelude.Text ->
  CreateWorkerConfiguration
newCreateWorkerConfiguration :: Text -> Text -> CreateWorkerConfiguration
newCreateWorkerConfiguration
  Text
pName_
  Text
pPropertiesFileContent_ =
    CreateWorkerConfiguration'
      { $sel:description:CreateWorkerConfiguration' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateWorkerConfiguration' :: Text
name = Text
pName_,
        $sel:propertiesFileContent:CreateWorkerConfiguration' :: Sensitive Text
propertiesFileContent =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPropertiesFileContent_
      }

-- | A summary description of the worker configuration.
createWorkerConfiguration_description :: Lens.Lens' CreateWorkerConfiguration (Prelude.Maybe Prelude.Text)
createWorkerConfiguration_description :: Lens' CreateWorkerConfiguration (Maybe Text)
createWorkerConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfiguration' {Maybe Text
description :: Maybe Text
$sel:description:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateWorkerConfiguration
s@CreateWorkerConfiguration' {} Maybe Text
a -> CreateWorkerConfiguration
s {$sel:description:CreateWorkerConfiguration' :: Maybe Text
description = Maybe Text
a} :: CreateWorkerConfiguration)

-- | The name of the worker configuration.
createWorkerConfiguration_name :: Lens.Lens' CreateWorkerConfiguration Prelude.Text
createWorkerConfiguration_name :: Lens' CreateWorkerConfiguration Text
createWorkerConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfiguration' {Text
name :: Text
$sel:name:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Text
name} -> Text
name) (\s :: CreateWorkerConfiguration
s@CreateWorkerConfiguration' {} Text
a -> CreateWorkerConfiguration
s {$sel:name:CreateWorkerConfiguration' :: Text
name = Text
a} :: CreateWorkerConfiguration)

-- | Base64 encoded contents of connect-distributed.properties file.
createWorkerConfiguration_propertiesFileContent :: Lens.Lens' CreateWorkerConfiguration Prelude.Text
createWorkerConfiguration_propertiesFileContent :: Lens' CreateWorkerConfiguration Text
createWorkerConfiguration_propertiesFileContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfiguration' {Sensitive Text
propertiesFileContent :: Sensitive Text
$sel:propertiesFileContent:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Sensitive Text
propertiesFileContent} -> Sensitive Text
propertiesFileContent) (\s :: CreateWorkerConfiguration
s@CreateWorkerConfiguration' {} Sensitive Text
a -> CreateWorkerConfiguration
s {$sel:propertiesFileContent:CreateWorkerConfiguration' :: Sensitive Text
propertiesFileContent = Sensitive Text
a} :: CreateWorkerConfiguration) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateWorkerConfiguration where
  type
    AWSResponse CreateWorkerConfiguration =
      CreateWorkerConfigurationResponse
  request :: (Service -> Service)
-> CreateWorkerConfiguration -> Request CreateWorkerConfiguration
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 CreateWorkerConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateWorkerConfiguration)))
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 ISO8601
-> Maybe WorkerConfigurationRevisionSummary
-> Maybe Text
-> Maybe Text
-> Int
-> CreateWorkerConfigurationResponse
CreateWorkerConfigurationResponse'
            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
"creationTime")
            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
"latestRevision")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"workerConfigurationArn")
            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 CreateWorkerConfiguration where
  hashWithSalt :: Int -> CreateWorkerConfiguration -> Int
hashWithSalt Int
_salt CreateWorkerConfiguration' {Maybe Text
Text
Sensitive Text
propertiesFileContent :: Sensitive Text
name :: Text
description :: Maybe Text
$sel:propertiesFileContent:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Sensitive Text
$sel:name:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Text
$sel:description:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
propertiesFileContent

instance Prelude.NFData CreateWorkerConfiguration where
  rnf :: CreateWorkerConfiguration -> ()
rnf CreateWorkerConfiguration' {Maybe Text
Text
Sensitive Text
propertiesFileContent :: Sensitive Text
name :: Text
description :: Maybe Text
$sel:propertiesFileContent:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Sensitive Text
$sel:name:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Text
$sel:description:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
propertiesFileContent

instance Data.ToHeaders CreateWorkerConfiguration where
  toHeaders :: CreateWorkerConfiguration -> 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 CreateWorkerConfiguration where
  toJSON :: CreateWorkerConfiguration -> Value
toJSON CreateWorkerConfiguration' {Maybe Text
Text
Sensitive Text
propertiesFileContent :: Sensitive Text
name :: Text
description :: Maybe Text
$sel:propertiesFileContent:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Sensitive Text
$sel:name:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Text
$sel:description:CreateWorkerConfiguration' :: CreateWorkerConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"propertiesFileContent"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
propertiesFileContent
              )
          ]
      )

instance Data.ToPath CreateWorkerConfiguration where
  toPath :: CreateWorkerConfiguration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/worker-configurations"

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

-- | /See:/ 'newCreateWorkerConfigurationResponse' smart constructor.
data CreateWorkerConfigurationResponse = CreateWorkerConfigurationResponse'
  { -- | The time that the worker configuration was created.
    CreateWorkerConfigurationResponse -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The latest revision of the worker configuration.
    CreateWorkerConfigurationResponse
-> Maybe WorkerConfigurationRevisionSummary
latestRevision :: Prelude.Maybe WorkerConfigurationRevisionSummary,
    -- | The name of the worker configuration.
    CreateWorkerConfigurationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) that Amazon assigned to the worker
    -- configuration.
    CreateWorkerConfigurationResponse -> Maybe Text
workerConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateWorkerConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateWorkerConfigurationResponse
-> CreateWorkerConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkerConfigurationResponse
-> CreateWorkerConfigurationResponse -> Bool
$c/= :: CreateWorkerConfigurationResponse
-> CreateWorkerConfigurationResponse -> Bool
== :: CreateWorkerConfigurationResponse
-> CreateWorkerConfigurationResponse -> Bool
$c== :: CreateWorkerConfigurationResponse
-> CreateWorkerConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [CreateWorkerConfigurationResponse]
ReadPrec CreateWorkerConfigurationResponse
Int -> ReadS CreateWorkerConfigurationResponse
ReadS [CreateWorkerConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkerConfigurationResponse]
$creadListPrec :: ReadPrec [CreateWorkerConfigurationResponse]
readPrec :: ReadPrec CreateWorkerConfigurationResponse
$creadPrec :: ReadPrec CreateWorkerConfigurationResponse
readList :: ReadS [CreateWorkerConfigurationResponse]
$creadList :: ReadS [CreateWorkerConfigurationResponse]
readsPrec :: Int -> ReadS CreateWorkerConfigurationResponse
$creadsPrec :: Int -> ReadS CreateWorkerConfigurationResponse
Prelude.Read, Int -> CreateWorkerConfigurationResponse -> ShowS
[CreateWorkerConfigurationResponse] -> ShowS
CreateWorkerConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkerConfigurationResponse] -> ShowS
$cshowList :: [CreateWorkerConfigurationResponse] -> ShowS
show :: CreateWorkerConfigurationResponse -> String
$cshow :: CreateWorkerConfigurationResponse -> String
showsPrec :: Int -> CreateWorkerConfigurationResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkerConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateWorkerConfigurationResponse x
-> CreateWorkerConfigurationResponse
forall x.
CreateWorkerConfigurationResponse
-> Rep CreateWorkerConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWorkerConfigurationResponse x
-> CreateWorkerConfigurationResponse
$cfrom :: forall x.
CreateWorkerConfigurationResponse
-> Rep CreateWorkerConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkerConfigurationResponse' 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:
--
-- 'creationTime', 'createWorkerConfigurationResponse_creationTime' - The time that the worker configuration was created.
--
-- 'latestRevision', 'createWorkerConfigurationResponse_latestRevision' - The latest revision of the worker configuration.
--
-- 'name', 'createWorkerConfigurationResponse_name' - The name of the worker configuration.
--
-- 'workerConfigurationArn', 'createWorkerConfigurationResponse_workerConfigurationArn' - The Amazon Resource Name (ARN) that Amazon assigned to the worker
-- configuration.
--
-- 'httpStatus', 'createWorkerConfigurationResponse_httpStatus' - The response's http status code.
newCreateWorkerConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWorkerConfigurationResponse
newCreateWorkerConfigurationResponse :: Int -> CreateWorkerConfigurationResponse
newCreateWorkerConfigurationResponse Int
pHttpStatus_ =
  CreateWorkerConfigurationResponse'
    { $sel:creationTime:CreateWorkerConfigurationResponse' :: Maybe ISO8601
creationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:latestRevision:CreateWorkerConfigurationResponse' :: Maybe WorkerConfigurationRevisionSummary
latestRevision = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateWorkerConfigurationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:workerConfigurationArn:CreateWorkerConfigurationResponse' :: Maybe Text
workerConfigurationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWorkerConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time that the worker configuration was created.
createWorkerConfigurationResponse_creationTime :: Lens.Lens' CreateWorkerConfigurationResponse (Prelude.Maybe Prelude.UTCTime)
createWorkerConfigurationResponse_creationTime :: Lens' CreateWorkerConfigurationResponse (Maybe UTCTime)
createWorkerConfigurationResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfigurationResponse' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: CreateWorkerConfigurationResponse
s@CreateWorkerConfigurationResponse' {} Maybe ISO8601
a -> CreateWorkerConfigurationResponse
s {$sel:creationTime:CreateWorkerConfigurationResponse' :: Maybe ISO8601
creationTime = Maybe ISO8601
a} :: CreateWorkerConfigurationResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The latest revision of the worker configuration.
createWorkerConfigurationResponse_latestRevision :: Lens.Lens' CreateWorkerConfigurationResponse (Prelude.Maybe WorkerConfigurationRevisionSummary)
createWorkerConfigurationResponse_latestRevision :: Lens'
  CreateWorkerConfigurationResponse
  (Maybe WorkerConfigurationRevisionSummary)
createWorkerConfigurationResponse_latestRevision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfigurationResponse' {Maybe WorkerConfigurationRevisionSummary
latestRevision :: Maybe WorkerConfigurationRevisionSummary
$sel:latestRevision:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse
-> Maybe WorkerConfigurationRevisionSummary
latestRevision} -> Maybe WorkerConfigurationRevisionSummary
latestRevision) (\s :: CreateWorkerConfigurationResponse
s@CreateWorkerConfigurationResponse' {} Maybe WorkerConfigurationRevisionSummary
a -> CreateWorkerConfigurationResponse
s {$sel:latestRevision:CreateWorkerConfigurationResponse' :: Maybe WorkerConfigurationRevisionSummary
latestRevision = Maybe WorkerConfigurationRevisionSummary
a} :: CreateWorkerConfigurationResponse)

-- | The name of the worker configuration.
createWorkerConfigurationResponse_name :: Lens.Lens' CreateWorkerConfigurationResponse (Prelude.Maybe Prelude.Text)
createWorkerConfigurationResponse_name :: Lens' CreateWorkerConfigurationResponse (Maybe Text)
createWorkerConfigurationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfigurationResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateWorkerConfigurationResponse
s@CreateWorkerConfigurationResponse' {} Maybe Text
a -> CreateWorkerConfigurationResponse
s {$sel:name:CreateWorkerConfigurationResponse' :: Maybe Text
name = Maybe Text
a} :: CreateWorkerConfigurationResponse)

-- | The Amazon Resource Name (ARN) that Amazon assigned to the worker
-- configuration.
createWorkerConfigurationResponse_workerConfigurationArn :: Lens.Lens' CreateWorkerConfigurationResponse (Prelude.Maybe Prelude.Text)
createWorkerConfigurationResponse_workerConfigurationArn :: Lens' CreateWorkerConfigurationResponse (Maybe Text)
createWorkerConfigurationResponse_workerConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkerConfigurationResponse' {Maybe Text
workerConfigurationArn :: Maybe Text
$sel:workerConfigurationArn:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe Text
workerConfigurationArn} -> Maybe Text
workerConfigurationArn) (\s :: CreateWorkerConfigurationResponse
s@CreateWorkerConfigurationResponse' {} Maybe Text
a -> CreateWorkerConfigurationResponse
s {$sel:workerConfigurationArn:CreateWorkerConfigurationResponse' :: Maybe Text
workerConfigurationArn = Maybe Text
a} :: CreateWorkerConfigurationResponse)

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

instance
  Prelude.NFData
    CreateWorkerConfigurationResponse
  where
  rnf :: CreateWorkerConfigurationResponse -> ()
rnf CreateWorkerConfigurationResponse' {Int
Maybe Text
Maybe ISO8601
Maybe WorkerConfigurationRevisionSummary
httpStatus :: Int
workerConfigurationArn :: Maybe Text
name :: Maybe Text
latestRevision :: Maybe WorkerConfigurationRevisionSummary
creationTime :: Maybe ISO8601
$sel:httpStatus:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Int
$sel:workerConfigurationArn:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe Text
$sel:name:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe Text
$sel:latestRevision:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse
-> Maybe WorkerConfigurationRevisionSummary
$sel:creationTime:CreateWorkerConfigurationResponse' :: CreateWorkerConfigurationResponse -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkerConfigurationRevisionSummary
latestRevision
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workerConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus