{-# 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.CreateCompilationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a model compilation job. After the model has been compiled,
-- Amazon SageMaker saves the resulting model artifacts to an Amazon Simple
-- Storage Service (Amazon S3) bucket that you specify.
--
-- If you choose to host your model using Amazon SageMaker hosting
-- services, you can use the resulting model artifacts as part of the
-- model. You can also use the artifacts with Amazon Web Services IoT
-- Greengrass. In that case, deploy them as an ML resource.
--
-- In the request body, you provide the following:
--
-- -   A name for the compilation job
--
-- -   Information about the input model artifacts
--
-- -   The output location for the compiled model and the device (target)
--     that the model runs on
--
-- -   The Amazon Resource Name (ARN) of the IAM role that Amazon SageMaker
--     assumes to perform the model compilation job.
--
-- You can also provide a @Tag@ to track the model compilation job\'s
-- resource use and costs. The response body contains the
-- @CompilationJobArn@ for the compiled job.
--
-- To stop a model compilation job, use StopCompilationJob. To get
-- information about a particular model compilation job, use
-- DescribeCompilationJob. To get information about multiple model
-- compilation jobs, use ListCompilationJobs.
module Amazonka.SageMaker.CreateCompilationJob
  ( -- * Creating a Request
    CreateCompilationJob (..),
    newCreateCompilationJob,

    -- * Request Lenses
    createCompilationJob_inputConfig,
    createCompilationJob_modelPackageVersionArn,
    createCompilationJob_tags,
    createCompilationJob_vpcConfig,
    createCompilationJob_compilationJobName,
    createCompilationJob_roleArn,
    createCompilationJob_outputConfig,
    createCompilationJob_stoppingCondition,

    -- * Destructuring the Response
    CreateCompilationJobResponse (..),
    newCreateCompilationJobResponse,

    -- * Response Lenses
    createCompilationJobResponse_httpStatus,
    createCompilationJobResponse_compilationJobArn,
  )
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:/ 'newCreateCompilationJob' smart constructor.
data CreateCompilationJob = CreateCompilationJob'
  { -- | Provides information about the location of input model artifacts, the
    -- name and shape of the expected data inputs, and the framework in which
    -- the model was trained.
    CreateCompilationJob -> Maybe InputConfig
inputConfig :: Prelude.Maybe InputConfig,
    -- | The Amazon Resource Name (ARN) of a versioned model package. Provide
    -- either a @ModelPackageVersionArn@ or an @InputConfig@ object in the
    -- request syntax. The presence of both objects in the
    -- @CreateCompilationJob@ request will return an exception.
    CreateCompilationJob -> Maybe Text
modelPackageVersionArn :: Prelude.Maybe Prelude.Text,
    -- | An array of key-value pairs. You can use tags to categorize your Amazon
    -- Web Services resources in different ways, for example, by purpose,
    -- owner, or environment. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
    CreateCompilationJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A VpcConfig object that specifies the VPC that you want your compilation
    -- job to connect to. Control access to your models by configuring the VPC.
    -- For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/neo-vpc.html Protect Compilation Jobs by Using an Amazon Virtual Private Cloud>.
    CreateCompilationJob -> Maybe NeoVpcConfig
vpcConfig :: Prelude.Maybe NeoVpcConfig,
    -- | A name for the model compilation job. The name must be unique within the
    -- Amazon Web Services Region and within your Amazon Web Services account.
    CreateCompilationJob -> Text
compilationJobName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an IAM role that enables Amazon
    -- SageMaker to perform tasks on your behalf.
    --
    -- During model compilation, Amazon SageMaker needs your permission to:
    --
    -- -   Read input data from an S3 bucket
    --
    -- -   Write model artifacts to an S3 bucket
    --
    -- -   Write logs to Amazon CloudWatch Logs
    --
    -- -   Publish metrics to Amazon CloudWatch
    --
    -- You grant permissions for all of these tasks to an IAM role. To pass
    -- this role to Amazon SageMaker, the caller of this API must have the
    -- @iam:PassRole@ permission. For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html Amazon SageMaker Roles.>
    CreateCompilationJob -> Text
roleArn :: Prelude.Text,
    -- | Provides information about the output location for the compiled model
    -- and the target device the model runs on.
    CreateCompilationJob -> OutputConfig
outputConfig :: OutputConfig,
    -- | Specifies a limit to how long a model compilation job can run. When the
    -- job reaches the time limit, Amazon SageMaker ends the compilation job.
    -- Use this API to cap model training costs.
    CreateCompilationJob -> StoppingCondition
stoppingCondition :: StoppingCondition
  }
  deriving (CreateCompilationJob -> CreateCompilationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCompilationJob -> CreateCompilationJob -> Bool
$c/= :: CreateCompilationJob -> CreateCompilationJob -> Bool
== :: CreateCompilationJob -> CreateCompilationJob -> Bool
$c== :: CreateCompilationJob -> CreateCompilationJob -> Bool
Prelude.Eq, ReadPrec [CreateCompilationJob]
ReadPrec CreateCompilationJob
Int -> ReadS CreateCompilationJob
ReadS [CreateCompilationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCompilationJob]
$creadListPrec :: ReadPrec [CreateCompilationJob]
readPrec :: ReadPrec CreateCompilationJob
$creadPrec :: ReadPrec CreateCompilationJob
readList :: ReadS [CreateCompilationJob]
$creadList :: ReadS [CreateCompilationJob]
readsPrec :: Int -> ReadS CreateCompilationJob
$creadsPrec :: Int -> ReadS CreateCompilationJob
Prelude.Read, Int -> CreateCompilationJob -> ShowS
[CreateCompilationJob] -> ShowS
CreateCompilationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCompilationJob] -> ShowS
$cshowList :: [CreateCompilationJob] -> ShowS
show :: CreateCompilationJob -> String
$cshow :: CreateCompilationJob -> String
showsPrec :: Int -> CreateCompilationJob -> ShowS
$cshowsPrec :: Int -> CreateCompilationJob -> ShowS
Prelude.Show, forall x. Rep CreateCompilationJob x -> CreateCompilationJob
forall x. CreateCompilationJob -> Rep CreateCompilationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCompilationJob x -> CreateCompilationJob
$cfrom :: forall x. CreateCompilationJob -> Rep CreateCompilationJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateCompilationJob' 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:
--
-- 'inputConfig', 'createCompilationJob_inputConfig' - Provides information about the location of input model artifacts, the
-- name and shape of the expected data inputs, and the framework in which
-- the model was trained.
--
-- 'modelPackageVersionArn', 'createCompilationJob_modelPackageVersionArn' - The Amazon Resource Name (ARN) of a versioned model package. Provide
-- either a @ModelPackageVersionArn@ or an @InputConfig@ object in the
-- request syntax. The presence of both objects in the
-- @CreateCompilationJob@ request will return an exception.
--
-- 'tags', 'createCompilationJob_tags' - An array of key-value pairs. You can use tags to categorize your Amazon
-- Web Services resources in different ways, for example, by purpose,
-- owner, or environment. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
--
-- 'vpcConfig', 'createCompilationJob_vpcConfig' - A VpcConfig object that specifies the VPC that you want your compilation
-- job to connect to. Control access to your models by configuring the VPC.
-- For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/neo-vpc.html Protect Compilation Jobs by Using an Amazon Virtual Private Cloud>.
--
-- 'compilationJobName', 'createCompilationJob_compilationJobName' - A name for the model compilation job. The name must be unique within the
-- Amazon Web Services Region and within your Amazon Web Services account.
--
-- 'roleArn', 'createCompilationJob_roleArn' - The Amazon Resource Name (ARN) of an IAM role that enables Amazon
-- SageMaker to perform tasks on your behalf.
--
-- During model compilation, Amazon SageMaker needs your permission to:
--
-- -   Read input data from an S3 bucket
--
-- -   Write model artifacts to an S3 bucket
--
-- -   Write logs to Amazon CloudWatch Logs
--
-- -   Publish metrics to Amazon CloudWatch
--
-- You grant permissions for all of these tasks to an IAM role. To pass
-- this role to Amazon SageMaker, the caller of this API must have the
-- @iam:PassRole@ permission. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html Amazon SageMaker Roles.>
--
-- 'outputConfig', 'createCompilationJob_outputConfig' - Provides information about the output location for the compiled model
-- and the target device the model runs on.
--
-- 'stoppingCondition', 'createCompilationJob_stoppingCondition' - Specifies a limit to how long a model compilation job can run. When the
-- job reaches the time limit, Amazon SageMaker ends the compilation job.
-- Use this API to cap model training costs.
newCreateCompilationJob ::
  -- | 'compilationJobName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'outputConfig'
  OutputConfig ->
  -- | 'stoppingCondition'
  StoppingCondition ->
  CreateCompilationJob
newCreateCompilationJob :: Text
-> Text
-> OutputConfig
-> StoppingCondition
-> CreateCompilationJob
newCreateCompilationJob
  Text
pCompilationJobName_
  Text
pRoleArn_
  OutputConfig
pOutputConfig_
  StoppingCondition
pStoppingCondition_ =
    CreateCompilationJob'
      { $sel:inputConfig:CreateCompilationJob' :: Maybe InputConfig
inputConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:modelPackageVersionArn:CreateCompilationJob' :: Maybe Text
modelPackageVersionArn = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCompilationJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfig:CreateCompilationJob' :: Maybe NeoVpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:compilationJobName:CreateCompilationJob' :: Text
compilationJobName = Text
pCompilationJobName_,
        $sel:roleArn:CreateCompilationJob' :: Text
roleArn = Text
pRoleArn_,
        $sel:outputConfig:CreateCompilationJob' :: OutputConfig
outputConfig = OutputConfig
pOutputConfig_,
        $sel:stoppingCondition:CreateCompilationJob' :: StoppingCondition
stoppingCondition = StoppingCondition
pStoppingCondition_
      }

-- | Provides information about the location of input model artifacts, the
-- name and shape of the expected data inputs, and the framework in which
-- the model was trained.
createCompilationJob_inputConfig :: Lens.Lens' CreateCompilationJob (Prelude.Maybe InputConfig)
createCompilationJob_inputConfig :: Lens' CreateCompilationJob (Maybe InputConfig)
createCompilationJob_inputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Maybe InputConfig
inputConfig :: Maybe InputConfig
$sel:inputConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe InputConfig
inputConfig} -> Maybe InputConfig
inputConfig) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Maybe InputConfig
a -> CreateCompilationJob
s {$sel:inputConfig:CreateCompilationJob' :: Maybe InputConfig
inputConfig = Maybe InputConfig
a} :: CreateCompilationJob)

-- | The Amazon Resource Name (ARN) of a versioned model package. Provide
-- either a @ModelPackageVersionArn@ or an @InputConfig@ object in the
-- request syntax. The presence of both objects in the
-- @CreateCompilationJob@ request will return an exception.
createCompilationJob_modelPackageVersionArn :: Lens.Lens' CreateCompilationJob (Prelude.Maybe Prelude.Text)
createCompilationJob_modelPackageVersionArn :: Lens' CreateCompilationJob (Maybe Text)
createCompilationJob_modelPackageVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Maybe Text
modelPackageVersionArn :: Maybe Text
$sel:modelPackageVersionArn:CreateCompilationJob' :: CreateCompilationJob -> Maybe Text
modelPackageVersionArn} -> Maybe Text
modelPackageVersionArn) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Maybe Text
a -> CreateCompilationJob
s {$sel:modelPackageVersionArn:CreateCompilationJob' :: Maybe Text
modelPackageVersionArn = Maybe Text
a} :: CreateCompilationJob)

-- | An array of key-value pairs. You can use tags to categorize your Amazon
-- Web Services resources in different ways, for example, by purpose,
-- owner, or environment. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
createCompilationJob_tags :: Lens.Lens' CreateCompilationJob (Prelude.Maybe [Tag])
createCompilationJob_tags :: Lens' CreateCompilationJob (Maybe [Tag])
createCompilationJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCompilationJob' :: CreateCompilationJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Maybe [Tag]
a -> CreateCompilationJob
s {$sel:tags:CreateCompilationJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCompilationJob) 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 VpcConfig object that specifies the VPC that you want your compilation
-- job to connect to. Control access to your models by configuring the VPC.
-- For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/neo-vpc.html Protect Compilation Jobs by Using an Amazon Virtual Private Cloud>.
createCompilationJob_vpcConfig :: Lens.Lens' CreateCompilationJob (Prelude.Maybe NeoVpcConfig)
createCompilationJob_vpcConfig :: Lens' CreateCompilationJob (Maybe NeoVpcConfig)
createCompilationJob_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Maybe NeoVpcConfig
vpcConfig :: Maybe NeoVpcConfig
$sel:vpcConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe NeoVpcConfig
vpcConfig} -> Maybe NeoVpcConfig
vpcConfig) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Maybe NeoVpcConfig
a -> CreateCompilationJob
s {$sel:vpcConfig:CreateCompilationJob' :: Maybe NeoVpcConfig
vpcConfig = Maybe NeoVpcConfig
a} :: CreateCompilationJob)

-- | A name for the model compilation job. The name must be unique within the
-- Amazon Web Services Region and within your Amazon Web Services account.
createCompilationJob_compilationJobName :: Lens.Lens' CreateCompilationJob Prelude.Text
createCompilationJob_compilationJobName :: Lens' CreateCompilationJob Text
createCompilationJob_compilationJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Text
compilationJobName :: Text
$sel:compilationJobName:CreateCompilationJob' :: CreateCompilationJob -> Text
compilationJobName} -> Text
compilationJobName) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Text
a -> CreateCompilationJob
s {$sel:compilationJobName:CreateCompilationJob' :: Text
compilationJobName = Text
a} :: CreateCompilationJob)

-- | The Amazon Resource Name (ARN) of an IAM role that enables Amazon
-- SageMaker to perform tasks on your behalf.
--
-- During model compilation, Amazon SageMaker needs your permission to:
--
-- -   Read input data from an S3 bucket
--
-- -   Write model artifacts to an S3 bucket
--
-- -   Write logs to Amazon CloudWatch Logs
--
-- -   Publish metrics to Amazon CloudWatch
--
-- You grant permissions for all of these tasks to an IAM role. To pass
-- this role to Amazon SageMaker, the caller of this API must have the
-- @iam:PassRole@ permission. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html Amazon SageMaker Roles.>
createCompilationJob_roleArn :: Lens.Lens' CreateCompilationJob Prelude.Text
createCompilationJob_roleArn :: Lens' CreateCompilationJob Text
createCompilationJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {Text
roleArn :: Text
$sel:roleArn:CreateCompilationJob' :: CreateCompilationJob -> Text
roleArn} -> Text
roleArn) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} Text
a -> CreateCompilationJob
s {$sel:roleArn:CreateCompilationJob' :: Text
roleArn = Text
a} :: CreateCompilationJob)

-- | Provides information about the output location for the compiled model
-- and the target device the model runs on.
createCompilationJob_outputConfig :: Lens.Lens' CreateCompilationJob OutputConfig
createCompilationJob_outputConfig :: Lens' CreateCompilationJob OutputConfig
createCompilationJob_outputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {OutputConfig
outputConfig :: OutputConfig
$sel:outputConfig:CreateCompilationJob' :: CreateCompilationJob -> OutputConfig
outputConfig} -> OutputConfig
outputConfig) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} OutputConfig
a -> CreateCompilationJob
s {$sel:outputConfig:CreateCompilationJob' :: OutputConfig
outputConfig = OutputConfig
a} :: CreateCompilationJob)

-- | Specifies a limit to how long a model compilation job can run. When the
-- job reaches the time limit, Amazon SageMaker ends the compilation job.
-- Use this API to cap model training costs.
createCompilationJob_stoppingCondition :: Lens.Lens' CreateCompilationJob StoppingCondition
createCompilationJob_stoppingCondition :: Lens' CreateCompilationJob StoppingCondition
createCompilationJob_stoppingCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJob' {StoppingCondition
stoppingCondition :: StoppingCondition
$sel:stoppingCondition:CreateCompilationJob' :: CreateCompilationJob -> StoppingCondition
stoppingCondition} -> StoppingCondition
stoppingCondition) (\s :: CreateCompilationJob
s@CreateCompilationJob' {} StoppingCondition
a -> CreateCompilationJob
s {$sel:stoppingCondition:CreateCompilationJob' :: StoppingCondition
stoppingCondition = StoppingCondition
a} :: CreateCompilationJob)

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

instance Prelude.Hashable CreateCompilationJob where
  hashWithSalt :: Int -> CreateCompilationJob -> Int
hashWithSalt Int
_salt CreateCompilationJob' {Maybe [Tag]
Maybe Text
Maybe InputConfig
Maybe NeoVpcConfig
Text
StoppingCondition
OutputConfig
stoppingCondition :: StoppingCondition
outputConfig :: OutputConfig
roleArn :: Text
compilationJobName :: Text
vpcConfig :: Maybe NeoVpcConfig
tags :: Maybe [Tag]
modelPackageVersionArn :: Maybe Text
inputConfig :: Maybe InputConfig
$sel:stoppingCondition:CreateCompilationJob' :: CreateCompilationJob -> StoppingCondition
$sel:outputConfig:CreateCompilationJob' :: CreateCompilationJob -> OutputConfig
$sel:roleArn:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:compilationJobName:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:vpcConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe NeoVpcConfig
$sel:tags:CreateCompilationJob' :: CreateCompilationJob -> Maybe [Tag]
$sel:modelPackageVersionArn:CreateCompilationJob' :: CreateCompilationJob -> Maybe Text
$sel:inputConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe InputConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputConfig
inputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelPackageVersionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NeoVpcConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
compilationJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputConfig
outputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StoppingCondition
stoppingCondition

instance Prelude.NFData CreateCompilationJob where
  rnf :: CreateCompilationJob -> ()
rnf CreateCompilationJob' {Maybe [Tag]
Maybe Text
Maybe InputConfig
Maybe NeoVpcConfig
Text
StoppingCondition
OutputConfig
stoppingCondition :: StoppingCondition
outputConfig :: OutputConfig
roleArn :: Text
compilationJobName :: Text
vpcConfig :: Maybe NeoVpcConfig
tags :: Maybe [Tag]
modelPackageVersionArn :: Maybe Text
inputConfig :: Maybe InputConfig
$sel:stoppingCondition:CreateCompilationJob' :: CreateCompilationJob -> StoppingCondition
$sel:outputConfig:CreateCompilationJob' :: CreateCompilationJob -> OutputConfig
$sel:roleArn:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:compilationJobName:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:vpcConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe NeoVpcConfig
$sel:tags:CreateCompilationJob' :: CreateCompilationJob -> Maybe [Tag]
$sel:modelPackageVersionArn:CreateCompilationJob' :: CreateCompilationJob -> Maybe Text
$sel:inputConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe InputConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InputConfig
inputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelPackageVersionArn
      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 NeoVpcConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
compilationJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OutputConfig
outputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StoppingCondition
stoppingCondition

instance Data.ToHeaders CreateCompilationJob where
  toHeaders :: CreateCompilationJob -> 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.CreateCompilationJob" ::
                          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 CreateCompilationJob where
  toJSON :: CreateCompilationJob -> Value
toJSON CreateCompilationJob' {Maybe [Tag]
Maybe Text
Maybe InputConfig
Maybe NeoVpcConfig
Text
StoppingCondition
OutputConfig
stoppingCondition :: StoppingCondition
outputConfig :: OutputConfig
roleArn :: Text
compilationJobName :: Text
vpcConfig :: Maybe NeoVpcConfig
tags :: Maybe [Tag]
modelPackageVersionArn :: Maybe Text
inputConfig :: Maybe InputConfig
$sel:stoppingCondition:CreateCompilationJob' :: CreateCompilationJob -> StoppingCondition
$sel:outputConfig:CreateCompilationJob' :: CreateCompilationJob -> OutputConfig
$sel:roleArn:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:compilationJobName:CreateCompilationJob' :: CreateCompilationJob -> Text
$sel:vpcConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe NeoVpcConfig
$sel:tags:CreateCompilationJob' :: CreateCompilationJob -> Maybe [Tag]
$sel:modelPackageVersionArn:CreateCompilationJob' :: CreateCompilationJob -> Maybe Text
$sel:inputConfig:CreateCompilationJob' :: CreateCompilationJob -> Maybe InputConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InputConfig" 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 InputConfig
inputConfig,
            (Key
"ModelPackageVersionArn" 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
modelPackageVersionArn,
            (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
"VpcConfig" 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 NeoVpcConfig
vpcConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CompilationJobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
compilationJobName),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"OutputConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OutputConfig
outputConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StoppingCondition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StoppingCondition
stoppingCondition)
          ]
      )

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

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

-- | /See:/ 'newCreateCompilationJobResponse' smart constructor.
data CreateCompilationJobResponse = CreateCompilationJobResponse'
  { -- | The response's http status code.
    CreateCompilationJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | If the action is successful, the service sends back an HTTP 200
    -- response. Amazon SageMaker returns the following data in JSON format:
    --
    -- -   @CompilationJobArn@: The Amazon Resource Name (ARN) of the compiled
    --     job.
    CreateCompilationJobResponse -> Text
compilationJobArn :: Prelude.Text
  }
  deriving (CreateCompilationJobResponse
-> CreateCompilationJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCompilationJobResponse
-> CreateCompilationJobResponse -> Bool
$c/= :: CreateCompilationJobResponse
-> CreateCompilationJobResponse -> Bool
== :: CreateCompilationJobResponse
-> CreateCompilationJobResponse -> Bool
$c== :: CreateCompilationJobResponse
-> CreateCompilationJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateCompilationJobResponse]
ReadPrec CreateCompilationJobResponse
Int -> ReadS CreateCompilationJobResponse
ReadS [CreateCompilationJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCompilationJobResponse]
$creadListPrec :: ReadPrec [CreateCompilationJobResponse]
readPrec :: ReadPrec CreateCompilationJobResponse
$creadPrec :: ReadPrec CreateCompilationJobResponse
readList :: ReadS [CreateCompilationJobResponse]
$creadList :: ReadS [CreateCompilationJobResponse]
readsPrec :: Int -> ReadS CreateCompilationJobResponse
$creadsPrec :: Int -> ReadS CreateCompilationJobResponse
Prelude.Read, Int -> CreateCompilationJobResponse -> ShowS
[CreateCompilationJobResponse] -> ShowS
CreateCompilationJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCompilationJobResponse] -> ShowS
$cshowList :: [CreateCompilationJobResponse] -> ShowS
show :: CreateCompilationJobResponse -> String
$cshow :: CreateCompilationJobResponse -> String
showsPrec :: Int -> CreateCompilationJobResponse -> ShowS
$cshowsPrec :: Int -> CreateCompilationJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCompilationJobResponse x -> CreateCompilationJobResponse
forall x.
CreateCompilationJobResponse -> Rep CreateCompilationJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCompilationJobResponse x -> CreateCompilationJobResponse
$cfrom :: forall x.
CreateCompilationJobResponse -> Rep CreateCompilationJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCompilationJobResponse' 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', 'createCompilationJobResponse_httpStatus' - The response's http status code.
--
-- 'compilationJobArn', 'createCompilationJobResponse_compilationJobArn' - If the action is successful, the service sends back an HTTP 200
-- response. Amazon SageMaker returns the following data in JSON format:
--
-- -   @CompilationJobArn@: The Amazon Resource Name (ARN) of the compiled
--     job.
newCreateCompilationJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'compilationJobArn'
  Prelude.Text ->
  CreateCompilationJobResponse
newCreateCompilationJobResponse :: Int -> Text -> CreateCompilationJobResponse
newCreateCompilationJobResponse
  Int
pHttpStatus_
  Text
pCompilationJobArn_ =
    CreateCompilationJobResponse'
      { $sel:httpStatus:CreateCompilationJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:compilationJobArn:CreateCompilationJobResponse' :: Text
compilationJobArn = Text
pCompilationJobArn_
      }

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

-- | If the action is successful, the service sends back an HTTP 200
-- response. Amazon SageMaker returns the following data in JSON format:
--
-- -   @CompilationJobArn@: The Amazon Resource Name (ARN) of the compiled
--     job.
createCompilationJobResponse_compilationJobArn :: Lens.Lens' CreateCompilationJobResponse Prelude.Text
createCompilationJobResponse_compilationJobArn :: Lens' CreateCompilationJobResponse Text
createCompilationJobResponse_compilationJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCompilationJobResponse' {Text
compilationJobArn :: Text
$sel:compilationJobArn:CreateCompilationJobResponse' :: CreateCompilationJobResponse -> Text
compilationJobArn} -> Text
compilationJobArn) (\s :: CreateCompilationJobResponse
s@CreateCompilationJobResponse' {} Text
a -> CreateCompilationJobResponse
s {$sel:compilationJobArn:CreateCompilationJobResponse' :: Text
compilationJobArn = Text
a} :: CreateCompilationJobResponse)

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