{-# 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.SynthesizeSpeech
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Synthesizes UTF-8 input, plain text or SSML, to a stream of bytes. SSML
-- input must be valid, well-formed SSML. Some alphabets might not be
-- available with all the voices (for example, Cyrillic might not be read
-- at all by English voices) unless phoneme mapping is used. For more
-- information, see
-- <https://docs.aws.amazon.com/polly/latest/dg/how-text-to-speech-works.html How it Works>.
module Amazonka.Polly.SynthesizeSpeech
  ( -- * Creating a Request
    SynthesizeSpeech (..),
    newSynthesizeSpeech,

    -- * Request Lenses
    synthesizeSpeech_engine,
    synthesizeSpeech_languageCode,
    synthesizeSpeech_lexiconNames,
    synthesizeSpeech_sampleRate,
    synthesizeSpeech_speechMarkTypes,
    synthesizeSpeech_textType,
    synthesizeSpeech_outputFormat,
    synthesizeSpeech_text,
    synthesizeSpeech_voiceId,

    -- * Destructuring the Response
    SynthesizeSpeechResponse (..),
    newSynthesizeSpeechResponse,

    -- * Response Lenses
    synthesizeSpeechResponse_contentType,
    synthesizeSpeechResponse_requestCharacters,
    synthesizeSpeechResponse_httpStatus,
    synthesizeSpeechResponse_audioStream,
  )
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:/ 'newSynthesizeSpeech' smart constructor.
data SynthesizeSpeech = SynthesizeSpeech'
  { -- | Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
    -- when processing input text for speech synthesis. For information on
    -- Amazon Polly voices and which voices are available in standard-only,
    -- NTTS-only, and both standard and NTTS formats, see
    -- <https://docs.aws.amazon.com/polly/latest/dg/voicelist.html Available Voices>.
    --
    -- __NTTS-only voices__
    --
    -- When using NTTS-only voices such as Kevin (en-US), this parameter is
    -- required and must be set to @neural@. If the engine is not specified, or
    -- is set to @standard@, this will result in an error.
    --
    -- Type: String
    --
    -- Valid Values: @standard@ | @neural@
    --
    -- Required: Yes
    --
    -- __Standard voices__
    --
    -- For standard voices, this is not required; the engine parameter defaults
    -- to @standard@. If the engine is not specified, or is set to @standard@
    -- and an NTTS-only voice is selected, this will result in an error.
    SynthesizeSpeech -> Maybe Engine
engine :: Prelude.Maybe Engine,
    -- | Optional language code for the Synthesize Speech 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.
    SynthesizeSpeech -> 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. For information about
    -- storing lexicons, see
    -- <https://docs.aws.amazon.com/polly/latest/dg/API_PutLexicon.html PutLexicon>.
    SynthesizeSpeech -> Maybe [Text]
lexiconNames :: 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\".
    SynthesizeSpeech -> Maybe Text
sampleRate :: Prelude.Maybe Prelude.Text,
    -- | The type of speech marks returned for the input text.
    SynthesizeSpeech -> Maybe [SpeechMarkType]
speechMarkTypes :: Prelude.Maybe [SpeechMarkType],
    -- | Specifies whether the input text is plain text or SSML. The default
    -- value is plain text. For more information, see
    -- <https://docs.aws.amazon.com/polly/latest/dg/ssml.html Using SSML>.
    SynthesizeSpeech -> 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.
    --
    -- When pcm is used, the content returned is audio\/pcm in a signed 16-bit,
    -- 1 channel (mono), little-endian format.
    SynthesizeSpeech -> OutputFormat
outputFormat :: OutputFormat,
    -- | Input text to synthesize. If you specify @ssml@ as the @TextType@,
    -- follow the SSML format for the input text.
    SynthesizeSpeech -> Text
text :: Prelude.Text,
    -- | Voice ID to use for the synthesis. You can get a list of available voice
    -- IDs by calling the
    -- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
    -- operation.
    SynthesizeSpeech -> VoiceId
voiceId :: VoiceId
  }
  deriving (SynthesizeSpeech -> SynthesizeSpeech -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SynthesizeSpeech -> SynthesizeSpeech -> Bool
$c/= :: SynthesizeSpeech -> SynthesizeSpeech -> Bool
== :: SynthesizeSpeech -> SynthesizeSpeech -> Bool
$c== :: SynthesizeSpeech -> SynthesizeSpeech -> Bool
Prelude.Eq, ReadPrec [SynthesizeSpeech]
ReadPrec SynthesizeSpeech
Int -> ReadS SynthesizeSpeech
ReadS [SynthesizeSpeech]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SynthesizeSpeech]
$creadListPrec :: ReadPrec [SynthesizeSpeech]
readPrec :: ReadPrec SynthesizeSpeech
$creadPrec :: ReadPrec SynthesizeSpeech
readList :: ReadS [SynthesizeSpeech]
$creadList :: ReadS [SynthesizeSpeech]
readsPrec :: Int -> ReadS SynthesizeSpeech
$creadsPrec :: Int -> ReadS SynthesizeSpeech
Prelude.Read, Int -> SynthesizeSpeech -> ShowS
[SynthesizeSpeech] -> ShowS
SynthesizeSpeech -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthesizeSpeech] -> ShowS
$cshowList :: [SynthesizeSpeech] -> ShowS
show :: SynthesizeSpeech -> String
$cshow :: SynthesizeSpeech -> String
showsPrec :: Int -> SynthesizeSpeech -> ShowS
$cshowsPrec :: Int -> SynthesizeSpeech -> ShowS
Prelude.Show, forall x. Rep SynthesizeSpeech x -> SynthesizeSpeech
forall x. SynthesizeSpeech -> Rep SynthesizeSpeech x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SynthesizeSpeech x -> SynthesizeSpeech
$cfrom :: forall x. SynthesizeSpeech -> Rep SynthesizeSpeech x
Prelude.Generic)

-- |
-- Create a value of 'SynthesizeSpeech' 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', 'synthesizeSpeech_engine' - Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
-- when processing input text for speech synthesis. For information on
-- Amazon Polly voices and which voices are available in standard-only,
-- NTTS-only, and both standard and NTTS formats, see
-- <https://docs.aws.amazon.com/polly/latest/dg/voicelist.html Available Voices>.
--
-- __NTTS-only voices__
--
-- When using NTTS-only voices such as Kevin (en-US), this parameter is
-- required and must be set to @neural@. If the engine is not specified, or
-- is set to @standard@, this will result in an error.
--
-- Type: String
--
-- Valid Values: @standard@ | @neural@
--
-- Required: Yes
--
-- __Standard voices__
--
-- For standard voices, this is not required; the engine parameter defaults
-- to @standard@. If the engine is not specified, or is set to @standard@
-- and an NTTS-only voice is selected, this will result in an error.
--
-- 'languageCode', 'synthesizeSpeech_languageCode' - Optional language code for the Synthesize Speech 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', 'synthesizeSpeech_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. For information about
-- storing lexicons, see
-- <https://docs.aws.amazon.com/polly/latest/dg/API_PutLexicon.html PutLexicon>.
--
-- 'sampleRate', 'synthesizeSpeech_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\".
--
-- 'speechMarkTypes', 'synthesizeSpeech_speechMarkTypes' - The type of speech marks returned for the input text.
--
-- 'textType', 'synthesizeSpeech_textType' - Specifies whether the input text is plain text or SSML. The default
-- value is plain text. For more information, see
-- <https://docs.aws.amazon.com/polly/latest/dg/ssml.html Using SSML>.
--
-- 'outputFormat', 'synthesizeSpeech_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.
--
-- When pcm is used, the content returned is audio\/pcm in a signed 16-bit,
-- 1 channel (mono), little-endian format.
--
-- 'text', 'synthesizeSpeech_text' - Input text to synthesize. If you specify @ssml@ as the @TextType@,
-- follow the SSML format for the input text.
--
-- 'voiceId', 'synthesizeSpeech_voiceId' - Voice ID to use for the synthesis. You can get a list of available voice
-- IDs by calling the
-- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
-- operation.
newSynthesizeSpeech ::
  -- | 'outputFormat'
  OutputFormat ->
  -- | 'text'
  Prelude.Text ->
  -- | 'voiceId'
  VoiceId ->
  SynthesizeSpeech
newSynthesizeSpeech :: OutputFormat -> Text -> VoiceId -> SynthesizeSpeech
newSynthesizeSpeech OutputFormat
pOutputFormat_ Text
pText_ VoiceId
pVoiceId_ =
  SynthesizeSpeech'
    { $sel:engine:SynthesizeSpeech' :: Maybe Engine
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:SynthesizeSpeech' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:lexiconNames:SynthesizeSpeech' :: Maybe [Text]
lexiconNames = forall a. Maybe a
Prelude.Nothing,
      $sel:sampleRate:SynthesizeSpeech' :: Maybe Text
sampleRate = forall a. Maybe a
Prelude.Nothing,
      $sel:speechMarkTypes:SynthesizeSpeech' :: Maybe [SpeechMarkType]
speechMarkTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:textType:SynthesizeSpeech' :: Maybe TextType
textType = forall a. Maybe a
Prelude.Nothing,
      $sel:outputFormat:SynthesizeSpeech' :: OutputFormat
outputFormat = OutputFormat
pOutputFormat_,
      $sel:text:SynthesizeSpeech' :: Text
text = Text
pText_,
      $sel:voiceId:SynthesizeSpeech' :: VoiceId
voiceId = VoiceId
pVoiceId_
    }

-- | Specifies the engine (@standard@ or @neural@) for Amazon Polly to use
-- when processing input text for speech synthesis. For information on
-- Amazon Polly voices and which voices are available in standard-only,
-- NTTS-only, and both standard and NTTS formats, see
-- <https://docs.aws.amazon.com/polly/latest/dg/voicelist.html Available Voices>.
--
-- __NTTS-only voices__
--
-- When using NTTS-only voices such as Kevin (en-US), this parameter is
-- required and must be set to @neural@. If the engine is not specified, or
-- is set to @standard@, this will result in an error.
--
-- Type: String
--
-- Valid Values: @standard@ | @neural@
--
-- Required: Yes
--
-- __Standard voices__
--
-- For standard voices, this is not required; the engine parameter defaults
-- to @standard@. If the engine is not specified, or is set to @standard@
-- and an NTTS-only voice is selected, this will result in an error.
synthesizeSpeech_engine :: Lens.Lens' SynthesizeSpeech (Prelude.Maybe Engine)
synthesizeSpeech_engine :: Lens' SynthesizeSpeech (Maybe Engine)
synthesizeSpeech_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {Maybe Engine
engine :: Maybe Engine
$sel:engine:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe Engine
engine} -> Maybe Engine
engine) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} Maybe Engine
a -> SynthesizeSpeech
s {$sel:engine:SynthesizeSpeech' :: Maybe Engine
engine = Maybe Engine
a} :: SynthesizeSpeech)

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

-- | 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. For information about
-- storing lexicons, see
-- <https://docs.aws.amazon.com/polly/latest/dg/API_PutLexicon.html PutLexicon>.
synthesizeSpeech_lexiconNames :: Lens.Lens' SynthesizeSpeech (Prelude.Maybe [Prelude.Text])
synthesizeSpeech_lexiconNames :: Lens' SynthesizeSpeech (Maybe [Text])
synthesizeSpeech_lexiconNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {Maybe [Text]
lexiconNames :: Maybe [Text]
$sel:lexiconNames:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [Text]
lexiconNames} -> Maybe [Text]
lexiconNames) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} Maybe [Text]
a -> SynthesizeSpeech
s {$sel:lexiconNames:SynthesizeSpeech' :: Maybe [Text]
lexiconNames = Maybe [Text]
a} :: SynthesizeSpeech) 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 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\".
synthesizeSpeech_sampleRate :: Lens.Lens' SynthesizeSpeech (Prelude.Maybe Prelude.Text)
synthesizeSpeech_sampleRate :: Lens' SynthesizeSpeech (Maybe Text)
synthesizeSpeech_sampleRate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {Maybe Text
sampleRate :: Maybe Text
$sel:sampleRate:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe Text
sampleRate} -> Maybe Text
sampleRate) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} Maybe Text
a -> SynthesizeSpeech
s {$sel:sampleRate:SynthesizeSpeech' :: Maybe Text
sampleRate = Maybe Text
a} :: SynthesizeSpeech)

-- | The type of speech marks returned for the input text.
synthesizeSpeech_speechMarkTypes :: Lens.Lens' SynthesizeSpeech (Prelude.Maybe [SpeechMarkType])
synthesizeSpeech_speechMarkTypes :: Lens' SynthesizeSpeech (Maybe [SpeechMarkType])
synthesizeSpeech_speechMarkTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {Maybe [SpeechMarkType]
speechMarkTypes :: Maybe [SpeechMarkType]
$sel:speechMarkTypes:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [SpeechMarkType]
speechMarkTypes} -> Maybe [SpeechMarkType]
speechMarkTypes) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} Maybe [SpeechMarkType]
a -> SynthesizeSpeech
s {$sel:speechMarkTypes:SynthesizeSpeech' :: Maybe [SpeechMarkType]
speechMarkTypes = Maybe [SpeechMarkType]
a} :: SynthesizeSpeech) 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. For more information, see
-- <https://docs.aws.amazon.com/polly/latest/dg/ssml.html Using SSML>.
synthesizeSpeech_textType :: Lens.Lens' SynthesizeSpeech (Prelude.Maybe TextType)
synthesizeSpeech_textType :: Lens' SynthesizeSpeech (Maybe TextType)
synthesizeSpeech_textType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {Maybe TextType
textType :: Maybe TextType
$sel:textType:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe TextType
textType} -> Maybe TextType
textType) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} Maybe TextType
a -> SynthesizeSpeech
s {$sel:textType:SynthesizeSpeech' :: Maybe TextType
textType = Maybe TextType
a} :: SynthesizeSpeech)

-- | 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.
--
-- When pcm is used, the content returned is audio\/pcm in a signed 16-bit,
-- 1 channel (mono), little-endian format.
synthesizeSpeech_outputFormat :: Lens.Lens' SynthesizeSpeech OutputFormat
synthesizeSpeech_outputFormat :: Lens' SynthesizeSpeech OutputFormat
synthesizeSpeech_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {OutputFormat
outputFormat :: OutputFormat
$sel:outputFormat:SynthesizeSpeech' :: SynthesizeSpeech -> OutputFormat
outputFormat} -> OutputFormat
outputFormat) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} OutputFormat
a -> SynthesizeSpeech
s {$sel:outputFormat:SynthesizeSpeech' :: OutputFormat
outputFormat = OutputFormat
a} :: SynthesizeSpeech)

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

-- | Voice ID to use for the synthesis. You can get a list of available voice
-- IDs by calling the
-- <https://docs.aws.amazon.com/polly/latest/dg/API_DescribeVoices.html DescribeVoices>
-- operation.
synthesizeSpeech_voiceId :: Lens.Lens' SynthesizeSpeech VoiceId
synthesizeSpeech_voiceId :: Lens' SynthesizeSpeech VoiceId
synthesizeSpeech_voiceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeech' {VoiceId
voiceId :: VoiceId
$sel:voiceId:SynthesizeSpeech' :: SynthesizeSpeech -> VoiceId
voiceId} -> VoiceId
voiceId) (\s :: SynthesizeSpeech
s@SynthesizeSpeech' {} VoiceId
a -> SynthesizeSpeech
s {$sel:voiceId:SynthesizeSpeech' :: VoiceId
voiceId = VoiceId
a} :: SynthesizeSpeech)

instance Core.AWSRequest SynthesizeSpeech where
  type
    AWSResponse SynthesizeSpeech =
      SynthesizeSpeechResponse
  request :: (Service -> Service)
-> SynthesizeSpeech -> Request SynthesizeSpeech
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 SynthesizeSpeech
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SynthesizeSpeech)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe Text
-> Maybe Int -> Int -> ResponseBody -> SynthesizeSpeechResponse
SynthesizeSpeechResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amzn-RequestCharacters")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable SynthesizeSpeech where
  hashWithSalt :: Int -> SynthesizeSpeech -> Int
hashWithSalt Int
_salt SynthesizeSpeech' {Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe Engine
Maybe LanguageCode
Maybe TextType
Text
OutputFormat
VoiceId
voiceId :: VoiceId
text :: Text
outputFormat :: OutputFormat
textType :: Maybe TextType
speechMarkTypes :: Maybe [SpeechMarkType]
sampleRate :: Maybe Text
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
$sel:voiceId:SynthesizeSpeech' :: SynthesizeSpeech -> VoiceId
$sel:text:SynthesizeSpeech' :: SynthesizeSpeech -> Text
$sel:outputFormat:SynthesizeSpeech' :: SynthesizeSpeech -> OutputFormat
$sel:textType:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe TextType
$sel:speechMarkTypes:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [SpeechMarkType]
$sel:sampleRate:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe Text
$sel:lexiconNames:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [Text]
$sel:languageCode:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe LanguageCode
$sel:engine:SynthesizeSpeech' :: SynthesizeSpeech -> 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
sampleRate
      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
text
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VoiceId
voiceId

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

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

instance Data.ToJSON SynthesizeSpeech where
  toJSON :: SynthesizeSpeech -> Value
toJSON SynthesizeSpeech' {Maybe [Text]
Maybe [SpeechMarkType]
Maybe Text
Maybe Engine
Maybe LanguageCode
Maybe TextType
Text
OutputFormat
VoiceId
voiceId :: VoiceId
text :: Text
outputFormat :: OutputFormat
textType :: Maybe TextType
speechMarkTypes :: Maybe [SpeechMarkType]
sampleRate :: Maybe Text
lexiconNames :: Maybe [Text]
languageCode :: Maybe LanguageCode
engine :: Maybe Engine
$sel:voiceId:SynthesizeSpeech' :: SynthesizeSpeech -> VoiceId
$sel:text:SynthesizeSpeech' :: SynthesizeSpeech -> Text
$sel:outputFormat:SynthesizeSpeech' :: SynthesizeSpeech -> OutputFormat
$sel:textType:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe TextType
$sel:speechMarkTypes:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [SpeechMarkType]
$sel:sampleRate:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe Text
$sel:lexiconNames:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe [Text]
$sel:languageCode:SynthesizeSpeech' :: SynthesizeSpeech -> Maybe LanguageCode
$sel:engine:SynthesizeSpeech' :: SynthesizeSpeech -> 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
"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
"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
"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 SynthesizeSpeech where
  toPath :: SynthesizeSpeech -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/speech"

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

-- | /See:/ 'newSynthesizeSpeechResponse' smart constructor.
data SynthesizeSpeechResponse = SynthesizeSpeechResponse'
  { -- | Specifies the type audio stream. This should reflect the @OutputFormat@
    -- parameter in your request.
    --
    -- -   If you request @mp3@ as the @OutputFormat@, the @ContentType@
    --     returned is audio\/mpeg.
    --
    -- -   If you request @ogg_vorbis@ as the @OutputFormat@, the @ContentType@
    --     returned is audio\/ogg.
    --
    -- -   If you request @pcm@ as the @OutputFormat@, the @ContentType@
    --     returned is audio\/pcm in a signed 16-bit, 1 channel (mono),
    --     little-endian format.
    --
    -- -   If you request @json@ as the @OutputFormat@, the @ContentType@
    --     returned is application\/x-json-stream.
    SynthesizeSpeechResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | Number of characters synthesized.
    SynthesizeSpeechResponse -> Maybe Int
requestCharacters :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    SynthesizeSpeechResponse -> Int
httpStatus :: Prelude.Int,
    -- | Stream containing the synthesized speech.
    SynthesizeSpeechResponse -> ResponseBody
audioStream :: Data.ResponseBody
  }
  deriving (Int -> SynthesizeSpeechResponse -> ShowS
[SynthesizeSpeechResponse] -> ShowS
SynthesizeSpeechResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthesizeSpeechResponse] -> ShowS
$cshowList :: [SynthesizeSpeechResponse] -> ShowS
show :: SynthesizeSpeechResponse -> String
$cshow :: SynthesizeSpeechResponse -> String
showsPrec :: Int -> SynthesizeSpeechResponse -> ShowS
$cshowsPrec :: Int -> SynthesizeSpeechResponse -> ShowS
Prelude.Show, forall x.
Rep SynthesizeSpeechResponse x -> SynthesizeSpeechResponse
forall x.
SynthesizeSpeechResponse -> Rep SynthesizeSpeechResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SynthesizeSpeechResponse x -> SynthesizeSpeechResponse
$cfrom :: forall x.
SynthesizeSpeechResponse -> Rep SynthesizeSpeechResponse x
Prelude.Generic)

-- |
-- Create a value of 'SynthesizeSpeechResponse' 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:
--
-- 'contentType', 'synthesizeSpeechResponse_contentType' - Specifies the type audio stream. This should reflect the @OutputFormat@
-- parameter in your request.
--
-- -   If you request @mp3@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/mpeg.
--
-- -   If you request @ogg_vorbis@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/ogg.
--
-- -   If you request @pcm@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/pcm in a signed 16-bit, 1 channel (mono),
--     little-endian format.
--
-- -   If you request @json@ as the @OutputFormat@, the @ContentType@
--     returned is application\/x-json-stream.
--
-- 'requestCharacters', 'synthesizeSpeechResponse_requestCharacters' - Number of characters synthesized.
--
-- 'httpStatus', 'synthesizeSpeechResponse_httpStatus' - The response's http status code.
--
-- 'audioStream', 'synthesizeSpeechResponse_audioStream' - Stream containing the synthesized speech.
newSynthesizeSpeechResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'audioStream'
  Data.ResponseBody ->
  SynthesizeSpeechResponse
newSynthesizeSpeechResponse :: Int -> ResponseBody -> SynthesizeSpeechResponse
newSynthesizeSpeechResponse
  Int
pHttpStatus_
  ResponseBody
pAudioStream_ =
    SynthesizeSpeechResponse'
      { $sel:contentType:SynthesizeSpeechResponse' :: Maybe Text
contentType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:requestCharacters:SynthesizeSpeechResponse' :: Maybe Int
requestCharacters = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:SynthesizeSpeechResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:audioStream:SynthesizeSpeechResponse' :: ResponseBody
audioStream = ResponseBody
pAudioStream_
      }

-- | Specifies the type audio stream. This should reflect the @OutputFormat@
-- parameter in your request.
--
-- -   If you request @mp3@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/mpeg.
--
-- -   If you request @ogg_vorbis@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/ogg.
--
-- -   If you request @pcm@ as the @OutputFormat@, the @ContentType@
--     returned is audio\/pcm in a signed 16-bit, 1 channel (mono),
--     little-endian format.
--
-- -   If you request @json@ as the @OutputFormat@, the @ContentType@
--     returned is application\/x-json-stream.
synthesizeSpeechResponse_contentType :: Lens.Lens' SynthesizeSpeechResponse (Prelude.Maybe Prelude.Text)
synthesizeSpeechResponse_contentType :: Lens' SynthesizeSpeechResponse (Maybe Text)
synthesizeSpeechResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeechResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:SynthesizeSpeechResponse' :: SynthesizeSpeechResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: SynthesizeSpeechResponse
s@SynthesizeSpeechResponse' {} Maybe Text
a -> SynthesizeSpeechResponse
s {$sel:contentType:SynthesizeSpeechResponse' :: Maybe Text
contentType = Maybe Text
a} :: SynthesizeSpeechResponse)

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

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

-- | Stream containing the synthesized speech.
synthesizeSpeechResponse_audioStream :: Lens.Lens' SynthesizeSpeechResponse Data.ResponseBody
synthesizeSpeechResponse_audioStream :: Lens' SynthesizeSpeechResponse ResponseBody
synthesizeSpeechResponse_audioStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SynthesizeSpeechResponse' {ResponseBody
audioStream :: ResponseBody
$sel:audioStream:SynthesizeSpeechResponse' :: SynthesizeSpeechResponse -> ResponseBody
audioStream} -> ResponseBody
audioStream) (\s :: SynthesizeSpeechResponse
s@SynthesizeSpeechResponse' {} ResponseBody
a -> SynthesizeSpeechResponse
s {$sel:audioStream:SynthesizeSpeechResponse' :: ResponseBody
audioStream = ResponseBody
a} :: SynthesizeSpeechResponse)