{-# 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.GetVocabulary
-- 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 custom vocabulary.
--
-- To view the status of the specified custom vocabulary, check the
-- @VocabularyState@ field. If the status is @READY@, your custom
-- vocabulary is available to use. If the status is @FAILED@,
-- @FailureReason@ provides details on why your custom vocabulary failed.
--
-- To get a list of your custom vocabularies, use the operation.
module Amazonka.Transcribe.GetVocabulary
  ( -- * Creating a Request
    GetVocabulary (..),
    newGetVocabulary,

    -- * Request Lenses
    getVocabulary_vocabularyName,

    -- * Destructuring the Response
    GetVocabularyResponse (..),
    newGetVocabularyResponse,

    -- * Response Lenses
    getVocabularyResponse_downloadUri,
    getVocabularyResponse_failureReason,
    getVocabularyResponse_languageCode,
    getVocabularyResponse_lastModifiedTime,
    getVocabularyResponse_vocabularyName,
    getVocabularyResponse_vocabularyState,
    getVocabularyResponse_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:/ 'newGetVocabulary' smart constructor.
data GetVocabulary = GetVocabulary'
  { -- | The name of the custom vocabulary you want information about. Custom
    -- vocabulary names are case sensitive.
    GetVocabulary -> Text
vocabularyName :: Prelude.Text
  }
  deriving (GetVocabulary -> GetVocabulary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVocabulary -> GetVocabulary -> Bool
$c/= :: GetVocabulary -> GetVocabulary -> Bool
== :: GetVocabulary -> GetVocabulary -> Bool
$c== :: GetVocabulary -> GetVocabulary -> Bool
Prelude.Eq, ReadPrec [GetVocabulary]
ReadPrec GetVocabulary
Int -> ReadS GetVocabulary
ReadS [GetVocabulary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVocabulary]
$creadListPrec :: ReadPrec [GetVocabulary]
readPrec :: ReadPrec GetVocabulary
$creadPrec :: ReadPrec GetVocabulary
readList :: ReadS [GetVocabulary]
$creadList :: ReadS [GetVocabulary]
readsPrec :: Int -> ReadS GetVocabulary
$creadsPrec :: Int -> ReadS GetVocabulary
Prelude.Read, Int -> GetVocabulary -> ShowS
[GetVocabulary] -> ShowS
GetVocabulary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVocabulary] -> ShowS
$cshowList :: [GetVocabulary] -> ShowS
show :: GetVocabulary -> String
$cshow :: GetVocabulary -> String
showsPrec :: Int -> GetVocabulary -> ShowS
$cshowsPrec :: Int -> GetVocabulary -> ShowS
Prelude.Show, forall x. Rep GetVocabulary x -> GetVocabulary
forall x. GetVocabulary -> Rep GetVocabulary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVocabulary x -> GetVocabulary
$cfrom :: forall x. GetVocabulary -> Rep GetVocabulary x
Prelude.Generic)

-- |
-- Create a value of 'GetVocabulary' 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:
--
-- 'vocabularyName', 'getVocabulary_vocabularyName' - The name of the custom vocabulary you want information about. Custom
-- vocabulary names are case sensitive.
newGetVocabulary ::
  -- | 'vocabularyName'
  Prelude.Text ->
  GetVocabulary
newGetVocabulary :: Text -> GetVocabulary
newGetVocabulary Text
pVocabularyName_ =
  GetVocabulary' {$sel:vocabularyName:GetVocabulary' :: Text
vocabularyName = Text
pVocabularyName_}

-- | The name of the custom vocabulary you want information about. Custom
-- vocabulary names are case sensitive.
getVocabulary_vocabularyName :: Lens.Lens' GetVocabulary Prelude.Text
getVocabulary_vocabularyName :: Lens' GetVocabulary Text
getVocabulary_vocabularyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabulary' {Text
vocabularyName :: Text
$sel:vocabularyName:GetVocabulary' :: GetVocabulary -> Text
vocabularyName} -> Text
vocabularyName) (\s :: GetVocabulary
s@GetVocabulary' {} Text
a -> GetVocabulary
s {$sel:vocabularyName:GetVocabulary' :: Text
vocabularyName = Text
a} :: GetVocabulary)

instance Core.AWSRequest GetVocabulary where
  type
    AWSResponse GetVocabulary =
      GetVocabularyResponse
  request :: (Service -> Service) -> GetVocabulary -> Request GetVocabulary
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 GetVocabulary
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetVocabulary)))
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 Text
-> Maybe Text
-> Maybe LanguageCode
-> Maybe POSIX
-> Maybe Text
-> Maybe VocabularyState
-> Int
-> GetVocabularyResponse
GetVocabularyResponse'
            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
"DownloadUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FailureReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LanguageCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastModifiedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VocabularyName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VocabularyState")
            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 GetVocabulary where
  hashWithSalt :: Int -> GetVocabulary -> Int
hashWithSalt Int
_salt GetVocabulary' {Text
vocabularyName :: Text
$sel:vocabularyName:GetVocabulary' :: GetVocabulary -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vocabularyName

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

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

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

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

-- | /See:/ 'newGetVocabularyResponse' smart constructor.
data GetVocabularyResponse = GetVocabularyResponse'
  { -- | The S3 location where the custom vocabulary is stored; use this URI to
    -- view or download the custom vocabulary.
    GetVocabularyResponse -> Maybe Text
downloadUri :: Prelude.Maybe Prelude.Text,
    -- | If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
    -- about why the custom vocabulary request failed. See also:
    -- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
    GetVocabularyResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The language code you selected for your custom vocabulary.
    GetVocabularyResponse -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | The date and time the specified custom vocabulary was last modified.
    --
    -- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
    -- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
    -- May 4, 2022.
    GetVocabularyResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the custom vocabulary you requested information about.
    GetVocabularyResponse -> Maybe Text
vocabularyName :: Prelude.Maybe Prelude.Text,
    -- | The processing state of your custom vocabulary. If the state is @READY@,
    -- you can use the custom vocabulary in a @StartTranscriptionJob@ request.
    GetVocabularyResponse -> Maybe VocabularyState
vocabularyState :: Prelude.Maybe VocabularyState,
    -- | The response's http status code.
    GetVocabularyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetVocabularyResponse -> GetVocabularyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVocabularyResponse -> GetVocabularyResponse -> Bool
$c/= :: GetVocabularyResponse -> GetVocabularyResponse -> Bool
== :: GetVocabularyResponse -> GetVocabularyResponse -> Bool
$c== :: GetVocabularyResponse -> GetVocabularyResponse -> Bool
Prelude.Eq, ReadPrec [GetVocabularyResponse]
ReadPrec GetVocabularyResponse
Int -> ReadS GetVocabularyResponse
ReadS [GetVocabularyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVocabularyResponse]
$creadListPrec :: ReadPrec [GetVocabularyResponse]
readPrec :: ReadPrec GetVocabularyResponse
$creadPrec :: ReadPrec GetVocabularyResponse
readList :: ReadS [GetVocabularyResponse]
$creadList :: ReadS [GetVocabularyResponse]
readsPrec :: Int -> ReadS GetVocabularyResponse
$creadsPrec :: Int -> ReadS GetVocabularyResponse
Prelude.Read, Int -> GetVocabularyResponse -> ShowS
[GetVocabularyResponse] -> ShowS
GetVocabularyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVocabularyResponse] -> ShowS
$cshowList :: [GetVocabularyResponse] -> ShowS
show :: GetVocabularyResponse -> String
$cshow :: GetVocabularyResponse -> String
showsPrec :: Int -> GetVocabularyResponse -> ShowS
$cshowsPrec :: Int -> GetVocabularyResponse -> ShowS
Prelude.Show, forall x. Rep GetVocabularyResponse x -> GetVocabularyResponse
forall x. GetVocabularyResponse -> Rep GetVocabularyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVocabularyResponse x -> GetVocabularyResponse
$cfrom :: forall x. GetVocabularyResponse -> Rep GetVocabularyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetVocabularyResponse' 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:
--
-- 'downloadUri', 'getVocabularyResponse_downloadUri' - The S3 location where the custom vocabulary is stored; use this URI to
-- view or download the custom vocabulary.
--
-- 'failureReason', 'getVocabularyResponse_failureReason' - If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
-- about why the custom vocabulary request failed. See also:
-- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
--
-- 'languageCode', 'getVocabularyResponse_languageCode' - The language code you selected for your custom vocabulary.
--
-- 'lastModifiedTime', 'getVocabularyResponse_lastModifiedTime' - The date and time the specified custom vocabulary was last modified.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
-- May 4, 2022.
--
-- 'vocabularyName', 'getVocabularyResponse_vocabularyName' - The name of the custom vocabulary you requested information about.
--
-- 'vocabularyState', 'getVocabularyResponse_vocabularyState' - The processing state of your custom vocabulary. If the state is @READY@,
-- you can use the custom vocabulary in a @StartTranscriptionJob@ request.
--
-- 'httpStatus', 'getVocabularyResponse_httpStatus' - The response's http status code.
newGetVocabularyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetVocabularyResponse
newGetVocabularyResponse :: Int -> GetVocabularyResponse
newGetVocabularyResponse Int
pHttpStatus_ =
  GetVocabularyResponse'
    { $sel:downloadUri:GetVocabularyResponse' :: Maybe Text
downloadUri =
        forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:GetVocabularyResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:GetVocabularyResponse' :: Maybe LanguageCode
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:GetVocabularyResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyName:GetVocabularyResponse' :: Maybe Text
vocabularyName = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyState:GetVocabularyResponse' :: Maybe VocabularyState
vocabularyState = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetVocabularyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The S3 location where the custom vocabulary is stored; use this URI to
-- view or download the custom vocabulary.
getVocabularyResponse_downloadUri :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe Prelude.Text)
getVocabularyResponse_downloadUri :: Lens' GetVocabularyResponse (Maybe Text)
getVocabularyResponse_downloadUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe Text
downloadUri :: Maybe Text
$sel:downloadUri:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
downloadUri} -> Maybe Text
downloadUri) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe Text
a -> GetVocabularyResponse
s {$sel:downloadUri:GetVocabularyResponse' :: Maybe Text
downloadUri = Maybe Text
a} :: GetVocabularyResponse)

-- | If @VocabularyState@ is @FAILED@, @FailureReason@ contains information
-- about why the custom vocabulary request failed. See also:
-- <https://docs.aws.amazon.com/transcribe/latest/APIReference/CommonErrors.html Common Errors>.
getVocabularyResponse_failureReason :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe Prelude.Text)
getVocabularyResponse_failureReason :: Lens' GetVocabularyResponse (Maybe Text)
getVocabularyResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe Text
a -> GetVocabularyResponse
s {$sel:failureReason:GetVocabularyResponse' :: Maybe Text
failureReason = Maybe Text
a} :: GetVocabularyResponse)

-- | The language code you selected for your custom vocabulary.
getVocabularyResponse_languageCode :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe LanguageCode)
getVocabularyResponse_languageCode :: Lens' GetVocabularyResponse (Maybe LanguageCode)
getVocabularyResponse_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe LanguageCode
languageCode :: Maybe LanguageCode
$sel:languageCode:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe LanguageCode
languageCode} -> Maybe LanguageCode
languageCode) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe LanguageCode
a -> GetVocabularyResponse
s {$sel:languageCode:GetVocabularyResponse' :: Maybe LanguageCode
languageCode = Maybe LanguageCode
a} :: GetVocabularyResponse)

-- | The date and time the specified custom vocabulary was last modified.
--
-- Timestamps are in the format @YYYY-MM-DD\'T\'HH:MM:SS.SSSSSS-UTC@. For
-- example, @2022-05-04T12:32:58.761000-07:00@ represents 12:32 PM UTC-7 on
-- May 4, 2022.
getVocabularyResponse_lastModifiedTime :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe Prelude.UTCTime)
getVocabularyResponse_lastModifiedTime :: Lens' GetVocabularyResponse (Maybe UTCTime)
getVocabularyResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe POSIX
a -> GetVocabularyResponse
s {$sel:lastModifiedTime:GetVocabularyResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: GetVocabularyResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the custom vocabulary you requested information about.
getVocabularyResponse_vocabularyName :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe Prelude.Text)
getVocabularyResponse_vocabularyName :: Lens' GetVocabularyResponse (Maybe Text)
getVocabularyResponse_vocabularyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe Text
vocabularyName :: Maybe Text
$sel:vocabularyName:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
vocabularyName} -> Maybe Text
vocabularyName) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe Text
a -> GetVocabularyResponse
s {$sel:vocabularyName:GetVocabularyResponse' :: Maybe Text
vocabularyName = Maybe Text
a} :: GetVocabularyResponse)

-- | The processing state of your custom vocabulary. If the state is @READY@,
-- you can use the custom vocabulary in a @StartTranscriptionJob@ request.
getVocabularyResponse_vocabularyState :: Lens.Lens' GetVocabularyResponse (Prelude.Maybe VocabularyState)
getVocabularyResponse_vocabularyState :: Lens' GetVocabularyResponse (Maybe VocabularyState)
getVocabularyResponse_vocabularyState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVocabularyResponse' {Maybe VocabularyState
vocabularyState :: Maybe VocabularyState
$sel:vocabularyState:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe VocabularyState
vocabularyState} -> Maybe VocabularyState
vocabularyState) (\s :: GetVocabularyResponse
s@GetVocabularyResponse' {} Maybe VocabularyState
a -> GetVocabularyResponse
s {$sel:vocabularyState:GetVocabularyResponse' :: Maybe VocabularyState
vocabularyState = Maybe VocabularyState
a} :: GetVocabularyResponse)

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

instance Prelude.NFData GetVocabularyResponse where
  rnf :: GetVocabularyResponse -> ()
rnf GetVocabularyResponse' {Int
Maybe Text
Maybe POSIX
Maybe LanguageCode
Maybe VocabularyState
httpStatus :: Int
vocabularyState :: Maybe VocabularyState
vocabularyName :: Maybe Text
lastModifiedTime :: Maybe POSIX
languageCode :: Maybe LanguageCode
failureReason :: Maybe Text
downloadUri :: Maybe Text
$sel:httpStatus:GetVocabularyResponse' :: GetVocabularyResponse -> Int
$sel:vocabularyState:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe VocabularyState
$sel:vocabularyName:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
$sel:lastModifiedTime:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe POSIX
$sel:languageCode:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe LanguageCode
$sel:failureReason:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
$sel:downloadUri:GetVocabularyResponse' :: GetVocabularyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
downloadUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      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 POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vocabularyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VocabularyState
vocabularyState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus