{-# 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.Transcribe.Types.TranscriptionJob
-- 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.Transcribe.Types.TranscriptionJob 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 Amazonka.Transcribe.Types.ContentRedaction
import Amazonka.Transcribe.Types.JobExecutionSettings
import Amazonka.Transcribe.Types.LanguageCode
import Amazonka.Transcribe.Types.LanguageCodeItem
import Amazonka.Transcribe.Types.LanguageIdSettings
import Amazonka.Transcribe.Types.Media
import Amazonka.Transcribe.Types.MediaFormat
import Amazonka.Transcribe.Types.ModelSettings
import Amazonka.Transcribe.Types.Settings
import Amazonka.Transcribe.Types.SubtitlesOutput
import Amazonka.Transcribe.Types.Tag
import Amazonka.Transcribe.Types.Transcript
import Amazonka.Transcribe.Types.TranscriptionJobStatus

-- | Provides detailed information about a transcription job.
--
-- To view the status of the specified transcription job, check the
-- @TranscriptionJobStatus@ field. If the status is @COMPLETED@, the job is
-- finished and you can find the results at the location specified in
-- @TranscriptFileUri@. If the status is @FAILED@, @FailureReason@ provides
-- details on why your transcription job failed.
--
-- If you enabled content redaction, the redacted transcript can be found
-- at the location specified in @RedactedTranscriptFileUri@.
--
-- /See:/ 'newTranscriptionJob' smart constructor.
data TranscriptionJob = TranscriptionJob'
  { -- | The date and time the specified transcription job finished processing.
    --
    -- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
    -- example, @2022-05-04T12:33:13.922000-07:00@ represents a transcription
    -- job that started processing at 12:33 PM UTC-7 on May 4, 2022.
    TranscriptionJob -> Maybe POSIX
completionTime :: Prelude.Maybe Data.POSIX,
    -- | Indicates whether redaction was enabled in your transcript.
    TranscriptionJob -> Maybe ContentRedaction
contentRedaction :: Prelude.Maybe ContentRedaction,
    -- | The date and time the specified transcription job request was made.
    --
    -- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
    -- example, @2022-05-04T12:32:58.761000-07:00@ represents a transcription
    -- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
    TranscriptionJob -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | If @TranscriptionJobStatus@ is @FAILED@, @FailureReason@ contains
    -- information about why the transcription job request failed.
    --
    -- The @FailureReason@ field contains one of the following values:
    --
    -- -   @Unsupported media format@.
    --
    --     The media format specified in @MediaFormat@ isn\'t valid. Refer to
    --     __MediaFormat__ for a list of supported formats.
    --
    -- -   @The media format provided does not match the detected media format@.
    --
    --     The media format specified in @MediaFormat@ doesn\'t match the
    --     format of the input file. Check the media format of your media file
    --     and correct the specified value.
    --
    -- -   @Invalid sample rate for audio file@.
    --
    --     The sample rate specified in @MediaSampleRateHertz@ isn\'t valid.
    --     The sample rate must be between 8,000 and 48,000 hertz.
    --
    -- -   @The sample rate provided does not match the detected sample rate@.
    --
    --     The sample rate specified in @MediaSampleRateHertz@ doesn\'t match
    --     the sample rate detected in your input media file. Check the sample
    --     rate of your media file and correct the specified value.
    --
    -- -   @Invalid file size: file size too large@.
    --
    --     The size of your media file is larger than what Amazon Transcribe
    --     can process. For more information, refer to
    --     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
    --
    -- -   @Invalid number of channels: number of channels too large@.
    --
    --     Your audio contains more channels than Amazon Transcribe is able to
    --     process. For more information, refer to
    --     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
    TranscriptionJob -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The confidence score associated with the language identified in your
    -- media file.
    --
    -- Confidence scores are values between 0 and 1; a larger value indicates a
    -- higher probability that the identified language correctly matches the
    -- language spoken in your media.
    TranscriptionJob -> Maybe Double
identifiedLanguageScore :: Prelude.Maybe Prelude.Double,
    -- | Indicates whether automatic language identification was enabled (@TRUE@)
    -- for the specified transcription job.
    TranscriptionJob -> Maybe Bool
identifyLanguage :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether automatic multi-language identification was enabled
    -- (@TRUE@) for the specified transcription job.
    TranscriptionJob -> Maybe Bool
identifyMultipleLanguages :: Prelude.Maybe Prelude.Bool,
    -- | Provides information about how your transcription job was processed.
    -- This parameter shows if your request was queued and what data access
    -- role was used.
    TranscriptionJob -> Maybe JobExecutionSettings
jobExecutionSettings :: Prelude.Maybe JobExecutionSettings,
    -- | The language code used to create your transcription job. This parameter
    -- is used with single-language identification. For multi-language
    -- identification requests, refer to the plural version of this parameter,
    -- @LanguageCodes@.
    TranscriptionJob -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | The language codes used to create your transcription job. This parameter
    -- is used with multi-language identification. For single-language
    -- identification requests, refer to the singular version of this
    -- parameter, @LanguageCode@.
    TranscriptionJob -> Maybe [LanguageCodeItem]
languageCodes :: Prelude.Maybe [LanguageCodeItem],
    -- | Provides the name and language of all custom language models, custom
    -- vocabularies, and custom vocabulary filters that you included in your
    -- request.
    TranscriptionJob -> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings :: Prelude.Maybe (Prelude.HashMap LanguageCode LanguageIdSettings),
    -- | Provides the language codes you specified in your request.
    TranscriptionJob -> Maybe (NonEmpty LanguageCode)
languageOptions :: Prelude.Maybe (Prelude.NonEmpty LanguageCode),
    -- | Provides the Amazon S3 location of the media file you used in your
    -- request.
    TranscriptionJob -> Maybe Media
media :: Prelude.Maybe Media,
    -- | The format of the input media file.
    TranscriptionJob -> Maybe MediaFormat
mediaFormat :: Prelude.Maybe MediaFormat,
    -- | The sample rate, in hertz, of the audio track in your input media file.
    TranscriptionJob -> Maybe Natural
mediaSampleRateHertz :: Prelude.Maybe Prelude.Natural,
    -- | Provides information on the custom language model you included in your
    -- request.
    TranscriptionJob -> Maybe ModelSettings
modelSettings :: Prelude.Maybe ModelSettings,
    -- | Provides information on any additional settings that were included in
    -- your request. Additional settings include channel identification,
    -- alternative transcriptions, speaker partitioning, custom vocabularies,
    -- and custom vocabulary filters.
    TranscriptionJob -> Maybe Settings
settings :: Prelude.Maybe Settings,
    -- | The date and time the specified transcription job began processing.
    --
    -- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
    -- example, @2022-05-04T12:32:58.789000-07:00@ represents a transcription
    -- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
    TranscriptionJob -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | Indicates whether subtitles were generated with your transcription.
    TranscriptionJob -> Maybe SubtitlesOutput
subtitles :: Prelude.Maybe SubtitlesOutput,
    -- | The tags, each in the form of a key:value pair, assigned to the
    -- specified transcription job.
    TranscriptionJob -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | Provides you with the Amazon S3 URI you can use to access your
    -- transcript.
    TranscriptionJob -> Maybe Transcript
transcript :: Prelude.Maybe Transcript,
    -- | The name of the transcription job. Job names are case sensitive and must
    -- be unique within an Amazon Web Services account.
    TranscriptionJob -> Maybe Text
transcriptionJobName :: Prelude.Maybe Prelude.Text,
    -- | Provides the status of the specified transcription job.
    --
    -- If the status is @COMPLETED@, the job is finished and you can find the
    -- results at the location specified in @TranscriptFileUri@ (or
    -- @RedactedTranscriptFileUri@, if you requested transcript redaction). If
    -- the status is @FAILED@, @FailureReason@ provides details on why your
    -- transcription job failed.
    TranscriptionJob -> Maybe TranscriptionJobStatus
transcriptionJobStatus :: Prelude.Maybe TranscriptionJobStatus
  }
  deriving (TranscriptionJob -> TranscriptionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TranscriptionJob -> TranscriptionJob -> Bool
$c/= :: TranscriptionJob -> TranscriptionJob -> Bool
== :: TranscriptionJob -> TranscriptionJob -> Bool
$c== :: TranscriptionJob -> TranscriptionJob -> Bool
Prelude.Eq, ReadPrec [TranscriptionJob]
ReadPrec TranscriptionJob
Int -> ReadS TranscriptionJob
ReadS [TranscriptionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TranscriptionJob]
$creadListPrec :: ReadPrec [TranscriptionJob]
readPrec :: ReadPrec TranscriptionJob
$creadPrec :: ReadPrec TranscriptionJob
readList :: ReadS [TranscriptionJob]
$creadList :: ReadS [TranscriptionJob]
readsPrec :: Int -> ReadS TranscriptionJob
$creadsPrec :: Int -> ReadS TranscriptionJob
Prelude.Read, Int -> TranscriptionJob -> ShowS
[TranscriptionJob] -> ShowS
TranscriptionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TranscriptionJob] -> ShowS
$cshowList :: [TranscriptionJob] -> ShowS
show :: TranscriptionJob -> String
$cshow :: TranscriptionJob -> String
showsPrec :: Int -> TranscriptionJob -> ShowS
$cshowsPrec :: Int -> TranscriptionJob -> ShowS
Prelude.Show, forall x. Rep TranscriptionJob x -> TranscriptionJob
forall x. TranscriptionJob -> Rep TranscriptionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TranscriptionJob x -> TranscriptionJob
$cfrom :: forall x. TranscriptionJob -> Rep TranscriptionJob x
Prelude.Generic)

-- |
-- Create a value of 'TranscriptionJob' 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:
--
-- 'completionTime', 'transcriptionJob_completionTime' - The date and time the specified transcription job finished processing.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:33:13.922000-07:00@ represents a transcription
-- job that started processing at 12:33 PM UTC-7 on May 4, 2022.
--
-- 'contentRedaction', 'transcriptionJob_contentRedaction' - Indicates whether redaction was enabled in your transcript.
--
-- 'creationTime', 'transcriptionJob_creationTime' - The date and time the specified transcription job request was made.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents a transcription
-- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
--
-- 'failureReason', 'transcriptionJob_failureReason' - If @TranscriptionJobStatus@ is @FAILED@, @FailureReason@ contains
-- information about why the transcription job request failed.
--
-- The @FailureReason@ field contains one of the following values:
--
-- -   @Unsupported media format@.
--
--     The media format specified in @MediaFormat@ isn\'t valid. Refer to
--     __MediaFormat__ for a list of supported formats.
--
-- -   @The media format provided does not match the detected media format@.
--
--     The media format specified in @MediaFormat@ doesn\'t match the
--     format of the input file. Check the media format of your media file
--     and correct the specified value.
--
-- -   @Invalid sample rate for audio file@.
--
--     The sample rate specified in @MediaSampleRateHertz@ isn\'t valid.
--     The sample rate must be between 8,000 and 48,000 hertz.
--
-- -   @The sample rate provided does not match the detected sample rate@.
--
--     The sample rate specified in @MediaSampleRateHertz@ doesn\'t match
--     the sample rate detected in your input media file. Check the sample
--     rate of your media file and correct the specified value.
--
-- -   @Invalid file size: file size too large@.
--
--     The size of your media file is larger than what Amazon Transcribe
--     can process. For more information, refer to
--     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
--
-- -   @Invalid number of channels: number of channels too large@.
--
--     Your audio contains more channels than Amazon Transcribe is able to
--     process. For more information, refer to
--     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
--
-- 'identifiedLanguageScore', 'transcriptionJob_identifiedLanguageScore' - The confidence score associated with the language identified in your
-- media file.
--
-- Confidence scores are values between 0 and 1; a larger value indicates a
-- higher probability that the identified language correctly matches the
-- language spoken in your media.
--
-- 'identifyLanguage', 'transcriptionJob_identifyLanguage' - Indicates whether automatic language identification was enabled (@TRUE@)
-- for the specified transcription job.
--
-- 'identifyMultipleLanguages', 'transcriptionJob_identifyMultipleLanguages' - Indicates whether automatic multi-language identification was enabled
-- (@TRUE@) for the specified transcription job.
--
-- 'jobExecutionSettings', 'transcriptionJob_jobExecutionSettings' - Provides information about how your transcription job was processed.
-- This parameter shows if your request was queued and what data access
-- role was used.
--
-- 'languageCode', 'transcriptionJob_languageCode' - The language code used to create your transcription job. This parameter
-- is used with single-language identification. For multi-language
-- identification requests, refer to the plural version of this parameter,
-- @LanguageCodes@.
--
-- 'languageCodes', 'transcriptionJob_languageCodes' - The language codes used to create your transcription job. This parameter
-- is used with multi-language identification. For single-language
-- identification requests, refer to the singular version of this
-- parameter, @LanguageCode@.
--
-- 'languageIdSettings', 'transcriptionJob_languageIdSettings' - Provides the name and language of all custom language models, custom
-- vocabularies, and custom vocabulary filters that you included in your
-- request.
--
-- 'languageOptions', 'transcriptionJob_languageOptions' - Provides the language codes you specified in your request.
--
-- 'media', 'transcriptionJob_media' - Provides the Amazon S3 location of the media file you used in your
-- request.
--
-- 'mediaFormat', 'transcriptionJob_mediaFormat' - The format of the input media file.
--
-- 'mediaSampleRateHertz', 'transcriptionJob_mediaSampleRateHertz' - The sample rate, in hertz, of the audio track in your input media file.
--
-- 'modelSettings', 'transcriptionJob_modelSettings' - Provides information on the custom language model you included in your
-- request.
--
-- 'settings', 'transcriptionJob_settings' - Provides information on any additional settings that were included in
-- your request. Additional settings include channel identification,
-- alternative transcriptions, speaker partitioning, custom vocabularies,
-- and custom vocabulary filters.
--
-- 'startTime', 'transcriptionJob_startTime' - The date and time the specified transcription job began processing.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.789000-07:00@ represents a transcription
-- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
--
-- 'subtitles', 'transcriptionJob_subtitles' - Indicates whether subtitles were generated with your transcription.
--
-- 'tags', 'transcriptionJob_tags' - The tags, each in the form of a key:value pair, assigned to the
-- specified transcription job.
--
-- 'transcript', 'transcriptionJob_transcript' - Provides you with the Amazon S3 URI you can use to access your
-- transcript.
--
-- 'transcriptionJobName', 'transcriptionJob_transcriptionJobName' - The name of the transcription job. Job names are case sensitive and must
-- be unique within an Amazon Web Services account.
--
-- 'transcriptionJobStatus', 'transcriptionJob_transcriptionJobStatus' - Provides the status of the specified transcription job.
--
-- If the status is @COMPLETED@, the job is finished and you can find the
-- results at the location specified in @TranscriptFileUri@ (or
-- @RedactedTranscriptFileUri@, if you requested transcript redaction). If
-- the status is @FAILED@, @FailureReason@ provides details on why your
-- transcription job failed.
newTranscriptionJob ::
  TranscriptionJob
newTranscriptionJob :: TranscriptionJob
newTranscriptionJob =
  TranscriptionJob'
    { $sel:completionTime:TranscriptionJob' :: Maybe POSIX
completionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:contentRedaction:TranscriptionJob' :: Maybe ContentRedaction
contentRedaction = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:TranscriptionJob' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:TranscriptionJob' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:identifiedLanguageScore:TranscriptionJob' :: Maybe Double
identifiedLanguageScore = forall a. Maybe a
Prelude.Nothing,
      $sel:identifyLanguage:TranscriptionJob' :: Maybe Bool
identifyLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:identifyMultipleLanguages:TranscriptionJob' :: Maybe Bool
identifyMultipleLanguages = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExecutionSettings:TranscriptionJob' :: Maybe JobExecutionSettings
jobExecutionSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:TranscriptionJob' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCodes:TranscriptionJob' :: Maybe [LanguageCodeItem]
languageCodes = forall a. Maybe a
Prelude.Nothing,
      $sel:languageIdSettings:TranscriptionJob' :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:languageOptions:TranscriptionJob' :: Maybe (NonEmpty LanguageCode)
languageOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:media:TranscriptionJob' :: Maybe Media
media = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaFormat:TranscriptionJob' :: Maybe MediaFormat
mediaFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaSampleRateHertz:TranscriptionJob' :: Maybe Natural
mediaSampleRateHertz = forall a. Maybe a
Prelude.Nothing,
      $sel:modelSettings:TranscriptionJob' :: Maybe ModelSettings
modelSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:settings:TranscriptionJob' :: Maybe Settings
settings = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:TranscriptionJob' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:subtitles:TranscriptionJob' :: Maybe SubtitlesOutput
subtitles = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:TranscriptionJob' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:transcript:TranscriptionJob' :: Maybe Transcript
transcript = forall a. Maybe a
Prelude.Nothing,
      $sel:transcriptionJobName:TranscriptionJob' :: Maybe Text
transcriptionJobName = forall a. Maybe a
Prelude.Nothing,
      $sel:transcriptionJobStatus:TranscriptionJob' :: Maybe TranscriptionJobStatus
transcriptionJobStatus = forall a. Maybe a
Prelude.Nothing
    }

