{-# 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.UpdateVocabularyFilter
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing custom vocabulary filter with a new list of words.
-- The new list you provide overwrites all previous entries; you cannot
-- append new terms onto an existing custom vocabulary filter.
module Amazonka.Transcribe.UpdateVocabularyFilter
  ( -- * Creating a Request
    UpdateVocabularyFilter (..),
    newUpdateVocabularyFilter,

    -- * Request Lenses
    updateVocabularyFilter_vocabularyFilterFileUri,
    updateVocabularyFilter_words,
    updateVocabularyFilter_vocabularyFilterName,

    -- * Destructuring the Response
    UpdateVocabularyFilterResponse (..),
    newUpdateVocabularyFilterResponse,

    -- * Response Lenses
    updateVocabularyFilterResponse_languageCode,
    updateVocabularyFilterResponse_lastModifiedTime,
    updateVocabularyFilterResponse_vocabularyFilterName,
    updateVocabularyFilterResponse_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:/ 'newUpdateVocabularyFilter' smart constructor.
data UpdateVocabularyFilter = UpdateVocabularyFilter'
  { -- | The Amazon S3 location of the text file that contains your custom
    -- vocabulary filter terms. The URI must be located in the same Amazon Web
    -- Services Region as the resource you\'re calling.
    --
    -- Here\'s an example URI path:
    -- @s3:\/\/DOC-EXAMPLE-BUCKET\/my-vocab-filter-file.txt@
    --
    -- Note that if you include @VocabularyFilterFileUri@ in your request, you
    -- cannot use @Words@; you must choose one or the other.
    UpdateVocabularyFilter -> Maybe Text
vocabularyFilterFileUri :: Prelude.Maybe Prelude.Text,
    -- | Use this parameter if you want to update your custom vocabulary filter
    -- by including all desired terms, as comma-separated values, within your
    -- request. The other option for updating your vocabulary filter is to save
    -- your entries in a text file and upload them to an Amazon S3 bucket, then
    -- specify the location of your file using the @VocabularyFilterFileUri@
    -- parameter.
    --
    -- Note that if you include @Words@ in your request, you cannot use
    -- @VocabularyFilterFileUri@; you must choose one or the other.
    --
    -- Each language has a character set that contains all allowed characters
    -- for that specific language. If you use unsupported characters, your
    -- custom vocabulary filter request fails. Refer to
    -- <https://docs.aws.amazon.com/transcribe/latest/dg/charsets.html Character Sets for Custom Vocabularies>
    -- to get the character set for your language.
    UpdateVocabularyFilter -> Maybe (NonEmpty Text)
words :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of the custom vocabulary filter you want to update. Custom
    -- vocabulary filter names are case sensitive.
    UpdateVocabularyFilter -> Text
vocabularyFilterName :: Prelude.Text
  }
  deriving (UpdateVocabularyFilter -> UpdateVocabularyFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVocabularyFilter -> UpdateVocabularyFilter -> Bool
$c/= :: UpdateVocabularyFilter -> UpdateVocabularyFilter -> Bool
== :: UpdateVocabularyFilter -> UpdateVocabularyFilter -> Bool
$c== :: UpdateVocabularyFilter -> UpdateVocabularyFilter -> Bool
Prelude.Eq, ReadPrec [UpdateVocabularyFilter]
ReadPrec UpdateVocabularyFilter
Int -> ReadS UpdateVocabularyFilter
ReadS [UpdateVocabularyFilter]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVocabularyFilter]
$creadListPrec :: ReadPrec [UpdateVocabularyFilter]
readPrec :: ReadPrec UpdateVocabularyFilter
$creadPrec :: ReadPrec UpdateVocabularyFilter
readList :: ReadS [UpdateVocabularyFilter]
$creadList :: ReadS [UpdateVocabularyFilter]
readsPrec :: Int -> ReadS UpdateVocabularyFilter
$creadsPrec :: Int -> ReadS UpdateVocabularyFilter
Prelude.Read, Int -> UpdateVocabularyFilter -> ShowS
[UpdateVocabularyFilter] -> ShowS
UpdateVocabularyFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVocabularyFilter] -> ShowS
$cshowList :: [UpdateVocabularyFilter] -> ShowS
show :: UpdateVocabularyFilter -> String
$cshow :: UpdateVocabularyFilter -> String
showsPrec :: Int -> UpdateVocabularyFilter -> ShowS
$cshowsPrec :: Int -> UpdateVocabularyFilter -> ShowS
Prelude.Show, forall x. Rep UpdateVocabularyFilter x -> UpdateVocabularyFilter
forall x. UpdateVocabularyFilter -> Rep UpdateVocabularyFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVocabularyFilter x -> UpdateVocabularyFilter
$cfrom :: forall x. UpdateVocabularyFilter -> Rep UpdateVocabularyFilter x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVocabularyFilter' 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:
--
-- 'vocabularyFilterFileUri', 'updateVocabularyFilter_vocabularyFilterFileUri' - The Amazon S3 location of the text file that contains your custom
-- vocabulary filter terms. The URI must be located in the same Amazon Web
-- Services Region as the resource you\'re calling.
--
-- Here\'s an example URI path:
-- @s3:\/\/DOC-EXAMPLE-BUCKET\/my-vocab-filter-file.txt@
--
-- Note that if you include @VocabularyFilterFileUri@ in your request, you
-- cannot use @Words@; you must choose one or the other.
--
-- 'words', 'updateVocabularyFilter_words' - Use this parameter if you want to update your custom vocabulary filter
-- by including all desired terms, as comma-separated values, within your
-- request. The other option for updating your vocabulary filter is to save
-- your entries in a text file and upload them to an Amazon S3 bucket, then
-- specify the location of your file using the @VocabularyFilterFileUri@
-- parameter.
--
-- Note that if you include @Words@ in your request, you cannot use
-- @VocabularyFilterFileUri@; you must choose one or the other.
--
-- Each language has a character set that contains all allowed characters
-- for that specific language. If you use unsupported characters, your
-- custom vocabulary filter request fails. Refer to
-- <https://docs.aws.amazon.com/transcribe/latest/dg/charsets.html Character Sets for Custom Vocabularies>
-- to get the character set for your language.
--
-- 'vocabularyFilterName', 'updateVocabularyFilter_vocabularyFilterName' - The name of the custom vocabulary filter you want to update. Custom
-- vocabulary filter names are case sensitive.
newUpdateVocabularyFilter ::
  -- | 'vocabularyFilterName'
  Prelude.Text ->
  UpdateVocabularyFilter
newUpdateVocabularyFilter :: Text -> UpdateVocabularyFilter
newUpdateVocabularyFilter Text
pVocabularyFilterName_ =
  UpdateVocabularyFilter'
    { $sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: Maybe Text
vocabularyFilterFileUri =
        forall a. Maybe a
Prelude.Nothing,
      $sel:words:UpdateVocabularyFilter' :: Maybe (NonEmpty Text)
words = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyFilterName:UpdateVocabularyFilter' :: Text
vocabularyFilterName = Text
pVocabularyFilterName_
    }

-- | The Amazon S3 location of the text file that contains your custom
-- vocabulary filter terms. The URI must be located in the same Amazon Web
-- Services Region as the resource you\'re calling.
--
-- Here\'s an example URI path:
-- @s3:\/\/DOC-EXAMPLE-BUCKET\/my-vocab-filter-file.txt@
--
-- Note that if you include @VocabularyFilterFileUri@ in your request, you
-- cannot use @Words@; you must choose one or the other.
updateVocabularyFilter_vocabularyFilterFileUri :: Lens.Lens' UpdateVocabularyFilter (Prelude.Maybe Prelude.Text)
updateVocabularyFilter_vocabularyFilterFileUri :: Lens' UpdateVocabularyFilter (Maybe Text)
updateVocabularyFilter_vocabularyFilterFileUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVocabularyFilter' {Maybe Text
vocabularyFilterFileUri :: Maybe Text
$sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe Text
vocabularyFilterFileUri} -> Maybe Text
vocabularyFilterFileUri) (\s :: UpdateVocabularyFilter
s@UpdateVocabularyFilter' {} Maybe Text
a -> UpdateVocabularyFilter
s {$sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: Maybe Text
vocabularyFilterFileUri = Maybe Text
a} :: UpdateVocabularyFilter)

