{-# 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.Translate.ImportTerminology
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates a custom terminology, depending on whether one
-- already exists for the given terminology name. Importing a terminology
-- with the same name as an existing one will merge the terminologies based
-- on the chosen merge strategy. The only supported merge strategy is
-- OVERWRITE, where the imported terminology overwrites the existing
-- terminology of the same name.
--
-- If you import a terminology that overwrites an existing one, the new
-- terminology takes up to 10 minutes to fully propagate. After that,
-- translations have access to the new terminology.
module Amazonka.Translate.ImportTerminology
  ( -- * Creating a Request
    ImportTerminology (..),
    newImportTerminology,

    -- * Request Lenses
    importTerminology_description,
    importTerminology_encryptionKey,
    importTerminology_tags,
    importTerminology_name,
    importTerminology_mergeStrategy,
    importTerminology_terminologyData,

    -- * Destructuring the Response
    ImportTerminologyResponse (..),
    newImportTerminologyResponse,

    -- * Response Lenses
    importTerminologyResponse_auxiliaryDataLocation,
    importTerminologyResponse_terminologyProperties,
    importTerminologyResponse_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.Translate.Types

-- | /See:/ 'newImportTerminology' smart constructor.
data ImportTerminology = ImportTerminology'
  { -- | The description of the custom terminology being imported.
    ImportTerminology -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The encryption key for the custom terminology being imported.
    ImportTerminology -> Maybe EncryptionKey
encryptionKey :: Prelude.Maybe EncryptionKey,
    -- | Tags to be associated with this resource. A tag is a key-value pair that
    -- adds metadata to a resource. Each tag key for the resource must be
    -- unique. For more information, see
    -- <https://docs.aws.amazon.com/translate/latest/dg/tagging.html Tagging your resources>.
    ImportTerminology -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the custom terminology being imported.
    ImportTerminology -> Text
name :: Prelude.Text,
    -- | The merge strategy of the custom terminology being imported. Currently,
    -- only the OVERWRITE merge strategy is supported. In this case, the
    -- imported terminology will overwrite an existing terminology of the same
    -- name.
    ImportTerminology -> MergeStrategy
mergeStrategy :: MergeStrategy,
    -- | The terminology data for the custom terminology being imported.
    ImportTerminology -> TerminologyData
terminologyData :: TerminologyData
  }
  deriving (ImportTerminology -> ImportTerminology -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportTerminology -> ImportTerminology -> Bool
$c/= :: ImportTerminology -> ImportTerminology -> Bool
== :: ImportTerminology -> ImportTerminology -> Bool
$c== :: ImportTerminology -> ImportTerminology -> Bool
Prelude.Eq, Int -> ImportTerminology -> ShowS
[ImportTerminology] -> ShowS
ImportTerminology -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportTerminology] -> ShowS
$cshowList :: [ImportTerminology] -> ShowS
show :: ImportTerminology -> String
$cshow :: ImportTerminology -> String
showsPrec :: Int -> ImportTerminology -> ShowS
$cshowsPrec :: Int -> ImportTerminology -> ShowS
Prelude.Show, forall x. Rep ImportTerminology x -> ImportTerminology
forall x. ImportTerminology -> Rep ImportTerminology x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportTerminology x -> ImportTerminology
$cfrom :: forall x. ImportTerminology -> Rep ImportTerminology x
Prelude.Generic)

-- |
-- Create a value of 'ImportTerminology' 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:
--
-- 'description', 'importTerminology_description' - The description of the custom terminology being imported.
--
-- 'encryptionKey', 'importTerminology_encryptionKey' - The encryption key for the custom terminology being imported.
--
-- 'tags', 'importTerminology_tags' - Tags to be associated with this resource. A tag is a key-value pair that
-- adds metadata to a resource. Each tag key for the resource must be
-- unique. For more information, see
-- <https://docs.aws.amazon.com/translate/latest/dg/tagging.html Tagging your resources>.
--
-- 'name', 'importTerminology_name' - The name of the custom terminology being imported.
--
-- 'mergeStrategy', 'importTerminology_mergeStrategy' - The merge strategy of the custom terminology being imported. Currently,
-- only the OVERWRITE merge strategy is supported. In this case, the
-- imported terminology will overwrite an existing terminology of the same
-- name.
--
-- 'terminologyData', 'importTerminology_terminologyData' - The terminology data for the custom terminology being imported.
newImportTerminology ::
  -- | 'name'
  Prelude.Text ->
  -- | 'mergeStrategy'
  MergeStrategy ->
  -- | 'terminologyData'
  TerminologyData ->
  ImportTerminology
newImportTerminology :: Text -> MergeStrategy -> TerminologyData -> ImportTerminology
newImportTerminology
  Text
pName_
  MergeStrategy
pMergeStrategy_
  TerminologyData
pTerminologyData_ =
    ImportTerminology'
      { $sel:description:ImportTerminology' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionKey:ImportTerminology' :: Maybe EncryptionKey
encryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:ImportTerminology' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:ImportTerminology' :: Text
name = Text
pName_,
        $sel:mergeStrategy:ImportTerminology' :: MergeStrategy
mergeStrategy = MergeStrategy
pMergeStrategy_,
        $sel:terminologyData:ImportTerminology' :: TerminologyData
terminologyData = TerminologyData
pTerminologyData_
      }

-- | The description of the custom terminology being imported.
importTerminology_description :: Lens.Lens' ImportTerminology (Prelude.Maybe Prelude.Text)
importTerminology_description :: Lens' ImportTerminology (Maybe Text)
importTerminology_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {Maybe Text
description :: Maybe Text
$sel:description:ImportTerminology' :: ImportTerminology -> Maybe Text
description} -> Maybe Text
description) (\s :: ImportTerminology
s@ImportTerminology' {} Maybe Text
a -> ImportTerminology
s {$sel:description:ImportTerminology' :: Maybe Text
description = Maybe Text
a} :: ImportTerminology)

-- | The encryption key for the custom terminology being imported.
importTerminology_encryptionKey :: Lens.Lens' ImportTerminology (Prelude.Maybe EncryptionKey)
importTerminology_encryptionKey :: Lens' ImportTerminology (Maybe EncryptionKey)
importTerminology_encryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {Maybe EncryptionKey
encryptionKey :: Maybe EncryptionKey
$sel:encryptionKey:ImportTerminology' :: ImportTerminology -> Maybe EncryptionKey
encryptionKey} -> Maybe EncryptionKey
encryptionKey) (\s :: ImportTerminology
s@ImportTerminology' {} Maybe EncryptionKey
a -> ImportTerminology
s {$sel:encryptionKey:ImportTerminology' :: Maybe EncryptionKey
encryptionKey = Maybe EncryptionKey
a} :: ImportTerminology)

-- | Tags to be associated with this resource. A tag is a key-value pair that
-- adds metadata to a resource. Each tag key for the resource must be
-- unique. For more information, see
-- <https://docs.aws.amazon.com/translate/latest/dg/tagging.html Tagging your resources>.
importTerminology_tags :: Lens.Lens' ImportTerminology (Prelude.Maybe [Tag])
importTerminology_tags :: Lens' ImportTerminology (Maybe [Tag])
importTerminology_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportTerminology' :: ImportTerminology -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportTerminology
s@ImportTerminology' {} Maybe [Tag]
a -> ImportTerminology
s {$sel:tags:ImportTerminology' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportTerminology) 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 terminology being imported.
importTerminology_name :: Lens.Lens' ImportTerminology Prelude.Text
importTerminology_name :: Lens' ImportTerminology Text
importTerminology_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {Text
name :: Text
$sel:name:ImportTerminology' :: ImportTerminology -> Text
name} -> Text
name) (\s :: ImportTerminology
s@ImportTerminology' {} Text
a -> ImportTerminology
s {$sel:name:ImportTerminology' :: Text
name = Text
a} :: ImportTerminology)

-- | The merge strategy of the custom terminology being imported. Currently,
-- only the OVERWRITE merge strategy is supported. In this case, the
-- imported terminology will overwrite an existing terminology of the same
-- name.
importTerminology_mergeStrategy :: Lens.Lens' ImportTerminology MergeStrategy
importTerminology_mergeStrategy :: Lens' ImportTerminology MergeStrategy
importTerminology_mergeStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {MergeStrategy
mergeStrategy :: MergeStrategy
$sel:mergeStrategy:ImportTerminology' :: ImportTerminology -> MergeStrategy
mergeStrategy} -> MergeStrategy
mergeStrategy) (\s :: ImportTerminology
s@ImportTerminology' {} MergeStrategy
a -> ImportTerminology
s {$sel:mergeStrategy:ImportTerminology' :: MergeStrategy
mergeStrategy = MergeStrategy
a} :: ImportTerminology)

-- | The terminology data for the custom terminology being imported.
importTerminology_terminologyData :: Lens.Lens' ImportTerminology TerminologyData
importTerminology_terminologyData :: Lens' ImportTerminology TerminologyData
importTerminology_terminologyData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminology' {TerminologyData
terminologyData :: TerminologyData
$sel:terminologyData:ImportTerminology' :: ImportTerminology -> TerminologyData
terminologyData} -> TerminologyData
terminologyData) (\s :: ImportTerminology
s@ImportTerminology' {} TerminologyData
a -> ImportTerminology
s {$sel:terminologyData:ImportTerminology' :: TerminologyData
terminologyData = TerminologyData
a} :: ImportTerminology)

instance Core.AWSRequest ImportTerminology where
  type
    AWSResponse ImportTerminology =
      ImportTerminologyResponse
  request :: (Service -> Service)
-> ImportTerminology -> Request ImportTerminology
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 ImportTerminology
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportTerminology)))
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 TerminologyDataLocation
-> Maybe TerminologyProperties -> Int -> ImportTerminologyResponse
ImportTerminologyResponse'
            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
"AuxiliaryDataLocation")
            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
"TerminologyProperties")
            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 ImportTerminology where
  hashWithSalt :: Int -> ImportTerminology -> Int
hashWithSalt Int
_salt ImportTerminology' {Maybe [Tag]
Maybe Text
Maybe EncryptionKey
Text
MergeStrategy
TerminologyData
terminologyData :: TerminologyData
mergeStrategy :: MergeStrategy
name :: Text
tags :: Maybe [Tag]
encryptionKey :: Maybe EncryptionKey
description :: Maybe Text
$sel:terminologyData:ImportTerminology' :: ImportTerminology -> TerminologyData
$sel:mergeStrategy:ImportTerminology' :: ImportTerminology -> MergeStrategy
$sel:name:ImportTerminology' :: ImportTerminology -> Text
$sel:tags:ImportTerminology' :: ImportTerminology -> Maybe [Tag]
$sel:encryptionKey:ImportTerminology' :: ImportTerminology -> Maybe EncryptionKey
$sel:description:ImportTerminology' :: ImportTerminology -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionKey
encryptionKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MergeStrategy
mergeStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TerminologyData
terminologyData

instance Prelude.NFData ImportTerminology where
  rnf :: ImportTerminology -> ()
rnf ImportTerminology' {Maybe [Tag]
Maybe Text
Maybe EncryptionKey
Text
MergeStrategy
TerminologyData
terminologyData :: TerminologyData
mergeStrategy :: MergeStrategy
name :: Text
tags :: Maybe [Tag]
encryptionKey :: Maybe EncryptionKey
description :: Maybe Text
$sel:terminologyData:ImportTerminology' :: ImportTerminology -> TerminologyData
$sel:mergeStrategy:ImportTerminology' :: ImportTerminology -> MergeStrategy
$sel:name:ImportTerminology' :: ImportTerminology -> Text
$sel:tags:ImportTerminology' :: ImportTerminology -> Maybe [Tag]
$sel:encryptionKey:ImportTerminology' :: ImportTerminology -> Maybe EncryptionKey
$sel:description:ImportTerminology' :: ImportTerminology -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionKey
encryptionKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MergeStrategy
mergeStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TerminologyData
terminologyData

instance Data.ToHeaders ImportTerminology where
  toHeaders :: ImportTerminology -> 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