-- | The date and time the specified transcription job finished processing.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:33:13.922000-07:00@ represents a transcription
-- job that started processing at 12:33 PM UTC-7 on May 4, 2022.
transcriptionJob_completionTime :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.UTCTime)
transcriptionJob_completionTime :: Lens' TranscriptionJob (Maybe UTCTime)
transcriptionJob_completionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe POSIX
completionTime :: Maybe POSIX
$sel:completionTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
completionTime} -> Maybe POSIX
completionTime) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe POSIX
a -> TranscriptionJob
s {$sel:completionTime:TranscriptionJob' :: Maybe POSIX
completionTime = Maybe POSIX
a} :: TranscriptionJob) 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

-- | Indicates whether redaction was enabled in your transcript.
transcriptionJob_contentRedaction :: Lens.Lens' TranscriptionJob (Prelude.Maybe ContentRedaction)
transcriptionJob_contentRedaction :: Lens' TranscriptionJob (Maybe ContentRedaction)
transcriptionJob_contentRedaction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe ContentRedaction
contentRedaction :: Maybe ContentRedaction
$sel:contentRedaction:TranscriptionJob' :: TranscriptionJob -> Maybe ContentRedaction
contentRedaction} -> Maybe ContentRedaction
contentRedaction) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe ContentRedaction
a -> TranscriptionJob
s {$sel:contentRedaction:TranscriptionJob' :: Maybe ContentRedaction
contentRedaction = Maybe ContentRedaction
a} :: TranscriptionJob)

-- | The date and time the specified transcription job request was made.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents a transcription
-- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
transcriptionJob_creationTime :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.UTCTime)
transcriptionJob_creationTime :: Lens' TranscriptionJob (Maybe UTCTime)
transcriptionJob_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe POSIX
a -> TranscriptionJob
s {$sel:creationTime:TranscriptionJob' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: TranscriptionJob) 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

-- | If @TranscriptionJobStatus@ is @FAILED@, @FailureReason@ contains
-- information about why the transcription job request failed.
--
-- The @FailureReason@ field contains one of the following values:
--
-- -   @Unsupported media format@.
--
--     The media format specified in @MediaFormat@ isn\'t valid. Refer to
--     __MediaFormat__ for a list of supported formats.
--
-- -   @The media format provided does not match the detected media format@.
--
--     The media format specified in @MediaFormat@ doesn\'t match the
--     format of the input file. Check the media format of your media file
--     and correct the specified value.
--
-- -   @Invalid sample rate for audio file@.
--
--     The sample rate specified in @MediaSampleRateHertz@ isn\'t valid.
--     The sample rate must be between 8,000 and 48,000 hertz.
--
-- -   @The sample rate provided does not match the detected sample rate@.
--
--     The sample rate specified in @MediaSampleRateHertz@ doesn\'t match
--     the sample rate detected in your input media file. Check the sample
--     rate of your media file and correct the specified value.
--
-- -   @Invalid file size: file size too large@.
--
--     The size of your media file is larger than what Amazon Transcribe
--     can process. For more information, refer to
--     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
--
-- -   @Invalid number of channels: number of channels too large@.
--
--     Your audio contains more channels than Amazon Transcribe is able to
--     process. For more information, refer to
--     <https://docs.aws.amazon.com/transcribe/latest/dg/limits-guidelines.html#limits Guidelines and quotas>.
transcriptionJob_failureReason :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Text)
transcriptionJob_failureReason :: Lens' TranscriptionJob (Maybe Text)
transcriptionJob_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:TranscriptionJob' :: TranscriptionJob -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Text
a -> TranscriptionJob
s {$sel:failureReason:TranscriptionJob' :: Maybe Text
failureReason = Maybe Text
a} :: TranscriptionJob)

-- | The confidence score associated with the language identified in your
-- media file.
--
-- Confidence scores are values between 0 and 1; a larger value indicates a
-- higher probability that the identified language correctly matches the
-- language spoken in your media.
transcriptionJob_identifiedLanguageScore :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Double)
transcriptionJob_identifiedLanguageScore :: Lens' TranscriptionJob (Maybe Double)
transcriptionJob_identifiedLanguageScore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Double
identifiedLanguageScore :: Maybe Double
$sel:identifiedLanguageScore:TranscriptionJob' :: TranscriptionJob -> Maybe Double
identifiedLanguageScore} -> Maybe Double
identifiedLanguageScore) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Double
a -> TranscriptionJob
s {$sel:identifiedLanguageScore:TranscriptionJob' :: Maybe Double
identifiedLanguageScore = Maybe Double
a} :: TranscriptionJob)

-- | Indicates whether automatic language identification was enabled (@TRUE@)
-- for the specified transcription job.
transcriptionJob_identifyLanguage :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Bool)
transcriptionJob_identifyLanguage :: Lens' TranscriptionJob (Maybe Bool)
transcriptionJob_identifyLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Bool
identifyLanguage :: Maybe Bool
$sel:identifyLanguage:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
identifyLanguage} -> Maybe Bool
identifyLanguage) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Bool
a -> TranscriptionJob
s {$sel:identifyLanguage:TranscriptionJob' :: Maybe Bool
identifyLanguage = Maybe Bool
a} :: TranscriptionJob)

-- | Indicates whether automatic multi-language identification was enabled
-- (@TRUE@) for the specified transcription job.
transcriptionJob_identifyMultipleLanguages :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Bool)
transcriptionJob_identifyMultipleLanguages :: Lens' TranscriptionJob (Maybe Bool)
transcriptionJob_identifyMultipleLanguages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Bool
identifyMultipleLanguages :: Maybe Bool
$sel:identifyMultipleLanguages:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
identifyMultipleLanguages} -> Maybe Bool
identifyMultipleLanguages) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Bool
a -> TranscriptionJob
s {$sel:identifyMultipleLanguages:TranscriptionJob' :: Maybe Bool
identifyMultipleLanguages = Maybe Bool
a} :: TranscriptionJob)

