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

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

-- |
-- Module      : Amazonka.Polly.StartSpeechSynthesisTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows the creation of an asynchronous synthesis task, by starting a new
-- @SpeechSynthesisTask@. This operation requires all the standard
-- information needed for speech synthesis, plus the name of an Amazon S3
-- bucket for the service to store the output of the synthesis task and two
-- optional parameters (@OutputS3KeyPrefix@ and @SnsTopicArn@). Once the
-- synthesis task is created, this operation will return a
-- @SpeechSynthesisTask@ object, which will include an identifier of this
-- task as well as the current status. The @SpeechSynthesisTask@ object is
-- available for 72 hours after starting the asynchronous synthesis task.
module Amazonka.Polly.StartSpeechSynthesisTask
  ( -- * Creating a Request
    StartSpeechSynthesisTask (..),
    newStartSpeechSynthesisTask,

    -- * Request Lenses
    startSpeechSynthesisTask_engine,
    startSpeechSynthesisTask_languageCode,
    startSpeechSynthesisTask_lexiconNames,
    startSpeechSynthesisTask_outputS3KeyPrefix,
    startSpeechSynthesisTask_sampleRate,
    startSpeechSynthesisTask_snsTopicArn,
    startSpeechSynthesisTask_speechMarkTypes,
    startSpeechSynthesisTask_textType,
    startSpeechSynthesisTask_outputFormat,
    startSpeechSynthesisTask_outputS3BucketName,
    startSpeechSynthesisTask_text,
    startSpeechSynthesisTask_voiceId,

    -- * Destructuring the Response
    StartSpeechSynthesisTaskResponse (..),
    newStartSpeechSynthesisTaskResponse,

    -- * Response Lenses
    startSpeechSynthesisTaskResponse_synthesisTask,
    startSpeechSynthesisTaskResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStartSpeechSynthesisTask' smart constructor.
data StartSpeechSynthesisTask = StartSpeechSynthesisTask'
  { -- | 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.
    StartSpeechSynthesisTask -> Maybe Engine
engine :: Prelude.Maybe Engine,
    -- | Optional language code for the Speech Synthesis request. 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.
    StartSpeechSynthesisTask -> 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.
    StartSpeechSynthesisTask -> Maybe [Text]
lexiconNames :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon S3 key prefix for the output speech file.
    StartSpeechSynthesisTask -> Maybe Text
outputS3KeyPrefix :: Prelude.Maybe Prelude.Text,
    -- | 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\".
    StartSpeechSynthesisTask -> Maybe Text
sampleRate :: Prelude.Maybe Prelude.Text,
    -- | ARN for the SNS topic optionally used for providing status notification
    -- for a speech synthesis task.
    StartSpeechSynthesisTask -> Maybe Text
snsTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The type of speech marks returned for the input text.
    StartSpeechSynthesisTask -> Maybe [SpeechMarkType]
speechMarkTypes :: Prelude.Maybe [SpeechMarkType],
    -- | Specifies whether the input text is plain text or SSML. The default
    -- value is plain text.
    StartSpeechSynthesisTask -> Maybe TextType
textType :: Prelude.Maybe TextType,
    -- | 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.
    StartSpeechSynthesisTask -> OutputFormat
outputFormat :: OutputFormat,
    -- | Amazon S3 bucket name to which the output file will be saved.
    StartSpeechSynthesisTask -> Text
outputS3BucketName :: Prelude.Text,
    -- | The input text to synthesize. If you specify ssml as the TextType,
    -- follow the SSML format for the input text.
    StartSpeechSynthesisTask -> Text
text :: Prelude.Text,
    -- | Voice ID to use for the synthesis.
    StartSpeechSynthesisTask -> VoiceId
voiceId :: VoiceId
  }
  deriving (StartSpeechSynthesisTask -> StartSpeechSynthesisTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSpeechSynthesisTask -> StartSpeechSynthesisTask -> Bool
$c/= :: StartSpeechSynthesisTask -> StartSpeechSynthesisTask -> Bool
== :: StartSpeechSynthesisTask -> StartSpeechSynthesisTask -> Bool
$c== :: StartSpeechSynthesisTask -> StartSpeechSynthesisTask -> Bool
Prelude.Eq, ReadPrec [StartSpeechSynthesisTask]
ReadPrec StartSpeechSynthesisTask
Int -> ReadS StartSpeechSynthesisTask
ReadS [StartSpeechSynthesisTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSpeechSynthesisTask]
$creadListPrec :: ReadPrec [StartSpeechSynthesisTask]
readPrec :: ReadPrec StartSpeechSynthesisTask
$creadPrec :: ReadPrec StartSpeechSynthesisTask
readList :: ReadS [StartSpeechSynthesisTask]
$creadList :: ReadS [StartSpeechSynthesisTask]
readsPrec :: Int -> ReadS StartSpeechSynthesisTask
$creadsPrec :: Int -> ReadS StartSpeechSynthesisTask
Prelude.Read, Int -> StartSpeechSynthesisTask -> ShowS
[StartSpeechSynthesisTask] -> ShowS
StartSpeechSynthesisTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSpeechSynthesisTask] -> ShowS
$cshowList :: [StartSpeechSynthesisTask] -> ShowS
show :: StartSpeechSynthesisTask -> String
$cshow :: StartSpeechSynthesisTask -> String
showsPrec :: Int -> StartSpeechSynthesisTask -> ShowS
$cshowsPrec :: Int -> StartSpeechSynthesisTask -> ShowS
Prelude.Show, forall x.
Rep StartSpeechSynthesisTask x -> StartSpeechSynthesisTask
forall x.
StartSpeechSynthesisTask -> Rep StartSpeechSynthesisTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartSpeechSynthesisTask x -> StartSpeechSynthesisTask
$cfrom :: forall x.
StartSpeechSynthesisTask -> Rep StartSpeechSynthesisTask x
Prelude.Generic)

