{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Comprehend.Types.KeyPhrasesDetectionJobProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Comprehend.Types.KeyPhrasesDetectionJobProperties where

import Amazonka.Comprehend.Types.InputDataConfig
import Amazonka.Comprehend.Types.JobStatus
import Amazonka.Comprehend.Types.LanguageCode
import Amazonka.Comprehend.Types.OutputDataConfig
import Amazonka.Comprehend.Types.VpcConfig
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

-- | Provides information about a key phrases detection job.
--
-- /See:/ 'newKeyPhrasesDetectionJobProperties' smart constructor.
data KeyPhrasesDetectionJobProperties = KeyPhrasesDetectionJobProperties'
  { -- | The Amazon Resource Name (ARN) that gives Amazon Comprehend read access
    -- to your input data.
    KeyPhrasesDetectionJobProperties -> Maybe Text
dataAccessRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The time that the key phrases detection job completed.
    KeyPhrasesDetectionJobProperties -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | The input data configuration that you supplied when you created the key
    -- phrases detection job.
    KeyPhrasesDetectionJobProperties -> Maybe InputDataConfig
inputDataConfig :: Prelude.Maybe InputDataConfig,
    -- | The Amazon Resource Name (ARN) of the key phrases detection job. It is a
    -- unique, fully qualified identifier for the job. It includes the AWS
    -- account, Region, and the job ID. The format of the ARN is as follows:
    --
    -- @arn:\<partition>:comprehend:\<region>:\<account-id>:key-phrases-detection-job\/\<job-id>@
    --
    -- The following is an example job ARN:
    --
    -- @arn:aws:comprehend:us-west-2:111122223333:key-phrases-detection-job\/1234abcd12ab34cd56ef1234567890ab@
    KeyPhrasesDetectionJobProperties -> Maybe Text
jobArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier assigned to the key phrases detection job.
    KeyPhrasesDetectionJobProperties -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The name that you assigned the key phrases detection job.
    KeyPhrasesDetectionJobProperties -> Maybe Text
jobName :: Prelude.Maybe Prelude.Text,
    -- | The current status of the key phrases detection job. If the status is
    -- @FAILED@, the @Message@ field shows the reason for the failure.
    KeyPhrasesDetectionJobProperties -> Maybe JobStatus
jobStatus :: Prelude.Maybe JobStatus,
    -- | The language code of the input documents.
    KeyPhrasesDetectionJobProperties -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | A description of the status of a job.
    KeyPhrasesDetectionJobProperties -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The output data configuration that you supplied when you created the key
    -- phrases detection job.
    KeyPhrasesDetectionJobProperties -> Maybe OutputDataConfig
outputDataConfig :: Prelude.Maybe OutputDataConfig,
    -- | The time that the key phrases detection job was submitted for
    -- processing.
    KeyPhrasesDetectionJobProperties -> Maybe POSIX
submitTime :: Prelude.Maybe Data.POSIX,
    -- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
    -- uses to encrypt data on the storage volume attached to the ML compute
    -- instance(s) that process the analysis job. The VolumeKmsKeyId can be
    -- either of the following formats:
    --
    -- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
    --
    -- -   Amazon Resource Name (ARN) of a KMS Key:
    --     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
    KeyPhrasesDetectionJobProperties -> Maybe Text
volumeKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Configuration parameters for a private Virtual Private Cloud (VPC)
    -- containing the resources you are using for your key phrases detection
    -- job. For more information, see
    -- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
    KeyPhrasesDetectionJobProperties -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig
  }
  deriving (KeyPhrasesDetectionJobProperties
-> KeyPhrasesDetectionJobProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyPhrasesDetectionJobProperties
-> KeyPhrasesDetectionJobProperties -> Bool
$c/= :: KeyPhrasesDetectionJobProperties
-> KeyPhrasesDetectionJobProperties -> Bool
== :: KeyPhrasesDetectionJobProperties
-> KeyPhrasesDetectionJobProperties -> Bool
$c== :: KeyPhrasesDetectionJobProperties
-> KeyPhrasesDetectionJobProperties -> Bool
Prelude.Eq, ReadPrec [KeyPhrasesDetectionJobProperties]
ReadPrec KeyPhrasesDetectionJobProperties
Int -> ReadS KeyPhrasesDetectionJobProperties
ReadS [KeyPhrasesDetectionJobProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KeyPhrasesDetectionJobProperties]
$creadListPrec :: ReadPrec [KeyPhrasesDetectionJobProperties]
readPrec :: ReadPrec KeyPhrasesDetectionJobProperties
$creadPrec :: ReadPrec KeyPhrasesDetectionJobProperties
readList :: ReadS [KeyPhrasesDetectionJobProperties]
$creadList :: ReadS [KeyPhrasesDetectionJobProperties]
readsPrec :: Int -> ReadS KeyPhrasesDetectionJobProperties
$creadsPrec :: Int -> ReadS KeyPhrasesDetectionJobProperties
Prelude.Read, Int -> KeyPhrasesDetectionJobProperties -> ShowS
[KeyPhrasesDetectionJobProperties] -> ShowS
KeyPhrasesDetectionJobProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyPhrasesDetectionJobProperties] -> ShowS
$cshowList :: [KeyPhrasesDetectionJobProperties] -> ShowS
show :: KeyPhrasesDetectionJobProperties -> String
$cshow :: KeyPhrasesDetectionJobProperties -> String
showsPrec :: Int -> KeyPhrasesDetectionJobProperties -> ShowS
$cshowsPrec :: Int -> KeyPhrasesDetectionJobProperties -> ShowS
Prelude.Show, forall x.
Rep KeyPhrasesDetectionJobProperties x
-> KeyPhrasesDetectionJobProperties
forall x.
KeyPhrasesDetectionJobProperties
-> Rep KeyPhrasesDetectionJobProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep KeyPhrasesDetectionJobProperties x
-> KeyPhrasesDetectionJobProperties
$cfrom :: forall x.
KeyPhrasesDetectionJobProperties
-> Rep KeyPhrasesDetectionJobProperties x
Prelude.Generic)

-- |
-- Create a value of 'KeyPhrasesDetectionJobProperties' 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:
--
-- 'dataAccessRoleArn', 'keyPhrasesDetectionJobProperties_dataAccessRoleArn' - The Amazon Resource Name (ARN) that gives Amazon Comprehend read access
-- to your input data.
--
-- 'endTime', 'keyPhrasesDetectionJobProperties_endTime' - The time that the key phrases detection job completed.
--
-- 'inputDataConfig', 'keyPhrasesDetectionJobProperties_inputDataConfig' - The input data configuration that you supplied when you created the key
-- phrases detection job.
--
-- 'jobArn', 'keyPhrasesDetectionJobProperties_jobArn' - The Amazon Resource Name (ARN) of the key phrases detection job. It is a
-- unique, fully qualified identifier for the job. It includes the AWS
-- account, Region, and the job ID. The format of the ARN is as follows:
--
-- @arn:\<partition>:comprehend:\<region>:\<account-id>:key-phrases-detection-job\/\<job-id>@
--
-- The following is an example job ARN:
--
-- @arn:aws:comprehend:us-west-2:111122223333:key-phrases-detection-job\/1234abcd12ab34cd56ef1234567890ab@
--
-- 'jobId', 'keyPhrasesDetectionJobProperties_jobId' - The identifier assigned to the key phrases detection job.
--
-- 'jobName', 'keyPhrasesDetectionJobProperties_jobName' - The name that you assigned the key phrases detection job.
--
-- 'jobStatus', 'keyPhrasesDetectionJobProperties_jobStatus' - The current status of the key phrases detection job. If the status is
-- @FAILED@, the @Message@ field shows the reason for the failure.
--
-- 'languageCode', 'keyPhrasesDetectionJobProperties_languageCode' - The language code of the input documents.
--
-- 'message', 'keyPhrasesDetectionJobProperties_message' - A description of the status of a job.
--
-- 'outputDataConfig', 'keyPhrasesDetectionJobProperties_outputDataConfig' - The output data configuration that you supplied when you created the key
-- phrases detection job.
--
-- 'submitTime', 'keyPhrasesDetectionJobProperties_submitTime' - The time that the key phrases detection job was submitted for
-- processing.
--
-- 'volumeKmsKeyId', 'keyPhrasesDetectionJobProperties_volumeKmsKeyId' - ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt data on the storage volume attached to the ML compute
-- instance(s) that process the analysis job. The VolumeKmsKeyId can be
-- either of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- 'vpcConfig', 'keyPhrasesDetectionJobProperties_vpcConfig' - Configuration parameters for a private Virtual Private Cloud (VPC)
-- containing the resources you are using for your key phrases detection
-- job. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
newKeyPhrasesDetectionJobProperties ::
  KeyPhrasesDetectionJobProperties