-- | Provides information about how your transcription job was processed.
-- This parameter shows if your request was queued and what data access
-- role was used.
transcriptionJob_jobExecutionSettings :: Lens.Lens' TranscriptionJob (Prelude.Maybe JobExecutionSettings)
transcriptionJob_jobExecutionSettings :: Lens' TranscriptionJob (Maybe JobExecutionSettings)
transcriptionJob_jobExecutionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe JobExecutionSettings
jobExecutionSettings :: Maybe JobExecutionSettings
$sel:jobExecutionSettings:TranscriptionJob' :: TranscriptionJob -> Maybe JobExecutionSettings
jobExecutionSettings} -> Maybe JobExecutionSettings
jobExecutionSettings) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe JobExecutionSettings
a -> TranscriptionJob
s {$sel:jobExecutionSettings:TranscriptionJob' :: Maybe JobExecutionSettings
jobExecutionSettings = Maybe JobExecutionSettings
a} :: TranscriptionJob)

-- | The language code used to create your transcription job. This parameter
-- is used with single-language identification. For multi-language
-- identification requests, refer to the plural version of this parameter,
-- @LanguageCodes@.
transcriptionJob_languageCode :: Lens.Lens' TranscriptionJob (Prelude.Maybe LanguageCode)
transcriptionJob_languageCode :: Lens' TranscriptionJob (Maybe LanguageCode)
transcriptionJob_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:TranscriptionJob' :: TranscriptionJob -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe LanguageCode
a -> TranscriptionJob
s {$sel:languageCode:TranscriptionJob' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: TranscriptionJob)

-- | The language codes used to create your transcription job. This parameter
-- is used with multi-language identification. For single-language
-- identification requests, refer to the singular version of this
-- parameter, @LanguageCode@.
transcriptionJob_languageCodes :: Lens.Lens' TranscriptionJob (Prelude.Maybe [LanguageCodeItem])
transcriptionJob_languageCodes :: Lens' TranscriptionJob (Maybe [LanguageCodeItem])
transcriptionJob_languageCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe [LanguageCodeItem]
languageCodes :: Maybe [LanguageCodeItem]
$sel:languageCodes:TranscriptionJob' :: TranscriptionJob -> Maybe [LanguageCodeItem]
languageCodes} -> Maybe [LanguageCodeItem]
languageCodes) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe [LanguageCodeItem]
a -> TranscriptionJob
s {$sel:languageCodes:TranscriptionJob' :: Maybe [LanguageCodeItem]
languageCodes = Maybe [LanguageCodeItem]
a} :: TranscriptionJob) 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

-- | Provides the name and language of all custom language models, custom
-- vocabularies, and custom vocabulary filters that you included in your
-- request.
transcriptionJob_languageIdSettings :: Lens.Lens' TranscriptionJob (Prelude.Maybe (Prelude.HashMap LanguageCode LanguageIdSettings))
transcriptionJob_languageIdSettings :: Lens'
  TranscriptionJob (Maybe (HashMap LanguageCode LanguageIdSettings))
transcriptionJob_languageIdSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageIdSettings:TranscriptionJob' :: TranscriptionJob -> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings} -> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe (HashMap LanguageCode LanguageIdSettings)
a -> TranscriptionJob
s {$sel:languageIdSettings:TranscriptionJob' :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings = Maybe (HashMap LanguageCode LanguageIdSettings)
a} :: TranscriptionJob) 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

-- | Provides the language codes you specified in your request.
transcriptionJob_languageOptions :: Lens.Lens' TranscriptionJob (Prelude.Maybe (Prelude.NonEmpty LanguageCode))
transcriptionJob_languageOptions :: Lens' TranscriptionJob (Maybe (NonEmpty LanguageCode))
transcriptionJob_languageOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe (NonEmpty LanguageCode)
languageOptions :: Maybe (NonEmpty LanguageCode)
$sel:languageOptions:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty LanguageCode)
languageOptions} -> Maybe (NonEmpty LanguageCode)
languageOptions) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe (NonEmpty LanguageCode)
a -> TranscriptionJob
s {$sel:languageOptions:TranscriptionJob' :: Maybe (NonEmpty LanguageCode)
languageOptions = Maybe (NonEmpty LanguageCode)
a} :: TranscriptionJob) 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

-- | Provides the Amazon S3 location of the media file you used in your
-- request.
transcriptionJob_media :: Lens.Lens' TranscriptionJob (Prelude.Maybe Media)
transcriptionJob_media :: Lens' TranscriptionJob (Maybe Media)
transcriptionJob_media = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Media
media :: Maybe Media
$sel:media:TranscriptionJob' :: TranscriptionJob -> Maybe Media
media} -> Maybe Media
media) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Media
a -> TranscriptionJob
s {$sel:media:TranscriptionJob' :: Maybe Media
media = Maybe Media
a} :: TranscriptionJob)

-- | The format of the input media file.
transcriptionJob_mediaFormat :: Lens.Lens' TranscriptionJob (Prelude.Maybe MediaFormat)
transcriptionJob_mediaFormat :: Lens' TranscriptionJob (Maybe MediaFormat)
transcriptionJob_mediaFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe MediaFormat
mediaFormat :: Maybe MediaFormat
$sel:mediaFormat:TranscriptionJob' :: TranscriptionJob -> Maybe MediaFormat
mediaFormat} -> Maybe MediaFormat
mediaFormat) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe MediaFormat
a -> TranscriptionJob
s {$sel:mediaFormat:TranscriptionJob' :: Maybe MediaFormat
mediaFormat = Maybe MediaFormat
a} :: TranscriptionJob)

