{-# 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.ComprehendMedical.StartRxNormInferenceJob
-- 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 an asynchronous job to detect medication entities and link them
-- to the RxNorm ontology. Use the @DescribeRxNormInferenceJob@ operation
-- to track the status of a job.
module Amazonka.ComprehendMedical.StartRxNormInferenceJob
  ( -- * Creating a Request
    StartRxNormInferenceJob (..),
    newStartRxNormInferenceJob,

    -- * Request Lenses
    startRxNormInferenceJob_clientRequestToken,
    startRxNormInferenceJob_jobName,
    startRxNormInferenceJob_kmsKey,
    startRxNormInferenceJob_inputDataConfig,
    startRxNormInferenceJob_outputDataConfig,
    startRxNormInferenceJob_dataAccessRoleArn,
    startRxNormInferenceJob_languageCode,

    -- * Destructuring the Response
    StartRxNormInferenceJobResponse (..),
    newStartRxNormInferenceJobResponse,

    -- * Response Lenses
    startRxNormInferenceJobResponse_jobId,
    startRxNormInferenceJobResponse_httpStatus,
  )
where

import Amazonka.ComprehendMedical.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:/ 'newStartRxNormInferenceJob' smart constructor.
data StartRxNormInferenceJob = StartRxNormInferenceJob'
  { -- | A unique identifier for the request. If you don\'t set the client
    -- request token, Comprehend Medical; generates one.
    StartRxNormInferenceJob -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the job.
    StartRxNormInferenceJob -> Maybe Text
jobName :: Prelude.Maybe Prelude.Text,
    -- | An AWS Key Management Service key to encrypt your output files. If you
    -- do not specify a key, the files are written in plain text.
    StartRxNormInferenceJob -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | Specifies the format and location of the input data for the job.
    StartRxNormInferenceJob -> InputDataConfig
inputDataConfig :: InputDataConfig,
    -- | Specifies where to send the output files.
    StartRxNormInferenceJob -> OutputDataConfig
outputDataConfig :: OutputDataConfig,
    -- | The Amazon Resource Name (ARN) of the AWS Identity and Access Management
    -- (IAM) role that grants Comprehend Medical; read access to your input
    -- data. For more information, see
    -- <https://docs.aws.amazon.com/comprehend/latest/dg/access-control-managing-permissions-med.html#auth-role-permissions-med Role-Based Permissions Required for Asynchronous Operations>.
    StartRxNormInferenceJob -> Text
dataAccessRoleArn :: Prelude.Text,
    -- | The language of the input documents. All documents must be in the same
    -- language.
    StartRxNormInferenceJob -> LanguageCode
languageCode :: LanguageCode
  }
  deriving (StartRxNormInferenceJob -> StartRxNormInferenceJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartRxNormInferenceJob -> StartRxNormInferenceJob -> Bool
$c/= :: StartRxNormInferenceJob -> StartRxNormInferenceJob -> Bool
== :: StartRxNormInferenceJob -> StartRxNormInferenceJob -> Bool
$c== :: StartRxNormInferenceJob -> StartRxNormInferenceJob -> Bool
Prelude.Eq, ReadPrec [StartRxNormInferenceJob]
ReadPrec StartRxNormInferenceJob
Int -> ReadS StartRxNormInferenceJob
ReadS [StartRxNormInferenceJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartRxNormInferenceJob]
$creadListPrec :: ReadPrec [StartRxNormInferenceJob]
readPrec :: ReadPrec StartRxNormInferenceJob
$creadPrec :: ReadPrec StartRxNormInferenceJob
readList :: ReadS [StartRxNormInferenceJob]
$creadList :: ReadS [StartRxNormInferenceJob]
readsPrec :: Int -> ReadS StartRxNormInferenceJob
$creadsPrec :: Int -> ReadS StartRxNormInferenceJob
Prelude.Read, Int -> StartRxNormInferenceJob -> ShowS
[StartRxNormInferenceJob] -> ShowS
StartRxNormInferenceJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartRxNormInferenceJob] -> ShowS
$cshowList :: [StartRxNormInferenceJob] -> ShowS
show :: StartRxNormInferenceJob -> String
$cshow :: StartRxNormInferenceJob -> String
showsPrec :: Int -> StartRxNormInferenceJob -> ShowS
$cshowsPrec :: Int -> StartRxNormInferenceJob -> ShowS
Prelude.Show, forall x. Rep StartRxNormInferenceJob x -> StartRxNormInferenceJob
forall x. StartRxNormInferenceJob -> Rep StartRxNormInferenceJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartRxNormInferenceJob x -> StartRxNormInferenceJob
$cfrom :: forall x. StartRxNormInferenceJob -> Rep StartRxNormInferenceJob x
Prelude.Generic)