newKeyPhrasesDetectionJobProperties :: KeyPhrasesDetectionJobProperties
newKeyPhrasesDetectionJobProperties =
  KeyPhrasesDetectionJobProperties'
    { $sel:dataAccessRoleArn:KeyPhrasesDetectionJobProperties' :: Maybe Text
dataAccessRoleArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:KeyPhrasesDetectionJobProperties' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:inputDataConfig:KeyPhrasesDetectionJobProperties' :: Maybe InputDataConfig
inputDataConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobArn:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobArn = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
      $sel:jobStatus:KeyPhrasesDetectionJobProperties' :: Maybe JobStatus
jobStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:KeyPhrasesDetectionJobProperties' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:message:KeyPhrasesDetectionJobProperties' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:outputDataConfig:KeyPhrasesDetectionJobProperties' :: Maybe OutputDataConfig
outputDataConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:submitTime:KeyPhrasesDetectionJobProperties' :: Maybe POSIX
submitTime = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeKmsKeyId:KeyPhrasesDetectionJobProperties' :: Maybe Text
volumeKmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:KeyPhrasesDetectionJobProperties' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) that gives Amazon Comprehend read access
-- to your input data.
keyPhrasesDetectionJobProperties_dataAccessRoleArn :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_dataAccessRoleArn :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_dataAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:dataAccessRoleArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
dataAccessRoleArn} -> Maybe Text
dataAccessRoleArn) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:dataAccessRoleArn:KeyPhrasesDetectionJobProperties' :: Maybe Text
dataAccessRoleArn = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | The time that the key phrases detection job completed.
keyPhrasesDetectionJobProperties_endTime :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.UTCTime)
keyPhrasesDetectionJobProperties_endTime :: Lens' KeyPhrasesDetectionJobProperties (Maybe UTCTime)
keyPhrasesDetectionJobProperties_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe POSIX
a -> KeyPhrasesDetectionJobProperties
s {$sel:endTime:KeyPhrasesDetectionJobProperties' :: Maybe POSIX
endTime = Maybe POSIX
a} :: KeyPhrasesDetectionJobProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The input data configuration that you supplied when you created the key
-- phrases detection job.
keyPhrasesDetectionJobProperties_inputDataConfig :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe InputDataConfig)
keyPhrasesDetectionJobProperties_inputDataConfig :: Lens' KeyPhrasesDetectionJobProperties (Maybe InputDataConfig)
keyPhrasesDetectionJobProperties_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe InputDataConfig
inputDataConfig :: Maybe InputDataConfig
$sel:inputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe InputDataConfig
inputDataConfig} -> Maybe InputDataConfig
inputDataConfig) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe InputDataConfig
a -> KeyPhrasesDetectionJobProperties
s {$sel:inputDataConfig:KeyPhrasesDetectionJobProperties' :: Maybe InputDataConfig
inputDataConfig = Maybe InputDataConfig
a} :: KeyPhrasesDetectionJobProperties)

-- | The Amazon Resource Name (ARN) of the key phrases detection job. It is a
-- unique, fully qualified identifier for the job. It includes the AWS
-- account, Region, and the job ID. The format of the ARN is as follows:
--
-- @arn:\<partition>:comprehend:\<region>:\<account-id>:key-phrases-detection-job\/\<job-id>@
--
-- The following is an example job ARN:
--
-- @arn:aws:comprehend:us-west-2:111122223333:key-phrases-detection-job\/1234abcd12ab34cd56ef1234567890ab@
keyPhrasesDetectionJobProperties_jobArn :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_jobArn :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
jobArn :: Maybe Text
$sel:jobArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
jobArn} -> Maybe Text
jobArn) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:jobArn:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobArn = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | The identifier assigned to the key phrases detection job.
keyPhrasesDetectionJobProperties_jobId :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_jobId :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
jobId :: Maybe Text
$sel:jobId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:jobId:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobId = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | The name that you assigned the key phrases detection job.
keyPhrasesDetectionJobProperties_jobName :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_jobName :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
jobName :: Maybe Text
$sel:jobName:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:jobName:KeyPhrasesDetectionJobProperties' :: Maybe Text
jobName = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | The current status of the key phrases detection job. If the status is
-- @FAILED@, the @Message@ field shows the reason for the failure.
keyPhrasesDetectionJobProperties_jobStatus :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe JobStatus)
keyPhrasesDetectionJobProperties_jobStatus :: Lens' KeyPhrasesDetectionJobProperties (Maybe JobStatus)
keyPhrasesDetectionJobProperties_jobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe JobStatus
jobStatus :: Maybe JobStatus
$sel:jobStatus:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe JobStatus
jobStatus} -> Maybe JobStatus
jobStatus) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe JobStatus
a -> KeyPhrasesDetectionJobProperties
s {$sel:jobStatus:KeyPhrasesDetectionJobProperties' :: Maybe JobStatus
jobStatus = Maybe JobStatus
a} :: KeyPhrasesDetectionJobProperties)

-- | The language code of the input documents.
keyPhrasesDetectionJobProperties_languageCode :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe LanguageCode)
keyPhrasesDetectionJobProperties_languageCode :: Lens' KeyPhrasesDetectionJobProperties (Maybe LanguageCode)
keyPhrasesDetectionJobProperties_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe LanguageCode
a -> KeyPhrasesDetectionJobProperties
s {$sel:languageCode:KeyPhrasesDetectionJobProperties' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: KeyPhrasesDetectionJobProperties)

-- | A description of the status of a job.
keyPhrasesDetectionJobProperties_message :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_message :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
message :: Maybe Text
$sel:message:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
message} -> Maybe Text
message) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:message:KeyPhrasesDetectionJobProperties' :: Maybe Text
message = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | The output data configuration that you supplied when you created the key
-- phrases detection job.
keyPhrasesDetectionJobProperties_outputDataConfig :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe OutputDataConfig)
keyPhrasesDetectionJobProperties_outputDataConfig :: Lens' KeyPhrasesDetectionJobProperties (Maybe OutputDataConfig)
keyPhrasesDetectionJobProperties_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe OutputDataConfig
outputDataConfig :: Maybe OutputDataConfig
$sel:outputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe OutputDataConfig
outputDataConfig} -> Maybe OutputDataConfig
outputDataConfig) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe OutputDataConfig
a -> KeyPhrasesDetectionJobProperties
s {$sel:outputDataConfig:KeyPhrasesDetectionJobProperties' :: Maybe OutputDataConfig
outputDataConfig = Maybe OutputDataConfig
a} :: KeyPhrasesDetectionJobProperties)

-- | The time that the key phrases detection job was submitted for
-- processing.
keyPhrasesDetectionJobProperties_submitTime :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.UTCTime)
keyPhrasesDetectionJobProperties_submitTime :: Lens' KeyPhrasesDetectionJobProperties (Maybe UTCTime)
keyPhrasesDetectionJobProperties_submitTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe POSIX
submitTime :: Maybe POSIX
$sel:submitTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
submitTime} -> Maybe POSIX
submitTime) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe POSIX
a -> KeyPhrasesDetectionJobProperties
s {$sel:submitTime:KeyPhrasesDetectionJobProperties' :: Maybe POSIX
submitTime = Maybe POSIX
a} :: KeyPhrasesDetectionJobProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt data on the storage volume attached to the ML compute
-- instance(s) that process the analysis job. The VolumeKmsKeyId can be
-- either of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
keyPhrasesDetectionJobProperties_volumeKmsKeyId :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe Prelude.Text)
keyPhrasesDetectionJobProperties_volumeKmsKeyId :: Lens' KeyPhrasesDetectionJobProperties (Maybe Text)
keyPhrasesDetectionJobProperties_volumeKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe Text
volumeKmsKeyId :: Maybe Text
$sel:volumeKmsKeyId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
volumeKmsKeyId} -> Maybe Text
volumeKmsKeyId) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe Text
a -> KeyPhrasesDetectionJobProperties
s {$sel:volumeKmsKeyId:KeyPhrasesDetectionJobProperties' :: Maybe Text
volumeKmsKeyId = Maybe Text
a} :: KeyPhrasesDetectionJobProperties)