-- | The sample rate, in hertz, of the audio track in your input media file.
transcriptionJob_mediaSampleRateHertz :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Natural)
transcriptionJob_mediaSampleRateHertz :: Lens' TranscriptionJob (Maybe Natural)
transcriptionJob_mediaSampleRateHertz = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Natural
mediaSampleRateHertz :: Maybe Natural
$sel:mediaSampleRateHertz:TranscriptionJob' :: TranscriptionJob -> Maybe Natural
mediaSampleRateHertz} -> Maybe Natural
mediaSampleRateHertz) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Natural
a -> TranscriptionJob
s {$sel:mediaSampleRateHertz:TranscriptionJob' :: Maybe Natural
mediaSampleRateHertz = Maybe Natural
a} :: TranscriptionJob)

-- | Provides information on the custom language model you included in your
-- request.
transcriptionJob_modelSettings :: Lens.Lens' TranscriptionJob (Prelude.Maybe ModelSettings)
transcriptionJob_modelSettings :: Lens' TranscriptionJob (Maybe ModelSettings)
transcriptionJob_modelSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe ModelSettings
modelSettings :: Maybe ModelSettings
$sel:modelSettings:TranscriptionJob' :: TranscriptionJob -> Maybe ModelSettings
modelSettings} -> Maybe ModelSettings
modelSettings) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe ModelSettings
a -> TranscriptionJob
s {$sel:modelSettings:TranscriptionJob' :: Maybe ModelSettings
modelSettings = Maybe ModelSettings
a} :: TranscriptionJob)

-- | Provides information on any additional settings that were included in
-- your request. Additional settings include channel identification,
-- alternative transcriptions, speaker partitioning, custom vocabularies,
-- and custom vocabulary filters.
transcriptionJob_settings :: Lens.Lens' TranscriptionJob (Prelude.Maybe Settings)
transcriptionJob_settings :: Lens' TranscriptionJob (Maybe Settings)
transcriptionJob_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Settings
settings :: Maybe Settings
$sel:settings:TranscriptionJob' :: TranscriptionJob -> Maybe Settings
settings} -> Maybe Settings
settings) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Settings
a -> TranscriptionJob
s {$sel:settings:TranscriptionJob' :: Maybe Settings
settings = Maybe Settings
a} :: TranscriptionJob)

-- | The date and time the specified transcription job began processing.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.789000-07:00@ represents a transcription
-- job that started processing at 12:32 PM UTC-7 on May 4, 2022.
transcriptionJob_startTime :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.UTCTime)
transcriptionJob_startTime :: Lens' TranscriptionJob (Maybe UTCTime)
transcriptionJob_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe POSIX
a -> TranscriptionJob
s {$sel:startTime:TranscriptionJob' :: Maybe POSIX
startTime = Maybe POSIX
a} :: TranscriptionJob) 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

-- | Indicates whether subtitles were generated with your transcription.
transcriptionJob_subtitles :: Lens.Lens' TranscriptionJob (Prelude.Maybe SubtitlesOutput)
transcriptionJob_subtitles :: Lens' TranscriptionJob (Maybe SubtitlesOutput)
transcriptionJob_subtitles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe SubtitlesOutput
subtitles :: Maybe SubtitlesOutput
$sel:subtitles:TranscriptionJob' :: TranscriptionJob -> Maybe SubtitlesOutput
subtitles} -> Maybe SubtitlesOutput
subtitles) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe SubtitlesOutput
a -> TranscriptionJob
s {$sel:subtitles:TranscriptionJob' :: Maybe SubtitlesOutput
subtitles = Maybe SubtitlesOutput
a} :: TranscriptionJob)

-- | The tags, each in the form of a key:value pair, assigned to the
-- specified transcription job.
transcriptionJob_tags :: Lens.Lens' TranscriptionJob (Prelude.Maybe (Prelude.NonEmpty Tag))
transcriptionJob_tags :: Lens' TranscriptionJob (Maybe (NonEmpty Tag))
transcriptionJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe (NonEmpty Tag)
a -> TranscriptionJob
s {$sel:tags:TranscriptionJob' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: TranscriptionJob) 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

-- | Provides you with the Amazon S3 URI you can use to access your
-- transcript.
transcriptionJob_transcript :: Lens.Lens' TranscriptionJob (Prelude.Maybe Transcript)
transcriptionJob_transcript :: Lens' TranscriptionJob (Maybe Transcript)
transcriptionJob_transcript = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Transcript
transcript :: Maybe Transcript
$sel:transcript:TranscriptionJob' :: TranscriptionJob -> Maybe Transcript
transcript} -> Maybe Transcript
transcript) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Transcript
a -> TranscriptionJob
s {$sel:transcript:TranscriptionJob' :: Maybe Transcript
transcript = Maybe Transcript
a} :: TranscriptionJob)

-- | The name of the transcription job. Job names are case sensitive and must
-- be unique within an Amazon Web Services account.
transcriptionJob_transcriptionJobName :: Lens.Lens' TranscriptionJob (Prelude.Maybe Prelude.Text)
transcriptionJob_transcriptionJobName :: Lens' TranscriptionJob (Maybe Text)
transcriptionJob_transcriptionJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe Text
transcriptionJobName :: Maybe Text
$sel:transcriptionJobName:TranscriptionJob' :: TranscriptionJob -> Maybe Text
transcriptionJobName} -> Maybe Text
transcriptionJobName) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe Text
a -> TranscriptionJob
s {$sel:transcriptionJobName:TranscriptionJob' :: Maybe Text
transcriptionJobName = Maybe Text
a} :: TranscriptionJob)

