{-# 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.GetTranscriptionJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information about the specified transcription job.
--
-- To view the status of the specified transcription job, check the
-- @TranscriptionJobStatus@ field. If the status is @COMPLETED@, the job is
-- finished. You can find the results at the location specified in
-- @TranscriptFileUri@. If the status is @FAILED@, @FailureReason@ provides
-- details on why your transcription job failed.
--
-- If you enabled content redaction, the redacted transcript can be found
-- at the location specified in @RedactedTranscriptFileUri@.
--
-- To get a list of your transcription jobs, use the operation.
module Amazonka.Transcribe.GetTranscriptionJob
  ( -- * Creating a Request
    GetTranscriptionJob (..),
    newGetTranscriptionJob,

    -- * Request Lenses
    getTranscriptionJob_transcriptionJobName,

    -- * Destructuring the Response
    GetTranscriptionJobResponse (..),
    newGetTranscriptionJobResponse,

    -- * Response Lenses
    getTranscriptionJobResponse_transcriptionJob,
    getTranscriptionJobResponse_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:/ 'newGetTranscriptionJob' smart constructor.
data GetTranscriptionJob = GetTranscriptionJob'
  { -- | The name of the transcription job you want information about. Job names
    -- are case sensitive.
    GetTranscriptionJob -> Text
transcriptionJobName :: Prelude.Text
  }
  deriving (GetTranscriptionJob -> GetTranscriptionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTranscriptionJob -> GetTranscriptionJob -> Bool
$c/= :: GetTranscriptionJob -> GetTranscriptionJob -> Bool
== :: GetTranscriptionJob -> GetTranscriptionJob -> Bool
$c== :: GetTranscriptionJob -> GetTranscriptionJob -> Bool
Prelude.Eq, ReadPrec [GetTranscriptionJob]
ReadPrec GetTranscriptionJob
Int -> ReadS GetTranscriptionJob
ReadS [GetTranscriptionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTranscriptionJob]
$creadListPrec :: ReadPrec [GetTranscriptionJob]
readPrec :: ReadPrec GetTranscriptionJob
$creadPrec :: ReadPrec GetTranscriptionJob
readList :: ReadS [GetTranscriptionJob]
$creadList :: ReadS [GetTranscriptionJob]
readsPrec :: Int -> ReadS GetTranscriptionJob
$creadsPrec :: Int -> ReadS GetTranscriptionJob
Prelude.Read, Int -> GetTranscriptionJob -> ShowS
[GetTranscriptionJob] -> ShowS
GetTranscriptionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTranscriptionJob] -> ShowS
$cshowList :: [GetTranscriptionJob] -> ShowS
show :: GetTranscriptionJob -> String
$cshow :: GetTranscriptionJob -> String
showsPrec :: Int -> GetTranscriptionJob -> ShowS
$cshowsPrec :: Int -> GetTranscriptionJob -> ShowS
Prelude.Show, forall x. Rep GetTranscriptionJob x -> GetTranscriptionJob
forall x. GetTranscriptionJob -> Rep GetTranscriptionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTranscriptionJob x -> GetTranscriptionJob
$cfrom :: forall x. GetTranscriptionJob -> Rep GetTranscriptionJob x
Prelude.Generic)

-- |
-- Create a value of 'GetTranscriptionJob' 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:
--
-- 'transcriptionJobName', 'getTranscriptionJob_transcriptionJobName' - The name of the transcription job you want information about. Job names
-- are case sensitive.
newGetTranscriptionJob ::
  -- | 'transcriptionJobName'
  Prelude.Text ->
  GetTranscriptionJob
newGetTranscriptionJob :: Text -> GetTranscriptionJob
newGetTranscriptionJob Text
pTranscriptionJobName_ =
  GetTranscriptionJob'
    { $sel:transcriptionJobName:GetTranscriptionJob' :: Text
transcriptionJobName =
        Text
pTranscriptionJobName_
    }

-- | The name of the transcription job you want information about. Job names
-- are case sensitive.
getTranscriptionJob_transcriptionJobName :: Lens.Lens' GetTranscriptionJob Prelude.Text
getTranscriptionJob_transcriptionJobName :: Lens' GetTranscriptionJob Text
getTranscriptionJob_transcriptionJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTranscriptionJob' {Text
transcriptionJobName :: Text
$sel:transcriptionJobName:GetTranscriptionJob' :: GetTranscriptionJob -> Text
transcriptionJobName} -> Text
transcriptionJobName) (\s :: GetTranscriptionJob
s@GetTranscriptionJob' {} Text
a -> GetTranscriptionJob
s {$sel:transcriptionJobName:GetTranscriptionJob' :: Text
transcriptionJobName = Text
a} :: GetTranscriptionJob)

instance Core.AWSRequest GetTranscriptionJob where
  type
    AWSResponse GetTranscriptionJob =
      GetTranscriptionJobResponse
  request :: (Service -> Service)
-> GetTranscriptionJob -> Request GetTranscriptionJob
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 GetTranscriptionJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetTranscriptionJob)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe TranscriptionJob -> Int -> GetTranscriptionJobResponse
GetTranscriptionJobResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TranscriptionJob")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetTranscriptionJob where
  hashWithSalt :: Int -> GetTranscriptionJob -> Int
hashWithSalt Int
_salt GetTranscriptionJob' {Text
transcriptionJobName :: Text
$sel:transcriptionJobName:GetTranscriptionJob' :: GetTranscriptionJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transcriptionJobName

instance Prelude.NFData GetTranscriptionJob where
  rnf :: GetTranscriptionJob -> ()
rnf GetTranscriptionJob' {Text
transcriptionJobName :: Text
$sel:transcriptionJobName:GetTranscriptionJob' :: GetTranscriptionJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
transcriptionJobName

instance Data.ToHeaders GetTranscriptionJob where
  toHeaders :: GetTranscriptionJob -> 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.GetTranscriptionJob" ::
                          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 GetTranscriptionJob where
  toJSON :: GetTranscriptionJob -> Value
toJSON GetTranscriptionJob' {Text
transcriptionJobName :: Text
$sel:transcriptionJobName:GetTranscriptionJob' :: GetTranscriptionJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"TranscriptionJobName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transcriptionJobName
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'GetTranscriptionJobResponse' 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:
--
-- 'transcriptionJob', 'getTranscriptionJobResponse_transcriptionJob' - Provides detailed information about the specified transcription job,
-- including job status and, if applicable, failure reason.
--
-- 'httpStatus', 'getTranscriptionJobResponse_httpStatus' - The response's http status code.
newGetTranscriptionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTranscriptionJobResponse
newGetTranscriptionJobResponse :: Int -> GetTranscriptionJobResponse
newGetTranscriptionJobResponse Int
pHttpStatus_ =
  GetTranscriptionJobResponse'
    { $sel:transcriptionJob:GetTranscriptionJobResponse' :: Maybe TranscriptionJob
transcriptionJob =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTranscriptionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Provides detailed information about the specified transcription job,
-- including job status and, if applicable, failure reason.
getTranscriptionJobResponse_transcriptionJob :: Lens.Lens' GetTranscriptionJobResponse (Prelude.Maybe TranscriptionJob)
getTranscriptionJobResponse_transcriptionJob :: Lens' GetTranscriptionJobResponse (Maybe TranscriptionJob)
getTranscriptionJobResponse_transcriptionJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTranscriptionJobResponse' {Maybe TranscriptionJob
transcriptionJob :: Maybe TranscriptionJob
$sel:transcriptionJob:GetTranscriptionJobResponse' :: GetTranscriptionJobResponse -> Maybe TranscriptionJob
transcriptionJob} -> Maybe TranscriptionJob
transcriptionJob) (\s :: GetTranscriptionJobResponse
s@GetTranscriptionJobResponse' {} Maybe TranscriptionJob
a -> GetTranscriptionJobResponse
s {$sel:transcriptionJob:GetTranscriptionJobResponse' :: Maybe TranscriptionJob
transcriptionJob = Maybe TranscriptionJob
a} :: GetTranscriptionJobResponse)

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

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