{-# 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.Comprehend.CreateDocumentClassifier
-- 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 a new document classifier that you can use to categorize
-- documents. To create a classifier, you provide a set of training
-- documents that labeled with the categories that you want to use. After
-- the classifier is trained you can use it to categorize a set of labeled
-- documents into the categories. For more information, see
-- <https://docs.aws.amazon.com/comprehend/latest/dg/how-document-classification.html Document Classification>
-- in the Comprehend Developer Guide.
module Amazonka.Comprehend.CreateDocumentClassifier
  ( -- * Creating a Request
    CreateDocumentClassifier (..),
    newCreateDocumentClassifier,

    -- * Request Lenses
    createDocumentClassifier_clientRequestToken,
    createDocumentClassifier_mode,
    createDocumentClassifier_modelKmsKeyId,
    createDocumentClassifier_modelPolicy,
    createDocumentClassifier_outputDataConfig,
    createDocumentClassifier_tags,
    createDocumentClassifier_versionName,
    createDocumentClassifier_volumeKmsKeyId,
    createDocumentClassifier_vpcConfig,
    createDocumentClassifier_documentClassifierName,
    createDocumentClassifier_dataAccessRoleArn,
    createDocumentClassifier_inputDataConfig,
    createDocumentClassifier_languageCode,

    -- * Destructuring the Response
    CreateDocumentClassifierResponse (..),
    newCreateDocumentClassifierResponse,

    -- * Response Lenses
    createDocumentClassifierResponse_documentClassifierArn,
    createDocumentClassifierResponse_httpStatus,
  )
where

import Amazonka.Comprehend.Types
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

-- | /See:/ 'newCreateDocumentClassifier' smart constructor.
data CreateDocumentClassifier = CreateDocumentClassifier'
  { -- | A unique identifier for the request. If you don\'t set the client
    -- request token, Amazon Comprehend generates one.
    CreateDocumentClassifier -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates the mode in which the classifier will be trained. The
    -- classifier can be trained in multi-class mode, which identifies one and
    -- only one class for each document, or multi-label mode, which identifies
    -- one or more labels for each document. In multi-label mode, multiple
    -- labels for an individual document are separated by a delimiter. The
    -- default delimiter between labels is a pipe (|).
    CreateDocumentClassifier -> Maybe DocumentClassifierMode
mode :: Prelude.Maybe DocumentClassifierMode,
    -- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
    -- uses to encrypt trained custom models. The ModelKmsKeyId can be either
    -- of the following formats:
    --
    -- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
    --
    -- -   Amazon Resource Name (ARN) of a KMS Key:
    --     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
    CreateDocumentClassifier -> Maybe Text
modelKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The resource-based policy to attach to your custom document classifier
    -- model. You can use this policy to allow another AWS account to import
    -- your custom model.
    --
    -- Provide your policy as a JSON body that you enter as a UTF-8 encoded
    -- string without line breaks. To provide valid JSON, enclose the attribute
    -- names and values in double quotes. If the JSON body is also enclosed in
    -- double quotes, then you must escape the double quotes that are inside
    -- the policy:
    --
    -- @\"{\\\"attribute\\\": \\\"value\\\", \\\"attribute\\\": [\\\"value\\\"]}\"@
    --
    -- To avoid escaping quotes, you can use single quotes to enclose the
    -- policy and double quotes to enclose the JSON names and values:
    --
    -- @\'{\"attribute\": \"value\", \"attribute\": [\"value\"]}\'@
    CreateDocumentClassifier -> Maybe Text
modelPolicy :: Prelude.Maybe Prelude.Text,
    -- | Enables the addition of output results configuration parameters for
    -- custom classifier jobs.
    CreateDocumentClassifier
-> Maybe DocumentClassifierOutputDataConfig
outputDataConfig :: Prelude.Maybe DocumentClassifierOutputDataConfig,
    -- | Tags to be associated with the document classifier being created. A tag
    -- is a key-value pair that adds as a metadata to a resource used by Amazon
    -- Comprehend. For example, a tag with \"Sales\" as the key might be added
    -- to a resource to indicate its use by the sales department.
    CreateDocumentClassifier -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The version name given to the newly created classifier. Version names
    -- can have a maximum of 256 characters. Alphanumeric characters, hyphens
    -- (-) and underscores (_) are allowed. The version name must be unique
    -- among all models with the same classifier name in the account\/AWS
    -- Region.
    CreateDocumentClassifier -> Maybe Text
versionName :: Prelude.Maybe Prelude.Text,
    -- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
    -- uses to encrypt data on the storage volume attached to the ML compute
    -- instance(s) that process the analysis job. The VolumeKmsKeyId can be
    -- either of the following formats:
    --
    -- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
    --
    -- -   Amazon Resource Name (ARN) of a KMS Key:
    --     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
    CreateDocumentClassifier -> Maybe Text
volumeKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Configuration parameters for an optional private Virtual Private Cloud
    -- (VPC) containing the resources you are using for your custom classifier.
    -- For more information, see
    -- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
    CreateDocumentClassifier -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig,
    -- | The name of the document classifier.
    CreateDocumentClassifier -> Text
documentClassifierName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
    -- role that grants Amazon Comprehend read access to your input data.
    CreateDocumentClassifier -> Text
dataAccessRoleArn :: Prelude.Text,
    -- | Specifies the format and location of the input data for the job.
    CreateDocumentClassifier -> DocumentClassifierInputDataConfig
inputDataConfig :: DocumentClassifierInputDataConfig,
    -- | The language of the input documents. You can specify any of the
    -- following languages supported by Amazon Comprehend: German (\"de\"),
    -- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
    -- or Portuguese (\"pt\"). All documents must be in the same language.
    CreateDocumentClassifier -> LanguageCode
languageCode :: LanguageCode
  }
  deriving (CreateDocumentClassifier -> CreateDocumentClassifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDocumentClassifier -> CreateDocumentClassifier -> Bool
$c/= :: CreateDocumentClassifier -> CreateDocumentClassifier -> Bool
== :: CreateDocumentClassifier -> CreateDocumentClassifier -> Bool
$c== :: CreateDocumentClassifier -> CreateDocumentClassifier -> Bool
Prelude.Eq, ReadPrec [CreateDocumentClassifier]
ReadPrec CreateDocumentClassifier
Int -> ReadS CreateDocumentClassifier
ReadS [CreateDocumentClassifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDocumentClassifier]
$creadListPrec :: ReadPrec [CreateDocumentClassifier]
readPrec :: ReadPrec CreateDocumentClassifier
$creadPrec :: ReadPrec CreateDocumentClassifier
readList :: ReadS [CreateDocumentClassifier]
$creadList :: ReadS [CreateDocumentClassifier]
readsPrec :: Int -> ReadS CreateDocumentClassifier
$creadsPrec :: Int -> ReadS CreateDocumentClassifier
Prelude.Read, Int -> CreateDocumentClassifier -> ShowS
[CreateDocumentClassifier] -> ShowS
CreateDocumentClassifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDocumentClassifier] -> ShowS
$cshowList :: [CreateDocumentClassifier] -> ShowS
show :: CreateDocumentClassifier -> String
$cshow :: CreateDocumentClassifier -> String
showsPrec :: Int -> CreateDocumentClassifier -> ShowS
$cshowsPrec :: Int -> CreateDocumentClassifier -> ShowS
Prelude.Show, forall x.
Rep CreateDocumentClassifier x -> CreateDocumentClassifier
forall x.
CreateDocumentClassifier -> Rep CreateDocumentClassifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDocumentClassifier x -> CreateDocumentClassifier
$cfrom :: forall x.
CreateDocumentClassifier -> Rep CreateDocumentClassifier x
Prelude.Generic)

-- |
-- Create a value of 'CreateDocumentClassifier' 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:
--
-- 'clientRequestToken', 'createDocumentClassifier_clientRequestToken' - A unique identifier for the request. If you don\'t set the client
-- request token, Amazon Comprehend generates one.
--
-- 'mode', 'createDocumentClassifier_mode' - Indicates the mode in which the classifier will be trained. The
-- classifier can be trained in multi-class mode, which identifies one and
-- only one class for each document, or multi-label mode, which identifies
-- one or more labels for each document. In multi-label mode, multiple
-- labels for an individual document are separated by a delimiter. The
-- default delimiter between labels is a pipe (|).
--
-- 'modelKmsKeyId', 'createDocumentClassifier_modelKmsKeyId' - ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt trained custom models. The ModelKmsKeyId can be either
-- of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- 'modelPolicy', 'createDocumentClassifier_modelPolicy' - The resource-based policy to attach to your custom document classifier
-- model. You can use this policy to allow another AWS account to import
-- your custom model.
--
-- Provide your policy as a JSON body that you enter as a UTF-8 encoded
-- string without line breaks. To provide valid JSON, enclose the attribute
-- names and values in double quotes. If the JSON body is also enclosed in
-- double quotes, then you must escape the double quotes that are inside
-- the policy:
--
-- @\"{\\\"attribute\\\": \\\"value\\\", \\\"attribute\\\": [\\\"value\\\"]}\"@
--
-- To avoid escaping quotes, you can use single quotes to enclose the
-- policy and double quotes to enclose the JSON names and values:
--
-- @\'{\"attribute\": \"value\", \"attribute\": [\"value\"]}\'@
--
-- 'outputDataConfig', 'createDocumentClassifier_outputDataConfig' - Enables the addition of output results configuration parameters for
-- custom classifier jobs.
--
-- 'tags', 'createDocumentClassifier_tags' - Tags to be associated with the document classifier being created. A tag
-- is a key-value pair that adds as a metadata to a resource used by Amazon
-- Comprehend. For example, a tag with \"Sales\" as the key might be added
-- to a resource to indicate its use by the sales department.
--
-- 'versionName', 'createDocumentClassifier_versionName' - The version name given to the newly created classifier. Version names
-- can have a maximum of 256 characters. Alphanumeric characters, hyphens
-- (-) and underscores (_) are allowed. The version name must be unique
-- among all models with the same classifier name in the account\/AWS
-- Region.
--
-- 'volumeKmsKeyId', 'createDocumentClassifier_volumeKmsKeyId' - ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt data on the storage volume attached to the ML compute
-- instance(s) that process the analysis job. The VolumeKmsKeyId can be
-- either of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- 'vpcConfig', 'createDocumentClassifier_vpcConfig' - Configuration parameters for an optional private Virtual Private Cloud
-- (VPC) containing the resources you are using for your custom classifier.
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
--
-- 'documentClassifierName', 'createDocumentClassifier_documentClassifierName' - The name of the document classifier.
--
-- 'dataAccessRoleArn', 'createDocumentClassifier_dataAccessRoleArn' - The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
-- role that grants Amazon Comprehend read access to your input data.
--
-- 'inputDataConfig', 'createDocumentClassifier_inputDataConfig' - Specifies the format and location of the input data for the job.
--
-- 'languageCode', 'createDocumentClassifier_languageCode' - The language of the input documents. You can specify any of the
-- following languages supported by Amazon Comprehend: German (\"de\"),
-- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
-- or Portuguese (\"pt\"). All documents must be in the same language.
newCreateDocumentClassifier ::
  -- | 'documentClassifierName'
  Prelude.Text ->
  -- | 'dataAccessRoleArn'
  Prelude.Text ->
  -- | 'inputDataConfig'
  DocumentClassifierInputDataConfig ->
  -- | 'languageCode'
  LanguageCode ->
  CreateDocumentClassifier
newCreateDocumentClassifier :: Text
-> Text
-> DocumentClassifierInputDataConfig
-> LanguageCode
-> CreateDocumentClassifier
newCreateDocumentClassifier
  Text
pDocumentClassifierName_
  Text
pDataAccessRoleArn_
  DocumentClassifierInputDataConfig
pInputDataConfig_
  LanguageCode
pLanguageCode_ =
    CreateDocumentClassifier'
      { $sel:clientRequestToken:CreateDocumentClassifier' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:mode:CreateDocumentClassifier' :: Maybe DocumentClassifierMode
mode = forall a. Maybe a
Prelude.Nothing,
        $sel:modelKmsKeyId:CreateDocumentClassifier' :: Maybe Text
modelKmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:modelPolicy:CreateDocumentClassifier' :: Maybe Text
modelPolicy = forall a. Maybe a
Prelude.Nothing,
        $sel:outputDataConfig:CreateDocumentClassifier' :: Maybe DocumentClassifierOutputDataConfig
outputDataConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDocumentClassifier' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:versionName:CreateDocumentClassifier' :: Maybe Text
versionName = forall a. Maybe a
Prelude.Nothing,
        $sel:volumeKmsKeyId:CreateDocumentClassifier' :: Maybe Text
volumeKmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfig:CreateDocumentClassifier' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:documentClassifierName:CreateDocumentClassifier' :: Text
documentClassifierName = Text
pDocumentClassifierName_,
        $sel:dataAccessRoleArn:CreateDocumentClassifier' :: Text
dataAccessRoleArn = Text
pDataAccessRoleArn_,
        $sel:inputDataConfig:CreateDocumentClassifier' :: DocumentClassifierInputDataConfig
inputDataConfig = DocumentClassifierInputDataConfig
pInputDataConfig_,
        $sel:languageCode:CreateDocumentClassifier' :: LanguageCode
languageCode = LanguageCode
pLanguageCode_
      }

-- | A unique identifier for the request. If you don\'t set the client
-- request token, Amazon Comprehend generates one.
createDocumentClassifier_clientRequestToken :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe Prelude.Text)
createDocumentClassifier_clientRequestToken :: Lens' CreateDocumentClassifier (Maybe Text)
createDocumentClassifier_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe Text
a -> CreateDocumentClassifier
s {$sel:clientRequestToken:CreateDocumentClassifier' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateDocumentClassifier)

-- | Indicates the mode in which the classifier will be trained. The
-- classifier can be trained in multi-class mode, which identifies one and
-- only one class for each document, or multi-label mode, which identifies
-- one or more labels for each document. In multi-label mode, multiple
-- labels for an individual document are separated by a delimiter. The
-- default delimiter between labels is a pipe (|).
createDocumentClassifier_mode :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe DocumentClassifierMode)
createDocumentClassifier_mode :: Lens' CreateDocumentClassifier (Maybe DocumentClassifierMode)
createDocumentClassifier_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe DocumentClassifierMode
mode :: Maybe DocumentClassifierMode
$sel:mode:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe DocumentClassifierMode
mode} -> Maybe DocumentClassifierMode
mode) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe DocumentClassifierMode
a -> CreateDocumentClassifier
s {$sel:mode:CreateDocumentClassifier' :: Maybe DocumentClassifierMode
mode = Maybe DocumentClassifierMode
a} :: CreateDocumentClassifier)

-- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt trained custom models. The ModelKmsKeyId can be either
-- of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
createDocumentClassifier_modelKmsKeyId :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe Prelude.Text)
createDocumentClassifier_modelKmsKeyId :: Lens' CreateDocumentClassifier (Maybe Text)
createDocumentClassifier_modelKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe Text
modelKmsKeyId :: Maybe Text
$sel:modelKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
modelKmsKeyId} -> Maybe Text
modelKmsKeyId) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe Text
a -> CreateDocumentClassifier
s {$sel:modelKmsKeyId:CreateDocumentClassifier' :: Maybe Text
modelKmsKeyId = Maybe Text
a} :: CreateDocumentClassifier)

-- | The resource-based policy to attach to your custom document classifier
-- model. You can use this policy to allow another AWS account to import
-- your custom model.
--
-- Provide your policy as a JSON body that you enter as a UTF-8 encoded
-- string without line breaks. To provide valid JSON, enclose the attribute
-- names and values in double quotes. If the JSON body is also enclosed in
-- double quotes, then you must escape the double quotes that are inside
-- the policy:
--
-- @\"{\\\"attribute\\\": \\\"value\\\", \\\"attribute\\\": [\\\"value\\\"]}\"@
--
-- To avoid escaping quotes, you can use single quotes to enclose the
-- policy and double quotes to enclose the JSON names and values:
--
-- @\'{\"attribute\": \"value\", \"attribute\": [\"value\"]}\'@
createDocumentClassifier_modelPolicy :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe Prelude.Text)
createDocumentClassifier_modelPolicy :: Lens' CreateDocumentClassifier (Maybe Text)
createDocumentClassifier_modelPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe Text
modelPolicy :: Maybe Text
$sel:modelPolicy:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
modelPolicy} -> Maybe Text
modelPolicy) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe Text
a -> CreateDocumentClassifier
s {$sel:modelPolicy:CreateDocumentClassifier' :: Maybe Text
modelPolicy = Maybe Text
a} :: CreateDocumentClassifier)