-- | Provides the status of the specified transcription job.
--
-- If the status is @COMPLETED@, the job is finished and you can find the
-- results at the location specified in @TranscriptFileUri@ (or
-- @RedactedTranscriptFileUri@, if you requested transcript redaction). If
-- the status is @FAILED@, @FailureReason@ provides details on why your
-- transcription job failed.
transcriptionJob_transcriptionJobStatus :: Lens.Lens' TranscriptionJob (Prelude.Maybe TranscriptionJobStatus)
transcriptionJob_transcriptionJobStatus :: Lens' TranscriptionJob (Maybe TranscriptionJobStatus)
transcriptionJob_transcriptionJobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TranscriptionJob' {Maybe TranscriptionJobStatus
transcriptionJobStatus :: Maybe TranscriptionJobStatus
$sel:transcriptionJobStatus:TranscriptionJob' :: TranscriptionJob -> Maybe TranscriptionJobStatus
transcriptionJobStatus} -> Maybe TranscriptionJobStatus
transcriptionJobStatus) (\s :: TranscriptionJob
s@TranscriptionJob' {} Maybe TranscriptionJobStatus
a -> TranscriptionJob
s {$sel:transcriptionJobStatus:TranscriptionJob' :: Maybe TranscriptionJobStatus
transcriptionJobStatus = Maybe TranscriptionJobStatus
a} :: TranscriptionJob)

instance Data.FromJSON TranscriptionJob where
  parseJSON :: Value -> Parser TranscriptionJob
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TranscriptionJob"
      ( \Object
x ->
          Maybe POSIX
-> Maybe ContentRedaction
-> Maybe POSIX
-> Maybe Text
-> Maybe Double
-> Maybe Bool
-> Maybe Bool
-> Maybe JobExecutionSettings
-> Maybe LanguageCode
-> Maybe [LanguageCodeItem]
-> Maybe (HashMap LanguageCode LanguageIdSettings)
-> Maybe (NonEmpty LanguageCode)
-> Maybe Media
-> Maybe MediaFormat
-> Maybe Natural
-> Maybe ModelSettings
-> Maybe Settings
-> Maybe POSIX
-> Maybe SubtitlesOutput
-> Maybe (NonEmpty Tag)
-> Maybe Transcript
-> Maybe Text
-> Maybe TranscriptionJobStatus
-> TranscriptionJob
TranscriptionJob'
            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
"CompletionTime")
            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
"ContentRedaction")
            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
"CreationTime")
            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
"FailureReason")
            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
"IdentifiedLanguageScore")
            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
"IdentifyLanguage")
            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
"IdentifyMultipleLanguages")
            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
"JobExecutionSettings")
            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
"LanguageCodes" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            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
"LanguageIdSettings"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            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
"LanguageOptions")
            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
"Media")
            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
"MediaFormat")
            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
"MediaSampleRateHertz")
            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
"ModelSettings")
            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
"Settings")
            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
"StartTime")
            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
"Subtitles")
            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
"Tags")
            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
"Transcript")
            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
"TranscriptionJobName")
            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
"TranscriptionJobStatus")
      )

instance Prelude.Hashable TranscriptionJob where
  hashWithSalt :: Int -> TranscriptionJob -> Int
hashWithSalt Int
_salt TranscriptionJob' {Maybe Bool
Maybe Double
Maybe Natural
Maybe [LanguageCodeItem]
Maybe (NonEmpty LanguageCode)
Maybe (NonEmpty Tag)
Maybe Text
Maybe (HashMap LanguageCode LanguageIdSettings)
Maybe POSIX
Maybe JobExecutionSettings
Maybe LanguageCode
Maybe Media
Maybe MediaFormat
Maybe ModelSettings
Maybe ContentRedaction
Maybe SubtitlesOutput
Maybe Transcript
Maybe TranscriptionJobStatus
Maybe Settings
transcriptionJobStatus :: Maybe TranscriptionJobStatus
transcriptionJobName :: Maybe Text
transcript :: Maybe Transcript
tags :: Maybe (NonEmpty Tag)
subtitles :: Maybe SubtitlesOutput
startTime :: Maybe POSIX
settings :: Maybe Settings
modelSettings :: Maybe ModelSettings
mediaSampleRateHertz :: Maybe Natural
mediaFormat :: Maybe MediaFormat
media :: Maybe Media
languageOptions :: Maybe (NonEmpty LanguageCode)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageCodes :: Maybe [LanguageCodeItem]
languageCode :: Maybe LanguageCode
jobExecutionSettings :: Maybe JobExecutionSettings
identifyMultipleLanguages :: Maybe Bool
identifyLanguage :: Maybe Bool
identifiedLanguageScore :: Maybe Double
failureReason :: Maybe Text
creationTime :: Maybe POSIX
contentRedaction :: Maybe ContentRedaction
completionTime :: Maybe POSIX
$sel:transcriptionJobStatus:TranscriptionJob' :: TranscriptionJob -> Maybe TranscriptionJobStatus
$sel:transcriptionJobName:TranscriptionJob' :: TranscriptionJob -> Maybe Text
$sel:transcript:TranscriptionJob' :: TranscriptionJob -> Maybe Transcript
$sel:tags:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty Tag)
$sel:subtitles:TranscriptionJob' :: TranscriptionJob -> Maybe SubtitlesOutput
$sel:startTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
$sel:settings:TranscriptionJob' :: TranscriptionJob -> Maybe Settings
$sel:modelSettings:TranscriptionJob' :: TranscriptionJob -> Maybe ModelSettings
$sel:mediaSampleRateHertz:TranscriptionJob' :: TranscriptionJob -> Maybe Natural
$sel:mediaFormat:TranscriptionJob' :: TranscriptionJob -> Maybe MediaFormat
$sel:media:TranscriptionJob' :: TranscriptionJob -> Maybe Media
$sel:languageOptions:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty LanguageCode)
$sel:languageIdSettings:TranscriptionJob' :: TranscriptionJob -> Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageCodes:TranscriptionJob' :: TranscriptionJob -> Maybe [LanguageCodeItem]
$sel:languageCode:TranscriptionJob' :: TranscriptionJob -> Maybe LanguageCode
$sel:jobExecutionSettings:TranscriptionJob' :: TranscriptionJob -> Maybe JobExecutionSettings
$sel:identifyMultipleLanguages:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
$sel:identifyLanguage:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
$sel:identifiedLanguageScore:TranscriptionJob' :: TranscriptionJob -> Maybe Double
$sel:failureReason:TranscriptionJob' :: TranscriptionJob -> Maybe Text
$sel:creationTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
$sel:contentRedaction:TranscriptionJob' :: TranscriptionJob -> Maybe ContentRedaction
$sel:completionTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
completionTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContentRedaction
contentRedaction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
failureReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
identifiedLanguageScore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
identifyLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
identifyMultipleLanguages
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobExecutionSettings
jobExecutionSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LanguageCode
languageCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LanguageCodeItem]
languageCodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty LanguageCode)
languageOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Media
media
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MediaFormat
mediaFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
mediaSampleRateHertz
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelSettings
modelSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Settings
settings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SubtitlesOutput
subtitles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Transcript
transcript
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
transcriptionJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TranscriptionJobStatus
transcriptionJobStatus