-- | Configuration parameters for a private Virtual Private Cloud (VPC)
-- containing the resources you are using for your key phrases detection
-- job. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
keyPhrasesDetectionJobProperties_vpcConfig :: Lens.Lens' KeyPhrasesDetectionJobProperties (Prelude.Maybe VpcConfig)
keyPhrasesDetectionJobProperties_vpcConfig :: Lens' KeyPhrasesDetectionJobProperties (Maybe VpcConfig)
keyPhrasesDetectionJobProperties_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\KeyPhrasesDetectionJobProperties' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: KeyPhrasesDetectionJobProperties
s@KeyPhrasesDetectionJobProperties' {} Maybe VpcConfig
a -> KeyPhrasesDetectionJobProperties
s {$sel:vpcConfig:KeyPhrasesDetectionJobProperties' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: KeyPhrasesDetectionJobProperties)

instance
  Data.FromJSON
    KeyPhrasesDetectionJobProperties
  where
  parseJSON :: Value -> Parser KeyPhrasesDetectionJobProperties
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"KeyPhrasesDetectionJobProperties"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe InputDataConfig
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe JobStatus
-> Maybe LanguageCode
-> Maybe Text
-> Maybe OutputDataConfig
-> Maybe POSIX
-> Maybe Text
-> Maybe VpcConfig
-> KeyPhrasesDetectionJobProperties
KeyPhrasesDetectionJobProperties'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DataAccessRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EndTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"InputDataConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"JobArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"JobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"JobName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"JobStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LanguageCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OutputDataConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SubmitTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"VolumeKmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"VpcConfig")
      )

instance
  Prelude.Hashable
    KeyPhrasesDetectionJobProperties
  where
  hashWithSalt :: Int -> KeyPhrasesDetectionJobProperties -> Int
hashWithSalt
    Int
_salt
    KeyPhrasesDetectionJobProperties' {Maybe Text
Maybe POSIX
Maybe InputDataConfig
Maybe JobStatus
Maybe LanguageCode
Maybe OutputDataConfig
Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
volumeKmsKeyId :: Maybe Text
submitTime :: Maybe POSIX
outputDataConfig :: Maybe OutputDataConfig
message :: Maybe Text
languageCode :: Maybe LanguageCode
jobStatus :: Maybe JobStatus
jobName :: Maybe Text
jobId :: Maybe Text
jobArn :: Maybe Text
inputDataConfig :: Maybe InputDataConfig
endTime :: Maybe POSIX
dataAccessRoleArn :: Maybe Text
$sel:vpcConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe VpcConfig
$sel:volumeKmsKeyId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:submitTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
$sel:outputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe OutputDataConfig
$sel:message:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:languageCode:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe LanguageCode
$sel:jobStatus:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe JobStatus
$sel:jobName:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:jobId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:jobArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:inputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe InputDataConfig
$sel:endTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
$sel:dataAccessRoleArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataAccessRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputDataConfig
inputDataConfig
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobStatus
jobStatus
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LanguageCode
languageCode
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
message
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputDataConfig
outputDataConfig
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
submitTime
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
volumeKmsKeyId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfig
vpcConfig

instance
  Prelude.NFData
    KeyPhrasesDetectionJobProperties
  where
  rnf :: KeyPhrasesDetectionJobProperties -> ()
rnf KeyPhrasesDetectionJobProperties' {Maybe Text
Maybe POSIX
Maybe InputDataConfig
Maybe JobStatus
Maybe LanguageCode
Maybe OutputDataConfig
Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
volumeKmsKeyId :: Maybe Text
submitTime :: Maybe POSIX
outputDataConfig :: Maybe OutputDataConfig
message :: Maybe Text
languageCode :: Maybe LanguageCode
jobStatus :: Maybe JobStatus
jobName :: Maybe Text
jobId :: Maybe Text
jobArn :: Maybe Text
inputDataConfig :: Maybe InputDataConfig
endTime :: Maybe POSIX
dataAccessRoleArn :: Maybe Text
$sel:vpcConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe VpcConfig
$sel:volumeKmsKeyId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:submitTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
$sel:outputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe OutputDataConfig
$sel:message:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:languageCode:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe LanguageCode
$sel:jobStatus:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe JobStatus
$sel:jobName:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:jobId:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:jobArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
$sel:inputDataConfig:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe InputDataConfig
$sel:endTime:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe POSIX
$sel:dataAccessRoleArn:KeyPhrasesDetectionJobProperties' :: KeyPhrasesDetectionJobProperties -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataAccessRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputDataConfig
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobStatus
jobStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LanguageCode
languageCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputDataConfig
outputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
submitTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
volumeKmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfig
vpcConfig