-- | Enables the addition of output results configuration parameters for
-- custom classifier jobs.
createDocumentClassifier_outputDataConfig :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe DocumentClassifierOutputDataConfig)
createDocumentClassifier_outputDataConfig :: Lens'
  CreateDocumentClassifier (Maybe DocumentClassifierOutputDataConfig)
createDocumentClassifier_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe DocumentClassifierOutputDataConfig
outputDataConfig :: Maybe DocumentClassifierOutputDataConfig
$sel:outputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier
-> Maybe DocumentClassifierOutputDataConfig
outputDataConfig} -> Maybe DocumentClassifierOutputDataConfig
outputDataConfig) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe DocumentClassifierOutputDataConfig
a -> CreateDocumentClassifier
s {$sel:outputDataConfig:CreateDocumentClassifier' :: Maybe DocumentClassifierOutputDataConfig
outputDataConfig = Maybe DocumentClassifierOutputDataConfig
a} :: CreateDocumentClassifier)

-- | Tags to be associated with the document classifier being created. A tag
-- is a key-value pair that adds as a metadata to a resource used by Amazon
-- Comprehend. For example, a tag with \"Sales\" as the key might be added
-- to a resource to indicate its use by the sales department.
createDocumentClassifier_tags :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe [Tag])
createDocumentClassifier_tags :: Lens' CreateDocumentClassifier (Maybe [Tag])
createDocumentClassifier_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe [Tag]
a -> CreateDocumentClassifier
s {$sel:tags:CreateDocumentClassifier' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDocumentClassifier) 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 version name given to the newly created classifier. Version names
-- can have a maximum of 256 characters. Alphanumeric characters, hyphens
-- (-) and underscores (_) are allowed. The version name must be unique
-- among all models with the same classifier name in the account\/AWS
-- Region.
createDocumentClassifier_versionName :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe Prelude.Text)
createDocumentClassifier_versionName :: Lens' CreateDocumentClassifier (Maybe Text)
createDocumentClassifier_versionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe Text
versionName :: Maybe Text
$sel:versionName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
versionName} -> Maybe Text
versionName) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe Text
a -> CreateDocumentClassifier
s {$sel:versionName:CreateDocumentClassifier' :: Maybe Text
versionName = Maybe Text
a} :: CreateDocumentClassifier)

-- | ID for the AWS Key Management Service (KMS) key that Amazon Comprehend
-- uses to encrypt data on the storage volume attached to the ML compute
-- instance(s) that process the analysis job. The VolumeKmsKeyId can be
-- either of the following formats:
--
-- -   KMS Key ID: @\"1234abcd-12ab-34cd-56ef-1234567890ab\"@
--
-- -   Amazon Resource Name (ARN) of a KMS Key:
--     @\"arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab\"@
createDocumentClassifier_volumeKmsKeyId :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe Prelude.Text)
createDocumentClassifier_volumeKmsKeyId :: Lens' CreateDocumentClassifier (Maybe Text)
createDocumentClassifier_volumeKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe Text
volumeKmsKeyId :: Maybe Text
$sel:volumeKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
volumeKmsKeyId} -> Maybe Text
volumeKmsKeyId) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe Text
a -> CreateDocumentClassifier
s {$sel:volumeKmsKeyId:CreateDocumentClassifier' :: Maybe Text
volumeKmsKeyId = Maybe Text
a} :: CreateDocumentClassifier)

-- | Configuration parameters for an optional private Virtual Private Cloud
-- (VPC) containing the resources you are using for your custom classifier.
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/what-is-amazon-vpc.html Amazon VPC>.
createDocumentClassifier_vpcConfig :: Lens.Lens' CreateDocumentClassifier (Prelude.Maybe VpcConfig)
createDocumentClassifier_vpcConfig :: Lens' CreateDocumentClassifier (Maybe VpcConfig)
createDocumentClassifier_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Maybe VpcConfig
a -> CreateDocumentClassifier
s {$sel:vpcConfig:CreateDocumentClassifier' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: CreateDocumentClassifier)

-- | The name of the document classifier.
createDocumentClassifier_documentClassifierName :: Lens.Lens' CreateDocumentClassifier Prelude.Text
createDocumentClassifier_documentClassifierName :: Lens' CreateDocumentClassifier Text
createDocumentClassifier_documentClassifierName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Text
documentClassifierName :: Text
$sel:documentClassifierName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
documentClassifierName} -> Text
documentClassifierName) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Text
a -> CreateDocumentClassifier
s {$sel:documentClassifierName:CreateDocumentClassifier' :: Text
documentClassifierName = Text
a} :: CreateDocumentClassifier)

-- | The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
-- role that grants Amazon Comprehend read access to your input data.
createDocumentClassifier_dataAccessRoleArn :: Lens.Lens' CreateDocumentClassifier Prelude.Text
createDocumentClassifier_dataAccessRoleArn :: Lens' CreateDocumentClassifier Text
createDocumentClassifier_dataAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {Text
dataAccessRoleArn :: Text
$sel:dataAccessRoleArn:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
dataAccessRoleArn} -> Text
dataAccessRoleArn) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} Text
a -> CreateDocumentClassifier
s {$sel:dataAccessRoleArn:CreateDocumentClassifier' :: Text
dataAccessRoleArn = Text
a} :: CreateDocumentClassifier)

-- | Specifies the format and location of the input data for the job.
createDocumentClassifier_inputDataConfig :: Lens.Lens' CreateDocumentClassifier DocumentClassifierInputDataConfig
createDocumentClassifier_inputDataConfig :: Lens' CreateDocumentClassifier DocumentClassifierInputDataConfig
createDocumentClassifier_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {DocumentClassifierInputDataConfig
inputDataConfig :: DocumentClassifierInputDataConfig
$sel:inputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> DocumentClassifierInputDataConfig
inputDataConfig} -> DocumentClassifierInputDataConfig
inputDataConfig) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} DocumentClassifierInputDataConfig
a -> CreateDocumentClassifier
s {$sel:inputDataConfig:CreateDocumentClassifier' :: DocumentClassifierInputDataConfig
inputDataConfig = DocumentClassifierInputDataConfig
a} :: CreateDocumentClassifier)

-- | The language of the input documents. You can specify any of the
-- following languages supported by Amazon Comprehend: German (\"de\"),
-- English (\"en\"), Spanish (\"es\"), French (\"fr\"), Italian (\"it\"),
-- or Portuguese (\"pt\"). All documents must be in the same language.
createDocumentClassifier_languageCode :: Lens.Lens' CreateDocumentClassifier LanguageCode
createDocumentClassifier_languageCode :: Lens' CreateDocumentClassifier LanguageCode
createDocumentClassifier_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifier' {LanguageCode
languageCode :: LanguageCode
$sel:languageCode:CreateDocumentClassifier' :: CreateDocumentClassifier -> LanguageCode
languageCode} -> LanguageCode
languageCode) (\s :: CreateDocumentClassifier
s@CreateDocumentClassifier' {} LanguageCode
a -> CreateDocumentClassifier
s {$sel:languageCode:CreateDocumentClassifier' :: LanguageCode
languageCode = LanguageCode
a} :: CreateDocumentClassifier)

instance Core.AWSRequest CreateDocumentClassifier where
  type
    AWSResponse CreateDocumentClassifier =
      CreateDocumentClassifierResponse
  request :: (Service -> Service)
-> CreateDocumentClassifier -> Request CreateDocumentClassifier
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 CreateDocumentClassifier
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDocumentClassifier)))
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 -> Int -> CreateDocumentClassifierResponse
CreateDocumentClassifierResponse'
            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
"DocumentClassifierArn")
            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 CreateDocumentClassifier where
  hashWithSalt :: Int -> CreateDocumentClassifier -> Int
hashWithSalt Int
_salt CreateDocumentClassifier' {Maybe [Tag]
Maybe Text
Maybe DocumentClassifierMode
Maybe DocumentClassifierOutputDataConfig
Maybe VpcConfig
Text
LanguageCode
DocumentClassifierInputDataConfig
languageCode :: LanguageCode
inputDataConfig :: DocumentClassifierInputDataConfig
dataAccessRoleArn :: Text
documentClassifierName :: Text
vpcConfig :: Maybe VpcConfig
volumeKmsKeyId :: Maybe Text
versionName :: Maybe Text
tags :: Maybe [Tag]
outputDataConfig :: Maybe DocumentClassifierOutputDataConfig
modelPolicy :: Maybe Text
modelKmsKeyId :: Maybe Text
mode :: Maybe DocumentClassifierMode
clientRequestToken :: Maybe Text
$sel:languageCode:CreateDocumentClassifier' :: CreateDocumentClassifier -> LanguageCode
$sel:inputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> DocumentClassifierInputDataConfig
$sel:dataAccessRoleArn:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:documentClassifierName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:vpcConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe VpcConfig
$sel:volumeKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:versionName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:tags:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe [Tag]
$sel:outputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier
-> Maybe DocumentClassifierOutputDataConfig
$sel:modelPolicy:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:modelKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:mode:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe DocumentClassifierMode
$sel:clientRequestToken:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentClassifierMode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelKmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentClassifierOutputDataConfig
outputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
versionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
volumeKmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
documentClassifierName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataAccessRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DocumentClassifierInputDataConfig
inputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LanguageCode
languageCode

instance Prelude.NFData CreateDocumentClassifier where
  rnf :: CreateDocumentClassifier -> ()
rnf CreateDocumentClassifier' {Maybe [Tag]
Maybe Text
Maybe DocumentClassifierMode
Maybe DocumentClassifierOutputDataConfig
Maybe VpcConfig
Text
LanguageCode
DocumentClassifierInputDataConfig
languageCode :: LanguageCode
inputDataConfig :: DocumentClassifierInputDataConfig
dataAccessRoleArn :: Text
documentClassifierName :: Text
vpcConfig :: Maybe VpcConfig
volumeKmsKeyId :: Maybe Text
versionName :: Maybe Text
tags :: Maybe [Tag]
outputDataConfig :: Maybe DocumentClassifierOutputDataConfig
modelPolicy :: Maybe Text
modelKmsKeyId :: Maybe Text
mode :: Maybe DocumentClassifierMode
clientRequestToken :: Maybe Text
$sel:languageCode:CreateDocumentClassifier' :: CreateDocumentClassifier -> LanguageCode
$sel:inputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> DocumentClassifierInputDataConfig
$sel:dataAccessRoleArn:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:documentClassifierName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:vpcConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe VpcConfig
$sel:volumeKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:versionName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:tags:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe [Tag]
$sel:outputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier
-> Maybe DocumentClassifierOutputDataConfig
$sel:modelPolicy:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:modelKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:mode:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe DocumentClassifierMode
$sel:clientRequestToken:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentClassifierMode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelKmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentClassifierOutputDataConfig
outputDataConfig
      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 Maybe Text
versionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
volumeKmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
documentClassifierName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataAccessRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DocumentClassifierInputDataConfig
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LanguageCode
languageCode

instance Data.ToHeaders CreateDocumentClassifier where
  toHeaders :: CreateDocumentClassifier -> 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
"Comprehend_20171127.CreateDocumentClassifier" ::
                          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 CreateDocumentClassifier where
  toJSON :: CreateDocumentClassifier -> Value
toJSON CreateDocumentClassifier' {Maybe [Tag]
Maybe Text
Maybe DocumentClassifierMode
Maybe DocumentClassifierOutputDataConfig
Maybe VpcConfig
Text
LanguageCode
DocumentClassifierInputDataConfig
languageCode :: LanguageCode
inputDataConfig :: DocumentClassifierInputDataConfig
dataAccessRoleArn :: Text
documentClassifierName :: Text
vpcConfig :: Maybe VpcConfig
volumeKmsKeyId :: Maybe Text
versionName :: Maybe Text
tags :: Maybe [Tag]
outputDataConfig :: Maybe DocumentClassifierOutputDataConfig
modelPolicy :: Maybe Text
modelKmsKeyId :: Maybe Text
mode :: Maybe DocumentClassifierMode
clientRequestToken :: Maybe Text
$sel:languageCode:CreateDocumentClassifier' :: CreateDocumentClassifier -> LanguageCode
$sel:inputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> DocumentClassifierInputDataConfig
$sel:dataAccessRoleArn:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:documentClassifierName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Text
$sel:vpcConfig:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe VpcConfig
$sel:volumeKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:versionName:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:tags:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe [Tag]
$sel:outputDataConfig:CreateDocumentClassifier' :: CreateDocumentClassifier
-> Maybe DocumentClassifierOutputDataConfig
$sel:modelPolicy:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:modelKmsKeyId:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
$sel:mode:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe DocumentClassifierMode
$sel:clientRequestToken:CreateDocumentClassifier' :: CreateDocumentClassifier -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"Mode" 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 DocumentClassifierMode
mode,
            (Key
"ModelKmsKeyId" 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
modelKmsKeyId,
            (Key
"ModelPolicy" 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
modelPolicy,
            (Key
"OutputDataConfig" 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 DocumentClassifierOutputDataConfig
outputDataConfig,
            (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,
            (Key
"VersionName" 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
versionName,
            (Key
"VolumeKmsKeyId" 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
volumeKmsKeyId,
            (Key
"VpcConfig" 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 VpcConfig
vpcConfig,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DocumentClassifierName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
documentClassifierName
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DataAccessRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataAccessRoleArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DocumentClassifierInputDataConfig
inputDataConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"LanguageCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LanguageCode
languageCode)
          ]
      )

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

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

-- | /See:/ 'newCreateDocumentClassifierResponse' smart constructor.
data CreateDocumentClassifierResponse = CreateDocumentClassifierResponse'
  { -- | The Amazon Resource Name (ARN) that identifies the document classifier.
    CreateDocumentClassifierResponse -> Maybe Text
documentClassifierArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDocumentClassifierResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDocumentClassifierResponse
-> CreateDocumentClassifierResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDocumentClassifierResponse
-> CreateDocumentClassifierResponse -> Bool
$c/= :: CreateDocumentClassifierResponse
-> CreateDocumentClassifierResponse -> Bool
== :: CreateDocumentClassifierResponse
-> CreateDocumentClassifierResponse -> Bool
$c== :: CreateDocumentClassifierResponse
-> CreateDocumentClassifierResponse -> Bool
Prelude.Eq, ReadPrec [CreateDocumentClassifierResponse]
ReadPrec CreateDocumentClassifierResponse
Int -> ReadS CreateDocumentClassifierResponse
ReadS [CreateDocumentClassifierResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDocumentClassifierResponse]
$creadListPrec :: ReadPrec [CreateDocumentClassifierResponse]
readPrec :: ReadPrec CreateDocumentClassifierResponse
$creadPrec :: ReadPrec CreateDocumentClassifierResponse
readList :: ReadS [CreateDocumentClassifierResponse]
$creadList :: ReadS [CreateDocumentClassifierResponse]
readsPrec :: Int -> ReadS CreateDocumentClassifierResponse
$creadsPrec :: Int -> ReadS CreateDocumentClassifierResponse
Prelude.Read, Int -> CreateDocumentClassifierResponse -> ShowS
[CreateDocumentClassifierResponse] -> ShowS
CreateDocumentClassifierResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDocumentClassifierResponse] -> ShowS
$cshowList :: [CreateDocumentClassifierResponse] -> ShowS
show :: CreateDocumentClassifierResponse -> String
$cshow :: CreateDocumentClassifierResponse -> String
showsPrec :: Int -> CreateDocumentClassifierResponse -> ShowS
$cshowsPrec :: Int -> CreateDocumentClassifierResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDocumentClassifierResponse x
-> CreateDocumentClassifierResponse
forall x.
CreateDocumentClassifierResponse
-> Rep CreateDocumentClassifierResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDocumentClassifierResponse x
-> CreateDocumentClassifierResponse
$cfrom :: forall x.
CreateDocumentClassifierResponse
-> Rep CreateDocumentClassifierResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDocumentClassifierResponse' 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:
--
-- 'documentClassifierArn', 'createDocumentClassifierResponse_documentClassifierArn' - The Amazon Resource Name (ARN) that identifies the document classifier.
--
-- 'httpStatus', 'createDocumentClassifierResponse_httpStatus' - The response's http status code.
newCreateDocumentClassifierResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDocumentClassifierResponse
newCreateDocumentClassifierResponse :: Int -> CreateDocumentClassifierResponse
newCreateDocumentClassifierResponse Int
pHttpStatus_ =
  CreateDocumentClassifierResponse'
    { $sel:documentClassifierArn:CreateDocumentClassifierResponse' :: Maybe Text
documentClassifierArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDocumentClassifierResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) that identifies the document classifier.
createDocumentClassifierResponse_documentClassifierArn :: Lens.Lens' CreateDocumentClassifierResponse (Prelude.Maybe Prelude.Text)
createDocumentClassifierResponse_documentClassifierArn :: Lens' CreateDocumentClassifierResponse (Maybe Text)
createDocumentClassifierResponse_documentClassifierArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentClassifierResponse' {Maybe Text
documentClassifierArn :: Maybe Text
$sel:documentClassifierArn:CreateDocumentClassifierResponse' :: CreateDocumentClassifierResponse -> Maybe Text
documentClassifierArn} -> Maybe Text
documentClassifierArn) (\s :: CreateDocumentClassifierResponse
s@CreateDocumentClassifierResponse' {} Maybe Text
a -> CreateDocumentClassifierResponse
s {$sel:documentClassifierArn:CreateDocumentClassifierResponse' :: Maybe Text
documentClassifierArn = Maybe Text
a} :: CreateDocumentClassifierResponse)

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

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