-- |
-- Create a value of 'StartRxNormInferenceJob' 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:
--
-- 'clientRequestToken', 'startRxNormInferenceJob_clientRequestToken' - A unique identifier for the request. If you don\'t set the client
-- request token, Comprehend Medical; generates one.
--
-- 'jobName', 'startRxNormInferenceJob_jobName' - The identifier of the job.
--
-- 'kmsKey', 'startRxNormInferenceJob_kmsKey' - An AWS Key Management Service key to encrypt your output files. If you
-- do not specify a key, the files are written in plain text.
--
-- 'inputDataConfig', 'startRxNormInferenceJob_inputDataConfig' - Specifies the format and location of the input data for the job.
--
-- 'outputDataConfig', 'startRxNormInferenceJob_outputDataConfig' - Specifies where to send the output files.
--
-- 'dataAccessRoleArn', 'startRxNormInferenceJob_dataAccessRoleArn' - The Amazon Resource Name (ARN) of the AWS Identity and Access Management
-- (IAM) role that grants Comprehend Medical; read access to your input
-- data. For more information, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/access-control-managing-permissions-med.html#auth-role-permissions-med Role-Based Permissions Required for Asynchronous Operations>.
--
-- 'languageCode', 'startRxNormInferenceJob_languageCode' - The language of the input documents. All documents must be in the same
-- language.
newStartRxNormInferenceJob ::
  -- | 'inputDataConfig'
  InputDataConfig ->
  -- | 'outputDataConfig'
  OutputDataConfig ->
  -- | 'dataAccessRoleArn'
  Prelude.Text ->
  -- | 'languageCode'
  LanguageCode ->
  StartRxNormInferenceJob
newStartRxNormInferenceJob :: InputDataConfig
-> OutputDataConfig
-> Text
-> LanguageCode
-> StartRxNormInferenceJob
newStartRxNormInferenceJob
  InputDataConfig
pInputDataConfig_
  OutputDataConfig
pOutputDataConfig_
  Text
pDataAccessRoleArn_
  LanguageCode
pLanguageCode_ =
    StartRxNormInferenceJob'
      { $sel:clientRequestToken:StartRxNormInferenceJob' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:jobName:StartRxNormInferenceJob' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKey:StartRxNormInferenceJob' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
        $sel:inputDataConfig:StartRxNormInferenceJob' :: InputDataConfig
inputDataConfig = InputDataConfig
pInputDataConfig_,
        $sel:outputDataConfig:StartRxNormInferenceJob' :: OutputDataConfig
outputDataConfig = OutputDataConfig
pOutputDataConfig_,
        $sel:dataAccessRoleArn:StartRxNormInferenceJob' :: Text
dataAccessRoleArn = Text
pDataAccessRoleArn_,
        $sel:languageCode:StartRxNormInferenceJob' :: LanguageCode
languageCode = LanguageCode
pLanguageCode_
      }

-- | A unique identifier for the request. If you don\'t set the client
-- request token, Comprehend Medical; generates one.
startRxNormInferenceJob_clientRequestToken :: Lens.Lens' StartRxNormInferenceJob (Prelude.Maybe Prelude.Text)
startRxNormInferenceJob_clientRequestToken :: Lens' StartRxNormInferenceJob (Maybe Text)
startRxNormInferenceJob_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} Maybe Text
a -> StartRxNormInferenceJob
s {$sel:clientRequestToken:StartRxNormInferenceJob' :: Maybe Text
clientRequestToken = Maybe Text
a} :: StartRxNormInferenceJob)

-- | The identifier of the job.
startRxNormInferenceJob_jobName :: Lens.Lens' StartRxNormInferenceJob (Prelude.Maybe Prelude.Text)
startRxNormInferenceJob_jobName :: Lens' StartRxNormInferenceJob (Maybe Text)
startRxNormInferenceJob_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {Maybe Text
jobName :: Maybe Text
$sel:jobName:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} Maybe Text
a -> StartRxNormInferenceJob
s {$sel:jobName:StartRxNormInferenceJob' :: Maybe Text
jobName = Maybe Text
a} :: StartRxNormInferenceJob)

-- | An AWS Key Management Service key to encrypt your output files. If you
-- do not specify a key, the files are written in plain text.
startRxNormInferenceJob_kmsKey :: Lens.Lens' StartRxNormInferenceJob (Prelude.Maybe Prelude.Text)
startRxNormInferenceJob_kmsKey :: Lens' StartRxNormInferenceJob (Maybe Text)
startRxNormInferenceJob_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} Maybe Text
a -> StartRxNormInferenceJob
s {$sel:kmsKey:StartRxNormInferenceJob' :: Maybe Text
kmsKey = Maybe Text
a} :: StartRxNormInferenceJob)

-- | Specifies the format and location of the input data for the job.
startRxNormInferenceJob_inputDataConfig :: Lens.Lens' StartRxNormInferenceJob InputDataConfig
startRxNormInferenceJob_inputDataConfig :: Lens' StartRxNormInferenceJob InputDataConfig
startRxNormInferenceJob_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {InputDataConfig
inputDataConfig :: InputDataConfig
$sel:inputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> InputDataConfig
inputDataConfig} -> InputDataConfig
inputDataConfig) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} InputDataConfig
a -> StartRxNormInferenceJob
s {$sel:inputDataConfig:StartRxNormInferenceJob' :: InputDataConfig
inputDataConfig = InputDataConfig
a} :: StartRxNormInferenceJob)

-- | Specifies where to send the output files.
startRxNormInferenceJob_outputDataConfig :: Lens.Lens' StartRxNormInferenceJob OutputDataConfig
startRxNormInferenceJob_outputDataConfig :: Lens' StartRxNormInferenceJob OutputDataConfig
startRxNormInferenceJob_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {OutputDataConfig
outputDataConfig :: OutputDataConfig
$sel:outputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> OutputDataConfig
outputDataConfig} -> OutputDataConfig
outputDataConfig) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} OutputDataConfig
a -> StartRxNormInferenceJob
s {$sel:outputDataConfig:StartRxNormInferenceJob' :: OutputDataConfig
outputDataConfig = OutputDataConfig
a} :: StartRxNormInferenceJob)

-- | The Amazon Resource Name (ARN) of the AWS Identity and Access Management
-- (IAM) role that grants Comprehend Medical; read access to your input
-- data. For more information, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/access-control-managing-permissions-med.html#auth-role-permissions-med Role-Based Permissions Required for Asynchronous Operations>.
startRxNormInferenceJob_dataAccessRoleArn :: Lens.Lens' StartRxNormInferenceJob Prelude.Text
startRxNormInferenceJob_dataAccessRoleArn :: Lens' StartRxNormInferenceJob Text
startRxNormInferenceJob_dataAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {Text
dataAccessRoleArn :: Text
$sel:dataAccessRoleArn:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Text
dataAccessRoleArn} -> Text
dataAccessRoleArn) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} Text
a -> StartRxNormInferenceJob
s {$sel:dataAccessRoleArn:StartRxNormInferenceJob' :: Text
dataAccessRoleArn = Text
a} :: StartRxNormInferenceJob)

-- | The language of the input documents. All documents must be in the same
-- language.
startRxNormInferenceJob_languageCode :: Lens.Lens' StartRxNormInferenceJob LanguageCode
startRxNormInferenceJob_languageCode :: Lens' StartRxNormInferenceJob LanguageCode
startRxNormInferenceJob_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJob' {LanguageCode
languageCode :: LanguageCode
$sel:languageCode:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> LanguageCode
languageCode} -> LanguageCode
languageCode) (\s :: StartRxNormInferenceJob
s@StartRxNormInferenceJob' {} LanguageCode
a -> StartRxNormInferenceJob
s {$sel:languageCode:StartRxNormInferenceJob' :: LanguageCode
languageCode = LanguageCode
a} :: StartRxNormInferenceJob)

instance Core.AWSRequest StartRxNormInferenceJob where
  type
    AWSResponse StartRxNormInferenceJob =
      StartRxNormInferenceJobResponse
  request :: (Service -> Service)
-> StartRxNormInferenceJob -> Request StartRxNormInferenceJob
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 StartRxNormInferenceJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartRxNormInferenceJob)))
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 Text -> Int -> StartRxNormInferenceJobResponse
StartRxNormInferenceJobResponse'
            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
"JobId")
            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 StartRxNormInferenceJob where
  hashWithSalt :: Int -> StartRxNormInferenceJob -> Int
hashWithSalt Int
_salt StartRxNormInferenceJob' {Maybe Text
Text
InputDataConfig
LanguageCode
OutputDataConfig
languageCode :: LanguageCode
dataAccessRoleArn :: Text
outputDataConfig :: OutputDataConfig
inputDataConfig :: InputDataConfig
kmsKey :: Maybe Text
jobName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:languageCode:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> LanguageCode
$sel:dataAccessRoleArn:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Text
$sel:outputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> OutputDataConfig
$sel:inputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> InputDataConfig
$sel:kmsKey:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:jobName:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:clientRequestToken:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InputDataConfig
inputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputDataConfig
outputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataAccessRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LanguageCode
languageCode

instance Prelude.NFData StartRxNormInferenceJob where
  rnf :: StartRxNormInferenceJob -> ()
rnf StartRxNormInferenceJob' {Maybe Text
Text
InputDataConfig
LanguageCode
OutputDataConfig
languageCode :: LanguageCode
dataAccessRoleArn :: Text
outputDataConfig :: OutputDataConfig
inputDataConfig :: InputDataConfig
kmsKey :: Maybe Text
jobName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:languageCode:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> LanguageCode
$sel:dataAccessRoleArn:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Text
$sel:outputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> OutputDataConfig
$sel:inputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> InputDataConfig
$sel:kmsKey:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:jobName:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:clientRequestToken:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InputDataConfig
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OutputDataConfig
outputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataAccessRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LanguageCode
languageCode

instance Data.ToHeaders StartRxNormInferenceJob where
  toHeaders :: StartRxNormInferenceJob -> 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
"ComprehendMedical_20181030.StartRxNormInferenceJob" ::
                          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 StartRxNormInferenceJob where
  toJSON :: StartRxNormInferenceJob -> Value
toJSON StartRxNormInferenceJob' {Maybe Text
Text
InputDataConfig
LanguageCode
OutputDataConfig
languageCode :: LanguageCode
dataAccessRoleArn :: Text
outputDataConfig :: OutputDataConfig
inputDataConfig :: InputDataConfig
kmsKey :: Maybe Text
jobName :: Maybe Text
clientRequestToken :: Maybe Text
$sel:languageCode:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> LanguageCode
$sel:dataAccessRoleArn:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Text
$sel:outputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> OutputDataConfig
$sel:inputDataConfig:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> InputDataConfig
$sel:kmsKey:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:jobName:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
$sel:clientRequestToken:StartRxNormInferenceJob' :: StartRxNormInferenceJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"JobName" 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
jobName,
            (Key
"KMSKey" 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
kmsKey,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InputDataConfig
inputDataConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OutputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OutputDataConfig
outputDataConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DataAccessRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataAccessRoleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LanguageCode
languageCode)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartRxNormInferenceJobResponse' 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:
--
-- 'jobId', 'startRxNormInferenceJobResponse_jobId' - The identifier of the job.
--
-- 'httpStatus', 'startRxNormInferenceJobResponse_httpStatus' - The response's http status code.
newStartRxNormInferenceJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartRxNormInferenceJobResponse
newStartRxNormInferenceJobResponse :: Int -> StartRxNormInferenceJobResponse
newStartRxNormInferenceJobResponse Int
pHttpStatus_ =
  StartRxNormInferenceJobResponse'
    { $sel:jobId:StartRxNormInferenceJobResponse' :: Maybe Text
jobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartRxNormInferenceJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the job.
startRxNormInferenceJobResponse_jobId :: Lens.Lens' StartRxNormInferenceJobResponse (Prelude.Maybe Prelude.Text)
startRxNormInferenceJobResponse_jobId :: Lens' StartRxNormInferenceJobResponse (Maybe Text)
startRxNormInferenceJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartRxNormInferenceJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StartRxNormInferenceJobResponse' :: StartRxNormInferenceJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StartRxNormInferenceJobResponse
s@StartRxNormInferenceJobResponse' {} Maybe Text
a -> StartRxNormInferenceJobResponse
s {$sel:jobId:StartRxNormInferenceJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: StartRxNormInferenceJobResponse)

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

instance
  Prelude.NFData
    StartRxNormInferenceJobResponse
  where
  rnf :: StartRxNormInferenceJobResponse -> ()
rnf StartRxNormInferenceJobResponse' {Int
Maybe Text
httpStatus :: Int
jobId :: Maybe Text
$sel:httpStatus:StartRxNormInferenceJobResponse' :: StartRxNormInferenceJobResponse -> Int
$sel:jobId:StartRxNormInferenceJobResponse' :: StartRxNormInferenceJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus