{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.Transcribe.StartTranscriptionJob
(
StartTranscriptionJob (..),
newStartTranscriptionJob,
startTranscriptionJob_contentRedaction,
startTranscriptionJob_identifyLanguage,
startTranscriptionJob_identifyMultipleLanguages,
startTranscriptionJob_jobExecutionSettings,
startTranscriptionJob_kmsEncryptionContext,
startTranscriptionJob_languageCode,
startTranscriptionJob_languageIdSettings,
startTranscriptionJob_languageOptions,
startTranscriptionJob_mediaFormat,
startTranscriptionJob_mediaSampleRateHertz,
startTranscriptionJob_modelSettings,
startTranscriptionJob_outputBucketName,
startTranscriptionJob_outputEncryptionKMSKeyId,
startTranscriptionJob_outputKey,
startTranscriptionJob_settings,
startTranscriptionJob_subtitles,
startTranscriptionJob_tags,
startTranscriptionJob_transcriptionJobName,
startTranscriptionJob_media,
StartTranscriptionJobResponse (..),
newStartTranscriptionJobResponse,
startTranscriptionJobResponse_transcriptionJob,
startTranscriptionJobResponse_httpStatus,
)
where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Transcribe.Types
data StartTranscriptionJob = StartTranscriptionJob'
{
StartTranscriptionJob -> Maybe ContentRedaction
contentRedaction :: Prelude.Maybe ContentRedaction,
StartTranscriptionJob -> Maybe Bool
identifyLanguage :: Prelude.Maybe Prelude.Bool,
StartTranscriptionJob -> Maybe Bool
identifyMultipleLanguages :: Prelude.Maybe Prelude.Bool,
StartTranscriptionJob -> Maybe JobExecutionSettings
jobExecutionSettings :: Prelude.Maybe JobExecutionSettings,
StartTranscriptionJob -> Maybe (HashMap Text Text)
kmsEncryptionContext :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
StartTranscriptionJob -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
StartTranscriptionJob
-> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings :: Prelude.Maybe (Prelude.HashMap LanguageCode LanguageIdSettings),
StartTranscriptionJob -> Maybe (NonEmpty LanguageCode)
languageOptions :: Prelude.Maybe (Prelude.NonEmpty LanguageCode),
StartTranscriptionJob -> Maybe MediaFormat
mediaFormat :: Prelude.Maybe MediaFormat,
StartTranscriptionJob -> Maybe Natural
mediaSampleRateHertz :: Prelude.Maybe Prelude.Natural,
StartTranscriptionJob -> Maybe ModelSettings
modelSettings :: Prelude.Maybe ModelSettings,
StartTranscriptionJob -> Maybe Text
outputBucketName :: Prelude.Maybe Prelude.Text,
StartTranscriptionJob -> Maybe Text
outputEncryptionKMSKeyId :: Prelude.Maybe Prelude.Text,
StartTranscriptionJob -> Maybe Text
outputKey :: Prelude.Maybe Prelude.Text,
StartTranscriptionJob -> Maybe Settings
settings :: Prelude.Maybe Settings,
StartTranscriptionJob -> Maybe Subtitles
subtitles :: Prelude.Maybe Subtitles,
StartTranscriptionJob -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
StartTranscriptionJob -> Text
transcriptionJobName :: Prelude.Text,
StartTranscriptionJob -> Media
media :: Media
}
deriving (StartTranscriptionJob -> StartTranscriptionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTranscriptionJob -> StartTranscriptionJob -> Bool
$c/= :: StartTranscriptionJob -> StartTranscriptionJob -> Bool
== :: StartTranscriptionJob -> StartTranscriptionJob -> Bool
$c== :: StartTranscriptionJob -> StartTranscriptionJob -> Bool
Prelude.Eq, ReadPrec [StartTranscriptionJob]
ReadPrec StartTranscriptionJob
Int -> ReadS StartTranscriptionJob
ReadS [StartTranscriptionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartTranscriptionJob]
$creadListPrec :: ReadPrec [StartTranscriptionJob]
readPrec :: ReadPrec StartTranscriptionJob
$creadPrec :: ReadPrec StartTranscriptionJob
readList :: ReadS [StartTranscriptionJob]
$creadList :: ReadS [StartTranscriptionJob]
readsPrec :: Int -> ReadS StartTranscriptionJob
$creadsPrec :: Int -> ReadS StartTranscriptionJob
Prelude.Read, Int -> StartTranscriptionJob -> ShowS
[StartTranscriptionJob] -> ShowS
StartTranscriptionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTranscriptionJob] -> ShowS
$cshowList :: [StartTranscriptionJob] -> ShowS
show :: StartTranscriptionJob -> String
$cshow :: StartTranscriptionJob -> String
showsPrec :: Int -> StartTranscriptionJob -> ShowS
$cshowsPrec :: Int -> StartTranscriptionJob -> ShowS
Prelude.Show, forall x. Rep StartTranscriptionJob x -> StartTranscriptionJob
forall x. StartTranscriptionJob -> Rep StartTranscriptionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartTranscriptionJob x -> StartTranscriptionJob
$cfrom :: forall x. StartTranscriptionJob -> Rep StartTranscriptionJob x
Prelude.Generic)
newStartTranscriptionJob ::
Prelude.Text ->
Media ->
StartTranscriptionJob
newStartTranscriptionJob :: Text -> Media -> StartTranscriptionJob
newStartTranscriptionJob
Text
pTranscriptionJobName_
Media
pMedia_ =
StartTranscriptionJob'
{ $sel:contentRedaction:StartTranscriptionJob' :: Maybe ContentRedaction
contentRedaction =
forall a. Maybe a
Prelude.Nothing,
$sel:identifyLanguage:StartTranscriptionJob' :: Maybe Bool
identifyLanguage = forall a. Maybe a
Prelude.Nothing,
$sel:identifyMultipleLanguages:StartTranscriptionJob' :: Maybe Bool
identifyMultipleLanguages = forall a. Maybe a
Prelude.Nothing,
$sel:jobExecutionSettings:StartTranscriptionJob' :: Maybe JobExecutionSettings
jobExecutionSettings = forall a. Maybe a
Prelude.Nothing,
$sel:kmsEncryptionContext:StartTranscriptionJob' :: Maybe (HashMap Text Text)
kmsEncryptionContext = forall a. Maybe a
Prelude.Nothing,
$sel:languageCode:StartTranscriptionJob' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
$sel:languageIdSettings:StartTranscriptionJob' :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings = forall a. Maybe a
Prelude.Nothing,
$sel:languageOptions:StartTranscriptionJob' :: Maybe (NonEmpty LanguageCode)
languageOptions = forall a. Maybe a
Prelude.Nothing,
$sel:mediaFormat:StartTranscriptionJob' :: Maybe MediaFormat
mediaFormat = forall a. Maybe a
Prelude.Nothing,
$sel:mediaSampleRateHertz:StartTranscriptionJob' :: Maybe Natural
mediaSampleRateHertz = forall a. Maybe a
Prelude.Nothing,
$sel:modelSettings:StartTranscriptionJob' :: Maybe ModelSettings
modelSettings = forall a. Maybe a
Prelude.Nothing,
$sel:outputBucketName:StartTranscriptionJob' :: Maybe Text
outputBucketName = forall a. Maybe a
Prelude.Nothing,
$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: Maybe Text
outputEncryptionKMSKeyId = forall a. Maybe a
Prelude.Nothing,
$sel:outputKey:StartTranscriptionJob' :: Maybe Text
outputKey = forall a. Maybe a
Prelude.Nothing,
$sel:settings:StartTranscriptionJob' :: Maybe Settings
settings = forall a. Maybe a
Prelude.Nothing,
$sel:subtitles:StartTranscriptionJob' :: Maybe Subtitles
subtitles = forall a. Maybe a
Prelude.Nothing,
$sel:tags:StartTranscriptionJob' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
$sel:transcriptionJobName:StartTranscriptionJob' :: Text
transcriptionJobName = Text
pTranscriptionJobName_,
$sel:media:StartTranscriptionJob' :: Media
media = Media
pMedia_
}
startTranscriptionJob_contentRedaction :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe ContentRedaction)
startTranscriptionJob_contentRedaction :: Lens' StartTranscriptionJob (Maybe ContentRedaction)
startTranscriptionJob_contentRedaction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe ContentRedaction
contentRedaction :: Maybe ContentRedaction
$sel:contentRedaction:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ContentRedaction
contentRedaction} -> Maybe ContentRedaction
contentRedaction) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe ContentRedaction
a -> StartTranscriptionJob
s {$sel:contentRedaction:StartTranscriptionJob' :: Maybe ContentRedaction
contentRedaction = Maybe ContentRedaction
a} :: StartTranscriptionJob)
startTranscriptionJob_identifyLanguage :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Bool)
startTranscriptionJob_identifyLanguage :: Lens' StartTranscriptionJob (Maybe Bool)
startTranscriptionJob_identifyLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Bool
identifyLanguage :: Maybe Bool
$sel:identifyLanguage:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
identifyLanguage} -> Maybe Bool
identifyLanguage) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Bool
a -> StartTranscriptionJob
s {$sel:identifyLanguage:StartTranscriptionJob' :: Maybe Bool
identifyLanguage = Maybe Bool
a} :: StartTranscriptionJob)
startTranscriptionJob_identifyMultipleLanguages :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Bool)
startTranscriptionJob_identifyMultipleLanguages :: Lens' StartTranscriptionJob (Maybe Bool)
startTranscriptionJob_identifyMultipleLanguages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Bool
identifyMultipleLanguages :: Maybe Bool
$sel:identifyMultipleLanguages:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
identifyMultipleLanguages} -> Maybe Bool
identifyMultipleLanguages) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Bool
a -> StartTranscriptionJob
s {$sel:identifyMultipleLanguages:StartTranscriptionJob' :: Maybe Bool
identifyMultipleLanguages = Maybe Bool
a} :: StartTranscriptionJob)
startTranscriptionJob_jobExecutionSettings :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe JobExecutionSettings)
startTranscriptionJob_jobExecutionSettings :: Lens' StartTranscriptionJob (Maybe JobExecutionSettings)
startTranscriptionJob_jobExecutionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe JobExecutionSettings
jobExecutionSettings :: Maybe JobExecutionSettings
$sel:jobExecutionSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe JobExecutionSettings
jobExecutionSettings} -> Maybe JobExecutionSettings
jobExecutionSettings) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe JobExecutionSettings
a -> StartTranscriptionJob
s {$sel:jobExecutionSettings:StartTranscriptionJob' :: Maybe JobExecutionSettings
jobExecutionSettings = Maybe JobExecutionSettings
a} :: StartTranscriptionJob)
startTranscriptionJob_kmsEncryptionContext :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startTranscriptionJob_kmsEncryptionContext :: Lens' StartTranscriptionJob (Maybe (HashMap Text Text))
startTranscriptionJob_kmsEncryptionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe (HashMap Text Text)
kmsEncryptionContext :: Maybe (HashMap Text Text)
$sel:kmsEncryptionContext:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (HashMap Text Text)
kmsEncryptionContext} -> Maybe (HashMap Text Text)
kmsEncryptionContext) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe (HashMap Text Text)
a -> StartTranscriptionJob
s {$sel:kmsEncryptionContext:StartTranscriptionJob' :: Maybe (HashMap Text Text)
kmsEncryptionContext = Maybe (HashMap Text Text)
a} :: StartTranscriptionJob) 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
startTranscriptionJob_languageCode :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe LanguageCode)
startTranscriptionJob_languageCode :: Lens' StartTranscriptionJob (Maybe LanguageCode)
startTranscriptionJob_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe LanguageCode
a -> StartTranscriptionJob
s {$sel:languageCode:StartTranscriptionJob' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: StartTranscriptionJob)
startTranscriptionJob_languageIdSettings :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe (Prelude.HashMap LanguageCode LanguageIdSettings))
startTranscriptionJob_languageIdSettings :: Lens'
StartTranscriptionJob
(Maybe (HashMap LanguageCode LanguageIdSettings))
startTranscriptionJob_languageIdSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageIdSettings:StartTranscriptionJob' :: StartTranscriptionJob
-> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings} -> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe (HashMap LanguageCode LanguageIdSettings)
a -> StartTranscriptionJob
s {$sel:languageIdSettings:StartTranscriptionJob' :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings = Maybe (HashMap LanguageCode LanguageIdSettings)
a} :: StartTranscriptionJob) 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
startTranscriptionJob_languageOptions :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe (Prelude.NonEmpty LanguageCode))
startTranscriptionJob_languageOptions :: Lens' StartTranscriptionJob (Maybe (NonEmpty LanguageCode))
startTranscriptionJob_languageOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe (NonEmpty LanguageCode)
languageOptions :: Maybe (NonEmpty LanguageCode)
$sel:languageOptions:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty LanguageCode)
languageOptions} -> Maybe (NonEmpty LanguageCode)
languageOptions) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe (NonEmpty LanguageCode)
a -> StartTranscriptionJob
s {$sel:languageOptions:StartTranscriptionJob' :: Maybe (NonEmpty LanguageCode)
languageOptions = Maybe (NonEmpty LanguageCode)
a} :: StartTranscriptionJob) 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
startTranscriptionJob_mediaFormat :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe MediaFormat)
startTranscriptionJob_mediaFormat :: Lens' StartTranscriptionJob (Maybe MediaFormat)
startTranscriptionJob_mediaFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe MediaFormat
mediaFormat :: Maybe MediaFormat
$sel:mediaFormat:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe MediaFormat
mediaFormat} -> Maybe MediaFormat
mediaFormat) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe MediaFormat
a -> StartTranscriptionJob
s {$sel:mediaFormat:StartTranscriptionJob' :: Maybe MediaFormat
mediaFormat = Maybe MediaFormat
a} :: StartTranscriptionJob)
startTranscriptionJob_mediaSampleRateHertz :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Natural)
startTranscriptionJob_mediaSampleRateHertz :: Lens' StartTranscriptionJob (Maybe Natural)
startTranscriptionJob_mediaSampleRateHertz = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Natural
mediaSampleRateHertz :: Maybe Natural
$sel:mediaSampleRateHertz:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Natural
mediaSampleRateHertz} -> Maybe Natural
mediaSampleRateHertz) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Natural
a -> StartTranscriptionJob
s {$sel:mediaSampleRateHertz:StartTranscriptionJob' :: Maybe Natural
mediaSampleRateHertz = Maybe Natural
a} :: StartTranscriptionJob)
startTranscriptionJob_modelSettings :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe ModelSettings)
startTranscriptionJob_modelSettings :: Lens' StartTranscriptionJob (Maybe ModelSettings)
startTranscriptionJob_modelSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe ModelSettings
modelSettings :: Maybe ModelSettings
$sel:modelSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ModelSettings
modelSettings} -> Maybe ModelSettings
modelSettings) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe ModelSettings
a -> StartTranscriptionJob
s {$sel:modelSettings:StartTranscriptionJob' :: Maybe ModelSettings
modelSettings = Maybe ModelSettings
a} :: StartTranscriptionJob)
startTranscriptionJob_outputBucketName :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Text)
startTranscriptionJob_outputBucketName :: Lens' StartTranscriptionJob (Maybe Text)
startTranscriptionJob_outputBucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Text
outputBucketName :: Maybe Text
$sel:outputBucketName:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
outputBucketName} -> Maybe Text
outputBucketName) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Text
a -> StartTranscriptionJob
s {$sel:outputBucketName:StartTranscriptionJob' :: Maybe Text
outputBucketName = Maybe Text
a} :: StartTranscriptionJob)
startTranscriptionJob_outputEncryptionKMSKeyId :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Text)
startTranscriptionJob_outputEncryptionKMSKeyId :: Lens' StartTranscriptionJob (Maybe Text)
startTranscriptionJob_outputEncryptionKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
outputEncryptionKMSKeyId} -> Maybe Text
outputEncryptionKMSKeyId) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Text
a -> StartTranscriptionJob
s {$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: Maybe Text
outputEncryptionKMSKeyId = Maybe Text
a} :: StartTranscriptionJob)
startTranscriptionJob_outputKey :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Prelude.Text)
startTranscriptionJob_outputKey :: Lens' StartTranscriptionJob (Maybe Text)
startTranscriptionJob_outputKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Text
outputKey :: Maybe Text
$sel:outputKey:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
outputKey} -> Maybe Text
outputKey) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Text
a -> StartTranscriptionJob
s {$sel:outputKey:StartTranscriptionJob' :: Maybe Text
outputKey = Maybe Text
a} :: StartTranscriptionJob)
startTranscriptionJob_settings :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Settings)
startTranscriptionJob_settings :: Lens' StartTranscriptionJob (Maybe Settings)
startTranscriptionJob_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Settings
settings :: Maybe Settings
$sel:settings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Settings
settings} -> Maybe Settings
settings) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Settings
a -> StartTranscriptionJob
s {$sel:settings:StartTranscriptionJob' :: Maybe Settings
settings = Maybe Settings
a} :: StartTranscriptionJob)
startTranscriptionJob_subtitles :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe Subtitles)
startTranscriptionJob_subtitles :: Lens' StartTranscriptionJob (Maybe Subtitles)
startTranscriptionJob_subtitles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe Subtitles
subtitles :: Maybe Subtitles
$sel:subtitles:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Subtitles
subtitles} -> Maybe Subtitles
subtitles) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe Subtitles
a -> StartTranscriptionJob
s {$sel:subtitles:StartTranscriptionJob' :: Maybe Subtitles
subtitles = Maybe Subtitles
a} :: StartTranscriptionJob)
startTranscriptionJob_tags :: Lens.Lens' StartTranscriptionJob (Prelude.Maybe (Prelude.NonEmpty Tag))
startTranscriptionJob_tags :: Lens' StartTranscriptionJob (Maybe (NonEmpty Tag))
startTranscriptionJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Maybe (NonEmpty Tag)
a -> StartTranscriptionJob
s {$sel:tags:StartTranscriptionJob' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: StartTranscriptionJob) 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
startTranscriptionJob_transcriptionJobName :: Lens.Lens' StartTranscriptionJob Prelude.Text
startTranscriptionJob_transcriptionJobName :: Lens' StartTranscriptionJob Text
startTranscriptionJob_transcriptionJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Text
transcriptionJobName :: Text
$sel:transcriptionJobName:StartTranscriptionJob' :: StartTranscriptionJob -> Text
transcriptionJobName} -> Text
transcriptionJobName) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Text
a -> StartTranscriptionJob
s {$sel:transcriptionJobName:StartTranscriptionJob' :: Text
transcriptionJobName = Text
a} :: StartTranscriptionJob)
startTranscriptionJob_media :: Lens.Lens' StartTranscriptionJob Media
startTranscriptionJob_media :: Lens' StartTranscriptionJob Media
startTranscriptionJob_media = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJob' {Media
media :: Media
$sel:media:StartTranscriptionJob' :: StartTranscriptionJob -> Media
media} -> Media
media) (\s :: StartTranscriptionJob
s@StartTranscriptionJob' {} Media
a -> StartTranscriptionJob
s {$sel:media:StartTranscriptionJob' :: Media
media = Media
a} :: StartTranscriptionJob)
instance Core.AWSRequest StartTranscriptionJob where
type
AWSResponse StartTranscriptionJob =
StartTranscriptionJobResponse
request :: (Service -> Service)
-> StartTranscriptionJob -> Request StartTranscriptionJob
request Service -> Service
overrides =
forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartTranscriptionJob
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse StartTranscriptionJob)))
response =
forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
( \Int
s ResponseHeaders
h Object
x ->
Maybe TranscriptionJob -> Int -> StartTranscriptionJobResponse
StartTranscriptionJobResponse'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TranscriptionJob")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
)
instance Prelude.Hashable StartTranscriptionJob where
hashWithSalt :: Int -> StartTranscriptionJob -> Int
hashWithSalt Int
_salt StartTranscriptionJob' {Maybe Bool
Maybe Natural
Maybe (NonEmpty LanguageCode)
Maybe (NonEmpty Tag)
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LanguageCode LanguageIdSettings)
Maybe JobExecutionSettings
Maybe LanguageCode
Maybe MediaFormat
Maybe ModelSettings
Maybe ContentRedaction
Maybe Subtitles
Maybe Settings
Text
Media
media :: Media
transcriptionJobName :: Text
tags :: Maybe (NonEmpty Tag)
subtitles :: Maybe Subtitles
settings :: Maybe Settings
outputKey :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
outputBucketName :: Maybe Text
modelSettings :: Maybe ModelSettings
mediaSampleRateHertz :: Maybe Natural
mediaFormat :: Maybe MediaFormat
languageOptions :: Maybe (NonEmpty LanguageCode)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageCode :: Maybe LanguageCode
kmsEncryptionContext :: Maybe (HashMap Text Text)
jobExecutionSettings :: Maybe JobExecutionSettings
identifyMultipleLanguages :: Maybe Bool
identifyLanguage :: Maybe Bool
contentRedaction :: Maybe ContentRedaction
$sel:media:StartTranscriptionJob' :: StartTranscriptionJob -> Media
$sel:transcriptionJobName:StartTranscriptionJob' :: StartTranscriptionJob -> Text
$sel:tags:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty Tag)
$sel:subtitles:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Subtitles
$sel:settings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Settings
$sel:outputKey:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputBucketName:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:modelSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ModelSettings
$sel:mediaSampleRateHertz:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Natural
$sel:mediaFormat:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe MediaFormat
$sel:languageOptions:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty LanguageCode)
$sel:languageIdSettings:StartTranscriptionJob' :: StartTranscriptionJob
-> Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageCode:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe LanguageCode
$sel:kmsEncryptionContext:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (HashMap Text Text)
$sel:jobExecutionSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe JobExecutionSettings
$sel:identifyMultipleLanguages:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:identifyLanguage:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:contentRedaction:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ContentRedaction
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContentRedaction
contentRedaction
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 (HashMap Text Text)
kmsEncryptionContext
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LanguageCode
languageCode
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 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 Text
outputBucketName
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputEncryptionKMSKeyId
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputKey
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Settings
settings
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Subtitles
subtitles
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transcriptionJobName
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Media
media
instance Prelude.NFData StartTranscriptionJob where
rnf :: StartTranscriptionJob -> ()
rnf StartTranscriptionJob' {Maybe Bool
Maybe Natural
Maybe (NonEmpty LanguageCode)
Maybe (NonEmpty Tag)
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LanguageCode LanguageIdSettings)
Maybe JobExecutionSettings
Maybe LanguageCode
Maybe MediaFormat
Maybe ModelSettings
Maybe ContentRedaction
Maybe Subtitles
Maybe Settings
Text
Media
media :: Media
transcriptionJobName :: Text
tags :: Maybe (NonEmpty Tag)
subtitles :: Maybe Subtitles
settings :: Maybe Settings
outputKey :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
outputBucketName :: Maybe Text
modelSettings :: Maybe ModelSettings
mediaSampleRateHertz :: Maybe Natural
mediaFormat :: Maybe MediaFormat
languageOptions :: Maybe (NonEmpty LanguageCode)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageCode :: Maybe LanguageCode
kmsEncryptionContext :: Maybe (HashMap Text Text)
jobExecutionSettings :: Maybe JobExecutionSettings
identifyMultipleLanguages :: Maybe Bool
identifyLanguage :: Maybe Bool
contentRedaction :: Maybe ContentRedaction
$sel:media:StartTranscriptionJob' :: StartTranscriptionJob -> Media
$sel:transcriptionJobName:StartTranscriptionJob' :: StartTranscriptionJob -> Text
$sel:tags:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty Tag)
$sel:subtitles:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Subtitles
$sel:settings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Settings
$sel:outputKey:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputBucketName:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:modelSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ModelSettings
$sel:mediaSampleRateHertz:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Natural
$sel:mediaFormat:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe MediaFormat
$sel:languageOptions:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty LanguageCode)
$sel:languageIdSettings:StartTranscriptionJob' :: StartTranscriptionJob
-> Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageCode:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe LanguageCode
$sel:kmsEncryptionContext:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (HashMap Text Text)
$sel:jobExecutionSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe JobExecutionSettings
$sel:identifyMultipleLanguages:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:identifyLanguage:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:contentRedaction:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ContentRedaction
..} =
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 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 (HashMap Text Text)
kmsEncryptionContext
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 (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 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 Text
outputBucketName
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputEncryptionKMSKeyId
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputKey
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 Subtitles
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 Text
transcriptionJobName
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Media
media
instance Data.ToHeaders StartTranscriptionJob where
toHeaders :: StartTranscriptionJob -> ResponseHeaders
toHeaders =
forall a b. a -> b -> a
Prelude.const
( forall a. Monoid a => [a] -> a
Prelude.mconcat
[ HeaderName
"X-Amz-Target"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Transcribe.StartTranscriptionJob" ::
Prelude.ByteString
),
HeaderName
"Content-Type"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
Prelude.ByteString
)
]
)
instance Data.ToJSON StartTranscriptionJob where
toJSON :: StartTranscriptionJob -> Value
toJSON StartTranscriptionJob' {Maybe Bool
Maybe Natural
Maybe (NonEmpty LanguageCode)
Maybe (NonEmpty Tag)
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap LanguageCode LanguageIdSettings)
Maybe JobExecutionSettings
Maybe LanguageCode
Maybe MediaFormat
Maybe ModelSettings
Maybe ContentRedaction
Maybe Subtitles
Maybe Settings
Text
Media
media :: Media
transcriptionJobName :: Text
tags :: Maybe (NonEmpty Tag)
subtitles :: Maybe Subtitles
settings :: Maybe Settings
outputKey :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
outputBucketName :: Maybe Text
modelSettings :: Maybe ModelSettings
mediaSampleRateHertz :: Maybe Natural
mediaFormat :: Maybe MediaFormat
languageOptions :: Maybe (NonEmpty LanguageCode)
languageIdSettings :: Maybe (HashMap LanguageCode LanguageIdSettings)
languageCode :: Maybe LanguageCode
kmsEncryptionContext :: Maybe (HashMap Text Text)
jobExecutionSettings :: Maybe JobExecutionSettings
identifyMultipleLanguages :: Maybe Bool
identifyLanguage :: Maybe Bool
contentRedaction :: Maybe ContentRedaction
$sel:media:StartTranscriptionJob' :: StartTranscriptionJob -> Media
$sel:transcriptionJobName:StartTranscriptionJob' :: StartTranscriptionJob -> Text
$sel:tags:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty Tag)
$sel:subtitles:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Subtitles
$sel:settings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Settings
$sel:outputKey:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:outputBucketName:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Text
$sel:modelSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ModelSettings
$sel:mediaSampleRateHertz:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Natural
$sel:mediaFormat:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe MediaFormat
$sel:languageOptions:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (NonEmpty LanguageCode)
$sel:languageIdSettings:StartTranscriptionJob' :: StartTranscriptionJob
-> Maybe (HashMap LanguageCode LanguageIdSettings)
$sel:languageCode:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe LanguageCode
$sel:kmsEncryptionContext:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe (HashMap Text Text)
$sel:jobExecutionSettings:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe JobExecutionSettings
$sel:identifyMultipleLanguages:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:identifyLanguage:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe Bool
$sel:contentRedaction:StartTranscriptionJob' :: StartTranscriptionJob -> Maybe ContentRedaction
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ (Key
"ContentRedaction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ContentRedaction
contentRedaction,
(Key
"IdentifyLanguage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
identifyLanguage,
(Key
"IdentifyMultipleLanguages" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
identifyMultipleLanguages,
(Key
"JobExecutionSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe JobExecutionSettings
jobExecutionSettings,
(Key
"KMSEncryptionContext" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
kmsEncryptionContext,
(Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe LanguageCode
languageCode,
(Key
"LanguageIdSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap LanguageCode LanguageIdSettings)
languageIdSettings,
(Key
"LanguageOptions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty LanguageCode)
languageOptions,
(Key
"MediaFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MediaFormat
mediaFormat,
(Key
"MediaSampleRateHertz" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
mediaSampleRateHertz,
(Key
"ModelSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ModelSettings
modelSettings,
(Key
"OutputBucketName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
outputBucketName,
(Key
"OutputEncryptionKMSKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
outputEncryptionKMSKeyId,
(Key
"OutputKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
outputKey,
(Key
"Settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Settings
settings,
(Key
"Subtitles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Subtitles
subtitles,
(Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags,
forall a. a -> Maybe a
Prelude.Just
( Key
"TranscriptionJobName"
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transcriptionJobName
),
forall a. a -> Maybe a
Prelude.Just (Key
"Media" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Media
media)
]
)
instance Data.ToPath StartTranscriptionJob where
toPath :: StartTranscriptionJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery StartTranscriptionJob where
toQuery :: StartTranscriptionJob -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data StartTranscriptionJobResponse = StartTranscriptionJobResponse'
{
StartTranscriptionJobResponse -> Maybe TranscriptionJob
transcriptionJob :: Prelude.Maybe TranscriptionJob,
StartTranscriptionJobResponse -> Int
httpStatus :: Prelude.Int
}
deriving (StartTranscriptionJobResponse
-> StartTranscriptionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTranscriptionJobResponse
-> StartTranscriptionJobResponse -> Bool
$c/= :: StartTranscriptionJobResponse
-> StartTranscriptionJobResponse -> Bool
== :: StartTranscriptionJobResponse
-> StartTranscriptionJobResponse -> Bool
$c== :: StartTranscriptionJobResponse
-> StartTranscriptionJobResponse -> Bool
Prelude.Eq, ReadPrec [StartTranscriptionJobResponse]
ReadPrec StartTranscriptionJobResponse
Int -> ReadS StartTranscriptionJobResponse
ReadS [StartTranscriptionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartTranscriptionJobResponse]
$creadListPrec :: ReadPrec [StartTranscriptionJobResponse]
readPrec :: ReadPrec StartTranscriptionJobResponse
$creadPrec :: ReadPrec StartTranscriptionJobResponse
readList :: ReadS [StartTranscriptionJobResponse]
$creadList :: ReadS [StartTranscriptionJobResponse]
readsPrec :: Int -> ReadS StartTranscriptionJobResponse
$creadsPrec :: Int -> ReadS StartTranscriptionJobResponse
Prelude.Read, Int -> StartTranscriptionJobResponse -> ShowS
[StartTranscriptionJobResponse] -> ShowS
StartTranscriptionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTranscriptionJobResponse] -> ShowS
$cshowList :: [StartTranscriptionJobResponse] -> ShowS
show :: StartTranscriptionJobResponse -> String
$cshow :: StartTranscriptionJobResponse -> String
showsPrec :: Int -> StartTranscriptionJobResponse -> ShowS
$cshowsPrec :: Int -> StartTranscriptionJobResponse -> ShowS
Prelude.Show, forall x.
Rep StartTranscriptionJobResponse x
-> StartTranscriptionJobResponse
forall x.
StartTranscriptionJobResponse
-> Rep StartTranscriptionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartTranscriptionJobResponse x
-> StartTranscriptionJobResponse
$cfrom :: forall x.
StartTranscriptionJobResponse
-> Rep StartTranscriptionJobResponse x
Prelude.Generic)
newStartTranscriptionJobResponse ::
Prelude.Int ->
StartTranscriptionJobResponse
newStartTranscriptionJobResponse :: Int -> StartTranscriptionJobResponse
newStartTranscriptionJobResponse Int
pHttpStatus_ =
StartTranscriptionJobResponse'
{ $sel:transcriptionJob:StartTranscriptionJobResponse' :: Maybe TranscriptionJob
transcriptionJob =
forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:StartTranscriptionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
}
startTranscriptionJobResponse_transcriptionJob :: Lens.Lens' StartTranscriptionJobResponse (Prelude.Maybe TranscriptionJob)
startTranscriptionJobResponse_transcriptionJob :: Lens' StartTranscriptionJobResponse (Maybe TranscriptionJob)
startTranscriptionJobResponse_transcriptionJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJobResponse' {Maybe TranscriptionJob
transcriptionJob :: Maybe TranscriptionJob
$sel:transcriptionJob:StartTranscriptionJobResponse' :: StartTranscriptionJobResponse -> Maybe TranscriptionJob
transcriptionJob} -> Maybe TranscriptionJob
transcriptionJob) (\s :: StartTranscriptionJobResponse
s@StartTranscriptionJobResponse' {} Maybe TranscriptionJob
a -> StartTranscriptionJobResponse
s {$sel:transcriptionJob:StartTranscriptionJobResponse' :: Maybe TranscriptionJob
transcriptionJob = Maybe TranscriptionJob
a} :: StartTranscriptionJobResponse)
startTranscriptionJobResponse_httpStatus :: Lens.Lens' StartTranscriptionJobResponse Prelude.Int
startTranscriptionJobResponse_httpStatus :: Lens' StartTranscriptionJobResponse Int
startTranscriptionJobResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartTranscriptionJobResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartTranscriptionJobResponse' :: StartTranscriptionJobResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartTranscriptionJobResponse
s@StartTranscriptionJobResponse' {} Int
a -> StartTranscriptionJobResponse
s {$sel:httpStatus:StartTranscriptionJobResponse' :: Int
httpStatus = Int
a} :: StartTranscriptionJobResponse)
instance Prelude.NFData StartTranscriptionJobResponse where
rnf :: StartTranscriptionJobResponse -> ()
rnf StartTranscriptionJobResponse' {Int
Maybe TranscriptionJob
httpStatus :: Int
transcriptionJob :: Maybe TranscriptionJob
$sel:httpStatus:StartTranscriptionJobResponse' :: StartTranscriptionJobResponse -> Int
$sel:transcriptionJob:StartTranscriptionJobResponse' :: StartTranscriptionJobResponse -> Maybe TranscriptionJob
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe TranscriptionJob
transcriptionJob
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus