{-# 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.GetTerminology
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a custom terminology.
module Amazonka.Translate.GetTerminology
  ( -- * Creating a Request
    GetTerminology (..),
    newGetTerminology,

    -- * Request Lenses
    getTerminology_terminologyDataFormat,
    getTerminology_name,

    -- * Destructuring the Response
    GetTerminologyResponse (..),
    newGetTerminologyResponse,

    -- * Response Lenses
    getTerminologyResponse_auxiliaryDataLocation,
    getTerminologyResponse_terminologyDataLocation,
    getTerminologyResponse_terminologyProperties,
    getTerminologyResponse_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:/ 'newGetTerminology' smart constructor.
data GetTerminology = GetTerminology'
  { -- | The data format of the custom terminology being retrieved.
    --
    -- If you don\'t specify this parameter, Amazon Translate returns a file
    -- with the same format as the file that was imported to create the
    -- terminology.
    --
    -- If you specify this parameter when you retrieve a multi-directional
    -- terminology resource, you must specify the same format as the input file
    -- that was imported to create it. Otherwise, Amazon Translate throws an
    -- error.
    GetTerminology -> Maybe TerminologyDataFormat
terminologyDataFormat :: Prelude.Maybe TerminologyDataFormat,
    -- | The name of the custom terminology being retrieved.
    GetTerminology -> Text
name :: Prelude.Text
  }
  deriving (GetTerminology -> GetTerminology -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTerminology -> GetTerminology -> Bool
$c/= :: GetTerminology -> GetTerminology -> Bool
== :: GetTerminology -> GetTerminology -> Bool
$c== :: GetTerminology -> GetTerminology -> Bool
Prelude.Eq, ReadPrec [GetTerminology]
ReadPrec GetTerminology
Int -> ReadS GetTerminology
ReadS [GetTerminology]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTerminology]
$creadListPrec :: ReadPrec [GetTerminology]
readPrec :: ReadPrec GetTerminology
$creadPrec :: ReadPrec GetTerminology
readList :: ReadS [GetTerminology]
$creadList :: ReadS [GetTerminology]
readsPrec :: Int -> ReadS GetTerminology
$creadsPrec :: Int -> ReadS GetTerminology
Prelude.Read, Int -> GetTerminology -> ShowS
[GetTerminology] -> ShowS
GetTerminology -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTerminology] -> ShowS
$cshowList :: [GetTerminology] -> ShowS
show :: GetTerminology -> String
$cshow :: GetTerminology -> String
showsPrec :: Int -> GetTerminology -> ShowS
$cshowsPrec :: Int -> GetTerminology -> ShowS
Prelude.Show, forall x. Rep GetTerminology x -> GetTerminology
forall x. GetTerminology -> Rep GetTerminology x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTerminology x -> GetTerminology
$cfrom :: forall x. GetTerminology -> Rep GetTerminology x
Prelude.Generic)

-- |
-- Create a value of 'GetTerminology' 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:
--
-- 'terminologyDataFormat', 'getTerminology_terminologyDataFormat' - The data format of the custom terminology being retrieved.
--
-- If you don\'t specify this parameter, Amazon Translate returns a file
-- with the same format as the file that was imported to create the
-- terminology.
--
-- If you specify this parameter when you retrieve a multi-directional
-- terminology resource, you must specify the same format as the input file
-- that was imported to create it. Otherwise, Amazon Translate throws an
-- error.
--
-- 'name', 'getTerminology_name' - The name of the custom terminology being retrieved.
newGetTerminology ::
  -- | 'name'
  Prelude.Text ->
  GetTerminology
newGetTerminology :: Text -> GetTerminology
newGetTerminology Text
pName_ =
  GetTerminology'
    { $sel:terminologyDataFormat:GetTerminology' :: Maybe TerminologyDataFormat
terminologyDataFormat =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetTerminology' :: Text
name = Text
pName_
    }

-- | The data format of the custom terminology being retrieved.
--
-- If you don\'t specify this parameter, Amazon Translate returns a file
-- with the same format as the file that was imported to create the
-- terminology.
--
-- If you specify this parameter when you retrieve a multi-directional
-- terminology resource, you must specify the same format as the input file
-- that was imported to create it. Otherwise, Amazon Translate throws an
-- error.
getTerminology_terminologyDataFormat :: Lens.Lens' GetTerminology (Prelude.Maybe TerminologyDataFormat)
getTerminology_terminologyDataFormat :: Lens' GetTerminology (Maybe TerminologyDataFormat)
getTerminology_terminologyDataFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTerminology' {Maybe TerminologyDataFormat
terminologyDataFormat :: Maybe TerminologyDataFormat
$sel:terminologyDataFormat:GetTerminology' :: GetTerminology -> Maybe TerminologyDataFormat
terminologyDataFormat} -> Maybe TerminologyDataFormat
terminologyDataFormat) (\s :: GetTerminology
s@GetTerminology' {} Maybe TerminologyDataFormat
a -> GetTerminology
s {$sel:terminologyDataFormat:GetTerminology' :: Maybe TerminologyDataFormat
terminologyDataFormat = Maybe TerminologyDataFormat
a} :: GetTerminology)

-- | The name of the custom terminology being retrieved.
getTerminology_name :: Lens.Lens' GetTerminology Prelude.Text
getTerminology_name :: Lens' GetTerminology Text
getTerminology_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTerminology' {Text
name :: Text
$sel:name:GetTerminology' :: GetTerminology -> Text
name} -> Text
name) (\s :: GetTerminology
s@GetTerminology' {} Text
a -> GetTerminology
s {$sel:name:GetTerminology' :: Text
name = Text
a} :: GetTerminology)

instance Core.AWSRequest GetTerminology where
  type
    AWSResponse GetTerminology =
      GetTerminologyResponse
  request :: (Service -> Service) -> GetTerminology -> Request GetTerminology
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 GetTerminology
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTerminology)))
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 TerminologyDataLocation
-> Maybe TerminologyProperties
-> Int
-> GetTerminologyResponse
GetTerminologyResponse'
            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
"TerminologyDataLocation")
            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 GetTerminology where
  hashWithSalt :: Int -> GetTerminology -> Int
hashWithSalt Int
_salt GetTerminology' {Maybe TerminologyDataFormat
Text
name :: Text
terminologyDataFormat :: Maybe TerminologyDataFormat
$sel:name:GetTerminology' :: GetTerminology -> Text
$sel:terminologyDataFormat:GetTerminology' :: GetTerminology -> Maybe TerminologyDataFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TerminologyDataFormat
terminologyDataFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetTerminology where
  rnf :: GetTerminology -> ()
rnf GetTerminology' {Maybe TerminologyDataFormat
Text
name :: Text
terminologyDataFormat :: Maybe TerminologyDataFormat
$sel:name:GetTerminology' :: GetTerminology -> Text
$sel:terminologyDataFormat:GetTerminology' :: GetTerminology -> Maybe TerminologyDataFormat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TerminologyDataFormat
terminologyDataFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

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

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

-- | /See:/ 'newGetTerminologyResponse' smart constructor.
data GetTerminologyResponse = GetTerminologyResponse'
  { -- | 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.
    GetTerminologyResponse -> Maybe TerminologyDataLocation
auxiliaryDataLocation :: Prelude.Maybe TerminologyDataLocation,
    -- | The Amazon S3 location of the most recent custom terminology input file
    -- that was successfully imported into Amazon Translate. The location is
    -- returned as a presigned URL that has a 30-minute expiration.
    --
    -- Amazon Translate doesn\'t scan all input files for the risk of CSV
    -- injection attacks.
    --
    -- CSV injection occurs when a .csv or .tsv file is altered so that a
    -- record contains malicious code. The record begins with a special
    -- character, such as =, +, -, or \@. When the file is opened in a
    -- spreadsheet program, the program might interpret the record as a formula
    -- and run the code within it.
    --
    -- Before you download an input file from Amazon S3, ensure that you
    -- recognize the file and trust its creator.
    GetTerminologyResponse -> Maybe TerminologyDataLocation
terminologyDataLocation :: Prelude.Maybe TerminologyDataLocation,
    -- | The properties of the custom terminology being retrieved.
    GetTerminologyResponse -> Maybe TerminologyProperties
terminologyProperties :: Prelude.Maybe TerminologyProperties,
    -- | The response's http status code.
    GetTerminologyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTerminologyResponse -> GetTerminologyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTerminologyResponse -> GetTerminologyResponse -> Bool
$c/= :: GetTerminologyResponse -> GetTerminologyResponse -> Bool
== :: GetTerminologyResponse -> GetTerminologyResponse -> Bool
$c== :: GetTerminologyResponse -> GetTerminologyResponse -> Bool
Prelude.Eq, ReadPrec [GetTerminologyResponse]
ReadPrec GetTerminologyResponse
Int -> ReadS GetTerminologyResponse
ReadS [GetTerminologyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTerminologyResponse]
$creadListPrec :: ReadPrec [GetTerminologyResponse]
readPrec :: ReadPrec GetTerminologyResponse
$creadPrec :: ReadPrec GetTerminologyResponse
readList :: ReadS [GetTerminologyResponse]
$creadList :: ReadS [GetTerminologyResponse]
readsPrec :: Int -> ReadS GetTerminologyResponse
$creadsPrec :: Int -> ReadS GetTerminologyResponse
Prelude.Read, Int -> GetTerminologyResponse -> ShowS
[GetTerminologyResponse] -> ShowS
GetTerminologyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTerminologyResponse] -> ShowS
$cshowList :: [GetTerminologyResponse] -> ShowS
show :: GetTerminologyResponse -> String
$cshow :: GetTerminologyResponse -> String
showsPrec :: Int -> GetTerminologyResponse -> ShowS
$cshowsPrec :: Int -> GetTerminologyResponse -> ShowS
Prelude.Show, forall x. Rep GetTerminologyResponse x -> GetTerminologyResponse
forall x. GetTerminologyResponse -> Rep GetTerminologyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTerminologyResponse x -> GetTerminologyResponse
$cfrom :: forall x. GetTerminologyResponse -> Rep GetTerminologyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTerminologyResponse' 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', 'getTerminologyResponse_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.
--
-- 'terminologyDataLocation', 'getTerminologyResponse_terminologyDataLocation' - The Amazon S3 location of the most recent custom terminology input file
-- that was successfully imported into Amazon Translate. The location is
-- returned as a presigned URL that has a 30-minute expiration.
--
-- Amazon Translate doesn\'t scan all input files for the risk of CSV
-- injection attacks.
--
-- CSV injection occurs when a .csv or .tsv file is altered so that a
-- record contains malicious code. The record begins with a special
-- character, such as =, +, -, or \@. When the file is opened in a
-- spreadsheet program, the program might interpret the record as a formula
-- and run the code within it.
--
-- Before you download an input file from Amazon S3, ensure that you
-- recognize the file and trust its creator.
--
-- 'terminologyProperties', 'getTerminologyResponse_terminologyProperties' - The properties of the custom terminology being retrieved.
--
-- 'httpStatus', 'getTerminologyResponse_httpStatus' - The response's http status code.
newGetTerminologyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTerminologyResponse
newGetTerminologyResponse :: Int -> GetTerminologyResponse
newGetTerminologyResponse Int
pHttpStatus_ =
  GetTerminologyResponse'
    { $sel:auxiliaryDataLocation:GetTerminologyResponse' :: Maybe TerminologyDataLocation
auxiliaryDataLocation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:terminologyDataLocation:GetTerminologyResponse' :: Maybe TerminologyDataLocation
terminologyDataLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:terminologyProperties:GetTerminologyResponse' :: Maybe TerminologyProperties
terminologyProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTerminologyResponse' :: 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.
getTerminologyResponse_auxiliaryDataLocation :: Lens.Lens' GetTerminologyResponse (Prelude.Maybe TerminologyDataLocation)
getTerminologyResponse_auxiliaryDataLocation :: Lens' GetTerminologyResponse (Maybe TerminologyDataLocation)
getTerminologyResponse_auxiliaryDataLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTerminologyResponse' {Maybe TerminologyDataLocation
auxiliaryDataLocation :: Maybe TerminologyDataLocation
$sel:auxiliaryDataLocation:GetTerminologyResponse' :: GetTerminologyResponse -> Maybe TerminologyDataLocation
auxiliaryDataLocation} -> Maybe TerminologyDataLocation
auxiliaryDataLocation) (\s :: GetTerminologyResponse
s@GetTerminologyResponse' {} Maybe TerminologyDataLocation
a -> GetTerminologyResponse
s {$sel:auxiliaryDataLocation:GetTerminologyResponse' :: Maybe TerminologyDataLocation
auxiliaryDataLocation = Maybe TerminologyDataLocation
a} :: GetTerminologyResponse)

-- | The Amazon S3 location of the most recent custom terminology input file
-- that was successfully imported into Amazon Translate. The location is
-- returned as a presigned URL that has a 30-minute expiration.
--
-- Amazon Translate doesn\'t scan all input files for the risk of CSV
-- injection attacks.
--
-- CSV injection occurs when a .csv or .tsv file is altered so that a
-- record contains malicious code. The record begins with a special
-- character, such as =, +, -, or \@. When the file is opened in a
-- spreadsheet program, the program might interpret the record as a formula
-- and run the code within it.
--
-- Before you download an input file from Amazon S3, ensure that you
-- recognize the file and trust its creator.
getTerminologyResponse_terminologyDataLocation :: Lens.Lens' GetTerminologyResponse (Prelude.Maybe TerminologyDataLocation)
getTerminologyResponse_terminologyDataLocation :: Lens' GetTerminologyResponse (Maybe TerminologyDataLocation)
getTerminologyResponse_terminologyDataLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTerminologyResponse' {Maybe TerminologyDataLocation
terminologyDataLocation :: Maybe TerminologyDataLocation
$sel:terminologyDataLocation:GetTerminologyResponse' :: GetTerminologyResponse -> Maybe TerminologyDataLocation
terminologyDataLocation} -> Maybe TerminologyDataLocation
terminologyDataLocation) (\s :: GetTerminologyResponse
s@GetTerminologyResponse' {} Maybe TerminologyDataLocation
a -> GetTerminologyResponse
s {$sel:terminologyDataLocation:GetTerminologyResponse' :: Maybe TerminologyDataLocation
terminologyDataLocation = Maybe TerminologyDataLocation
a} :: GetTerminologyResponse)

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

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

instance Prelude.NFData GetTerminologyResponse where
  rnf :: GetTerminologyResponse -> ()
rnf GetTerminologyResponse' {Int
Maybe TerminologyDataLocation
Maybe TerminologyProperties
httpStatus :: Int
terminologyProperties :: Maybe TerminologyProperties
terminologyDataLocation :: Maybe TerminologyDataLocation
auxiliaryDataLocation :: Maybe TerminologyDataLocation
$sel:httpStatus:GetTerminologyResponse' :: GetTerminologyResponse -> Int
$sel:terminologyProperties:GetTerminologyResponse' :: GetTerminologyResponse -> Maybe TerminologyProperties
$sel:terminologyDataLocation:GetTerminologyResponse' :: GetTerminologyResponse -> Maybe TerminologyDataLocation
$sel:auxiliaryDataLocation:GetTerminologyResponse' :: GetTerminologyResponse -> 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 TerminologyDataLocation
terminologyDataLocation
      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