{-# 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.ImportModel
-- 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 custom model that replicates a source custom model that
-- you import. The source model can be in your AWS account or another one.
--
-- If the source model is in another AWS account, then it must have a
-- resource-based policy that authorizes you to import it.
--
-- The source model must be in the same AWS region that you\'re using when
-- you import. You can\'t import a model that\'s in a different region.
module Amazonka.Comprehend.ImportModel
  ( -- * Creating a Request
    ImportModel (..),
    newImportModel,

    -- * Request Lenses
    importModel_dataAccessRoleArn,
    importModel_modelKmsKeyId,
    importModel_modelName,
    importModel_tags,
    importModel_versionName,
    importModel_sourceModelArn,

    -- * Destructuring the Response
    ImportModelResponse (..),
    newImportModelResponse,

    -- * Response Lenses
    importModelResponse_modelArn,
    importModelResponse_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:/ 'newImportModel' smart constructor.
data ImportModel = ImportModel'
  { -- | The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
    -- role that allows Amazon Comprehend to use Amazon Key Management Service
    -- (KMS) to encrypt or decrypt the custom model.
    ImportModel -> Maybe Text
dataAccessRoleArn :: Prelude.Maybe Prelude.Text,
    -- | 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\"@
    ImportModel -> Maybe Text
modelKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name to assign to the custom model that is created in Amazon
    -- Comprehend by this import.
    ImportModel -> Maybe Text
modelName :: Prelude.Maybe Prelude.Text,
    -- | Tags to be associated with the custom model that is created by this
    -- import. 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.
    ImportModel -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The version name given to the custom model that is created by this
    -- import. 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.
    ImportModel -> Maybe Text
versionName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the custom model to import.
    ImportModel -> Text
sourceModelArn :: Prelude.Text
  }
  deriving (ImportModel -> ImportModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportModel -> ImportModel -> Bool
$c/= :: ImportModel -> ImportModel -> Bool
== :: ImportModel -> ImportModel -> Bool
$c== :: ImportModel -> ImportModel -> Bool
Prelude.Eq, ReadPrec [ImportModel]
ReadPrec ImportModel
Int -> ReadS ImportModel
ReadS [ImportModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportModel]
$creadListPrec :: ReadPrec [ImportModel]
readPrec :: ReadPrec ImportModel
$creadPrec :: ReadPrec ImportModel
readList :: ReadS [ImportModel]
$creadList :: ReadS [ImportModel]
readsPrec :: Int -> ReadS ImportModel
$creadsPrec :: Int -> ReadS ImportModel
Prelude.Read, Int -> ImportModel -> ShowS
[ImportModel] -> ShowS
ImportModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportModel] -> ShowS
$cshowList :: [ImportModel] -> ShowS
show :: ImportModel -> String
$cshow :: ImportModel -> String
showsPrec :: Int -> ImportModel -> ShowS
$cshowsPrec :: Int -> ImportModel -> ShowS
Prelude.Show, forall x. Rep ImportModel x -> ImportModel
forall x. ImportModel -> Rep ImportModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportModel x -> ImportModel
$cfrom :: forall x. ImportModel -> Rep ImportModel x
Prelude.Generic)

-- |
-- Create a value of 'ImportModel' 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:
--
-- 'dataAccessRoleArn', 'importModel_dataAccessRoleArn' - The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
-- role that allows Amazon Comprehend to use Amazon Key Management Service
-- (KMS) to encrypt or decrypt the custom model.
--
-- 'modelKmsKeyId', 'importModel_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\"@
--
-- 'modelName', 'importModel_modelName' - The name to assign to the custom model that is created in Amazon
-- Comprehend by this import.
--
-- 'tags', 'importModel_tags' - Tags to be associated with the custom model that is created by this
-- import. 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', 'importModel_versionName' - The version name given to the custom model that is created by this
-- import. 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.
--
-- 'sourceModelArn', 'importModel_sourceModelArn' - The Amazon Resource Name (ARN) of the custom model to import.
newImportModel ::
  -- | 'sourceModelArn'
  Prelude.Text ->
  ImportModel
newImportModel :: Text -> ImportModel
newImportModel Text
pSourceModelArn_ =
  ImportModel'
    { $sel:dataAccessRoleArn:ImportModel' :: Maybe Text
dataAccessRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:modelKmsKeyId:ImportModel' :: Maybe Text
modelKmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:modelName:ImportModel' :: Maybe Text
modelName = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportModel' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:versionName:ImportModel' :: Maybe Text
versionName = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceModelArn:ImportModel' :: Text
sourceModelArn = Text
pSourceModelArn_
    }

-- | The Amazon Resource Name (ARN) of the AWS Identity and Management (IAM)
-- role that allows Amazon Comprehend to use Amazon Key Management Service
-- (KMS) to encrypt or decrypt the custom model.
importModel_dataAccessRoleArn :: Lens.Lens' ImportModel (Prelude.Maybe Prelude.Text)
importModel_dataAccessRoleArn :: Lens' ImportModel (Maybe Text)
importModel_dataAccessRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:dataAccessRoleArn:ImportModel' :: ImportModel -> Maybe Text
dataAccessRoleArn} -> Maybe Text
dataAccessRoleArn) (\s :: ImportModel
s@ImportModel' {} Maybe Text
a -> ImportModel
s {$sel:dataAccessRoleArn:ImportModel' :: Maybe Text
dataAccessRoleArn = Maybe Text
a} :: ImportModel)

-- | 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\"@
importModel_modelKmsKeyId :: Lens.Lens' ImportModel (Prelude.Maybe Prelude.Text)
importModel_modelKmsKeyId :: Lens' ImportModel (Maybe Text)
importModel_modelKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Maybe Text
modelKmsKeyId :: Maybe Text
$sel:modelKmsKeyId:ImportModel' :: ImportModel -> Maybe Text
modelKmsKeyId} -> Maybe Text
modelKmsKeyId) (\s :: ImportModel
s@ImportModel' {} Maybe Text
a -> ImportModel
s {$sel:modelKmsKeyId:ImportModel' :: Maybe Text
modelKmsKeyId = Maybe Text
a} :: ImportModel)

-- | The name to assign to the custom model that is created in Amazon
-- Comprehend by this import.
importModel_modelName :: Lens.Lens' ImportModel (Prelude.Maybe Prelude.Text)
importModel_modelName :: Lens' ImportModel (Maybe Text)
importModel_modelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Maybe Text
modelName :: Maybe Text
$sel:modelName:ImportModel' :: ImportModel -> Maybe Text
modelName} -> Maybe Text
modelName) (\s :: ImportModel
s@ImportModel' {} Maybe Text
a -> ImportModel
s {$sel:modelName:ImportModel' :: Maybe Text
modelName = Maybe Text
a} :: ImportModel)

-- | Tags to be associated with the custom model that is created by this
-- import. 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.
importModel_tags :: Lens.Lens' ImportModel (Prelude.Maybe [Tag])
importModel_tags :: Lens' ImportModel (Maybe [Tag])
importModel_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ImportModel' :: ImportModel -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ImportModel
s@ImportModel' {} Maybe [Tag]
a -> ImportModel
s {$sel:tags:ImportModel' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ImportModel) 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 custom model that is created by this
-- import. 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.
importModel_versionName :: Lens.Lens' ImportModel (Prelude.Maybe Prelude.Text)
importModel_versionName :: Lens' ImportModel (Maybe Text)
importModel_versionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Maybe Text
versionName :: Maybe Text
$sel:versionName:ImportModel' :: ImportModel -> Maybe Text
versionName} -> Maybe Text
versionName) (\s :: ImportModel
s@ImportModel' {} Maybe Text
a -> ImportModel
s {$sel:versionName:ImportModel' :: Maybe Text
versionName = Maybe Text
a} :: ImportModel)

-- | The Amazon Resource Name (ARN) of the custom model to import.
importModel_sourceModelArn :: Lens.Lens' ImportModel Prelude.Text
importModel_sourceModelArn :: Lens' ImportModel Text
importModel_sourceModelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModel' {Text
sourceModelArn :: Text
$sel:sourceModelArn:ImportModel' :: ImportModel -> Text
sourceModelArn} -> Text
sourceModelArn) (\s :: ImportModel
s@ImportModel' {} Text
a -> ImportModel
s {$sel:sourceModelArn:ImportModel' :: Text
sourceModelArn = Text
a} :: ImportModel)

instance Core.AWSRequest ImportModel where
  type AWSResponse ImportModel = ImportModelResponse
  request :: (Service -> Service) -> ImportModel -> Request ImportModel
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 ImportModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportModel)))
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 -> ImportModelResponse
ImportModelResponse'
            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
"ModelArn")
            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 ImportModel where
  hashWithSalt :: Int -> ImportModel -> Int
hashWithSalt Int
_salt ImportModel' {Maybe [Tag]
Maybe Text
Text
sourceModelArn :: Text
versionName :: Maybe Text
tags :: Maybe [Tag]
modelName :: Maybe Text
modelKmsKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:sourceModelArn:ImportModel' :: ImportModel -> Text
$sel:versionName:ImportModel' :: ImportModel -> Maybe Text
$sel:tags:ImportModel' :: ImportModel -> Maybe [Tag]
$sel:modelName:ImportModel' :: ImportModel -> Maybe Text
$sel:modelKmsKeyId:ImportModel' :: ImportModel -> Maybe Text
$sel:dataAccessRoleArn:ImportModel' :: ImportModel -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataAccessRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelKmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelName
      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` Text
sourceModelArn

instance Prelude.NFData ImportModel where
  rnf :: ImportModel -> ()
rnf ImportModel' {Maybe [Tag]
Maybe Text
Text
sourceModelArn :: Text
versionName :: Maybe Text
tags :: Maybe [Tag]
modelName :: Maybe Text
modelKmsKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:sourceModelArn:ImportModel' :: ImportModel -> Text
$sel:versionName:ImportModel' :: ImportModel -> Maybe Text
$sel:tags:ImportModel' :: ImportModel -> Maybe [Tag]
$sel:modelName:ImportModel' :: ImportModel -> Maybe Text
$sel:modelKmsKeyId:ImportModel' :: ImportModel -> Maybe Text
$sel:dataAccessRoleArn:ImportModel' :: ImportModel -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataAccessRoleArn
      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
modelName
      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 Text
sourceModelArn

instance Data.ToHeaders ImportModel where
  toHeaders :: ImportModel -> 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.ImportModel" ::
                          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 ImportModel where
  toJSON :: ImportModel -> Value
toJSON ImportModel' {Maybe [Tag]
Maybe Text
Text
sourceModelArn :: Text
versionName :: Maybe Text
tags :: Maybe [Tag]
modelName :: Maybe Text
modelKmsKeyId :: Maybe Text
dataAccessRoleArn :: Maybe Text
$sel:sourceModelArn:ImportModel' :: ImportModel -> Text
$sel:versionName:ImportModel' :: ImportModel -> Maybe Text
$sel:tags:ImportModel' :: ImportModel -> Maybe [Tag]
$sel:modelName:ImportModel' :: ImportModel -> Maybe Text
$sel:modelKmsKeyId:ImportModel' :: ImportModel -> Maybe Text
$sel:dataAccessRoleArn:ImportModel' :: ImportModel -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataAccessRoleArn" 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
dataAccessRoleArn,
            (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
"ModelName" 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
modelName,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SourceModelArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceModelArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'ImportModelResponse' 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:
--
-- 'modelArn', 'importModelResponse_modelArn' - The Amazon Resource Name (ARN) of the custom model being imported.
--
-- 'httpStatus', 'importModelResponse_httpStatus' - The response's http status code.
newImportModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportModelResponse
newImportModelResponse :: Int -> ImportModelResponse
newImportModelResponse Int
pHttpStatus_ =
  ImportModelResponse'
    { $sel:modelArn:ImportModelResponse' :: Maybe Text
modelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportModelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the custom model being imported.
importModelResponse_modelArn :: Lens.Lens' ImportModelResponse (Prelude.Maybe Prelude.Text)
importModelResponse_modelArn :: Lens' ImportModelResponse (Maybe Text)
importModelResponse_modelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportModelResponse' {Maybe Text
modelArn :: Maybe Text
$sel:modelArn:ImportModelResponse' :: ImportModelResponse -> Maybe Text
modelArn} -> Maybe Text
modelArn) (\s :: ImportModelResponse
s@ImportModelResponse' {} Maybe Text
a -> ImportModelResponse
s {$sel:modelArn:ImportModelResponse' :: Maybe Text
modelArn = Maybe Text
a} :: ImportModelResponse)

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

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