{-# 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.MachineLearning.CreateMLModel
-- 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 @MLModel@ using the @DataSource@ and the recipe as
-- information sources.
--
-- An @MLModel@ is nearly immutable. Users can update only the
-- @MLModelName@ and the @ScoreThreshold@ in an @MLModel@ without creating
-- a new @MLModel@.
--
-- @CreateMLModel@ is an asynchronous operation. In response to
-- @CreateMLModel@, Amazon Machine Learning (Amazon ML) immediately returns
-- and sets the @MLModel@ status to @PENDING@. After the @MLModel@ has been
-- created and ready is for use, Amazon ML sets the status to @COMPLETED@.
--
-- You can use the @GetMLModel@ operation to check the progress of the
-- @MLModel@ during the creation operation.
--
-- @CreateMLModel@ requires a @DataSource@ with computed statistics, which
-- can be created by setting @ComputeStatistics@ to @true@ in
-- @CreateDataSourceFromRDS@, @CreateDataSourceFromS3@, or
-- @CreateDataSourceFromRedshift@ operations.
module Amazonka.MachineLearning.CreateMLModel
  ( -- * Creating a Request
    CreateMLModel (..),
    newCreateMLModel,

    -- * Request Lenses
    createMLModel_mLModelName,
    createMLModel_parameters,
    createMLModel_recipe,
    createMLModel_recipeUri,
    createMLModel_mLModelId,
    createMLModel_mLModelType,
    createMLModel_trainingDataSourceId,

    -- * Destructuring the Response
    CreateMLModelResponse (..),
    newCreateMLModelResponse,

    -- * Response Lenses
    createMLModelResponse_mLModelId,
    createMLModelResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MachineLearning.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateMLModel' smart constructor.
data CreateMLModel = CreateMLModel'
  { -- | A user-supplied name or description of the @MLModel@.
    CreateMLModel -> Maybe Text
mLModelName :: Prelude.Maybe Prelude.Text,
    -- | A list of the training parameters in the @MLModel@. The list is
    -- implemented as a map of key-value pairs.
    --
    -- The following is the current set of training parameters:
    --
    -- -   @sgd.maxMLModelSizeInBytes@ - The maximum allowed size of the model.
    --     Depending on the input data, the size of the model might affect its
    --     performance.
    --
    --     The value is an integer that ranges from @100000@ to @2147483648@.
    --     The default value is @33554432@.
    --
    -- -   @sgd.maxPasses@ - The number of times that the training process
    --     traverses the observations to build the @MLModel@. The value is an
    --     integer that ranges from @1@ to @10000@. The default value is @10@.
    --
    -- -   @sgd.shuffleType@ - Whether Amazon ML shuffles the training data.
    --     Shuffling the data improves a model\'s ability to find the optimal
    --     solution for a variety of data types. The valid values are @auto@
    --     and @none@. The default value is @none@. We strongly recommend that
    --     you shuffle your data.
    --
    -- -   @sgd.l1RegularizationAmount@ - The coefficient regularization L1
    --     norm. It controls overfitting the data by penalizing large
    --     coefficients. This tends to drive coefficients to zero, resulting in
    --     a sparse feature set. If you use this parameter, start by specifying
    --     a small value, such as @1.0E-08@.
    --
    --     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
    --     default is to not use L1 normalization. This parameter can\'t be
    --     used when @L2@ is specified. Use this parameter sparingly.
    --
    -- -   @sgd.l2RegularizationAmount@ - The coefficient regularization L2
    --     norm. It controls overfitting the data by penalizing large
    --     coefficients. This tends to drive coefficients to small, nonzero
    --     values. If you use this parameter, start by specifying a small
    --     value, such as @1.0E-08@.
    --
    --     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
    --     default is to not use L2 normalization. This parameter can\'t be
    --     used when @L1@ is specified. Use this parameter sparingly.
    CreateMLModel -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The data recipe for creating the @MLModel@. You must specify either the
    -- recipe or its URI. If you don\'t specify a recipe or its URI, Amazon ML
    -- creates a default.
    CreateMLModel -> Maybe Text
recipe :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Simple Storage Service (Amazon S3) location and file name
    -- that contains the @MLModel@ recipe. You must specify either the recipe
    -- or its URI. If you don\'t specify a recipe or its URI, Amazon ML creates
    -- a default.
    CreateMLModel -> Maybe Text
recipeUri :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied ID that uniquely identifies the @MLModel@.
    CreateMLModel -> Text
mLModelId :: Prelude.Text,
    -- | The category of supervised learning that this @MLModel@ will address.
    -- Choose from the following types:
    --
    -- -   Choose @REGRESSION@ if the @MLModel@ will be used to predict a
    --     numeric value.
    --
    -- -   Choose @BINARY@ if the @MLModel@ result has two possible values.
    --
    -- -   Choose @MULTICLASS@ if the @MLModel@ result has a limited number of
    --     values.
    --
    -- For more information, see the
    -- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
    CreateMLModel -> MLModelType
mLModelType :: MLModelType,
    -- | The @DataSource@ that points to the training data.
    CreateMLModel -> Text
trainingDataSourceId :: Prelude.Text
  }
  deriving (CreateMLModel -> CreateMLModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMLModel -> CreateMLModel -> Bool
$c/= :: CreateMLModel -> CreateMLModel -> Bool
== :: CreateMLModel -> CreateMLModel -> Bool
$c== :: CreateMLModel -> CreateMLModel -> Bool
Prelude.Eq, ReadPrec [CreateMLModel]
ReadPrec CreateMLModel
Int -> ReadS CreateMLModel
ReadS [CreateMLModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMLModel]
$creadListPrec :: ReadPrec [CreateMLModel]
readPrec :: ReadPrec CreateMLModel
$creadPrec :: ReadPrec CreateMLModel
readList :: ReadS [CreateMLModel]
$creadList :: ReadS [CreateMLModel]
readsPrec :: Int -> ReadS CreateMLModel
$creadsPrec :: Int -> ReadS CreateMLModel
Prelude.Read, Int -> CreateMLModel -> ShowS
[CreateMLModel] -> ShowS
CreateMLModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMLModel] -> ShowS
$cshowList :: [CreateMLModel] -> ShowS
show :: CreateMLModel -> String
$cshow :: CreateMLModel -> String
showsPrec :: Int -> CreateMLModel -> ShowS
$cshowsPrec :: Int -> CreateMLModel -> ShowS
Prelude.Show, forall x. Rep CreateMLModel x -> CreateMLModel
forall x. CreateMLModel -> Rep CreateMLModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMLModel x -> CreateMLModel
$cfrom :: forall x. CreateMLModel -> Rep CreateMLModel x
Prelude.Generic)

-- |
-- Create a value of 'CreateMLModel' 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:
--
-- 'mLModelName', 'createMLModel_mLModelName' - A user-supplied name or description of the @MLModel@.
--
-- 'parameters', 'createMLModel_parameters' - A list of the training parameters in the @MLModel@. The list is
-- implemented as a map of key-value pairs.
--
-- The following is the current set of training parameters:
--
-- -   @sgd.maxMLModelSizeInBytes@ - The maximum allowed size of the model.
--     Depending on the input data, the size of the model might affect its
--     performance.
--
--     The value is an integer that ranges from @100000@ to @2147483648@.
--     The default value is @33554432@.
--
-- -   @sgd.maxPasses@ - The number of times that the training process
--     traverses the observations to build the @MLModel@. The value is an
--     integer that ranges from @1@ to @10000@. The default value is @10@.
--
-- -   @sgd.shuffleType@ - Whether Amazon ML shuffles the training data.
--     Shuffling the data improves a model\'s ability to find the optimal
--     solution for a variety of data types. The valid values are @auto@
--     and @none@. The default value is @none@. We strongly recommend that
--     you shuffle your data.
--
-- -   @sgd.l1RegularizationAmount@ - The coefficient regularization L1
--     norm. It controls overfitting the data by penalizing large
--     coefficients. This tends to drive coefficients to zero, resulting in
--     a sparse feature set. If you use this parameter, start by specifying
--     a small value, such as @1.0E-08@.
--
--     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
--     default is to not use L1 normalization. This parameter can\'t be
--     used when @L2@ is specified. Use this parameter sparingly.
--
-- -   @sgd.l2RegularizationAmount@ - The coefficient regularization L2
--     norm. It controls overfitting the data by penalizing large
--     coefficients. This tends to drive coefficients to small, nonzero
--     values. If you use this parameter, start by specifying a small
--     value, such as @1.0E-08@.
--
--     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
--     default is to not use L2 normalization. This parameter can\'t be
--     used when @L1@ is specified. Use this parameter sparingly.
--
-- 'recipe', 'createMLModel_recipe' - The data recipe for creating the @MLModel@. You must specify either the
-- recipe or its URI. If you don\'t specify a recipe or its URI, Amazon ML
-- creates a default.
--
-- 'recipeUri', 'createMLModel_recipeUri' - The Amazon Simple Storage Service (Amazon S3) location and file name
-- that contains the @MLModel@ recipe. You must specify either the recipe
-- or its URI. If you don\'t specify a recipe or its URI, Amazon ML creates
-- a default.
--
-- 'mLModelId', 'createMLModel_mLModelId' - A user-supplied ID that uniquely identifies the @MLModel@.
--
-- 'mLModelType', 'createMLModel_mLModelType' - The category of supervised learning that this @MLModel@ will address.
-- Choose from the following types:
--
-- -   Choose @REGRESSION@ if the @MLModel@ will be used to predict a
--     numeric value.
--
-- -   Choose @BINARY@ if the @MLModel@ result has two possible values.
--
-- -   Choose @MULTICLASS@ if the @MLModel@ result has a limited number of
--     values.
--
-- For more information, see the
-- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
--
-- 'trainingDataSourceId', 'createMLModel_trainingDataSourceId' - The @DataSource@ that points to the training data.
newCreateMLModel ::
  -- | 'mLModelId'
  Prelude.Text ->
  -- | 'mLModelType'
  MLModelType ->
  -- | 'trainingDataSourceId'
  Prelude.Text ->
  CreateMLModel
newCreateMLModel :: Text -> MLModelType -> Text -> CreateMLModel
newCreateMLModel
  Text
pMLModelId_
  MLModelType
pMLModelType_
  Text
pTrainingDataSourceId_ =
    CreateMLModel'
      { $sel:mLModelName:CreateMLModel' :: Maybe Text
mLModelName = forall a. Maybe a
Prelude.Nothing,
        $sel:parameters:CreateMLModel' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
        $sel:recipe:CreateMLModel' :: Maybe Text
recipe = forall a. Maybe a
Prelude.Nothing,
        $sel:recipeUri:CreateMLModel' :: Maybe Text
recipeUri = forall a. Maybe a
Prelude.Nothing,
        $sel:mLModelId:CreateMLModel' :: Text
mLModelId = Text
pMLModelId_,
        $sel:mLModelType:CreateMLModel' :: MLModelType
mLModelType = MLModelType
pMLModelType_,
        $sel:trainingDataSourceId:CreateMLModel' :: Text
trainingDataSourceId = Text
pTrainingDataSourceId_
      }

-- | A user-supplied name or description of the @MLModel@.
createMLModel_mLModelName :: Lens.Lens' CreateMLModel (Prelude.Maybe Prelude.Text)
createMLModel_mLModelName :: Lens' CreateMLModel (Maybe Text)
createMLModel_mLModelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Maybe Text
mLModelName :: Maybe Text
$sel:mLModelName:CreateMLModel' :: CreateMLModel -> Maybe Text
mLModelName} -> Maybe Text
mLModelName) (\s :: CreateMLModel
s@CreateMLModel' {} Maybe Text
a -> CreateMLModel
s {$sel:mLModelName:CreateMLModel' :: Maybe Text
mLModelName = Maybe Text
a} :: CreateMLModel)

-- | A list of the training parameters in the @MLModel@. The list is
-- implemented as a map of key-value pairs.
--
-- The following is the current set of training parameters:
--
-- -   @sgd.maxMLModelSizeInBytes@ - The maximum allowed size of the model.
--     Depending on the input data, the size of the model might affect its
--     performance.
--
--     The value is an integer that ranges from @100000@ to @2147483648@.
--     The default value is @33554432@.
--
-- -   @sgd.maxPasses@ - The number of times that the training process
--     traverses the observations to build the @MLModel@. The value is an
--     integer that ranges from @1@ to @10000@. The default value is @10@.
--
-- -   @sgd.shuffleType@ - Whether Amazon ML shuffles the training data.
--     Shuffling the data improves a model\'s ability to find the optimal
--     solution for a variety of data types. The valid values are @auto@
--     and @none@. The default value is @none@. We strongly recommend that
--     you shuffle your data.
--
-- -   @sgd.l1RegularizationAmount@ - The coefficient regularization L1
--     norm. It controls overfitting the data by penalizing large
--     coefficients. This tends to drive coefficients to zero, resulting in
--     a sparse feature set. If you use this parameter, start by specifying
--     a small value, such as @1.0E-08@.
--
--     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
--     default is to not use L1 normalization. This parameter can\'t be
--     used when @L2@ is specified. Use this parameter sparingly.
--
-- -   @sgd.l2RegularizationAmount@ - The coefficient regularization L2
--     norm. It controls overfitting the data by penalizing large
--     coefficients. This tends to drive coefficients to small, nonzero
--     values. If you use this parameter, start by specifying a small
--     value, such as @1.0E-08@.
--
--     The value is a double that ranges from @0@ to @MAX_DOUBLE@. The
--     default is to not use L2 normalization. This parameter can\'t be
--     used when @L1@ is specified. Use this parameter sparingly.
createMLModel_parameters :: Lens.Lens' CreateMLModel (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createMLModel_parameters :: Lens' CreateMLModel (Maybe (HashMap Text Text))
createMLModel_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:CreateMLModel' :: CreateMLModel -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: CreateMLModel
s@CreateMLModel' {} Maybe (HashMap Text Text)
a -> CreateMLModel
s {$sel:parameters:CreateMLModel' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: CreateMLModel) 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 data recipe for creating the @MLModel@. You must specify either the
-- recipe or its URI. If you don\'t specify a recipe or its URI, Amazon ML
-- creates a default.
createMLModel_recipe :: Lens.Lens' CreateMLModel (Prelude.Maybe Prelude.Text)
createMLModel_recipe :: Lens' CreateMLModel (Maybe Text)
createMLModel_recipe = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Maybe Text
recipe :: Maybe Text
$sel:recipe:CreateMLModel' :: CreateMLModel -> Maybe Text
recipe} -> Maybe Text
recipe) (\s :: CreateMLModel
s@CreateMLModel' {} Maybe Text
a -> CreateMLModel
s {$sel:recipe:CreateMLModel' :: Maybe Text
recipe = Maybe Text
a} :: CreateMLModel)