-- |
-- Create a value of 'StartSpeechSynthesisTask' 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:
--
-- 'engine', 'startSpeechSynthesisTask_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', 'startSpeechSynthesisTask_languageCode' - Optional language code for the Speech Synthesis request. 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', 'startSpeechSynthesisTask_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.
--
-- 'outputS3KeyPrefix', 'startSpeechSynthesisTask_outputS3KeyPrefix' - The Amazon S3 key prefix for the output speech file.
--
-- 'sampleRate', 'startSpeechSynthesisTask_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', 'startSpeechSynthesisTask_snsTopicArn' - ARN for the SNS topic optionally used for providing status notification
-- for a speech synthesis task.
--
-- 'speechMarkTypes', 'startSpeechSynthesisTask_speechMarkTypes' - The type of speech marks returned for the input text.
--
-- 'textType', 'startSpeechSynthesisTask_textType' - Specifies whether the input text is plain text or SSML. The default
-- value is plain text.
--
-- 'outputFormat', 'startSpeechSynthesisTask_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.
--
-- 'outputS3BucketName', 'startSpeechSynthesisTask_outputS3BucketName' - Amazon S3 bucket name to which the output file will be saved.
--
-- 'text', 'startSpeechSynthesisTask_text' - The input text to synthesize. If you specify ssml as the TextType,
-- follow the SSML format for the input text.
--
-- 'voiceId', 'startSpeechSynthesisTask_voiceId' - Voice ID to use for the synthesis.
newStartSpeechSynthesisTask ::
  -- | 'outputFormat'
  OutputFormat ->
  -- | 'outputS3BucketName'
  Prelude.Text ->
  -- | 'text'
  Prelude.Text ->
  -- | 'voiceId'
  VoiceId ->
  StartSpeechSynthesisTask
newStartSpeechSynthesisTask :: OutputFormat -> Text -> Text -> VoiceId -> StartSpeechSynthesisTask
newStartSpeechSynthesisTask
  OutputFormat
pOutputFormat_
  Text
pOutputS3BucketName_
  Text
pText_
  VoiceId
pVoiceId_ =
    StartSpeechSynthesisTask'
      { $sel:engine:StartSpeechSynthesisTask' :: Maybe Engine
engine = forall a. Maybe a
Prelude.Nothing,
        $sel:languageCode:StartSpeechSynthesisTask' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
        $sel:lexiconNames:StartSpeechSynthesisTask' :: Maybe [Text]
lexiconNames = forall a. Maybe a
Prelude.Nothing,
        $sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: Maybe Text
outputS3KeyPrefix = forall a. Maybe a
Prelude.Nothing,
        $sel:sampleRate:StartSpeechSynthesisTask' :: Maybe Text
sampleRate = forall a. Maybe a
Prelude.Nothing,
        $sel:snsTopicArn:StartSpeechSynthesisTask' :: Maybe Text
snsTopicArn = forall a. Maybe a
Prelude.Nothing,
        $sel:speechMarkTypes:StartSpeechSynthesisTask' :: Maybe [SpeechMarkType]
speechMarkTypes = forall a. Maybe a
Prelude.Nothing,
        $sel:textType:StartSpeechSynthesisTask' :: Maybe TextType
textType = forall a. Maybe a
Prelude.Nothing,
        $sel:outputFormat:StartSpeechSynthesisTask' :: OutputFormat
outputFormat = OutputFormat
pOutputFormat_,
        $sel:outputS3BucketName:StartSpeechSynthesisTask' :: Text
outputS3BucketName = Text
pOutputS3BucketName_,
        $sel:text:StartSpeechSynthesisTask' :: Text
text = Text
pText_,
        $sel:voiceId:StartSpeechSynthesisTask' :: VoiceId
voiceId = VoiceId
pVoiceId_
      }

-- | 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.
startSpeechSynthesisTask_engine :: Lens.Lens' StartSpeechSynthesisTask (Prelude.Maybe Engine)
startSpeechSynthesisTask_engine :: Lens' StartSpeechSynthesisTask (Maybe Engine)
startSpeechSynthesisTask_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Maybe Engine
engine :: Maybe Engine
$sel:engine:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Engine
engine} -> Maybe Engine
engine) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Maybe Engine
a -> StartSpeechSynthesisTask
s {$sel:engine:StartSpeechSynthesisTask' :: Maybe Engine
engine = Maybe Engine
a} :: StartSpeechSynthesisTask)

-- | Optional language code for the Speech Synthesis request. 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.
startSpeechSynthesisTask_languageCode :: Lens.Lens' StartSpeechSynthesisTask (Prelude.Maybe LanguageCode)
startSpeechSynthesisTask_languageCode :: Lens' StartSpeechSynthesisTask (Maybe LanguageCode)
startSpeechSynthesisTask_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Maybe LanguageCode
a -> StartSpeechSynthesisTask
s {$sel:languageCode:StartSpeechSynthesisTask' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: StartSpeechSynthesisTask)

-- | 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.
startSpeechSynthesisTask_lexiconNames :: Lens.Lens' StartSpeechSynthesisTask (Prelude.Maybe [Prelude.Text])
startSpeechSynthesisTask_lexiconNames :: Lens' StartSpeechSynthesisTask (Maybe [Text])
startSpeechSynthesisTask_lexiconNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Maybe [Text]
lexiconNames :: Maybe [Text]
$sel:lexiconNames:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [Text]
lexiconNames} -> Maybe [Text]
lexiconNames) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Maybe [Text]
a -> StartSpeechSynthesisTask
s {$sel:lexiconNames:StartSpeechSynthesisTask' :: Maybe [Text]
lexiconNames = Maybe [Text]
a} :: StartSpeechSynthesisTask) 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 S3 key prefix for the output speech file.
startSpeechSynthesisTask_outputS3KeyPrefix :: Lens.Lens' StartSpeechSynthesisTask (Prelude.Maybe Prelude.Text)
startSpeechSynthesisTask_outputS3KeyPrefix :: Lens' StartSpeechSynthesisTask (Maybe Text)
startSpeechSynthesisTask_outputS3KeyPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Maybe Text
outputS3KeyPrefix :: Maybe Text
$sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
outputS3KeyPrefix} -> Maybe Text
outputS3KeyPrefix) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Maybe Text
a -> StartSpeechSynthesisTask
s {$sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: Maybe Text
outputS3KeyPrefix = Maybe Text
a} :: StartSpeechSynthesisTask)

-- | 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\".
startSpeechSynthesisTask_sampleRate :: Lens.Lens' StartSpeechSynthesisTask (Prelude.Maybe Prelude.Text)
startSpeechSynthesisTask_sampleRate :: Lens' StartSpeechSynthesisTask (Maybe Text)
startSpeechSynthesisTask_sampleRate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Maybe Text
sampleRate :: Maybe Text
$sel:sampleRate:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
sampleRate} -> Maybe Text
sampleRate) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Maybe Text
a -> StartSpeechSynthesisTask
s {$sel:sampleRate:StartSpeechSynthesisTask' :: Maybe Text
sampleRate = Maybe Text
a} :: StartSpeechSynthesisTask)

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

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

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

-- | 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.
startSpeechSynthesisTask_outputFormat :: Lens.Lens' StartSpeechSynthesisTask OutputFormat
startSpeechSynthesisTask_outputFormat :: Lens' StartSpeechSynthesisTask OutputFormat
startSpeechSynthesisTask_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {OutputFormat
outputFormat :: OutputFormat
$sel:outputFormat:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> OutputFormat
outputFormat} -> OutputFormat
outputFormat) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} OutputFormat
a -> StartSpeechSynthesisTask
s {$sel:outputFormat:StartSpeechSynthesisTask' :: OutputFormat
outputFormat = OutputFormat
a} :: StartSpeechSynthesisTask)

-- | Amazon S3 bucket name to which the output file will be saved.
startSpeechSynthesisTask_outputS3BucketName :: Lens.Lens' StartSpeechSynthesisTask Prelude.Text
startSpeechSynthesisTask_outputS3BucketName :: Lens' StartSpeechSynthesisTask Text
startSpeechSynthesisTask_outputS3BucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Text
outputS3BucketName :: Text
$sel:outputS3BucketName:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
outputS3BucketName} -> Text
outputS3BucketName) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Text
a -> StartSpeechSynthesisTask
s {$sel:outputS3BucketName:StartSpeechSynthesisTask' :: Text
outputS3BucketName = Text
a} :: StartSpeechSynthesisTask)

-- | The input text to synthesize. If you specify ssml as the TextType,
-- follow the SSML format for the input text.
startSpeechSynthesisTask_text :: Lens.Lens' StartSpeechSynthesisTask Prelude.Text
startSpeechSynthesisTask_text :: Lens' StartSpeechSynthesisTask Text
startSpeechSynthesisTask_text = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTask' {Text
text :: Text
$sel:text:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
text} -> Text
text) (\s :: StartSpeechSynthesisTask
s@StartSpeechSynthesisTask' {} Text
a -> StartSpeechSynthesisTask
s {$sel:text:StartSpeechSynthesisTask' :: Text
text = Text
a} :: StartSpeechSynthesisTask)

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

instance Core.AWSRequest StartSpeechSynthesisTask where
  type
    AWSResponse StartSpeechSynthesisTask =
      StartSpeechSynthesisTaskResponse
  request :: (Service -> Service)
-> StartSpeechSynthesisTask -> Request StartSpeechSynthesisTask
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 StartSpeechSynthesisTask
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartSpeechSynthesisTask)))
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 SynthesisTask -> Int -> StartSpeechSynthesisTaskResponse
StartSpeechSynthesisTaskResponse'
            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
"SynthesisTask")
            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 StartSpeechSynthesisTask where
  hashWithSalt :: Int -> StartSpeechSynthesisTask -> Int
hashWithSalt Int
_salt StartSpeechSynthesisTask' {Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe Engine
Maybe LanguageCode
Maybe TextType
Text
OutputFormat
VoiceId
voiceId :: VoiceId
text :: Text
outputS3BucketName :: Text
outputFormat :: OutputFormat
textType :: Maybe TextType
speechMarkTypes :: Maybe [SpeechMarkType]
snsTopicArn :: Maybe Text
sampleRate :: Maybe Text
outputS3KeyPrefix :: Maybe Text
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
$sel:voiceId:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> VoiceId
$sel:text:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputS3BucketName:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputFormat:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> OutputFormat
$sel:textType:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe TextType
$sel:speechMarkTypes:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [SpeechMarkType]
$sel:snsTopicArn:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:sampleRate:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:lexiconNames:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [Text]
$sel:languageCode:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe LanguageCode
$sel:engine:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Engine
..} =
    Int
_salt
      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 Text
outputS3KeyPrefix
      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 TextType
textType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputFormat
outputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outputS3BucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VoiceId
voiceId

instance Prelude.NFData StartSpeechSynthesisTask where
  rnf :: StartSpeechSynthesisTask -> ()
rnf StartSpeechSynthesisTask' {Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe Engine
Maybe LanguageCode
Maybe TextType
Text
OutputFormat
VoiceId
voiceId :: VoiceId
text :: Text
outputS3BucketName :: Text
outputFormat :: OutputFormat
textType :: Maybe TextType
speechMarkTypes :: Maybe [SpeechMarkType]
snsTopicArn :: Maybe Text
sampleRate :: Maybe Text
outputS3KeyPrefix :: Maybe Text
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
$sel:voiceId:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> VoiceId
$sel:text:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputS3BucketName:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputFormat:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> OutputFormat
$sel:textType:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe TextType
$sel:speechMarkTypes:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [SpeechMarkType]
$sel:snsTopicArn:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:sampleRate:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:lexiconNames:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [Text]
$sel:languageCode:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe LanguageCode
$sel:engine:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Engine
..} =
    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 Text
outputS3KeyPrefix
      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 TextType
textType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OutputFormat
outputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
outputS3BucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
text
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VoiceId
voiceId

instance Data.ToHeaders StartSpeechSynthesisTask where
  toHeaders :: StartSpeechSynthesisTask -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON StartSpeechSynthesisTask where
  toJSON :: StartSpeechSynthesisTask -> Value
toJSON StartSpeechSynthesisTask' {Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe Engine
Maybe LanguageCode
Maybe TextType
Text
OutputFormat
VoiceId
voiceId :: VoiceId
text :: Text
outputS3BucketName :: Text
outputFormat :: OutputFormat
textType :: Maybe TextType
speechMarkTypes :: Maybe [SpeechMarkType]
snsTopicArn :: Maybe Text
sampleRate :: Maybe Text
outputS3KeyPrefix :: Maybe Text
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
$sel:voiceId:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> VoiceId
$sel:text:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputS3BucketName:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Text
$sel:outputFormat:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> OutputFormat
$sel:textType:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe TextType
$sel:speechMarkTypes:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [SpeechMarkType]
$sel:snsTopicArn:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:sampleRate:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:outputS3KeyPrefix:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Text
$sel:lexiconNames:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe [Text]
$sel:languageCode:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe LanguageCode
$sel:engine:StartSpeechSynthesisTask' :: StartSpeechSynthesisTask -> Maybe Engine
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Engine" 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 Engine
engine,
            (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
"LexiconNames" 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]
lexiconNames,
            (Key
"OutputS3KeyPrefix" 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
outputS3KeyPrefix,
            (Key
"SampleRate" 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
sampleRate,
            (Key
"SnsTopicArn" 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
snsTopicArn,
            (Key
"SpeechMarkTypes" 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 [SpeechMarkType]
speechMarkTypes,
            (Key
"TextType" 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 TextType
textType,
            forall a. a -> Maybe a
Prelude.Just (Key
"OutputFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OutputFormat
outputFormat),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OutputS3BucketName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
outputS3BucketName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
text),
            forall a. a -> Maybe a
Prelude.Just (Key
"VoiceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= VoiceId
voiceId)
          ]
      )

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

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

-- | /See:/ 'newStartSpeechSynthesisTaskResponse' smart constructor.
data StartSpeechSynthesisTaskResponse = StartSpeechSynthesisTaskResponse'
  { -- | SynthesisTask object that provides information and attributes about a
    -- newly submitted speech synthesis task.
    StartSpeechSynthesisTaskResponse -> Maybe SynthesisTask
synthesisTask :: Prelude.Maybe SynthesisTask,
    -- | The response's http status code.
    StartSpeechSynthesisTaskResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartSpeechSynthesisTaskResponse
-> StartSpeechSynthesisTaskResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartSpeechSynthesisTaskResponse
-> StartSpeechSynthesisTaskResponse -> Bool
$c/= :: StartSpeechSynthesisTaskResponse
-> StartSpeechSynthesisTaskResponse -> Bool
== :: StartSpeechSynthesisTaskResponse
-> StartSpeechSynthesisTaskResponse -> Bool
$c== :: StartSpeechSynthesisTaskResponse
-> StartSpeechSynthesisTaskResponse -> Bool
Prelude.Eq, ReadPrec [StartSpeechSynthesisTaskResponse]
ReadPrec StartSpeechSynthesisTaskResponse
Int -> ReadS StartSpeechSynthesisTaskResponse
ReadS [StartSpeechSynthesisTaskResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartSpeechSynthesisTaskResponse]
$creadListPrec :: ReadPrec [StartSpeechSynthesisTaskResponse]
readPrec :: ReadPrec StartSpeechSynthesisTaskResponse
$creadPrec :: ReadPrec StartSpeechSynthesisTaskResponse
readList :: ReadS [StartSpeechSynthesisTaskResponse]
$creadList :: ReadS [StartSpeechSynthesisTaskResponse]
readsPrec :: Int -> ReadS StartSpeechSynthesisTaskResponse
$creadsPrec :: Int -> ReadS StartSpeechSynthesisTaskResponse
Prelude.Read, Int -> StartSpeechSynthesisTaskResponse -> ShowS
[StartSpeechSynthesisTaskResponse] -> ShowS
StartSpeechSynthesisTaskResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartSpeechSynthesisTaskResponse] -> ShowS
$cshowList :: [StartSpeechSynthesisTaskResponse] -> ShowS
show :: StartSpeechSynthesisTaskResponse -> String
$cshow :: StartSpeechSynthesisTaskResponse -> String
showsPrec :: Int -> StartSpeechSynthesisTaskResponse -> ShowS
$cshowsPrec :: Int -> StartSpeechSynthesisTaskResponse -> ShowS
Prelude.Show, forall x.
Rep StartSpeechSynthesisTaskResponse x
-> StartSpeechSynthesisTaskResponse
forall x.
StartSpeechSynthesisTaskResponse
-> Rep StartSpeechSynthesisTaskResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartSpeechSynthesisTaskResponse x
-> StartSpeechSynthesisTaskResponse
$cfrom :: forall x.
StartSpeechSynthesisTaskResponse
-> Rep StartSpeechSynthesisTaskResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartSpeechSynthesisTaskResponse' 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:
--
-- 'synthesisTask', 'startSpeechSynthesisTaskResponse_synthesisTask' - SynthesisTask object that provides information and attributes about a
-- newly submitted speech synthesis task.
--
-- 'httpStatus', 'startSpeechSynthesisTaskResponse_httpStatus' - The response's http status code.
newStartSpeechSynthesisTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartSpeechSynthesisTaskResponse
newStartSpeechSynthesisTaskResponse :: Int -> StartSpeechSynthesisTaskResponse
newStartSpeechSynthesisTaskResponse Int
pHttpStatus_ =
  StartSpeechSynthesisTaskResponse'
    { $sel:synthesisTask:StartSpeechSynthesisTaskResponse' :: Maybe SynthesisTask
synthesisTask =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartSpeechSynthesisTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | SynthesisTask object that provides information and attributes about a
-- newly submitted speech synthesis task.
startSpeechSynthesisTaskResponse_synthesisTask :: Lens.Lens' StartSpeechSynthesisTaskResponse (Prelude.Maybe SynthesisTask)
startSpeechSynthesisTaskResponse_synthesisTask :: Lens' StartSpeechSynthesisTaskResponse (Maybe SynthesisTask)
startSpeechSynthesisTaskResponse_synthesisTask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartSpeechSynthesisTaskResponse' {Maybe SynthesisTask
synthesisTask :: Maybe SynthesisTask
$sel:synthesisTask:StartSpeechSynthesisTaskResponse' :: StartSpeechSynthesisTaskResponse -> Maybe SynthesisTask
synthesisTask} -> Maybe SynthesisTask
synthesisTask) (\s :: StartSpeechSynthesisTaskResponse
s@StartSpeechSynthesisTaskResponse' {} Maybe SynthesisTask
a -> StartSpeechSynthesisTaskResponse
s {$sel:synthesisTask:StartSpeechSynthesisTaskResponse' :: Maybe SynthesisTask
synthesisTask = Maybe SynthesisTask
a} :: StartSpeechSynthesisTaskResponse)

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

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