{-# 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.Braket.CreateJob
-- 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 an Amazon Braket job.
module Amazonka.Braket.CreateJob
  ( -- * Creating a Request
    CreateJob (..),
    newCreateJob,

    -- * Request Lenses
    createJob_checkpointConfig,
    createJob_hyperParameters,
    createJob_inputDataConfig,
    createJob_stoppingCondition,
    createJob_tags,
    createJob_algorithmSpecification,
    createJob_clientToken,
    createJob_deviceConfig,
    createJob_instanceConfig,
    createJob_jobName,
    createJob_outputDataConfig,
    createJob_roleArn,

    -- * Destructuring the Response
    CreateJobResponse (..),
    newCreateJobResponse,

    -- * Response Lenses
    createJobResponse_httpStatus,
    createJobResponse_jobArn,
  )
where

import Amazonka.Braket.Types
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

-- | /See:/ 'newCreateJob' smart constructor.
data CreateJob = CreateJob'
  { -- | Information about the output locations for job checkpoint data.
    CreateJob -> Maybe JobCheckpointConfig
checkpointConfig :: Prelude.Maybe JobCheckpointConfig,
    -- | Algorithm-specific parameters used by an Amazon Braket job that
    -- influence the quality of the training job. The values are set with a
    -- string of JSON key:value pairs, where the key is the name of the
    -- hyperparameter and the value is the value of th hyperparameter.
    CreateJob -> Maybe (HashMap Text Text)
hyperParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of parameters that specify the name and type of input data and
    -- where it is located.
    CreateJob -> Maybe [InputFileConfig]
inputDataConfig :: Prelude.Maybe [InputFileConfig],
    -- | The user-defined criteria that specifies when a job stops running.
    CreateJob -> Maybe JobStoppingCondition
stoppingCondition :: Prelude.Maybe JobStoppingCondition,
    -- | A tag object that consists of a key and an optional value, used to
    -- manage metadata for Amazon Braket resources.
    CreateJob -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Definition of the Amazon Braket job to be created. Specifies the
    -- container image the job uses and information about the Python scripts
    -- used for entry and training.
    CreateJob -> AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification,
    -- | A unique token that guarantees that the call to this API is idempotent.
    CreateJob -> Text
clientToken :: Prelude.Text,
    -- | The quantum processing unit (QPU) or simulator used to create an Amazon
    -- Braket job.
    CreateJob -> DeviceConfig
deviceConfig :: DeviceConfig,
    -- | Configuration of the resource instances to use while running the hybrid
    -- job on Amazon Braket.
    CreateJob -> InstanceConfig
instanceConfig :: InstanceConfig,
    -- | The name of the Amazon Braket job.
    CreateJob -> Text
jobName :: Prelude.Text,
    -- | The path to the S3 location where you want to store job artifacts and
    -- the encryption key used to store them.
    CreateJob -> JobOutputDataConfig
outputDataConfig :: JobOutputDataConfig,
    -- | The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
    -- assume to perform tasks on behalf of a user. It can access user
    -- resources, run an Amazon Braket job container on behalf of user, and
    -- output resources to the users\' s3 buckets.
    CreateJob -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateJob -> CreateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJob -> CreateJob -> Bool
$c/= :: CreateJob -> CreateJob -> Bool
== :: CreateJob -> CreateJob -> Bool
$c== :: CreateJob -> CreateJob -> Bool
Prelude.Eq, ReadPrec [CreateJob]
ReadPrec CreateJob
Int -> ReadS CreateJob
ReadS [CreateJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJob]
$creadListPrec :: ReadPrec [CreateJob]
readPrec :: ReadPrec CreateJob
$creadPrec :: ReadPrec CreateJob
readList :: ReadS [CreateJob]
$creadList :: ReadS [CreateJob]
readsPrec :: Int -> ReadS CreateJob
$creadsPrec :: Int -> ReadS CreateJob
Prelude.Read, Int -> CreateJob -> ShowS
[CreateJob] -> ShowS
CreateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJob] -> ShowS
$cshowList :: [CreateJob] -> ShowS
show :: CreateJob -> String
$cshow :: CreateJob -> String
showsPrec :: Int -> CreateJob -> ShowS
$cshowsPrec :: Int -> CreateJob -> ShowS
Prelude.Show, forall x. Rep CreateJob x -> CreateJob
forall x. CreateJob -> Rep CreateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJob x -> CreateJob
$cfrom :: forall x. CreateJob -> Rep CreateJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateJob' 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:
--
-- 'checkpointConfig', 'createJob_checkpointConfig' - Information about the output locations for job checkpoint data.
--
-- 'hyperParameters', 'createJob_hyperParameters' - Algorithm-specific parameters used by an Amazon Braket job that
-- influence the quality of the training job. The values are set with a
-- string of JSON key:value pairs, where the key is the name of the
-- hyperparameter and the value is the value of th hyperparameter.
--
-- 'inputDataConfig', 'createJob_inputDataConfig' - A list of parameters that specify the name and type of input data and
-- where it is located.
--
-- 'stoppingCondition', 'createJob_stoppingCondition' - The user-defined criteria that specifies when a job stops running.
--
-- 'tags', 'createJob_tags' - A tag object that consists of a key and an optional value, used to
-- manage metadata for Amazon Braket resources.
--
-- 'algorithmSpecification', 'createJob_algorithmSpecification' - Definition of the Amazon Braket job to be created. Specifies the
-- container image the job uses and information about the Python scripts
-- used for entry and training.
--
-- 'clientToken', 'createJob_clientToken' - A unique token that guarantees that the call to this API is idempotent.
--
-- 'deviceConfig', 'createJob_deviceConfig' - The quantum processing unit (QPU) or simulator used to create an Amazon
-- Braket job.
--
-- 'instanceConfig', 'createJob_instanceConfig' - Configuration of the resource instances to use while running the hybrid
-- job on Amazon Braket.
--
-- 'jobName', 'createJob_jobName' - The name of the Amazon Braket job.
--
-- 'outputDataConfig', 'createJob_outputDataConfig' - The path to the S3 location where you want to store job artifacts and
-- the encryption key used to store them.
--
-- 'roleArn', 'createJob_roleArn' - The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
-- assume to perform tasks on behalf of a user. It can access user
-- resources, run an Amazon Braket job container on behalf of user, and
-- output resources to the users\' s3 buckets.
newCreateJob ::
  -- | 'algorithmSpecification'
  AlgorithmSpecification ->
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'deviceConfig'
  DeviceConfig ->
  -- | 'instanceConfig'
  InstanceConfig ->
  -- | 'jobName'
  Prelude.Text ->
  -- | 'outputDataConfig'
  JobOutputDataConfig ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateJob
newCreateJob :: AlgorithmSpecification
-> Text
-> DeviceConfig
-> InstanceConfig
-> Text
-> JobOutputDataConfig
-> Text
-> CreateJob
newCreateJob
  AlgorithmSpecification
pAlgorithmSpecification_
  Text
pClientToken_
  DeviceConfig
pDeviceConfig_
  InstanceConfig
pInstanceConfig_
  Text
pJobName_
  JobOutputDataConfig
pOutputDataConfig_
  Text
pRoleArn_ =
    CreateJob'
      { $sel:checkpointConfig:CreateJob' :: Maybe JobCheckpointConfig
checkpointConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:hyperParameters:CreateJob' :: Maybe (HashMap Text Text)
hyperParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:inputDataConfig:CreateJob' :: Maybe [InputFileConfig]
inputDataConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:stoppingCondition:CreateJob' :: Maybe JobStoppingCondition
stoppingCondition = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateJob' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:algorithmSpecification:CreateJob' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
pAlgorithmSpecification_,
        $sel:clientToken:CreateJob' :: Text
clientToken = Text
pClientToken_,
        $sel:deviceConfig:CreateJob' :: DeviceConfig
deviceConfig = DeviceConfig
pDeviceConfig_,
        $sel:instanceConfig:CreateJob' :: InstanceConfig
instanceConfig = InstanceConfig
pInstanceConfig_,
        $sel:jobName:CreateJob' :: Text
jobName = Text
pJobName_,
        $sel:outputDataConfig:CreateJob' :: JobOutputDataConfig
outputDataConfig = JobOutputDataConfig
pOutputDataConfig_,
        $sel:roleArn:CreateJob' :: Text
roleArn = Text
pRoleArn_
      }

-- | Information about the output locations for job checkpoint data.
createJob_checkpointConfig :: Lens.Lens' CreateJob (Prelude.Maybe JobCheckpointConfig)
createJob_checkpointConfig :: Lens' CreateJob (Maybe JobCheckpointConfig)
createJob_checkpointConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobCheckpointConfig
checkpointConfig :: Maybe JobCheckpointConfig
$sel:checkpointConfig:CreateJob' :: CreateJob -> Maybe JobCheckpointConfig
checkpointConfig} -> Maybe JobCheckpointConfig
checkpointConfig) (\s :: CreateJob
s@CreateJob' {} Maybe JobCheckpointConfig
a -> CreateJob
s {$sel:checkpointConfig:CreateJob' :: Maybe JobCheckpointConfig
checkpointConfig = Maybe JobCheckpointConfig
a} :: CreateJob)

-- | Algorithm-specific parameters used by an Amazon Braket job that
-- influence the quality of the training job. The values are set with a
-- string of JSON key:value pairs, where the key is the name of the
-- hyperparameter and the value is the value of th hyperparameter.
createJob_hyperParameters :: Lens.Lens' CreateJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createJob_hyperParameters :: Lens' CreateJob (Maybe (HashMap Text Text))
createJob_hyperParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe (HashMap Text Text)
hyperParameters :: Maybe (HashMap Text Text)
$sel:hyperParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
hyperParameters} -> Maybe (HashMap Text Text)
hyperParameters) (\s :: CreateJob
s@CreateJob' {} Maybe (HashMap Text Text)
a -> CreateJob
s {$sel:hyperParameters:CreateJob' :: Maybe (HashMap Text Text)
hyperParameters = Maybe (HashMap Text Text)
a} :: CreateJob) 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

-- | A list of parameters that specify the name and type of input data and
-- where it is located.
createJob_inputDataConfig :: Lens.Lens' CreateJob (Prelude.Maybe [InputFileConfig])
createJob_inputDataConfig :: Lens' CreateJob (Maybe [InputFileConfig])
createJob_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe [InputFileConfig]
inputDataConfig :: Maybe [InputFileConfig]
$sel:inputDataConfig:CreateJob' :: CreateJob -> Maybe [InputFileConfig]
inputDataConfig} -> Maybe [InputFileConfig]
inputDataConfig) (\s :: CreateJob
s@CreateJob' {} Maybe [InputFileConfig]
a -> CreateJob
s {$sel:inputDataConfig:CreateJob' :: Maybe [InputFileConfig]
inputDataConfig = Maybe [InputFileConfig]
a} :: CreateJob) 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

-- | The user-defined criteria that specifies when a job stops running.
createJob_stoppingCondition :: Lens.Lens' CreateJob (Prelude.Maybe JobStoppingCondition)
createJob_stoppingCondition :: Lens' CreateJob (Maybe JobStoppingCondition)
createJob_stoppingCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobStoppingCondition
stoppingCondition :: Maybe JobStoppingCondition
$sel:stoppingCondition:CreateJob' :: CreateJob -> Maybe JobStoppingCondition
stoppingCondition} -> Maybe JobStoppingCondition
stoppingCondition) (\s :: CreateJob
s@CreateJob' {} Maybe JobStoppingCondition
a -> CreateJob
s {$sel:stoppingCondition:CreateJob' :: Maybe JobStoppingCondition
stoppingCondition = Maybe JobStoppingCondition
a} :: CreateJob)

-- | A tag object that consists of a key and an optional value, used to
-- manage metadata for Amazon Braket resources.
createJob_tags :: Lens.Lens' CreateJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createJob_tags :: Lens' CreateJob (Maybe (HashMap Text Text))
createJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateJob
s@CreateJob' {} Maybe (HashMap Text Text)
a -> CreateJob
s {$sel:tags:CreateJob' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateJob) 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

-- | Definition of the Amazon Braket job to be created. Specifies the
-- container image the job uses and information about the Python scripts
-- used for entry and training.
createJob_algorithmSpecification :: Lens.Lens' CreateJob AlgorithmSpecification
createJob_algorithmSpecification :: Lens' CreateJob AlgorithmSpecification
createJob_algorithmSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification
$sel:algorithmSpecification:CreateJob' :: CreateJob -> AlgorithmSpecification
algorithmSpecification} -> AlgorithmSpecification
algorithmSpecification) (\s :: CreateJob
s@CreateJob' {} AlgorithmSpecification
a -> CreateJob
s {$sel:algorithmSpecification:CreateJob' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
a} :: CreateJob)

-- | A unique token that guarantees that the call to this API is idempotent.
createJob_clientToken :: Lens.Lens' CreateJob Prelude.Text
createJob_clientToken :: Lens' CreateJob Text
createJob_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Text
clientToken :: Text
$sel:clientToken:CreateJob' :: CreateJob -> Text
clientToken} -> Text
clientToken) (\s :: CreateJob
s@CreateJob' {} Text
a -> CreateJob
s {$sel:clientToken:CreateJob' :: Text
clientToken = Text
a} :: CreateJob)

-- | The quantum processing unit (QPU) or simulator used to create an Amazon
-- Braket job.
createJob_deviceConfig :: Lens.Lens' CreateJob DeviceConfig
createJob_deviceConfig :: Lens' CreateJob DeviceConfig
createJob_deviceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {DeviceConfig
deviceConfig :: DeviceConfig
$sel:deviceConfig:CreateJob' :: CreateJob -> DeviceConfig
deviceConfig} -> DeviceConfig
deviceConfig) (\s :: CreateJob
s@CreateJob' {} DeviceConfig
a -> CreateJob
s {$sel:deviceConfig:CreateJob' :: DeviceConfig
deviceConfig = DeviceConfig
a} :: CreateJob)

-- | Configuration of the resource instances to use while running the hybrid
-- job on Amazon Braket.
createJob_instanceConfig :: Lens.Lens' CreateJob InstanceConfig
createJob_instanceConfig :: Lens' CreateJob InstanceConfig
createJob_instanceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {InstanceConfig
instanceConfig :: InstanceConfig
$sel:instanceConfig:CreateJob' :: CreateJob -> InstanceConfig
instanceConfig} -> InstanceConfig
instanceConfig) (\s :: CreateJob
s@CreateJob' {} InstanceConfig
a -> CreateJob
s {$sel:instanceConfig:CreateJob' :: InstanceConfig
instanceConfig = InstanceConfig
a} :: CreateJob)

-- | The name of the Amazon Braket job.
createJob_jobName :: Lens.Lens' CreateJob Prelude.Text
createJob_jobName :: Lens' CreateJob Text
createJob_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Text
jobName :: Text
$sel:jobName:CreateJob' :: CreateJob -> Text
jobName} -> Text
jobName) (\s :: CreateJob
s@CreateJob' {} Text
a -> CreateJob
s {$sel:jobName:CreateJob' :: Text
jobName = Text
a} :: CreateJob)

-- | The path to the S3 location where you want to store job artifacts and
-- the encryption key used to store them.
createJob_outputDataConfig :: Lens.Lens' CreateJob JobOutputDataConfig
createJob_outputDataConfig :: Lens' CreateJob JobOutputDataConfig
createJob_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {JobOutputDataConfig
outputDataConfig :: JobOutputDataConfig
$sel:outputDataConfig:CreateJob' :: CreateJob -> JobOutputDataConfig
outputDataConfig} -> JobOutputDataConfig
outputDataConfig) (\s :: CreateJob
s@CreateJob' {} JobOutputDataConfig
a -> CreateJob
s {$sel:outputDataConfig:CreateJob' :: JobOutputDataConfig
outputDataConfig = JobOutputDataConfig
a} :: CreateJob)

-- | The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
-- assume to perform tasks on behalf of a user. It can access user
-- resources, run an Amazon Braket job container on behalf of user, and
-- output resources to the users\' s3 buckets.
createJob_roleArn :: Lens.Lens' CreateJob Prelude.Text
createJob_roleArn :: Lens' CreateJob Text
createJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Text
roleArn :: Text
$sel:roleArn:CreateJob' :: CreateJob -> Text
roleArn} -> Text
roleArn) (\s :: CreateJob
s@CreateJob' {} Text
a -> CreateJob
s {$sel:roleArn:CreateJob' :: Text
roleArn = Text
a} :: CreateJob)

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

instance Prelude.Hashable CreateJob where
  hashWithSalt :: Int -> CreateJob -> Int
hashWithSalt Int
_salt CreateJob' {Maybe [InputFileConfig]
Maybe (HashMap Text Text)
Maybe JobCheckpointConfig
Maybe JobStoppingCondition
Text
DeviceConfig
InstanceConfig
JobOutputDataConfig
AlgorithmSpecification
roleArn :: Text
outputDataConfig :: JobOutputDataConfig
jobName :: Text
instanceConfig :: InstanceConfig
deviceConfig :: DeviceConfig
clientToken :: Text
algorithmSpecification :: AlgorithmSpecification
tags :: Maybe (HashMap Text Text)
stoppingCondition :: Maybe JobStoppingCondition
inputDataConfig :: Maybe [InputFileConfig]
hyperParameters :: Maybe (HashMap Text Text)
checkpointConfig :: Maybe JobCheckpointConfig
$sel:roleArn:CreateJob' :: CreateJob -> Text
$sel:outputDataConfig:CreateJob' :: CreateJob -> JobOutputDataConfig
$sel:jobName:CreateJob' :: CreateJob -> Text
$sel:instanceConfig:CreateJob' :: CreateJob -> InstanceConfig
$sel:deviceConfig:CreateJob' :: CreateJob -> DeviceConfig
$sel:clientToken:CreateJob' :: CreateJob -> Text
$sel:algorithmSpecification:CreateJob' :: CreateJob -> AlgorithmSpecification
$sel:tags:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:stoppingCondition:CreateJob' :: CreateJob -> Maybe JobStoppingCondition
$sel:inputDataConfig:CreateJob' :: CreateJob -> Maybe [InputFileConfig]
$sel:hyperParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:checkpointConfig:CreateJob' :: CreateJob -> Maybe JobCheckpointConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobCheckpointConfig
checkpointConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
hyperParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputFileConfig]
inputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobStoppingCondition
stoppingCondition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlgorithmSpecification
algorithmSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeviceConfig
deviceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InstanceConfig
instanceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` JobOutputDataConfig
outputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateJob where
  rnf :: CreateJob -> ()
rnf CreateJob' {Maybe [InputFileConfig]
Maybe (HashMap Text Text)
Maybe JobCheckpointConfig
Maybe JobStoppingCondition
Text
DeviceConfig
InstanceConfig
JobOutputDataConfig
AlgorithmSpecification
roleArn :: Text
outputDataConfig :: JobOutputDataConfig
jobName :: Text
instanceConfig :: InstanceConfig
deviceConfig :: DeviceConfig
clientToken :: Text
algorithmSpecification :: AlgorithmSpecification
tags :: Maybe (HashMap Text Text)
stoppingCondition :: Maybe JobStoppingCondition
inputDataConfig :: Maybe [InputFileConfig]
hyperParameters :: Maybe (HashMap Text Text)
checkpointConfig :: Maybe JobCheckpointConfig
$sel:roleArn:CreateJob' :: CreateJob -> Text
$sel:outputDataConfig:CreateJob' :: CreateJob -> JobOutputDataConfig
$sel:jobName:CreateJob' :: CreateJob -> Text
$sel:instanceConfig:CreateJob' :: CreateJob -> InstanceConfig
$sel:deviceConfig:CreateJob' :: CreateJob -> DeviceConfig
$sel:clientToken:CreateJob' :: CreateJob -> Text
$sel:algorithmSpecification:CreateJob' :: CreateJob -> AlgorithmSpecification
$sel:tags:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:stoppingCondition:CreateJob' :: CreateJob -> Maybe JobStoppingCondition
$sel:inputDataConfig:CreateJob' :: CreateJob -> Maybe [InputFileConfig]
$sel:hyperParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:checkpointConfig:CreateJob' :: CreateJob -> Maybe JobCheckpointConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe JobCheckpointConfig
checkpointConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
hyperParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputFileConfig]
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobStoppingCondition
stoppingCondition
      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 AlgorithmSpecification
algorithmSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeviceConfig
deviceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InstanceConfig
instanceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobOutputDataConfig
outputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders CreateJob where
  toHeaders :: CreateJob -> 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 CreateJob where
  toJSON :: CreateJob -> Value
toJSON CreateJob' {Maybe [InputFileConfig]
Maybe (HashMap Text Text)
Maybe JobCheckpointConfig
Maybe JobStoppingCondition
Text
DeviceConfig
InstanceConfig
JobOutputDataConfig
AlgorithmSpecification
roleArn :: Text
outputDataConfig :: JobOutputDataConfig
jobName :: Text
instanceConfig :: InstanceConfig
deviceConfig :: DeviceConfig
clientToken :: Text
algorithmSpecification :: AlgorithmSpecification
tags :: Maybe (HashMap Text Text)
stoppingCondition :: Maybe JobStoppingCondition
inputDataConfig :: Maybe [InputFileConfig]
hyperParameters :: Maybe (HashMap Text Text)
checkpointConfig :: Maybe JobCheckpointConfig
$sel:roleArn:CreateJob' :: CreateJob -> Text
$sel:outputDataConfig:CreateJob' :: CreateJob -> JobOutputDataConfig
$sel:jobName:CreateJob' :: CreateJob -> Text
$sel:instanceConfig:CreateJob' :: CreateJob -> InstanceConfig
$sel:deviceConfig:CreateJob' :: CreateJob -> DeviceConfig
$sel:clientToken:CreateJob' :: CreateJob -> Text
$sel:algorithmSpecification:CreateJob' :: CreateJob -> AlgorithmSpecification
$sel:tags:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:stoppingCondition:CreateJob' :: CreateJob -> Maybe JobStoppingCondition
$sel:inputDataConfig:CreateJob' :: CreateJob -> Maybe [InputFileConfig]
$sel:hyperParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:checkpointConfig:CreateJob' :: CreateJob -> Maybe JobCheckpointConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"checkpointConfig" 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 JobCheckpointConfig
checkpointConfig,
            (Key
"hyperParameters" 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)
hyperParameters,
            (Key
"inputDataConfig" 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 [InputFileConfig]
inputDataConfig,
            (Key
"stoppingCondition" 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 JobStoppingCondition
stoppingCondition,
            (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
"algorithmSpecification"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlgorithmSpecification
algorithmSpecification
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken),
            forall a. a -> Maybe a
Prelude.Just (Key
"deviceConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DeviceConfig
deviceConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"instanceConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InstanceConfig
instanceConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"jobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"outputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= JobOutputDataConfig
outputDataConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateJobResponse' 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', 'createJobResponse_httpStatus' - The response's http status code.
--
-- 'jobArn', 'createJobResponse_jobArn' - The ARN of the Amazon Braket job created.
newCreateJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobArn'
  Prelude.Text ->
  CreateJobResponse
newCreateJobResponse :: Int -> Text -> CreateJobResponse
newCreateJobResponse Int
pHttpStatus_ Text
pJobArn_ =
  CreateJobResponse'
    { $sel:httpStatus:CreateJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:jobArn:CreateJobResponse' :: Text
jobArn = Text
pJobArn_
    }

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

-- | The ARN of the Amazon Braket job created.
createJobResponse_jobArn :: Lens.Lens' CreateJobResponse Prelude.Text
createJobResponse_jobArn :: Lens' CreateJobResponse Text
createJobResponse_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobResponse' {Text
jobArn :: Text
$sel:jobArn:CreateJobResponse' :: CreateJobResponse -> Text
jobArn} -> Text
jobArn) (\s :: CreateJobResponse
s@CreateJobResponse' {} Text
a -> CreateJobResponse
s {$sel:jobArn:CreateJobResponse' :: Text
jobArn = Text
a} :: CreateJobResponse)

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