-- | The Amazon Simple Storage Service (Amazon S3) location and file name
-- that contains the @MLModel@ recipe. You must specify either the recipe
-- or its URI. If you don\'t specify a recipe or its URI, Amazon ML creates
-- a default.
createMLModel_recipeUri :: Lens.Lens' CreateMLModel (Prelude.Maybe Prelude.Text)
createMLModel_recipeUri :: Lens' CreateMLModel (Maybe Text)
createMLModel_recipeUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Maybe Text
recipeUri :: Maybe Text
$sel:recipeUri:CreateMLModel' :: CreateMLModel -> Maybe Text
recipeUri} -> Maybe Text
recipeUri) (\s :: CreateMLModel
s@CreateMLModel' {} Maybe Text
a -> CreateMLModel
s {$sel:recipeUri:CreateMLModel' :: Maybe Text
recipeUri = Maybe Text
a} :: CreateMLModel)

-- | A user-supplied ID that uniquely identifies the @MLModel@.
createMLModel_mLModelId :: Lens.Lens' CreateMLModel Prelude.Text
createMLModel_mLModelId :: Lens' CreateMLModel Text
createMLModel_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Text
mLModelId :: Text
$sel:mLModelId:CreateMLModel' :: CreateMLModel -> Text
mLModelId} -> Text
mLModelId) (\s :: CreateMLModel
s@CreateMLModel' {} Text
a -> CreateMLModel
s {$sel:mLModelId:CreateMLModel' :: Text
mLModelId = Text
a} :: CreateMLModel)

-- | The category of supervised learning that this @MLModel@ will address.
-- Choose from the following types:
--
-- -   Choose @REGRESSION@ if the @MLModel@ will be used to predict a
--     numeric value.
--
-- -   Choose @BINARY@ if the @MLModel@ result has two possible values.
--
-- -   Choose @MULTICLASS@ if the @MLModel@ result has a limited number of
--     values.
--
-- For more information, see the
-- <https://docs.aws.amazon.com/machine-learning/latest/dg Amazon Machine Learning Developer Guide>.
createMLModel_mLModelType :: Lens.Lens' CreateMLModel MLModelType
createMLModel_mLModelType :: Lens' CreateMLModel MLModelType
createMLModel_mLModelType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {MLModelType
mLModelType :: MLModelType
$sel:mLModelType:CreateMLModel' :: CreateMLModel -> MLModelType
mLModelType} -> MLModelType
mLModelType) (\s :: CreateMLModel
s@CreateMLModel' {} MLModelType
a -> CreateMLModel
s {$sel:mLModelType:CreateMLModel' :: MLModelType
mLModelType = MLModelType
a} :: CreateMLModel)

-- | The @DataSource@ that points to the training data.
createMLModel_trainingDataSourceId :: Lens.Lens' CreateMLModel Prelude.Text
createMLModel_trainingDataSourceId :: Lens' CreateMLModel Text
createMLModel_trainingDataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModel' {Text
trainingDataSourceId :: Text
$sel:trainingDataSourceId:CreateMLModel' :: CreateMLModel -> Text
trainingDataSourceId} -> Text
trainingDataSourceId) (\s :: CreateMLModel
s@CreateMLModel' {} Text
a -> CreateMLModel
s {$sel:trainingDataSourceId:CreateMLModel' :: Text
trainingDataSourceId = Text
a} :: CreateMLModel)

instance Core.AWSRequest CreateMLModel where
  type
    AWSResponse CreateMLModel =
      CreateMLModelResponse
  request :: (Service -> Service) -> CreateMLModel -> Request CreateMLModel
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 CreateMLModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateMLModel)))
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 -> CreateMLModelResponse
CreateMLModelResponse'
            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
"MLModelId")
            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 CreateMLModel where
  hashWithSalt :: Int -> CreateMLModel -> Int
hashWithSalt Int
_salt CreateMLModel' {Maybe Text
Maybe (HashMap Text Text)
Text
MLModelType
trainingDataSourceId :: Text
mLModelType :: MLModelType
mLModelId :: Text
recipeUri :: Maybe Text
recipe :: Maybe Text
parameters :: Maybe (HashMap Text Text)
mLModelName :: Maybe Text
$sel:trainingDataSourceId:CreateMLModel' :: CreateMLModel -> Text
$sel:mLModelType:CreateMLModel' :: CreateMLModel -> MLModelType
$sel:mLModelId:CreateMLModel' :: CreateMLModel -> Text
$sel:recipeUri:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:recipe:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:parameters:CreateMLModel' :: CreateMLModel -> Maybe (HashMap Text Text)
$sel:mLModelName:CreateMLModel' :: CreateMLModel -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
mLModelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recipe
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
recipeUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MLModelType
mLModelType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trainingDataSourceId

instance Prelude.NFData CreateMLModel where
  rnf :: CreateMLModel -> ()
rnf CreateMLModel' {Maybe Text
Maybe (HashMap Text Text)
Text
MLModelType
trainingDataSourceId :: Text
mLModelType :: MLModelType
mLModelId :: Text
recipeUri :: Maybe Text
recipe :: Maybe Text
parameters :: Maybe (HashMap Text Text)
mLModelName :: Maybe Text
$sel:trainingDataSourceId:CreateMLModel' :: CreateMLModel -> Text
$sel:mLModelType:CreateMLModel' :: CreateMLModel -> MLModelType
$sel:mLModelId:CreateMLModel' :: CreateMLModel -> Text
$sel:recipeUri:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:recipe:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:parameters:CreateMLModel' :: CreateMLModel -> Maybe (HashMap Text Text)
$sel:mLModelName:CreateMLModel' :: CreateMLModel -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
mLModelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recipe
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recipeUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mLModelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MLModelType
mLModelType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trainingDataSourceId

instance Data.ToHeaders CreateMLModel where
  toHeaders :: CreateMLModel -> 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
"AmazonML_20141212.CreateMLModel" ::
                          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 CreateMLModel where
  toJSON :: CreateMLModel -> Value
toJSON CreateMLModel' {Maybe Text
Maybe (HashMap Text Text)
Text
MLModelType
trainingDataSourceId :: Text
mLModelType :: MLModelType
mLModelId :: Text
recipeUri :: Maybe Text
recipe :: Maybe Text
parameters :: Maybe (HashMap Text Text)
mLModelName :: Maybe Text
$sel:trainingDataSourceId:CreateMLModel' :: CreateMLModel -> Text
$sel:mLModelType:CreateMLModel' :: CreateMLModel -> MLModelType
$sel:mLModelId:CreateMLModel' :: CreateMLModel -> Text
$sel:recipeUri:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:recipe:CreateMLModel' :: CreateMLModel -> Maybe Text
$sel:parameters:CreateMLModel' :: CreateMLModel -> Maybe (HashMap Text Text)
$sel:mLModelName:CreateMLModel' :: CreateMLModel -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MLModelName" 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
mLModelName,
            (Key
"Parameters" 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 (HashMap Text Text)
parameters,
            (Key
"Recipe" 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
recipe,
            (Key
"RecipeUri" 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
recipeUri,
            forall a. a -> Maybe a
Prelude.Just (Key
"MLModelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mLModelId),
            forall a. a -> Maybe a
Prelude.Just (Key
"MLModelType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MLModelType
mLModelType),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TrainingDataSourceId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trainingDataSourceId
              )
          ]
      )

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

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

-- | Represents the output of a @CreateMLModel@ operation, and is an
-- acknowledgement that Amazon ML received the request.
--
-- The @CreateMLModel@ operation is asynchronous. You can poll for status
-- updates by using the @GetMLModel@ operation and checking the @Status@
-- parameter.
--
-- /See:/ 'newCreateMLModelResponse' smart constructor.
data CreateMLModelResponse = CreateMLModelResponse'
  { -- | A user-supplied ID that uniquely identifies the @MLModel@. This value
    -- should be identical to the value of the @MLModelId@ in the request.
    CreateMLModelResponse -> Maybe Text
mLModelId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateMLModelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateMLModelResponse -> CreateMLModelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMLModelResponse -> CreateMLModelResponse -> Bool
$c/= :: CreateMLModelResponse -> CreateMLModelResponse -> Bool
== :: CreateMLModelResponse -> CreateMLModelResponse -> Bool
$c== :: CreateMLModelResponse -> CreateMLModelResponse -> Bool
Prelude.Eq, ReadPrec [CreateMLModelResponse]
ReadPrec CreateMLModelResponse
Int -> ReadS CreateMLModelResponse
ReadS [CreateMLModelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMLModelResponse]
$creadListPrec :: ReadPrec [CreateMLModelResponse]
readPrec :: ReadPrec CreateMLModelResponse
$creadPrec :: ReadPrec CreateMLModelResponse
readList :: ReadS [CreateMLModelResponse]
$creadList :: ReadS [CreateMLModelResponse]
readsPrec :: Int -> ReadS CreateMLModelResponse
$creadsPrec :: Int -> ReadS CreateMLModelResponse
Prelude.Read, Int -> CreateMLModelResponse -> ShowS
[CreateMLModelResponse] -> ShowS
CreateMLModelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMLModelResponse] -> ShowS
$cshowList :: [CreateMLModelResponse] -> ShowS
show :: CreateMLModelResponse -> String
$cshow :: CreateMLModelResponse -> String
showsPrec :: Int -> CreateMLModelResponse -> ShowS
$cshowsPrec :: Int -> CreateMLModelResponse -> ShowS
Prelude.Show, forall x. Rep CreateMLModelResponse x -> CreateMLModelResponse
forall x. CreateMLModelResponse -> Rep CreateMLModelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMLModelResponse x -> CreateMLModelResponse
$cfrom :: forall x. CreateMLModelResponse -> Rep CreateMLModelResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMLModelResponse' 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:
--
-- 'mLModelId', 'createMLModelResponse_mLModelId' - A user-supplied ID that uniquely identifies the @MLModel@. This value
-- should be identical to the value of the @MLModelId@ in the request.
--
-- 'httpStatus', 'createMLModelResponse_httpStatus' - The response's http status code.
newCreateMLModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMLModelResponse
newCreateMLModelResponse :: Int -> CreateMLModelResponse
newCreateMLModelResponse Int
pHttpStatus_ =
  CreateMLModelResponse'
    { $sel:mLModelId:CreateMLModelResponse' :: Maybe Text
mLModelId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMLModelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A user-supplied ID that uniquely identifies the @MLModel@. This value
-- should be identical to the value of the @MLModelId@ in the request.
createMLModelResponse_mLModelId :: Lens.Lens' CreateMLModelResponse (Prelude.Maybe Prelude.Text)
createMLModelResponse_mLModelId :: Lens' CreateMLModelResponse (Maybe Text)
createMLModelResponse_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMLModelResponse' {Maybe Text
mLModelId :: Maybe Text
$sel:mLModelId:CreateMLModelResponse' :: CreateMLModelResponse -> Maybe Text
mLModelId} -> Maybe Text
mLModelId) (\s :: CreateMLModelResponse
s@CreateMLModelResponse' {} Maybe Text
a -> CreateMLModelResponse
s {$sel:mLModelId:CreateMLModelResponse' :: Maybe Text
mLModelId = Maybe Text
a} :: CreateMLModelResponse)

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

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