"AWSShineFrontendService_20170701.ImportTerminology" ::
                          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 ImportTerminology where
  toJSON :: ImportTerminology -> Value
toJSON ImportTerminology' {Maybe [Tag]
Maybe Text
Maybe EncryptionKey
Text
MergeStrategy
TerminologyData
terminologyData :: TerminologyData
mergeStrategy :: MergeStrategy
name :: Text
tags :: Maybe [Tag]
encryptionKey :: Maybe EncryptionKey
description :: Maybe Text
$sel:terminologyData:ImportTerminology' :: ImportTerminology -> TerminologyData
$sel:mergeStrategy:ImportTerminology' :: ImportTerminology -> MergeStrategy
$sel:name:ImportTerminology' :: ImportTerminology -> Text
$sel:tags:ImportTerminology' :: ImportTerminology -> Maybe [Tag]
$sel:encryptionKey:ImportTerminology' :: ImportTerminology -> Maybe EncryptionKey
$sel:description:ImportTerminology' :: ImportTerminology -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"EncryptionKey" 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 EncryptionKey
encryptionKey,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"MergeStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MergeStrategy
mergeStrategy),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TerminologyData" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TerminologyData
terminologyData)
          ]
      )

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

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

-- | /See:/ 'newImportTerminologyResponse' smart constructor.
data ImportTerminologyResponse = ImportTerminologyResponse'
  { -- | The Amazon S3 location of a file that provides any errors or warnings
    -- that were produced by your input file. This file was created when Amazon
    -- Translate attempted to create a terminology resource. The location is
    -- returned as a presigned URL to that has a 30 minute expiration.
    ImportTerminologyResponse -> Maybe TerminologyDataLocation
auxiliaryDataLocation :: Prelude.Maybe TerminologyDataLocation,
    -- | The properties of the custom terminology being imported.
    ImportTerminologyResponse -> Maybe TerminologyProperties
terminologyProperties :: Prelude.Maybe TerminologyProperties,
    -- | The response's http status code.
    ImportTerminologyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ImportTerminologyResponse -> ImportTerminologyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportTerminologyResponse -> ImportTerminologyResponse -> Bool
$c/= :: ImportTerminologyResponse -> ImportTerminologyResponse -> Bool
== :: ImportTerminologyResponse -> ImportTerminologyResponse -> Bool
$c== :: ImportTerminologyResponse -> ImportTerminologyResponse -> Bool
Prelude.Eq, ReadPrec [ImportTerminologyResponse]
ReadPrec ImportTerminologyResponse
Int -> ReadS ImportTerminologyResponse
ReadS [ImportTerminologyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportTerminologyResponse]
$creadListPrec :: ReadPrec [ImportTerminologyResponse]
readPrec :: ReadPrec ImportTerminologyResponse
$creadPrec :: ReadPrec ImportTerminologyResponse
readList :: ReadS [ImportTerminologyResponse]
$creadList :: ReadS [ImportTerminologyResponse]
readsPrec :: Int -> ReadS ImportTerminologyResponse
$creadsPrec :: Int -> ReadS ImportTerminologyResponse
Prelude.Read, Int -> ImportTerminologyResponse -> ShowS
[ImportTerminologyResponse] -> ShowS
ImportTerminologyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportTerminologyResponse] -> ShowS
$cshowList :: [ImportTerminologyResponse] -> ShowS
show :: ImportTerminologyResponse -> String
$cshow :: ImportTerminologyResponse -> String
showsPrec :: Int -> ImportTerminologyResponse -> ShowS
$cshowsPrec :: Int -> ImportTerminologyResponse -> ShowS
Prelude.Show, forall x.
Rep ImportTerminologyResponse x -> ImportTerminologyResponse
forall x.
ImportTerminologyResponse -> Rep ImportTerminologyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ImportTerminologyResponse x -> ImportTerminologyResponse
$cfrom :: forall x.
ImportTerminologyResponse -> Rep ImportTerminologyResponse x
Prelude.Generic)

-- |
-- Create a value of 'ImportTerminologyResponse' 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:
--
-- 'auxiliaryDataLocation', 'importTerminologyResponse_auxiliaryDataLocation' - The Amazon S3 location of a file that provides any errors or warnings
-- that were produced by your input file. This file was created when Amazon
-- Translate attempted to create a terminology resource. The location is
-- returned as a presigned URL to that has a 30 minute expiration.
--
-- 'terminologyProperties', 'importTerminologyResponse_terminologyProperties' - The properties of the custom terminology being imported.
--
-- 'httpStatus', 'importTerminologyResponse_httpStatus' - The response's http status code.
newImportTerminologyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportTerminologyResponse
newImportTerminologyResponse :: Int -> ImportTerminologyResponse
newImportTerminologyResponse Int
pHttpStatus_ =
  ImportTerminologyResponse'
    { $sel:auxiliaryDataLocation:ImportTerminologyResponse' :: Maybe TerminologyDataLocation
auxiliaryDataLocation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:terminologyProperties:ImportTerminologyResponse' :: Maybe TerminologyProperties
terminologyProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportTerminologyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon S3 location of a file that provides any errors or warnings
-- that were produced by your input file. This file was created when Amazon
-- Translate attempted to create a terminology resource. The location is
-- returned as a presigned URL to that has a 30 minute expiration.
importTerminologyResponse_auxiliaryDataLocation :: Lens.Lens' ImportTerminologyResponse (Prelude.Maybe TerminologyDataLocation)
importTerminologyResponse_auxiliaryDataLocation :: Lens' ImportTerminologyResponse (Maybe TerminologyDataLocation)
importTerminologyResponse_auxiliaryDataLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminologyResponse' {Maybe TerminologyDataLocation
auxiliaryDataLocation :: Maybe TerminologyDataLocation
$sel:auxiliaryDataLocation:ImportTerminologyResponse' :: ImportTerminologyResponse -> Maybe TerminologyDataLocation
auxiliaryDataLocation} -> Maybe TerminologyDataLocation
auxiliaryDataLocation) (\s :: ImportTerminologyResponse
s@ImportTerminologyResponse' {} Maybe TerminologyDataLocation
a -> ImportTerminologyResponse
s {$sel:auxiliaryDataLocation:ImportTerminologyResponse' :: Maybe TerminologyDataLocation
auxiliaryDataLocation = Maybe TerminologyDataLocation
a} :: ImportTerminologyResponse)

-- | The properties of the custom terminology being imported.
importTerminologyResponse_terminologyProperties :: Lens.Lens' ImportTerminologyResponse (Prelude.Maybe TerminologyProperties)
importTerminologyResponse_terminologyProperties :: Lens' ImportTerminologyResponse (Maybe TerminologyProperties)
importTerminologyResponse_terminologyProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportTerminologyResponse' {Maybe TerminologyProperties
terminologyProperties :: Maybe TerminologyProperties
$sel:terminologyProperties:ImportTerminologyResponse' :: ImportTerminologyResponse -> Maybe TerminologyProperties
terminologyProperties} -> Maybe TerminologyProperties
terminologyProperties) (\s :: ImportTerminologyResponse
s@ImportTerminologyResponse' {} Maybe TerminologyProperties
a -> ImportTerminologyResponse
s {$sel:terminologyProperties:ImportTerminologyResponse' :: Maybe TerminologyProperties
terminologyProperties = Maybe TerminologyProperties
a} :: ImportTerminologyResponse)

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

instance Prelude.NFData ImportTerminologyResponse where
  rnf :: ImportTerminologyResponse -> ()
rnf ImportTerminologyResponse' {Int
Maybe TerminologyDataLocation
Maybe TerminologyProperties
httpStatus :: Int
terminologyProperties :: Maybe TerminologyProperties
auxiliaryDataLocation :: Maybe TerminologyDataLocation
$sel:httpStatus:ImportTerminologyResponse' :: ImportTerminologyResponse -> Int
$sel:terminologyProperties:ImportTerminologyResponse' :: ImportTerminologyResponse -> Maybe TerminologyProperties
$sel:auxiliaryDataLocation:ImportTerminologyResponse' :: ImportTerminologyResponse -> Maybe TerminologyDataLocation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TerminologyDataLocation
auxiliaryDataLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TerminologyProperties
terminologyProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus