{-# 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.Polly.Types.SynthesisTask
-- 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.Polly.Types.SynthesisTask where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Polly.Types.Engine
import Amazonka.Polly.Types.LanguageCode
import Amazonka.Polly.Types.OutputFormat
import Amazonka.Polly.Types.SpeechMarkType
import Amazonka.Polly.Types.TaskStatus
import Amazonka.Polly.Types.TextType
import Amazonka.Polly.Types.VoiceId
import qualified Amazonka.Prelude as Prelude

-- | SynthesisTask object that provides information about a speech synthesis
-- task.
--
-- /See:/ 'newSynthesisTask' smart constructor.
data SynthesisTask = SynthesisTask'
  { -- | Timestamp for the time the synthesis task was started.
    SynthesisTask -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
    -- when processing input text for speech synthesis. Using a voice that is
    -- not supported for the engine selected will result in an error.
    SynthesisTask -> Maybe Engine
engine :: Prelude.Maybe Engine,
    -- | Optional language code for a synthesis task. This is only necessary if
    -- using a bilingual voice, such as Aditi, which can be used for either
    -- Indian English (en-IN) or Hindi (hi-IN).
    --
    -- If a bilingual voice is used and no language code is specified, Amazon
    -- Polly uses the default language of the bilingual voice. The default
    -- language for any voice is the one returned by the
    -- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
    -- operation for the @LanguageCode@ parameter. For example, if no language
    -- code is specified, Aditi will use Indian English rather than Hindi.
    SynthesisTask -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | List of one or more pronunciation lexicon names you want the service to
    -- apply during synthesis. Lexicons are applied only if the language of the
    -- lexicon is the same as the language of the voice.
    SynthesisTask -> Maybe [Text]
lexiconNames :: Prelude.Maybe [Prelude.Text],
    -- | The format in which the returned output will be encoded. For audio
    -- stream, this will be mp3, ogg_vorbis, or pcm. For speech marks, this
    -- will be json.
    SynthesisTask -> Maybe OutputFormat
outputFormat :: Prelude.Maybe OutputFormat,
    -- | Pathway for the output speech file.
    SynthesisTask -> Maybe Text
outputUri :: Prelude.Maybe Prelude.Text,
    -- | Number of billable characters synthesized.
    SynthesisTask -> Maybe Int
requestCharacters :: Prelude.Maybe Prelude.Int,
    -- | The audio frequency specified in Hz.
    --
    -- The valid values for mp3 and ogg_vorbis are \"8000\", \"16000\",
    -- \"22050\", and \"24000\". The default value for standard voices is
    -- \"22050\". The default value for neural voices is \"24000\".
    --
    -- Valid values for pcm are \"8000\" and \"16000\" The default value is
    -- \"16000\".
    SynthesisTask -> Maybe Text
sampleRate :: Prelude.Maybe Prelude.Text,
    -- | ARN for the SNS topic optionally used for providing status notification
    -- for a speech synthesis task.
    SynthesisTask -> Maybe Text
snsTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The type of speech marks returned for the input text.
    SynthesisTask -> Maybe [SpeechMarkType]
speechMarkTypes :: Prelude.Maybe [SpeechMarkType],
    -- | The Amazon Polly generated identifier for a speech synthesis task.
    SynthesisTask -> Maybe Text
taskId :: Prelude.Maybe Prelude.Text,
    -- | Current status of the individual speech synthesis task.
    SynthesisTask -> Maybe TaskStatus
taskStatus :: Prelude.Maybe TaskStatus,
    -- | Reason for the current status of a specific speech synthesis task,
    -- including errors if the task has failed.
    SynthesisTask -> Maybe Text
taskStatusReason :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether the input text is plain text or SSML. The default
    -- value is plain text.
    SynthesisTask -> Maybe TextType
textType :: Prelude.Maybe TextType,
    -- | Voice ID to use for the synthesis.
    SynthesisTask -> Maybe VoiceId
voiceId :: Prelude.Maybe VoiceId
  }
  deriving (SynthesisTask -> SynthesisTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SynthesisTask -> SynthesisTask -> Bool
$c/= :: SynthesisTask -> SynthesisTask -> Bool
== :: SynthesisTask -> SynthesisTask -> Bool
$c== :: SynthesisTask -> SynthesisTask -> Bool
Prelude.Eq, ReadPrec [SynthesisTask]
ReadPrec SynthesisTask
Int -> ReadS SynthesisTask
ReadS [SynthesisTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SynthesisTask]
$creadListPrec :: ReadPrec [SynthesisTask]
readPrec :: ReadPrec SynthesisTask
$creadPrec :: ReadPrec SynthesisTask
readList :: ReadS [SynthesisTask]
$creadList :: ReadS [SynthesisTask]
readsPrec :: Int -> ReadS SynthesisTask
$creadsPrec :: Int -> ReadS SynthesisTask
Prelude.Read, Int -> SynthesisTask -> ShowS
[SynthesisTask] -> ShowS
SynthesisTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthesisTask] -> ShowS
$cshowList :: [SynthesisTask] -> ShowS
show :: SynthesisTask -> String
$cshow :: SynthesisTask -> String
showsPrec :: Int -> SynthesisTask -> ShowS
$cshowsPrec :: Int -> SynthesisTask -> ShowS
Prelude.Show, forall x. Rep SynthesisTask x -> SynthesisTask
forall x. SynthesisTask -> Rep SynthesisTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SynthesisTask x -> SynthesisTask
$cfrom :: forall x. SynthesisTask -> Rep SynthesisTask x
Prelude.Generic)

