{-# 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.Transcribe.StartCallAnalyticsJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Transcribes the audio from a customer service call and applies any
-- additional Request Parameters you choose to include in your request.
--
-- In addition to many standard transcription features, Call Analytics
-- provides you with call characteristics, call summarization, speaker
-- sentiment, and optional redaction of your text transcript and your audio
-- file. You can also apply custom categories to flag specified conditions.
-- To learn more about these features and insights, refer to
-- <https://docs.aws.amazon.com/transcribe/latest/dg/call-analytics.html Analyzing call center audio with Call Analytics>.
--
-- If you want to apply categories to your Call Analytics job, you must
-- create them before submitting your job request. Categories cannot be
-- retroactively applied to a job. To create a new category, use the
-- operation. To learn more about Call Analytics categories, see
-- <https://docs.aws.amazon.com/transcribe/latest/dg/tca-categories-batch.html Creating categories for batch transcriptions>
-- and
-- <https://docs.aws.amazon.com/transcribe/latest/dg/tca-categories-stream.html Creating categories for streaming transcriptions>.
--
-- To make a @StartCallAnalyticsJob@ request, you must first upload your
-- media file into an Amazon S3 bucket; you can then specify the Amazon S3
-- location of the file using the @Media@ parameter.
--
-- You must include the following parameters in your
-- @StartCallAnalyticsJob@ request:
--
-- -   @region@: The Amazon Web Services Region where you are making your
--     request. For a list of Amazon Web Services Regions supported with
--     Amazon Transcribe, refer to
--     <https://docs.aws.amazon.com/general/latest/gr/transcribe.html Amazon Transcribe endpoints and quotas>.
--
-- -   @CallAnalyticsJobName@: A custom name that you create for your
--     transcription job that\'s unique within your Amazon Web Services
--     account.
--
-- -   @DataAccessRoleArn@: The Amazon Resource Name (ARN) of an IAM role
--     that has permissions to access the Amazon S3 bucket that contains
--     your input files.
--
-- -   @Media@ (@MediaFileUri@ or @RedactedMediaFileUri@): The Amazon S3
--     location of your media file.
--
-- With Call Analytics, you can redact the audio contained in your media
-- file by including @RedactedMediaFileUri@, instead of @MediaFileUri@, to
-- specify the location of your input audio. If you choose to redact your
-- audio, you can find your redacted media at the location specified in the
-- @RedactedMediaFileUri@ field of your response.
module Amazonka.Transcribe.StartCallAnalyticsJob
  ( -- * Creating a Request
    StartCallAnalyticsJob (..),
    newStartCallAnalyticsJob,

    -- * Request Lenses
    startCallAnalyticsJob_channelDefinitions,
    startCallAnalyticsJob_dataAccessRoleArn,
    startCallAnalyticsJob_outputEncryptionKMSKeyId,
    startCallAnalyticsJob_outputLocation,
    startCallAnalyticsJob_settings,
    startCallAnalyticsJob_callAnalyticsJobName,
    startCallAnalyticsJob_media,

    -- * Destructuring the Response
    StartCallAnalyticsJobResponse (..),
    newStartCallAnalyticsJobResponse,

    -- * Response Lenses
    startCallAnalyticsJobResponse_callAnalyticsJob,
    startCallAnalyticsJobResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Transcribe.Types

-- | /See:/ 'newStartCallAnalyticsJob' smart constructor.
data StartCallAnalyticsJob = StartCallAnalyticsJob'
  { -- | Makes it possible to specify which speaker is on which channel. For
    -- example, if your agent is the first participant to speak, you would set
    -- @ChannelId@ to @0@ (to indicate the first channel) and @ParticipantRole@
    -- to @AGENT@ (to indicate that it\'s the agent speaking).
    StartCallAnalyticsJob -> Maybe (NonEmpty ChannelDefinition)
channelDefinitions :: Prelude.Maybe (Prelude.NonEmpty ChannelDefinition),
    -- | The Amazon Resource Name (ARN) of an IAM role that has permissions to
    -- access the Amazon S3 bucket that contains your input files. If the role
    -- that you specify doesn’t have the appropriate permissions to access the
    -- specified Amazon S3 location, your request fails.
    --
    -- IAM role ARNs have the format
    -- @arn:partition:iam::account:role\/role-name-with-path@. For example:
    -- @arn:aws:iam::111122223333:role\/Admin@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html#identifiers-arns IAM ARNs>.
    StartCallAnalyticsJob -> Maybe Text
dataAccessRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The KMS key you want to use to encrypt your Call Analytics output.
    --
    -- If using a key located in the __current__ Amazon Web Services account,
    -- you can specify your KMS key in one of four ways:
    --
    -- 1.  Use the KMS key ID itself. For example,
    --     @1234abcd-12ab-34cd-56ef-1234567890ab@.
    --
    -- 2.  Use an alias for the KMS key ID. For example, @alias\/ExampleAlias@.
    --
    -- 3.  Use the Amazon Resource Name (ARN) for the KMS key ID. For example,
    --     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
    --
    -- 4.  Use the ARN for the KMS key alias. For example,
    --     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
    --
    -- If using a key located in a __different__ Amazon Web Services account
    -- than the current Amazon Web Services account, you can specify your KMS
    -- key in one of two ways:
    --
    -- 1.  Use the ARN for the KMS key ID. For example,
    --     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
    --
    -- 2.  Use the ARN for the KMS key alias. For example,
    --     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
    --
    -- If you don\'t specify an encryption key, your output is encrypted with
    -- the default Amazon S3 key (SSE-S3).
    --
    -- If you specify a KMS key to encrypt your output, you must also specify
    -- an output location using the @OutputLocation@ parameter.
    --
    -- Note that the user making the request must have permission to use the
    -- specified KMS key.
    StartCallAnalyticsJob -> Maybe Text
outputEncryptionKMSKeyId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon S3 location where you want your Call Analytics transcription
    -- output stored. You can use any of the following formats to specify the
    -- output location:
    --
    -- 1.  s3:\/\/DOC-EXAMPLE-BUCKET
    --
    -- 2.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/
    --
    -- 3.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/my-call-analytics-job.json
    --
    -- Unless you specify a file name (option 3), the name of your output file
    -- has a default value that matches the name you specified for your
    -- transcription job using the @CallAnalyticsJobName@ parameter.
    --
    -- You can specify a KMS key to encrypt your output using the
    -- @OutputEncryptionKMSKeyId@ parameter. If you don\'t specify a KMS key,
    -- Amazon Transcribe uses the default Amazon S3 key for server-side
    -- encryption.
    --
    -- If you don\'t specify @OutputLocation@, your transcript is placed in a
    -- service-managed Amazon S3 bucket and you are provided with a URI to
    -- access your transcript.
    StartCallAnalyticsJob -> Maybe Text
outputLocation :: Prelude.Maybe Prelude.Text,
    -- | Specify additional optional settings in your request, including content
    -- redaction; allows you to apply custom language models, vocabulary
    -- filters, and custom vocabularies to your Call Analytics job.
    StartCallAnalyticsJob -> Maybe CallAnalyticsJobSettings
settings :: Prelude.Maybe CallAnalyticsJobSettings,
    -- | A unique name, chosen by you, for your Call Analytics job.
    --
    -- This name is case sensitive, cannot contain spaces, and must be unique
    -- within an Amazon Web Services account. If you try to create a new job
    -- with the same name as an existing job, you get a @ConflictException@
    -- error.
    StartCallAnalyticsJob -> Text
callAnalyticsJobName :: Prelude.Text,
    -- | Describes the Amazon S3 location of the media file you want to use in
    -- your Call Analytics request.
    StartCallAnalyticsJob -> Media
media :: Media
  }
  deriving (StartCallAnalyticsJob -> StartCallAnalyticsJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartCallAnalyticsJob -> StartCallAnalyticsJob -> Bool
$c/= :: StartCallAnalyticsJob -> StartCallAnalyticsJob -> Bool
== :: StartCallAnalyticsJob -> StartCallAnalyticsJob -> Bool
$c== :: StartCallAnalyticsJob -> StartCallAnalyticsJob -> Bool
Prelude.Eq, ReadPrec [StartCallAnalyticsJob]
ReadPrec StartCallAnalyticsJob
Int -> ReadS StartCallAnalyticsJob
ReadS [StartCallAnalyticsJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartCallAnalyticsJob]
$creadListPrec :: ReadPrec [StartCallAnalyticsJob]
readPrec :: ReadPrec StartCallAnalyticsJob
$creadPrec :: ReadPrec StartCallAnalyticsJob
readList :: ReadS [StartCallAnalyticsJob]
$creadList :: ReadS [StartCallAnalyticsJob]
readsPrec :: Int -> ReadS StartCallAnalyticsJob
$creadsPrec :: Int -> ReadS StartCallAnalyticsJob
Prelude.Read, Int -> StartCallAnalyticsJob -> ShowS
[StartCallAnalyticsJob] -> ShowS
StartCallAnalyticsJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartCallAnalyticsJob] -> ShowS
$cshowList :: [StartCallAnalyticsJob] -> ShowS
show :: StartCallAnalyticsJob -> String
$cshow :: StartCallAnalyticsJob -> String
showsPrec :: Int -> StartCallAnalyticsJob -> ShowS
$cshowsPrec :: Int -> StartCallAnalyticsJob -> ShowS
Prelude.Show, forall x. Rep StartCallAnalyticsJob x -> StartCallAnalyticsJob
forall x. StartCallAnalyticsJob -> Rep StartCallAnalyticsJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartCallAnalyticsJob x -> StartCallAnalyticsJob
$cfrom :: forall x. StartCallAnalyticsJob -> Rep StartCallAnalyticsJob x
Prelude.Generic)

-- |
-- Create a value of 'StartCallAnalyticsJob' 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:
--
-- 'channelDefinitions', 'startCallAnalyticsJob_channelDefinitions' - Makes it possible to specify which speaker is on which channel. For
-- example, if your agent is the first participant to speak, you would set
-- @ChannelId@ to @0@ (to indicate the first channel) and @ParticipantRole@
-- to @AGENT@ (to indicate that it\'s the agent speaking).
--
-- 'dataAccessRoleArn', 'startCallAnalyticsJob_dataAccessRoleArn' - The Amazon Resource Name (ARN) of an IAM role that has permissions to
-- access the Amazon S3 bucket that contains your input files. If the role
-- that you specify doesn’t have the appropriate permissions to access the
-- specified Amazon S3 location, your request fails.
--
-- IAM role ARNs have the format
-- @arn:partition:iam::account:role\/role-name-with-path@. For example:
-- @arn:aws:iam::111122223333:role\/Admin@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html#identifiers-arns IAM ARNs>.
--
-- 'outputEncryptionKMSKeyId', 'startCallAnalyticsJob_outputEncryptionKMSKeyId' - The KMS key you want to use to encrypt your Call Analytics output.
--
-- If using a key located in the __current__ Amazon Web Services account,
-- you can specify your KMS key in one of four ways:
--
-- 1.  Use the KMS key ID itself. For example,
--     @1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 2.  Use an alias for the KMS key ID. For example, @alias\/ExampleAlias@.
--
-- 3.  Use the Amazon Resource Name (ARN) for the KMS key ID. For example,
--     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 4.  Use the ARN for the KMS key alias. For example,
--     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
--
-- If using a key located in a __different__ Amazon Web Services account
-- than the current Amazon Web Services account, you can specify your KMS
-- key in one of two ways:
--
-- 1.  Use the ARN for the KMS key ID. For example,
--     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 2.  Use the ARN for the KMS key alias. For example,
--     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
--
-- If you don\'t specify an encryption key, your output is encrypted with
-- the default Amazon S3 key (SSE-S3).
--
-- If you specify a KMS key to encrypt your output, you must also specify
-- an output location using the @OutputLocation@ parameter.
--
-- Note that the user making the request must have permission to use the
-- specified KMS key.
--
-- 'outputLocation', 'startCallAnalyticsJob_outputLocation' - The Amazon S3 location where you want your Call Analytics transcription
-- output stored. You can use any of the following formats to specify the
-- output location:
--
-- 1.  s3:\/\/DOC-EXAMPLE-BUCKET
--
-- 2.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/
--
-- 3.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/my-call-analytics-job.json
--
-- Unless you specify a file name (option 3), the name of your output file
-- has a default value that matches the name you specified for your
-- transcription job using the @CallAnalyticsJobName@ parameter.
--
-- You can specify a KMS key to encrypt your output using the
-- @OutputEncryptionKMSKeyId@ parameter. If you don\'t specify a KMS key,
-- Amazon Transcribe uses the default Amazon S3 key for server-side
-- encryption.
--
-- If you don\'t specify @OutputLocation@, your transcript is placed in a
-- service-managed Amazon S3 bucket and you are provided with a URI to
-- access your transcript.
--
-- 'settings', 'startCallAnalyticsJob_settings' - Specify additional optional settings in your request, including content
-- redaction; allows you to apply custom language models, vocabulary
-- filters, and custom vocabularies to your Call Analytics job.
--
-- 'callAnalyticsJobName', 'startCallAnalyticsJob_callAnalyticsJobName' - A unique name, chosen by you, for your Call Analytics job.
--
-- This name is case sensitive, cannot contain spaces, and must be unique
-- within an Amazon Web Services account. If you try to create a new job
-- with the same name as an existing job, you get a @ConflictException@
-- error.
--
-- 'media', 'startCallAnalyticsJob_media' - Describes the Amazon S3 location of the media file you want to use in
-- your Call Analytics request.
newStartCallAnalyticsJob ::
  -- | 'callAnalyticsJobName'
  Prelude.Text ->
  -- | 'media'
  Media ->
  StartCallAnalyticsJob
newStartCallAnalyticsJob :: Text -> Media -> StartCallAnalyticsJob
newStartCallAnalyticsJob
  Text
pCallAnalyticsJobName_
  Media
pMedia_ =
    StartCallAnalyticsJob'
      { $sel:channelDefinitions:StartCallAnalyticsJob' :: Maybe (NonEmpty ChannelDefinition)
channelDefinitions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dataAccessRoleArn:StartCallAnalyticsJob' :: Maybe Text
dataAccessRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: Maybe Text
outputEncryptionKMSKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:outputLocation:StartCallAnalyticsJob' :: Maybe Text
outputLocation = forall a. Maybe a
Prelude.Nothing,
        $sel:settings:StartCallAnalyticsJob' :: Maybe CallAnalyticsJobSettings
settings = forall a. Maybe a
Prelude.Nothing,
        $sel:callAnalyticsJobName:StartCallAnalyticsJob' :: Text
callAnalyticsJobName = Text
pCallAnalyticsJobName_,
        $sel:media:StartCallAnalyticsJob' :: Media
media = Media
pMedia_
      }

-- | Makes it possible to specify which speaker is on which channel. For
-- example, if your agent is the first participant to speak, you would set
-- @ChannelId@ to @0@ (to indicate the first channel) and @ParticipantRole@
-- to @AGENT@ (to indicate that it\'s the agent speaking).
startCallAnalyticsJob_channelDefinitions :: Lens.Lens' StartCallAnalyticsJob (Prelude.Maybe (Prelude.NonEmpty ChannelDefinition))
startCallAnalyticsJob_channelDefinitions :: Lens' StartCallAnalyticsJob (Maybe (NonEmpty ChannelDefinition))
startCallAnalyticsJob_channelDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Maybe (NonEmpty ChannelDefinition)
channelDefinitions :: Maybe (NonEmpty ChannelDefinition)
$sel:channelDefinitions:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe (NonEmpty ChannelDefinition)
channelDefinitions} -> Maybe (NonEmpty ChannelDefinition)
channelDefinitions) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Maybe (NonEmpty ChannelDefinition)
a -> StartCallAnalyticsJob
s {$sel:channelDefinitions:StartCallAnalyticsJob' :: Maybe (NonEmpty ChannelDefinition)
channelDefinitions = Maybe (NonEmpty ChannelDefinition)
a} :: StartCallAnalyticsJob) 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 Resource Name (ARN) of an IAM role that has permissions to
-- access the Amazon S3 bucket that contains your input files. If the role
-- that you specify doesn’t have the appropriate permissions to access the
-- specified Amazon S3 location, your request fails.
--
-- IAM role ARNs have the format
-- @arn:partition:iam::account:role\/role-name-with-path@. For example:
-- @arn:aws:iam::111122223333:role\/Admin@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_identifiers.html#identifiers-arns IAM ARNs>.
startCallAnalyticsJob_dataAccessRoleArn :: Lens.Lens' StartCallAnalyticsJob (Prelude.Maybe Prelude.Text)
startCallAnalyticsJob_dataAccessRoleArn :: Lens' StartCallAnalyticsJob (Maybe Text)
startCallAnalyticsJob_dataAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:dataAccessRoleArn:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
dataAccessRoleArn} -> Maybe Text
dataAccessRoleArn) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Maybe Text
a -> StartCallAnalyticsJob
s {$sel:dataAccessRoleArn:StartCallAnalyticsJob' :: Maybe Text
dataAccessRoleArn = Maybe Text
a} :: StartCallAnalyticsJob)

-- | The KMS key you want to use to encrypt your Call Analytics output.
--
-- If using a key located in the __current__ Amazon Web Services account,
-- you can specify your KMS key in one of four ways:
--
-- 1.  Use the KMS key ID itself. For example,
--     @1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 2.  Use an alias for the KMS key ID. For example, @alias\/ExampleAlias@.
--
-- 3.  Use the Amazon Resource Name (ARN) for the KMS key ID. For example,
--     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 4.  Use the ARN for the KMS key alias. For example,
--     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
--
-- If using a key located in a __different__ Amazon Web Services account
-- than the current Amazon Web Services account, you can specify your KMS
-- key in one of two ways:
--
-- 1.  Use the ARN for the KMS key ID. For example,
--     @arn:aws:kms:region:account-ID:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 2.  Use the ARN for the KMS key alias. For example,
--     @arn:aws:kms:region:account-ID:alias\/ExampleAlias@.
--
-- If you don\'t specify an encryption key, your output is encrypted with
-- the default Amazon S3 key (SSE-S3).
--
-- If you specify a KMS key to encrypt your output, you must also specify
-- an output location using the @OutputLocation@ parameter.
--
-- Note that the user making the request must have permission to use the
-- specified KMS key.
startCallAnalyticsJob_outputEncryptionKMSKeyId :: Lens.Lens' StartCallAnalyticsJob (Prelude.Maybe Prelude.Text)
startCallAnalyticsJob_outputEncryptionKMSKeyId :: Lens' StartCallAnalyticsJob (Maybe Text)
startCallAnalyticsJob_outputEncryptionKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
$sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
outputEncryptionKMSKeyId} -> Maybe Text
outputEncryptionKMSKeyId) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Maybe Text
a -> StartCallAnalyticsJob
s {$sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: Maybe Text
outputEncryptionKMSKeyId = Maybe Text
a} :: StartCallAnalyticsJob)

-- | The Amazon S3 location where you want your Call Analytics transcription
-- output stored. You can use any of the following formats to specify the
-- output location:
--
-- 1.  s3:\/\/DOC-EXAMPLE-BUCKET
--
-- 2.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/
--
-- 3.  s3:\/\/DOC-EXAMPLE-BUCKET\/my-output-folder\/my-call-analytics-job.json
--
-- Unless you specify a file name (option 3), the name of your output file
-- has a default value that matches the name you specified for your
-- transcription job using the @CallAnalyticsJobName@ parameter.
--
-- You can specify a KMS key to encrypt your output using the
-- @OutputEncryptionKMSKeyId@ parameter. If you don\'t specify a KMS key,
-- Amazon Transcribe uses the default Amazon S3 key for server-side
-- encryption.
--
-- If you don\'t specify @OutputLocation@, your transcript is placed in a
-- service-managed Amazon S3 bucket and you are provided with a URI to
-- access your transcript.
startCallAnalyticsJob_outputLocation :: Lens.Lens' StartCallAnalyticsJob (Prelude.Maybe Prelude.Text)
startCallAnalyticsJob_outputLocation :: Lens' StartCallAnalyticsJob (Maybe Text)
startCallAnalyticsJob_outputLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Maybe Text
outputLocation :: Maybe Text
$sel:outputLocation:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
outputLocation} -> Maybe Text
outputLocation) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Maybe Text
a -> StartCallAnalyticsJob
s {$sel:outputLocation:StartCallAnalyticsJob' :: Maybe Text
outputLocation = Maybe Text
a} :: StartCallAnalyticsJob)

-- | Specify additional optional settings in your request, including content
-- redaction; allows you to apply custom language models, vocabulary
-- filters, and custom vocabularies to your Call Analytics job.
startCallAnalyticsJob_settings :: Lens.Lens' StartCallAnalyticsJob (Prelude.Maybe CallAnalyticsJobSettings)
startCallAnalyticsJob_settings :: Lens' StartCallAnalyticsJob (Maybe CallAnalyticsJobSettings)
startCallAnalyticsJob_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Maybe CallAnalyticsJobSettings
settings :: Maybe CallAnalyticsJobSettings
$sel:settings:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe CallAnalyticsJobSettings
settings} -> Maybe CallAnalyticsJobSettings
settings) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Maybe CallAnalyticsJobSettings
a -> StartCallAnalyticsJob
s {$sel:settings:StartCallAnalyticsJob' :: Maybe CallAnalyticsJobSettings
settings = Maybe CallAnalyticsJobSettings
a} :: StartCallAnalyticsJob)

-- | A unique name, chosen by you, for your Call Analytics job.
--
-- This name is case sensitive, cannot contain spaces, and must be unique
-- within an Amazon Web Services account. If you try to create a new job
-- with the same name as an existing job, you get a @ConflictException@
-- error.
startCallAnalyticsJob_callAnalyticsJobName :: Lens.Lens' StartCallAnalyticsJob Prelude.Text
startCallAnalyticsJob_callAnalyticsJobName :: Lens' StartCallAnalyticsJob Text
startCallAnalyticsJob_callAnalyticsJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Text
callAnalyticsJobName :: Text
$sel:callAnalyticsJobName:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Text
callAnalyticsJobName} -> Text
callAnalyticsJobName) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Text
a -> StartCallAnalyticsJob
s {$sel:callAnalyticsJobName:StartCallAnalyticsJob' :: Text
callAnalyticsJobName = Text
a} :: StartCallAnalyticsJob)

-- | Describes the Amazon S3 location of the media file you want to use in
-- your Call Analytics request.
startCallAnalyticsJob_media :: Lens.Lens' StartCallAnalyticsJob Media
startCallAnalyticsJob_media :: Lens' StartCallAnalyticsJob Media
startCallAnalyticsJob_media = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJob' {Media
media :: Media
$sel:media:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Media
media} -> Media
media) (\s :: StartCallAnalyticsJob
s@StartCallAnalyticsJob' {} Media
a -> StartCallAnalyticsJob
s {$sel:media:StartCallAnalyticsJob' :: Media
media = Media
a} :: StartCallAnalyticsJob)

instance Core.AWSRequest StartCallAnalyticsJob where
  type
    AWSResponse StartCallAnalyticsJob =
      StartCallAnalyticsJobResponse
  request :: (Service -> Service)
-> StartCallAnalyticsJob -> Request StartCallAnalyticsJob
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 StartCallAnalyticsJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartCallAnalyticsJob)))
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 CallAnalyticsJob -> Int -> StartCallAnalyticsJobResponse
StartCallAnalyticsJobResponse'
            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
"CallAnalyticsJob")
            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 StartCallAnalyticsJob where
  hashWithSalt :: Int -> StartCallAnalyticsJob -> Int
hashWithSalt Int
_salt StartCallAnalyticsJob' {Maybe (NonEmpty ChannelDefinition)
Maybe Text
Maybe CallAnalyticsJobSettings
Text
Media
media :: Media
callAnalyticsJobName :: Text
settings :: Maybe CallAnalyticsJobSettings
outputLocation :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
channelDefinitions :: Maybe (NonEmpty ChannelDefinition)
$sel:media:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Media
$sel:callAnalyticsJobName:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Text
$sel:settings:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe CallAnalyticsJobSettings
$sel:outputLocation:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:dataAccessRoleArn:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:channelDefinitions:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe (NonEmpty ChannelDefinition)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ChannelDefinition)
channelDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataAccessRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputEncryptionKMSKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CallAnalyticsJobSettings
settings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callAnalyticsJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Media
media

instance Prelude.NFData StartCallAnalyticsJob where
  rnf :: StartCallAnalyticsJob -> ()
rnf StartCallAnalyticsJob' {Maybe (NonEmpty ChannelDefinition)
Maybe Text
Maybe CallAnalyticsJobSettings
Text
Media
media :: Media
callAnalyticsJobName :: Text
settings :: Maybe CallAnalyticsJobSettings
outputLocation :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
channelDefinitions :: Maybe (NonEmpty ChannelDefinition)
$sel:media:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Media
$sel:callAnalyticsJobName:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Text
$sel:settings:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe CallAnalyticsJobSettings
$sel:outputLocation:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:dataAccessRoleArn:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:channelDefinitions:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe (NonEmpty ChannelDefinition)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ChannelDefinition)
channelDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataAccessRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputEncryptionKMSKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CallAnalyticsJobSettings
settings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
callAnalyticsJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Media
media

instance Data.ToHeaders StartCallAnalyticsJob where
  toHeaders :: StartCallAnalyticsJob -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Transcribe.StartCallAnalyticsJob" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartCallAnalyticsJob where
  toJSON :: StartCallAnalyticsJob -> Value
toJSON StartCallAnalyticsJob' {Maybe (NonEmpty ChannelDefinition)
Maybe Text
Maybe CallAnalyticsJobSettings
Text
Media
media :: Media
callAnalyticsJobName :: Text
settings :: Maybe CallAnalyticsJobSettings
outputLocation :: Maybe Text
outputEncryptionKMSKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
channelDefinitions :: Maybe (NonEmpty ChannelDefinition)
$sel:media:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Media
$sel:callAnalyticsJobName:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Text
$sel:settings:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe CallAnalyticsJobSettings
$sel:outputLocation:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:outputEncryptionKMSKeyId:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:dataAccessRoleArn:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe Text
$sel:channelDefinitions:StartCallAnalyticsJob' :: StartCallAnalyticsJob -> Maybe (NonEmpty ChannelDefinition)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ChannelDefinitions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty ChannelDefinition)
channelDefinitions,
            (Key
"DataAccessRoleArn" 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
dataAccessRoleArn,
            (Key
"OutputEncryptionKMSKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
outputEncryptionKMSKeyId,
            (Key
"OutputLocation" 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
outputLocation,
            (Key
"Settings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CallAnalyticsJobSettings
settings,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"CallAnalyticsJobName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
callAnalyticsJobName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Media" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Media
media)
          ]
      )

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

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

-- | /See:/ 'newStartCallAnalyticsJobResponse' smart constructor.
data StartCallAnalyticsJobResponse = StartCallAnalyticsJobResponse'
  { -- | Provides detailed information about the current Call Analytics job,
    -- including job status and, if applicable, failure reason.
    StartCallAnalyticsJobResponse -> Maybe CallAnalyticsJob
callAnalyticsJob :: Prelude.Maybe CallAnalyticsJob,
    -- | The response's http status code.
    StartCallAnalyticsJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartCallAnalyticsJobResponse
-> StartCallAnalyticsJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartCallAnalyticsJobResponse
-> StartCallAnalyticsJobResponse -> Bool
$c/= :: StartCallAnalyticsJobResponse
-> StartCallAnalyticsJobResponse -> Bool
== :: StartCallAnalyticsJobResponse
-> StartCallAnalyticsJobResponse -> Bool
$c== :: StartCallAnalyticsJobResponse
-> StartCallAnalyticsJobResponse -> Bool
Prelude.Eq, ReadPrec [StartCallAnalyticsJobResponse]
ReadPrec StartCallAnalyticsJobResponse
Int -> ReadS StartCallAnalyticsJobResponse
ReadS [StartCallAnalyticsJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartCallAnalyticsJobResponse]
$creadListPrec :: ReadPrec [StartCallAnalyticsJobResponse]
readPrec :: ReadPrec StartCallAnalyticsJobResponse
$creadPrec :: ReadPrec StartCallAnalyticsJobResponse
readList :: ReadS [StartCallAnalyticsJobResponse]
$creadList :: ReadS [StartCallAnalyticsJobResponse]
readsPrec :: Int -> ReadS StartCallAnalyticsJobResponse
$creadsPrec :: Int -> ReadS StartCallAnalyticsJobResponse
Prelude.Read, Int -> StartCallAnalyticsJobResponse -> ShowS
[StartCallAnalyticsJobResponse] -> ShowS
StartCallAnalyticsJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartCallAnalyticsJobResponse] -> ShowS
$cshowList :: [StartCallAnalyticsJobResponse] -> ShowS
show :: StartCallAnalyticsJobResponse -> String
$cshow :: StartCallAnalyticsJobResponse -> String
showsPrec :: Int -> StartCallAnalyticsJobResponse -> ShowS
$cshowsPrec :: Int -> StartCallAnalyticsJobResponse -> ShowS
Prelude.Show, forall x.
Rep StartCallAnalyticsJobResponse x
-> StartCallAnalyticsJobResponse
forall x.
StartCallAnalyticsJobResponse
-> Rep StartCallAnalyticsJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartCallAnalyticsJobResponse x
-> StartCallAnalyticsJobResponse
$cfrom :: forall x.
StartCallAnalyticsJobResponse
-> Rep StartCallAnalyticsJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartCallAnalyticsJobResponse' 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:
--
-- 'callAnalyticsJob', 'startCallAnalyticsJobResponse_callAnalyticsJob' - Provides detailed information about the current Call Analytics job,
-- including job status and, if applicable, failure reason.
--
-- 'httpStatus', 'startCallAnalyticsJobResponse_httpStatus' - The response's http status code.
newStartCallAnalyticsJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartCallAnalyticsJobResponse
newStartCallAnalyticsJobResponse :: Int -> StartCallAnalyticsJobResponse
newStartCallAnalyticsJobResponse Int
pHttpStatus_ =
  StartCallAnalyticsJobResponse'
    { $sel:callAnalyticsJob:StartCallAnalyticsJobResponse' :: Maybe CallAnalyticsJob
callAnalyticsJob =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartCallAnalyticsJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Provides detailed information about the current Call Analytics job,
-- including job status and, if applicable, failure reason.
startCallAnalyticsJobResponse_callAnalyticsJob :: Lens.Lens' StartCallAnalyticsJobResponse (Prelude.Maybe CallAnalyticsJob)
startCallAnalyticsJobResponse_callAnalyticsJob :: Lens' StartCallAnalyticsJobResponse (Maybe CallAnalyticsJob)
startCallAnalyticsJobResponse_callAnalyticsJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartCallAnalyticsJobResponse' {Maybe CallAnalyticsJob
callAnalyticsJob :: Maybe CallAnalyticsJob
$sel:callAnalyticsJob:StartCallAnalyticsJobResponse' :: StartCallAnalyticsJobResponse -> Maybe CallAnalyticsJob
callAnalyticsJob} -> Maybe CallAnalyticsJob
callAnalyticsJob) (\s :: StartCallAnalyticsJobResponse
s@StartCallAnalyticsJobResponse' {} Maybe CallAnalyticsJob
a -> StartCallAnalyticsJobResponse
s {$sel:callAnalyticsJob:StartCallAnalyticsJobResponse' :: Maybe CallAnalyticsJob
callAnalyticsJob = Maybe CallAnalyticsJob
a} :: StartCallAnalyticsJobResponse)

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

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