instance Prelude.NFData TranscriptionJob where
  rnf :: TranscriptionJob -> ()
rnf TranscriptionJob' {Maybe Bool
Maybe Double
Maybe Natural
Maybe [LanguageCodeItem]
Maybe (NonEmpty LanguageCode)
Maybe (NonEmpty Tag)
Maybe Text
Maybe (HashMap LanguageCode LanguageIdSettings)
Maybe POSIX
Maybe JobExecutionSettings
Maybe LanguageCode
Maybe Media
Maybe MediaFormat
Maybe ModelSettings
Maybe ContentRedaction
Maybe SubtitlesOutput
Maybe Transcript
Maybe TranscriptionJobStatus
Maybe Settings
transcriptionJobStatus :: Maybe TranscriptionJobStatus
transcriptionJobName :: Maybe Text
transcript :: Maybe Transcript
tags :: Maybe (NonEmpty Tag)
subtitles :: Maybe SubtitlesOutput
startTime :: Maybe POSIX
settings :: Maybe Settings
modelSettings :: Maybe ModelSettings
mediaSampleRateHertz :: Maybe Natural
mediaFormat :: Maybe MediaFormat
media :: Maybe Media
languageOptions :: Maybe (NonEmpty LanguageCode)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageCodes :: Maybe [LanguageCodeItem]
languageCode :: Maybe LanguageCode
jobExecutionSettings :: Maybe JobExecutionSettings
identifyMultipleLanguages :: Maybe Bool
identifyLanguage :: Maybe Bool
identifiedLanguageScore :: Maybe Double
failureReason :: Maybe Text
creationTime :: Maybe POSIX
contentRedaction :: Maybe ContentRedaction
completionTime :: Maybe POSIX
$sel:transcriptionJobStatus:TranscriptionJob' :: TranscriptionJob -> Maybe TranscriptionJobStatus
$sel:transcriptionJobName:TranscriptionJob' :: TranscriptionJob -> Maybe Text
$sel:transcript:TranscriptionJob' :: TranscriptionJob -> Maybe Transcript
$sel:tags:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty Tag)
$sel:subtitles:TranscriptionJob' :: TranscriptionJob -> Maybe SubtitlesOutput
$sel:startTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
$sel:settings:TranscriptionJob' :: TranscriptionJob -> Maybe Settings
$sel:modelSettings:TranscriptionJob' :: TranscriptionJob -> Maybe ModelSettings
$sel:mediaSampleRateHertz:TranscriptionJob' :: TranscriptionJob -> Maybe Natural
$sel:mediaFormat:TranscriptionJob' :: TranscriptionJob -> Maybe MediaFormat
$sel:media:TranscriptionJob' :: TranscriptionJob -> Maybe Media
$sel:languageOptions:TranscriptionJob' :: TranscriptionJob -> Maybe (NonEmpty LanguageCode)
$sel:languageIdSettings:TranscriptionJob' :: TranscriptionJob -> Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageCodes:TranscriptionJob' :: TranscriptionJob -> Maybe [LanguageCodeItem]
$sel:languageCode:TranscriptionJob' :: TranscriptionJob -> Maybe LanguageCode
$sel:jobExecutionSettings:TranscriptionJob' :: TranscriptionJob -> Maybe JobExecutionSettings
$sel:identifyMultipleLanguages:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
$sel:identifyLanguage:TranscriptionJob' :: TranscriptionJob -> Maybe Bool
$sel:identifiedLanguageScore:TranscriptionJob' :: TranscriptionJob -> Maybe Double
$sel:failureReason:TranscriptionJob' :: TranscriptionJob -> Maybe Text
$sel:creationTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
$sel:contentRedaction:TranscriptionJob' :: TranscriptionJob -> Maybe ContentRedaction
$sel:completionTime:TranscriptionJob' :: TranscriptionJob -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
completionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContentRedaction
contentRedaction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
identifiedLanguageScore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
identifyLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
identifyMultipleLanguages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobExecutionSettings
jobExecutionSettings
      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 [LanguageCodeItem]
languageCodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty LanguageCode)
languageOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Media
media
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MediaFormat
mediaFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
mediaSampleRateHertz
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelSettings
modelSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Settings
settings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SubtitlesOutput
subtitles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Transcript
transcript
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
transcriptionJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe TranscriptionJobStatus
transcriptionJobStatus