-- |
-- Create a value of 'SynthesisTask' 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:
--
-- 'creationTime', 'synthesisTask_creationTime' - Timestamp for the time the synthesis task was started.
--
-- 'engine', 'synthesisTask_engine' - Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
-- when processing input text for speech synthesis. Using a voice that is
-- not supported for the engine selected will result in an error.
--
-- 'languageCode', 'synthesisTask_languageCode' - Optional language code for a synthesis task. This is only necessary if
-- using a bilingual voice, such as Aditi, which can be used for either
-- Indian English (en-IN) or Hindi (hi-IN).
--
-- If a bilingual voice is used and no language code is specified, Amazon
-- Polly uses the default language of the bilingual voice. The default
-- language for any voice is the one returned by the
-- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
-- operation for the @LanguageCode@ parameter. For example, if no language
-- code is specified, Aditi will use Indian English rather than Hindi.
--
-- 'lexiconNames', 'synthesisTask_lexiconNames' - List of one or more pronunciation lexicon names you want the service to
-- apply during synthesis. Lexicons are applied only if the language of the
-- lexicon is the same as the language of the voice.
--
-- 'outputFormat', 'synthesisTask_outputFormat' - The format in which the returned output will be encoded. For audio
-- stream, this will be mp3, ogg_vorbis, or pcm. For speech marks, this
-- will be json.
--
-- 'outputUri', 'synthesisTask_outputUri' - Pathway for the output speech file.
--
-- 'requestCharacters', 'synthesisTask_requestCharacters' - Number of billable characters synthesized.
--
-- 'sampleRate', 'synthesisTask_sampleRate' - The audio frequency specified in Hz.
--
-- The valid values for mp3 and ogg_vorbis are \"8000\", \"16000\",
-- \"22050\", and \"24000\". The default value for standard voices is
-- \"22050\". The default value for neural voices is \"24000\".
--
-- Valid values for pcm are \"8000\" and \"16000\" The default value is
-- \"16000\".
--
-- 'snsTopicArn', 'synthesisTask_snsTopicArn' - ARN for the SNS topic optionally used for providing status notification
-- for a speech synthesis task.
--
-- 'speechMarkTypes', 'synthesisTask_speechMarkTypes' - The type of speech marks returned for the input text.
--
-- 'taskId', 'synthesisTask_taskId' - The Amazon Polly generated identifier for a speech synthesis task.
--
-- 'taskStatus', 'synthesisTask_taskStatus' - Current status of the individual speech synthesis task.
--
-- 'taskStatusReason', 'synthesisTask_taskStatusReason' - Reason for the current status of a specific speech synthesis task,
-- including errors if the task has failed.
--
-- 'textType', 'synthesisTask_textType' - Specifies whether the input text is plain text or SSML. The default
-- value is plain text.
--
-- 'voiceId', 'synthesisTask_voiceId' - Voice ID to use for the synthesis.
newSynthesisTask ::
  SynthesisTask