-- | Use this parameter if you want to update your custom vocabulary filter
-- by including all desired terms, as comma-separated values, within your
-- request. The other option for updating your vocabulary filter is to save
-- your entries in a text file and upload them to an Amazon S3 bucket, then
-- specify the location of your file using the @VocabularyFilterFileUri@
-- parameter.
--
-- Note that if you include @Words@ in your request, you cannot use
-- @VocabularyFilterFileUri@; you must choose one or the other.
--
-- Each language has a character set that contains all allowed characters
-- for that specific language. If you use unsupported characters, your
-- custom vocabulary filter request fails. Refer to
-- <https://docs.aws.amazon.com/transcribe/latest/dg/charsets.html Character Sets for Custom Vocabularies>
-- to get the character set for your language.
updateVocabularyFilter_words :: Lens.Lens' UpdateVocabularyFilter (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateVocabularyFilter_words :: Lens' UpdateVocabularyFilter (Maybe (NonEmpty Text))
updateVocabularyFilter_words = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVocabularyFilter' {Maybe (NonEmpty Text)
words :: Maybe (NonEmpty Text)
$sel:words:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe (NonEmpty Text)
words} -> Maybe (NonEmpty Text)
words) (\s :: UpdateVocabularyFilter
s@UpdateVocabularyFilter' {} Maybe (NonEmpty Text)
a -> UpdateVocabularyFilter
s {$sel:words:UpdateVocabularyFilter' :: Maybe (NonEmpty Text)
words = Maybe (NonEmpty Text)
a} :: UpdateVocabularyFilter) 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 name of the custom vocabulary filter you want to update. Custom
-- vocabulary filter names are case sensitive.
updateVocabularyFilter_vocabularyFilterName :: Lens.Lens' UpdateVocabularyFilter Prelude.Text
updateVocabularyFilter_vocabularyFilterName :: Lens' UpdateVocabularyFilter Text
updateVocabularyFilter_vocabularyFilterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVocabularyFilter' {Text
vocabularyFilterName :: Text
$sel:vocabularyFilterName:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Text
vocabularyFilterName} -> Text
vocabularyFilterName) (\s :: UpdateVocabularyFilter
s@UpdateVocabularyFilter' {} Text
a -> UpdateVocabularyFilter
s {$sel:vocabularyFilterName:UpdateVocabularyFilter' :: Text
vocabularyFilterName = Text
a} :: UpdateVocabularyFilter)

instance Core.AWSRequest UpdateVocabularyFilter where
  type
    AWSResponse UpdateVocabularyFilter =
      UpdateVocabularyFilterResponse
  request :: (Service -> Service)
-> UpdateVocabularyFilter -> Request UpdateVocabularyFilter
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 UpdateVocabularyFilter
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateVocabularyFilter)))
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 LanguageCode
-> Maybe POSIX
-> Maybe Text
-> Int
-> UpdateVocabularyFilterResponse
UpdateVocabularyFilterResponse'
            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
"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
"VocabularyFilterName")
            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 UpdateVocabularyFilter where
  hashWithSalt :: Int -> UpdateVocabularyFilter -> Int
hashWithSalt Int
_salt UpdateVocabularyFilter' {Maybe (NonEmpty Text)
Maybe Text
Text
vocabularyFilterName :: Text
words :: Maybe (NonEmpty Text)
vocabularyFilterFileUri :: Maybe Text
$sel:vocabularyFilterName:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Text
$sel:words:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe (NonEmpty Text)
$sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vocabularyFilterFileUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
words
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vocabularyFilterName

instance Prelude.NFData UpdateVocabularyFilter where
  rnf :: UpdateVocabularyFilter -> ()
rnf UpdateVocabularyFilter' {Maybe (NonEmpty Text)
Maybe Text
Text
vocabularyFilterName :: Text
words :: Maybe (NonEmpty Text)
vocabularyFilterFileUri :: Maybe Text
$sel:vocabularyFilterName:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Text
$sel:words:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe (NonEmpty Text)
$sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vocabularyFilterFileUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
words
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vocabularyFilterName

instance Data.ToHeaders UpdateVocabularyFilter where
  toHeaders :: UpdateVocabularyFilter -> 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.UpdateVocabularyFilter" ::
                          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 UpdateVocabularyFilter where
  toJSON :: UpdateVocabularyFilter -> Value
toJSON UpdateVocabularyFilter' {Maybe (NonEmpty Text)
Maybe Text
Text
vocabularyFilterName :: Text
words :: Maybe (NonEmpty Text)
vocabularyFilterFileUri :: Maybe Text
$sel:vocabularyFilterName:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Text
$sel:words:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe (NonEmpty Text)
$sel:vocabularyFilterFileUri:UpdateVocabularyFilter' :: UpdateVocabularyFilter -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"VocabularyFilterFileUri" 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
vocabularyFilterFileUri,
            (Key
"Words" 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 Text)
words,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"VocabularyFilterName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
vocabularyFilterName
              )
          ]
      )

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

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

-- | /See:/ 'newUpdateVocabularyFilterResponse' smart constructor.
data UpdateVocabularyFilterResponse = UpdateVocabularyFilterResponse'
  { -- | The language code you selected for your custom vocabulary filter.
    UpdateVocabularyFilterResponse -> Maybe LanguageCode
languageCode :: Prelude.Maybe LanguageCode,
    -- | The date and time the specified custom vocabulary filter was last
    -- updated.
    --
    -- 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.
    UpdateVocabularyFilterResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the updated custom vocabulary filter.
    UpdateVocabularyFilterResponse -> Maybe Text
vocabularyFilterName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateVocabularyFilterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateVocabularyFilterResponse
-> UpdateVocabularyFilterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVocabularyFilterResponse
-> UpdateVocabularyFilterResponse -> Bool
$c/= :: UpdateVocabularyFilterResponse
-> UpdateVocabularyFilterResponse -> Bool
== :: UpdateVocabularyFilterResponse
-> UpdateVocabularyFilterResponse -> Bool
$c== :: UpdateVocabularyFilterResponse
-> UpdateVocabularyFilterResponse -> Bool
Prelude.Eq, ReadPrec [UpdateVocabularyFilterResponse]
ReadPrec UpdateVocabularyFilterResponse
Int -> ReadS UpdateVocabularyFilterResponse
ReadS [UpdateVocabularyFilterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVocabularyFilterResponse]
$creadListPrec :: ReadPrec [UpdateVocabularyFilterResponse]
readPrec :: ReadPrec UpdateVocabularyFilterResponse
$creadPrec :: ReadPrec UpdateVocabularyFilterResponse
readList :: ReadS [UpdateVocabularyFilterResponse]
$creadList :: ReadS [UpdateVocabularyFilterResponse]
readsPrec :: Int -> ReadS UpdateVocabularyFilterResponse
$creadsPrec :: Int -> ReadS UpdateVocabularyFilterResponse
Prelude.Read, Int -> UpdateVocabularyFilterResponse -> ShowS
[UpdateVocabularyFilterResponse] -> ShowS
UpdateVocabularyFilterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVocabularyFilterResponse] -> ShowS
$cshowList :: [UpdateVocabularyFilterResponse] -> ShowS
show :: UpdateVocabularyFilterResponse -> String
$cshow :: UpdateVocabularyFilterResponse -> String
showsPrec :: Int -> UpdateVocabularyFilterResponse -> ShowS
$cshowsPrec :: Int -> UpdateVocabularyFilterResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateVocabularyFilterResponse x
-> UpdateVocabularyFilterResponse
forall x.
UpdateVocabularyFilterResponse
-> Rep UpdateVocabularyFilterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateVocabularyFilterResponse x
-> UpdateVocabularyFilterResponse
$cfrom :: forall x.
UpdateVocabularyFilterResponse
-> Rep UpdateVocabularyFilterResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVocabularyFilterResponse' 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:
--
-- 'languageCode', 'updateVocabularyFilterResponse_languageCode' - The language code you selected for your custom vocabulary filter.
--
-- 'lastModifiedTime', 'updateVocabularyFilterResponse_lastModifiedTime' - The date and time the specified custom vocabulary filter was last
-- updated.
--
-- 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.
--
-- 'vocabularyFilterName', 'updateVocabularyFilterResponse_vocabularyFilterName' - The name of the updated custom vocabulary filter.
--
-- 'httpStatus', 'updateVocabularyFilterResponse_httpStatus' - The response's http status code.
newUpdateVocabularyFilterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateVocabularyFilterResponse
newUpdateVocabularyFilterResponse :: Int -> UpdateVocabularyFilterResponse
newUpdateVocabularyFilterResponse Int
pHttpStatus_ =
  UpdateVocabularyFilterResponse'
    { $sel:languageCode:UpdateVocabularyFilterResponse' :: Maybe LanguageCode
languageCode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:UpdateVocabularyFilterResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:vocabularyFilterName:UpdateVocabularyFilterResponse' :: Maybe Text
vocabularyFilterName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateVocabularyFilterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The date and time the specified custom vocabulary filter was last
-- updated.
--
-- 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.
updateVocabularyFilterResponse_lastModifiedTime :: Lens.Lens' UpdateVocabularyFilterResponse (Prelude.Maybe Prelude.UTCTime)
updateVocabularyFilterResponse_lastModifiedTime :: Lens' UpdateVocabularyFilterResponse (Maybe UTCTime)
updateVocabularyFilterResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVocabularyFilterResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:UpdateVocabularyFilterResponse' :: UpdateVocabularyFilterResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: UpdateVocabularyFilterResponse
s@UpdateVocabularyFilterResponse' {} Maybe POSIX
a -> UpdateVocabularyFilterResponse
s {$sel:lastModifiedTime:UpdateVocabularyFilterResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: UpdateVocabularyFilterResponse) 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 updated custom vocabulary filter.
updateVocabularyFilterResponse_vocabularyFilterName :: Lens.Lens' UpdateVocabularyFilterResponse (Prelude.Maybe Prelude.Text)
updateVocabularyFilterResponse_vocabularyFilterName :: Lens' UpdateVocabularyFilterResponse (Maybe Text)
updateVocabularyFilterResponse_vocabularyFilterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVocabularyFilterResponse' {Maybe Text
vocabularyFilterName :: Maybe Text
$sel:vocabularyFilterName:UpdateVocabularyFilterResponse' :: UpdateVocabularyFilterResponse -> Maybe Text
vocabularyFilterName} -> Maybe Text
vocabularyFilterName) (\s :: UpdateVocabularyFilterResponse
s@UpdateVocabularyFilterResponse' {} Maybe Text
a -> UpdateVocabularyFilterResponse
s {$sel:vocabularyFilterName:UpdateVocabularyFilterResponse' :: Maybe Text
vocabularyFilterName = Maybe Text
a} :: UpdateVocabularyFilterResponse)

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

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