newSynthesisTask :: SynthesisTask
newSynthesisTask =
  SynthesisTask'
    { $sel:creationTime:SynthesisTask' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:SynthesisTask' :: Maybe Engine
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:SynthesisTask' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:lexiconNames:SynthesisTask' :: Maybe [Text]
lexiconNames = forall a. Maybe a
Prelude.Nothing,
      $sel:outputFormat:SynthesisTask' :: Maybe OutputFormat
outputFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:outputUri:SynthesisTask' :: Maybe Text
outputUri = forall a. Maybe a
Prelude.Nothing,
      $sel:requestCharacters:SynthesisTask' :: Maybe Int
requestCharacters = forall a. Maybe a
Prelude.Nothing,
      $sel:sampleRate:SynthesisTask' :: Maybe Text
sampleRate = forall a. Maybe a
Prelude.Nothing,
      $sel:snsTopicArn:SynthesisTask' :: Maybe Text
snsTopicArn = forall a. Maybe a
Prelude.Nothing,
      $sel:speechMarkTypes:SynthesisTask' :: Maybe [SpeechMarkType]
speechMarkTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:taskId:SynthesisTask' :: Maybe Text
taskId = forall a. Maybe a
Prelude.Nothing,
      $sel:taskStatus:SynthesisTask' :: Maybe TaskStatus
taskStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:taskStatusReason:SynthesisTask' :: Maybe Text
taskStatusReason = forall a. Maybe a
Prelude.Nothing,
      $sel:textType:SynthesisTask' :: Maybe TextType
textType = forall a. Maybe a
Prelude.Nothing,
      $sel:voiceId:SynthesisTask' :: Maybe VoiceId
voiceId = forall a. Maybe a
Prelude.Nothing
    }

-- | Timestamp for the time the synthesis task was started.
synthesisTask_creationTime :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.UTCTime)
synthesisTask_creationTime :: Lens' SynthesisTask (Maybe UTCTime)
synthesisTask_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:SynthesisTask' :: SynthesisTask -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe POSIX
a -> SynthesisTask
s {$sel:creationTime:SynthesisTask' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: SynthesisTask) 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

-- | Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
-- when processing input text for speech synthesis. Using a voice that is
-- not supported for the engine selected will result in an error.
synthesisTask_engine :: Lens.Lens' SynthesisTask (Prelude.Maybe Engine)
synthesisTask_engine :: Lens' SynthesisTask (Maybe Engine)
synthesisTask_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Engine
engine :: Maybe Engine
$sel:engine:SynthesisTask' :: SynthesisTask -> Maybe Engine
engine} -> Maybe Engine
engine) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Engine
a -> SynthesisTask
s {$sel:engine:SynthesisTask' :: Maybe Engine
engine = Maybe Engine
a} :: SynthesisTask)

-- | Optional language code for a synthesis task. This is only necessary if
-- using a bilingual voice, such as Aditi, which can be used for either
-- Indian English (en-IN) or Hindi (hi-IN).
--
-- If a bilingual voice is used and no language code is specified, Amazon
-- Polly uses the default language of the bilingual voice. The default
-- language for any voice is the one returned by the
-- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
-- operation for the @LanguageCode@ parameter. For example, if no language
-- code is specified, Aditi will use Indian English rather than Hindi.
synthesisTask_languageCode :: Lens.Lens' SynthesisTask (Prelude.Maybe LanguageCode)
synthesisTask_languageCode :: Lens' SynthesisTask (Maybe LanguageCode)
synthesisTask_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:SynthesisTask' :: SynthesisTask -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe LanguageCode
a -> SynthesisTask
s {$sel:languageCode:SynthesisTask' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: SynthesisTask)

-- | List of one or more pronunciation lexicon names you want the service to
-- apply during synthesis. Lexicons are applied only if the language of the
-- lexicon is the same as the language of the voice.
synthesisTask_lexiconNames :: Lens.Lens' SynthesisTask (Prelude.Maybe [Prelude.Text])
synthesisTask_lexiconNames :: Lens' SynthesisTask (Maybe [Text])
synthesisTask_lexiconNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe [Text]
lexiconNames :: Maybe [Text]
$sel:lexiconNames:SynthesisTask' :: SynthesisTask -> Maybe [Text]
lexiconNames} -> Maybe [Text]
lexiconNames) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe [Text]
a -> SynthesisTask
s {$sel:lexiconNames:SynthesisTask' :: Maybe [Text]
lexiconNames = Maybe [Text]
a} :: SynthesisTask) 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

-- | The format in which the returned output will be encoded. For audio
-- stream, this will be mp3, ogg_vorbis, or pcm. For speech marks, this
-- will be json.
synthesisTask_outputFormat :: Lens.Lens' SynthesisTask (Prelude.Maybe OutputFormat)
synthesisTask_outputFormat :: Lens' SynthesisTask (Maybe OutputFormat)
synthesisTask_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe OutputFormat
outputFormat :: Maybe OutputFormat
$sel:outputFormat:SynthesisTask' :: SynthesisTask -> Maybe OutputFormat
outputFormat} -> Maybe OutputFormat
outputFormat) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe OutputFormat
a -> SynthesisTask
s {$sel:outputFormat:SynthesisTask' :: Maybe OutputFormat
outputFormat = Maybe OutputFormat
a} :: SynthesisTask)

-- | Pathway for the output speech file.
synthesisTask_outputUri :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Text)
synthesisTask_outputUri :: Lens' SynthesisTask (Maybe Text)
synthesisTask_outputUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Text
outputUri :: Maybe Text
$sel:outputUri:SynthesisTask' :: SynthesisTask -> Maybe Text
outputUri} -> Maybe Text
outputUri) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Text
a -> SynthesisTask
s {$sel:outputUri:SynthesisTask' :: Maybe Text
outputUri = Maybe Text
a} :: SynthesisTask)

-- | Number of billable characters synthesized.
synthesisTask_requestCharacters :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Int)
synthesisTask_requestCharacters :: Lens' SynthesisTask (Maybe Int)
synthesisTask_requestCharacters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Int
requestCharacters :: Maybe Int
$sel:requestCharacters:SynthesisTask' :: SynthesisTask -> Maybe Int
requestCharacters} -> Maybe Int
requestCharacters) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Int
a -> SynthesisTask
s {$sel:requestCharacters:SynthesisTask' :: Maybe Int
requestCharacters = Maybe Int
a} :: SynthesisTask)

-- | The audio frequency specified in Hz.
--
-- The valid values for mp3 and ogg_vorbis are \"8000\", \"16000\",
-- \"22050\", and \"24000\". The default value for standard voices is
-- \"22050\". The default value for neural voices is \"24000\".
--
-- Valid values for pcm are \"8000\" and \"16000\" The default value is
-- \"16000\".
synthesisTask_sampleRate :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Text)
synthesisTask_sampleRate :: Lens' SynthesisTask (Maybe Text)
synthesisTask_sampleRate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Text
sampleRate :: Maybe Text
$sel:sampleRate:SynthesisTask' :: SynthesisTask -> Maybe Text
sampleRate} -> Maybe Text
sampleRate) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Text
a -> SynthesisTask
s {$sel:sampleRate:SynthesisTask' :: Maybe Text
sampleRate = Maybe Text
a} :: SynthesisTask)

-- | ARN for the SNS topic optionally used for providing status notification
-- for a speech synthesis task.
synthesisTask_snsTopicArn :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Text)
synthesisTask_snsTopicArn :: Lens' SynthesisTask (Maybe Text)
synthesisTask_snsTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Text
snsTopicArn :: Maybe Text
$sel:snsTopicArn:SynthesisTask' :: SynthesisTask -> Maybe Text
snsTopicArn} -> Maybe Text
snsTopicArn) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Text
a -> SynthesisTask
s {$sel:snsTopicArn:SynthesisTask' :: Maybe Text
snsTopicArn = Maybe Text
a} :: SynthesisTask)

-- | The type of speech marks returned for the input text.
synthesisTask_speechMarkTypes :: Lens.Lens' SynthesisTask (Prelude.Maybe [SpeechMarkType])
synthesisTask_speechMarkTypes :: Lens' SynthesisTask (Maybe [SpeechMarkType])
synthesisTask_speechMarkTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe [SpeechMarkType]
speechMarkTypes :: Maybe [SpeechMarkType]
$sel:speechMarkTypes:SynthesisTask' :: SynthesisTask -> Maybe [SpeechMarkType]
speechMarkTypes} -> Maybe [SpeechMarkType]
speechMarkTypes) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe [SpeechMarkType]
a -> SynthesisTask
s {$sel:speechMarkTypes:SynthesisTask' :: Maybe [SpeechMarkType]
speechMarkTypes = Maybe [SpeechMarkType]
a} :: SynthesisTask) 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

-- | The Amazon Polly generated identifier for a speech synthesis task.
synthesisTask_taskId :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Text)
synthesisTask_taskId :: Lens' SynthesisTask (Maybe Text)
synthesisTask_taskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Text
taskId :: Maybe Text
$sel:taskId:SynthesisTask' :: SynthesisTask -> Maybe Text
taskId} -> Maybe Text
taskId) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Text
a -> SynthesisTask
s {$sel:taskId:SynthesisTask' :: Maybe Text
taskId = Maybe Text
a} :: SynthesisTask)

-- | Current status of the individual speech synthesis task.
synthesisTask_taskStatus :: Lens.Lens' SynthesisTask (Prelude.Maybe TaskStatus)
synthesisTask_taskStatus :: Lens' SynthesisTask (Maybe TaskStatus)
synthesisTask_taskStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe TaskStatus
taskStatus :: Maybe TaskStatus
$sel:taskStatus:SynthesisTask' :: SynthesisTask -> Maybe TaskStatus
taskStatus} -> Maybe TaskStatus
taskStatus) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe TaskStatus
a -> SynthesisTask
s {$sel:taskStatus:SynthesisTask' :: Maybe TaskStatus
taskStatus = Maybe TaskStatus
a} :: SynthesisTask)

-- | Reason for the current status of a specific speech synthesis task,
-- including errors if the task has failed.
synthesisTask_taskStatusReason :: Lens.Lens' SynthesisTask (Prelude.Maybe Prelude.Text)
synthesisTask_taskStatusReason :: Lens' SynthesisTask (Maybe Text)
synthesisTask_taskStatusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe Text
taskStatusReason :: Maybe Text
$sel:taskStatusReason:SynthesisTask' :: SynthesisTask -> Maybe Text
taskStatusReason} -> Maybe Text
taskStatusReason) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe Text
a -> SynthesisTask
s {$sel:taskStatusReason:SynthesisTask' :: Maybe Text
taskStatusReason = Maybe Text
a} :: SynthesisTask)

-- | Specifies whether the input text is plain text or SSML. The default
-- value is plain text.
synthesisTask_textType :: Lens.Lens' SynthesisTask (Prelude.Maybe TextType)
synthesisTask_textType :: Lens' SynthesisTask (Maybe TextType)
synthesisTask_textType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe TextType
textType :: Maybe TextType
$sel:textType:SynthesisTask' :: SynthesisTask -> Maybe TextType
textType} -> Maybe TextType
textType) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe TextType
a -> SynthesisTask
s {$sel:textType:SynthesisTask' :: Maybe TextType
textType = Maybe TextType
a} :: SynthesisTask)

-- | Voice ID to use for the synthesis.
synthesisTask_voiceId :: Lens.Lens' SynthesisTask (Prelude.Maybe VoiceId)
synthesisTask_voiceId :: Lens' SynthesisTask (Maybe VoiceId)
synthesisTask_voiceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesisTask' {Maybe VoiceId
voiceId :: Maybe VoiceId
$sel:voiceId:SynthesisTask' :: SynthesisTask -> Maybe VoiceId
voiceId} -> Maybe VoiceId
voiceId) (\s :: SynthesisTask
s@SynthesisTask' {} Maybe VoiceId
a -> SynthesisTask
s {$sel:voiceId:SynthesisTask' :: Maybe VoiceId
voiceId = Maybe VoiceId
a} :: SynthesisTask)

instance Data.FromJSON SynthesisTask where
  parseJSON :: Value -> Parser SynthesisTask
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SynthesisTask"
      ( \Object
x ->
          Maybe POSIX
-> Maybe Engine
-> Maybe LanguageCode
-> Maybe [Text]
-> Maybe OutputFormat
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe [SpeechMarkType]
-> Maybe Text
-> Maybe TaskStatus
-> Maybe Text
-> Maybe TextType
-> Maybe VoiceId
-> SynthesisTask
SynthesisTask'
            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
"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
"Engine")
            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
"LexiconNames" 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
"OutputFormat")
            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
"OutputUri")
            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
"RequestCharacters")
            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
"SampleRate")
            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
"SnsTopicArn")
            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
"SpeechMarkTypes"
                            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
"TaskId")
            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
"TaskStatus")
            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
"TaskStatusReason")
            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
"TextType")
            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
"VoiceId")
      )

instance Prelude.Hashable SynthesisTask where
  hashWithSalt :: Int -> SynthesisTask -> Int
hashWithSalt Int
_salt SynthesisTask' {Maybe Int
Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe POSIX
Maybe Engine
Maybe LanguageCode
Maybe OutputFormat
Maybe TaskStatus
Maybe TextType
Maybe VoiceId
voiceId :: Maybe VoiceId
textType :: Maybe TextType
taskStatusReason :: Maybe Text
taskStatus :: Maybe TaskStatus
taskId :: Maybe Text
speechMarkTypes :: Maybe [SpeechMarkType]
snsTopicArn :: Maybe Text
sampleRate :: Maybe Text
requestCharacters :: Maybe Int
outputUri :: Maybe Text
outputFormat :: Maybe OutputFormat
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
creationTime :: Maybe POSIX
$sel:voiceId:SynthesisTask' :: SynthesisTask -> Maybe VoiceId
$sel:textType:SynthesisTask' :: SynthesisTask -> Maybe TextType
$sel:taskStatusReason:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:taskStatus:SynthesisTask' :: SynthesisTask -> Maybe TaskStatus
$sel:taskId:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:speechMarkTypes:SynthesisTask' :: SynthesisTask -> Maybe [SpeechMarkType]
$sel:snsTopicArn:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:sampleRate:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:requestCharacters:SynthesisTask' :: SynthesisTask -> Maybe Int
$sel:outputUri:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:outputFormat:SynthesisTask' :: SynthesisTask -> Maybe OutputFormat
$sel:lexiconNames:SynthesisTask' :: SynthesisTask -> Maybe [Text]
$sel:languageCode:SynthesisTask' :: SynthesisTask -> Maybe LanguageCode
$sel:engine:SynthesisTask' :: SynthesisTask -> Maybe Engine
$sel:creationTime:SynthesisTask' :: SynthesisTask -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Engine
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LanguageCode
languageCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
lexiconNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputFormat
outputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
requestCharacters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sampleRate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snsTopicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SpeechMarkType]
speechMarkTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaskStatus
taskStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
taskStatusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TextType
textType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VoiceId
voiceId

instance Prelude.NFData SynthesisTask where
  rnf :: SynthesisTask -> ()
rnf SynthesisTask' {Maybe Int
Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe POSIX
Maybe Engine
Maybe LanguageCode
Maybe OutputFormat
Maybe TaskStatus
Maybe TextType
Maybe VoiceId
voiceId :: Maybe VoiceId
textType :: Maybe TextType
taskStatusReason :: Maybe Text
taskStatus :: Maybe TaskStatus
taskId :: Maybe Text
speechMarkTypes :: Maybe [SpeechMarkType]
snsTopicArn :: Maybe Text
sampleRate :: Maybe Text
requestCharacters :: Maybe Int
outputUri :: Maybe Text
outputFormat :: Maybe OutputFormat
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
creationTime :: Maybe POSIX
$sel:voiceId:SynthesisTask' :: SynthesisTask -> Maybe VoiceId
$sel:textType:SynthesisTask' :: SynthesisTask -> Maybe TextType
$sel:taskStatusReason:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:taskStatus:SynthesisTask' :: SynthesisTask -> Maybe TaskStatus
$sel:taskId:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:speechMarkTypes:SynthesisTask' :: SynthesisTask -> Maybe [SpeechMarkType]
$sel:snsTopicArn:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:sampleRate:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:requestCharacters:SynthesisTask' :: SynthesisTask -> Maybe Int
$sel:outputUri:SynthesisTask' :: SynthesisTask -> Maybe Text
$sel:outputFormat:SynthesisTask' :: SynthesisTask -> Maybe OutputFormat
$sel:lexiconNames:SynthesisTask' :: SynthesisTask -> Maybe [Text]
$sel:languageCode:SynthesisTask' :: SynthesisTask -> Maybe LanguageCode
$sel:engine:SynthesisTask' :: SynthesisTask -> Maybe Engine
$sel:creationTime:SynthesisTask' :: SynthesisTask -> Maybe POSIX
..} =
    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 Engine
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LanguageCode
languageCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
lexiconNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputFormat
outputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
requestCharacters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sampleRate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snsTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SpeechMarkType]
speechMarkTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskStatus
taskStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskStatusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TextType
textType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VoiceId
voiceId