{-# 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.GetMLModel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns an @MLModel@ that includes detailed metadata, data source
-- information, and the current status of the @MLModel@.
--
-- @GetMLModel@ provides results in normal or verbose format.
module Amazonka.MachineLearning.GetMLModel
  ( -- * Creating a Request
    GetMLModel (..),
    newGetMLModel,

    -- * Request Lenses
    getMLModel_verbose,
    getMLModel_mLModelId,

    -- * Destructuring the Response
    GetMLModelResponse (..),
    newGetMLModelResponse,

    -- * Response Lenses
    getMLModelResponse_computeTime,
    getMLModelResponse_createdAt,
    getMLModelResponse_createdByIamUser,
    getMLModelResponse_endpointInfo,
    getMLModelResponse_finishedAt,
    getMLModelResponse_inputDataLocationS3,
    getMLModelResponse_lastUpdatedAt,
    getMLModelResponse_logUri,
    getMLModelResponse_mLModelId,
    getMLModelResponse_mLModelType,
    getMLModelResponse_message,
    getMLModelResponse_name,
    getMLModelResponse_recipe,
    getMLModelResponse_schema,
    getMLModelResponse_scoreThreshold,
    getMLModelResponse_scoreThresholdLastUpdatedAt,
    getMLModelResponse_sizeInBytes,
    getMLModelResponse_startedAt,
    getMLModelResponse_status,
    getMLModelResponse_trainingDataSourceId,
    getMLModelResponse_trainingParameters,
    getMLModelResponse_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:/ 'newGetMLModel' smart constructor.
data GetMLModel = GetMLModel'
  { -- | Specifies whether the @GetMLModel@ operation should return @Recipe@.
    --
    -- If true, @Recipe@ is returned.
    --
    -- If false, @Recipe@ is not returned.
    GetMLModel -> Maybe Bool
verbose :: Prelude.Maybe Prelude.Bool,
    -- | The ID assigned to the @MLModel@ at creation.
    GetMLModel -> Text
mLModelId :: Prelude.Text
  }
  deriving (GetMLModel -> GetMLModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMLModel -> GetMLModel -> Bool
$c/= :: GetMLModel -> GetMLModel -> Bool
== :: GetMLModel -> GetMLModel -> Bool
$c== :: GetMLModel -> GetMLModel -> Bool
Prelude.Eq, ReadPrec [GetMLModel]
ReadPrec GetMLModel
Int -> ReadS GetMLModel
ReadS [GetMLModel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMLModel]
$creadListPrec :: ReadPrec [GetMLModel]
readPrec :: ReadPrec GetMLModel
$creadPrec :: ReadPrec GetMLModel
readList :: ReadS [GetMLModel]
$creadList :: ReadS [GetMLModel]
readsPrec :: Int -> ReadS GetMLModel
$creadsPrec :: Int -> ReadS GetMLModel
Prelude.Read, Int -> GetMLModel -> ShowS
[GetMLModel] -> ShowS
GetMLModel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMLModel] -> ShowS
$cshowList :: [GetMLModel] -> ShowS
show :: GetMLModel -> String
$cshow :: GetMLModel -> String
showsPrec :: Int -> GetMLModel -> ShowS
$cshowsPrec :: Int -> GetMLModel -> ShowS
Prelude.Show, forall x. Rep GetMLModel x -> GetMLModel
forall x. GetMLModel -> Rep GetMLModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMLModel x -> GetMLModel
$cfrom :: forall x. GetMLModel -> Rep GetMLModel x
Prelude.Generic)

-- |
-- Create a value of 'GetMLModel' 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:
--
-- 'verbose', 'getMLModel_verbose' - Specifies whether the @GetMLModel@ operation should return @Recipe@.
--
-- If true, @Recipe@ is returned.
--
-- If false, @Recipe@ is not returned.
--
-- 'mLModelId', 'getMLModel_mLModelId' - The ID assigned to the @MLModel@ at creation.
newGetMLModel ::
  -- | 'mLModelId'
  Prelude.Text ->
  GetMLModel
newGetMLModel :: Text -> GetMLModel
newGetMLModel Text
pMLModelId_ =
  GetMLModel'
    { $sel:verbose:GetMLModel' :: Maybe Bool
verbose = forall a. Maybe a
Prelude.Nothing,
      $sel:mLModelId:GetMLModel' :: Text
mLModelId = Text
pMLModelId_
    }

-- | Specifies whether the @GetMLModel@ operation should return @Recipe@.
--
-- If true, @Recipe@ is returned.
--
-- If false, @Recipe@ is not returned.
getMLModel_verbose :: Lens.Lens' GetMLModel (Prelude.Maybe Prelude.Bool)
getMLModel_verbose :: Lens' GetMLModel (Maybe Bool)
getMLModel_verbose = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModel' {Maybe Bool
verbose :: Maybe Bool
$sel:verbose:GetMLModel' :: GetMLModel -> Maybe Bool
verbose} -> Maybe Bool
verbose) (\s :: GetMLModel
s@GetMLModel' {} Maybe Bool
a -> GetMLModel
s {$sel:verbose:GetMLModel' :: Maybe Bool
verbose = Maybe Bool
a} :: GetMLModel)

-- | The ID assigned to the @MLModel@ at creation.
getMLModel_mLModelId :: Lens.Lens' GetMLModel Prelude.Text
getMLModel_mLModelId :: Lens' GetMLModel Text
getMLModel_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModel' {Text
mLModelId :: Text
$sel:mLModelId:GetMLModel' :: GetMLModel -> Text
mLModelId} -> Text
mLModelId) (\s :: GetMLModel
s@GetMLModel' {} Text
a -> GetMLModel
s {$sel:mLModelId:GetMLModel' :: Text
mLModelId = Text
a} :: GetMLModel)

instance Core.AWSRequest GetMLModel where
  type AWSResponse GetMLModel = GetMLModelResponse
  request :: (Service -> Service) -> GetMLModel -> Request GetMLModel
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 GetMLModel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMLModel)))
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 Integer
-> Maybe POSIX
-> Maybe Text
-> Maybe RealtimeEndpointInfo
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe MLModelType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe POSIX
-> Maybe Integer
-> Maybe POSIX
-> Maybe EntityStatus
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> GetMLModelResponse
GetMLModelResponse'
            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
"ComputeTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreatedByIamUser")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndpointInfo")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FinishedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"InputDataLocationS3")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LogUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MLModelId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MLModelType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Recipe")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Schema")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScoreThreshold")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScoreThresholdLastUpdatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SizeInBytes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TrainingDataSourceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TrainingParameters"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 GetMLModel where
  hashWithSalt :: Int -> GetMLModel -> Int
hashWithSalt Int
_salt GetMLModel' {Maybe Bool
Text
mLModelId :: Text
verbose :: Maybe Bool
$sel:mLModelId:GetMLModel' :: GetMLModel -> Text
$sel:verbose:GetMLModel' :: GetMLModel -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
verbose
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mLModelId

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

instance Data.ToHeaders GetMLModel where
  toHeaders :: GetMLModel -> 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.GetMLModel" ::
                          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 GetMLModel where
  toJSON :: GetMLModel -> Value
toJSON GetMLModel' {Maybe Bool
Text
mLModelId :: Text
verbose :: Maybe Bool
$sel:mLModelId:GetMLModel' :: GetMLModel -> Text
$sel:verbose:GetMLModel' :: GetMLModel -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Verbose" 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 Bool
verbose,
            forall a. a -> Maybe a
Prelude.Just (Key
"MLModelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mLModelId)
          ]
      )

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

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

-- | Represents the output of a @GetMLModel@ operation, and provides detailed
-- information about a @MLModel@.
--
-- /See:/ 'newGetMLModelResponse' smart constructor.
data GetMLModelResponse = GetMLModelResponse'
  { -- | The approximate CPU time in milliseconds that Amazon Machine Learning
    -- spent processing the @MLModel@, normalized and scaled on computation
    -- resources. @ComputeTime@ is only available if the @MLModel@ is in the
    -- @COMPLETED@ state.
    GetMLModelResponse -> Maybe Integer
computeTime :: Prelude.Maybe Prelude.Integer,
    -- | The time that the @MLModel@ was created. The time is expressed in epoch
    -- time.
    GetMLModelResponse -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The AWS user account from which the @MLModel@ was created. The account
    -- type can be either an AWS root account or an AWS Identity and Access
    -- Management (IAM) user account.
    GetMLModelResponse -> Maybe Text
createdByIamUser :: Prelude.Maybe Prelude.Text,
    -- | The current endpoint of the @MLModel@
    GetMLModelResponse -> Maybe RealtimeEndpointInfo
endpointInfo :: Prelude.Maybe RealtimeEndpointInfo,
    -- | The epoch time when Amazon Machine Learning marked the @MLModel@ as
    -- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
    -- @MLModel@ is in the @COMPLETED@ or @FAILED@ state.
    GetMLModelResponse -> Maybe POSIX
finishedAt :: Prelude.Maybe Data.POSIX,
    -- | The location of the data file or directory in Amazon Simple Storage
    -- Service (Amazon S3).
    GetMLModelResponse -> Maybe Text
inputDataLocationS3 :: Prelude.Maybe Prelude.Text,
    -- | The time of the most recent edit to the @MLModel@. The time is expressed
    -- in epoch time.
    GetMLModelResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | A link to the file that contains logs of the @CreateMLModel@ operation.
    GetMLModelResponse -> Maybe Text
logUri :: Prelude.Maybe Prelude.Text,
    -- | The MLModel ID, which is same as the @MLModelId@ in the request.
    GetMLModelResponse -> Maybe Text
mLModelId :: Prelude.Maybe Prelude.Text,
    -- | Identifies the @MLModel@ category. The following are the available
    -- types:
    --
    -- -   REGRESSION -- Produces a numeric result. For example, \"What price
    --     should a house be listed at?\"
    --
    -- -   BINARY -- Produces one of two possible results. For example, \"Is
    --     this an e-commerce website?\"
    --
    -- -   MULTICLASS -- Produces one of several possible results. For example,
    --     \"Is this a HIGH, LOW or MEDIUM risk trade?\"
    GetMLModelResponse -> Maybe MLModelType
mLModelType :: Prelude.Maybe MLModelType,
    -- | A description of the most recent details about accessing the @MLModel@.
    GetMLModelResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied name or description of the @MLModel@.
    GetMLModelResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The recipe to use when training the @MLModel@. The @Recipe@ provides
    -- detailed information about the observation data to use during training,
    -- and manipulations to perform on the observation data during training.
    --
    -- __Note:__ This parameter is provided as part of the verbose format.
    GetMLModelResponse -> Maybe Text
recipe :: Prelude.Maybe Prelude.Text,
    -- | The schema used by all of the data files referenced by the @DataSource@.
    --
    -- __Note:__ This parameter is provided as part of the verbose format.
    GetMLModelResponse -> Maybe Text
schema :: Prelude.Maybe Prelude.Text,
    -- | The scoring threshold is used in binary classification @MLModel@ models.
    -- It marks the boundary between a positive prediction and a negative
    -- prediction.
    --
    -- Output values greater than or equal to the threshold receive a positive
    -- result from the MLModel, such as @true@. Output values less than the
    -- threshold receive a negative response from the MLModel, such as @false@.
    GetMLModelResponse -> Maybe Double
scoreThreshold :: Prelude.Maybe Prelude.Double,
    -- | The time of the most recent edit to the @ScoreThreshold@. The time is
    -- expressed in epoch time.
    GetMLModelResponse -> Maybe POSIX
scoreThresholdLastUpdatedAt :: Prelude.Maybe Data.POSIX,
    GetMLModelResponse -> Maybe Integer
sizeInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The epoch time when Amazon Machine Learning marked the @MLModel@ as
    -- @INPROGRESS@. @StartedAt@ isn\'t available if the @MLModel@ is in the
    -- @PENDING@ state.
    GetMLModelResponse -> Maybe POSIX
startedAt :: Prelude.Maybe Data.POSIX,
    -- | The current status of the @MLModel@. This element can have one of the
    -- following values:
    --
    -- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
    --     to describe a @MLModel@.
    --
    -- -   @INPROGRESS@ - The request is processing.
    --
    -- -   @FAILED@ - The request did not run to completion. The ML model
    --     isn\'t usable.
    --
    -- -   @COMPLETED@ - The request completed successfully.
    --
    -- -   @DELETED@ - The @MLModel@ is marked as deleted. It isn\'t usable.
    GetMLModelResponse -> Maybe EntityStatus
status :: Prelude.Maybe EntityStatus,
    -- | The ID of the training @DataSource@.
    GetMLModelResponse -> Maybe Text
trainingDataSourceId :: 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 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.
    GetMLModelResponse -> Maybe (HashMap Text Text)
trainingParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetMLModelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMLModelResponse -> GetMLModelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMLModelResponse -> GetMLModelResponse -> Bool
$c/= :: GetMLModelResponse -> GetMLModelResponse -> Bool
== :: GetMLModelResponse -> GetMLModelResponse -> Bool
$c== :: GetMLModelResponse -> GetMLModelResponse -> Bool
Prelude.Eq, ReadPrec [GetMLModelResponse]
ReadPrec GetMLModelResponse
Int -> ReadS GetMLModelResponse
ReadS [GetMLModelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMLModelResponse]
$creadListPrec :: ReadPrec [GetMLModelResponse]
readPrec :: ReadPrec GetMLModelResponse
$creadPrec :: ReadPrec GetMLModelResponse
readList :: ReadS [GetMLModelResponse]
$creadList :: ReadS [GetMLModelResponse]
readsPrec :: Int -> ReadS GetMLModelResponse
$creadsPrec :: Int -> ReadS GetMLModelResponse
Prelude.Read, Int -> GetMLModelResponse -> ShowS
[GetMLModelResponse] -> ShowS
GetMLModelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMLModelResponse] -> ShowS
$cshowList :: [GetMLModelResponse] -> ShowS
show :: GetMLModelResponse -> String
$cshow :: GetMLModelResponse -> String
showsPrec :: Int -> GetMLModelResponse -> ShowS
$cshowsPrec :: Int -> GetMLModelResponse -> ShowS
Prelude.Show, forall x. Rep GetMLModelResponse x -> GetMLModelResponse
forall x. GetMLModelResponse -> Rep GetMLModelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMLModelResponse x -> GetMLModelResponse
$cfrom :: forall x. GetMLModelResponse -> Rep GetMLModelResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMLModelResponse' 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:
--
-- 'computeTime', 'getMLModelResponse_computeTime' - The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @MLModel@, normalized and scaled on computation
-- resources. @ComputeTime@ is only available if the @MLModel@ is in the
-- @COMPLETED@ state.
--
-- 'createdAt', 'getMLModelResponse_createdAt' - The time that the @MLModel@ was created. The time is expressed in epoch
-- time.
--
-- 'createdByIamUser', 'getMLModelResponse_createdByIamUser' - The AWS user account from which the @MLModel@ was created. The account
-- type can be either an AWS root account or an AWS Identity and Access
-- Management (IAM) user account.
--
-- 'endpointInfo', 'getMLModelResponse_endpointInfo' - The current endpoint of the @MLModel@
--
-- 'finishedAt', 'getMLModelResponse_finishedAt' - The epoch time when Amazon Machine Learning marked the @MLModel@ as
-- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @MLModel@ is in the @COMPLETED@ or @FAILED@ state.
--
-- 'inputDataLocationS3', 'getMLModelResponse_inputDataLocationS3' - The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
--
-- 'lastUpdatedAt', 'getMLModelResponse_lastUpdatedAt' - The time of the most recent edit to the @MLModel@. The time is expressed
-- in epoch time.
--
-- 'logUri', 'getMLModelResponse_logUri' - A link to the file that contains logs of the @CreateMLModel@ operation.
--
-- 'mLModelId', 'getMLModelResponse_mLModelId' - The MLModel ID, which is same as the @MLModelId@ in the request.
--
-- 'mLModelType', 'getMLModelResponse_mLModelType' - Identifies the @MLModel@ category. The following are the available
-- types:
--
-- -   REGRESSION -- Produces a numeric result. For example, \"What price
--     should a house be listed at?\"
--
-- -   BINARY -- Produces one of two possible results. For example, \"Is
--     this an e-commerce website?\"
--
-- -   MULTICLASS -- Produces one of several possible results. For example,
--     \"Is this a HIGH, LOW or MEDIUM risk trade?\"
--
-- 'message', 'getMLModelResponse_message' - A description of the most recent details about accessing the @MLModel@.
--
-- 'name', 'getMLModelResponse_name' - A user-supplied name or description of the @MLModel@.
--
-- 'recipe', 'getMLModelResponse_recipe' - The recipe to use when training the @MLModel@. The @Recipe@ provides
-- detailed information about the observation data to use during training,
-- and manipulations to perform on the observation data during training.
--
-- __Note:__ This parameter is provided as part of the verbose format.
--
-- 'schema', 'getMLModelResponse_schema' - The schema used by all of the data files referenced by the @DataSource@.
--
-- __Note:__ This parameter is provided as part of the verbose format.
--
-- 'scoreThreshold', 'getMLModelResponse_scoreThreshold' - The scoring threshold is used in binary classification @MLModel@ models.
-- It marks the boundary between a positive prediction and a negative
-- prediction.
--
-- Output values greater than or equal to the threshold receive a positive
-- result from the MLModel, such as @true@. Output values less than the
-- threshold receive a negative response from the MLModel, such as @false@.
--
-- 'scoreThresholdLastUpdatedAt', 'getMLModelResponse_scoreThresholdLastUpdatedAt' - The time of the most recent edit to the @ScoreThreshold@. The time is
-- expressed in epoch time.
--
-- 'sizeInBytes', 'getMLModelResponse_sizeInBytes' - Undocumented member.
--
-- 'startedAt', 'getMLModelResponse_startedAt' - The epoch time when Amazon Machine Learning marked the @MLModel@ as
-- @INPROGRESS@. @StartedAt@ isn\'t available if the @MLModel@ is in the
-- @PENDING@ state.
--
-- 'status', 'getMLModelResponse_status' - The current status of the @MLModel@. This element can have one of the
-- following values:
--
-- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
--     to describe a @MLModel@.
--
-- -   @INPROGRESS@ - The request is processing.
--
-- -   @FAILED@ - The request did not run to completion. The ML model
--     isn\'t usable.
--
-- -   @COMPLETED@ - The request completed successfully.
--
-- -   @DELETED@ - The @MLModel@ is marked as deleted. It isn\'t usable.
--
-- 'trainingDataSourceId', 'getMLModelResponse_trainingDataSourceId' - The ID of the training @DataSource@.
--
-- 'trainingParameters', 'getMLModelResponse_trainingParameters' - 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 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.
--
-- 'httpStatus', 'getMLModelResponse_httpStatus' - The response's http status code.
newGetMLModelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMLModelResponse
newGetMLModelResponse :: Int -> GetMLModelResponse
newGetMLModelResponse Int
pHttpStatus_ =
  GetMLModelResponse'
    { $sel:computeTime:GetMLModelResponse' :: Maybe Integer
computeTime = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:GetMLModelResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:createdByIamUser:GetMLModelResponse' :: Maybe Text
createdByIamUser = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointInfo:GetMLModelResponse' :: Maybe RealtimeEndpointInfo
endpointInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:finishedAt:GetMLModelResponse' :: Maybe POSIX
finishedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:inputDataLocationS3:GetMLModelResponse' :: Maybe Text
inputDataLocationS3 = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:GetMLModelResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:logUri:GetMLModelResponse' :: Maybe Text
logUri = forall a. Maybe a
Prelude.Nothing,
      $sel:mLModelId:GetMLModelResponse' :: Maybe Text
mLModelId = forall a. Maybe a
Prelude.Nothing,
      $sel:mLModelType:GetMLModelResponse' :: Maybe MLModelType
mLModelType = forall a. Maybe a
Prelude.Nothing,
      $sel:message:GetMLModelResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetMLModelResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:recipe:GetMLModelResponse' :: Maybe Text
recipe = forall a. Maybe a
Prelude.Nothing,
      $sel:schema:GetMLModelResponse' :: Maybe Text
schema = forall a. Maybe a
Prelude.Nothing,
      $sel:scoreThreshold:GetMLModelResponse' :: Maybe Double
scoreThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:scoreThresholdLastUpdatedAt:GetMLModelResponse' :: Maybe POSIX
scoreThresholdLastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:sizeInBytes:GetMLModelResponse' :: Maybe Integer
sizeInBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAt:GetMLModelResponse' :: Maybe POSIX
startedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetMLModelResponse' :: Maybe EntityStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:trainingDataSourceId:GetMLModelResponse' :: Maybe Text
trainingDataSourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:trainingParameters:GetMLModelResponse' :: Maybe (HashMap Text Text)
trainingParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMLModelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @MLModel@, normalized and scaled on computation
-- resources. @ComputeTime@ is only available if the @MLModel@ is in the
-- @COMPLETED@ state.
getMLModelResponse_computeTime :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Integer)
getMLModelResponse_computeTime :: Lens' GetMLModelResponse (Maybe Integer)
getMLModelResponse_computeTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Integer
computeTime :: Maybe Integer
$sel:computeTime:GetMLModelResponse' :: GetMLModelResponse -> Maybe Integer
computeTime} -> Maybe Integer
computeTime) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Integer
a -> GetMLModelResponse
s {$sel:computeTime:GetMLModelResponse' :: Maybe Integer
computeTime = Maybe Integer
a} :: GetMLModelResponse)

-- | The time that the @MLModel@ was created. The time is expressed in epoch
-- time.
getMLModelResponse_createdAt :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.UTCTime)
getMLModelResponse_createdAt :: Lens' GetMLModelResponse (Maybe UTCTime)
getMLModelResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe POSIX
a -> GetMLModelResponse
s {$sel:createdAt:GetMLModelResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: GetMLModelResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The AWS user account from which the @MLModel@ was created. The account
-- type can be either an AWS root account or an AWS Identity and Access
-- Management (IAM) user account.
getMLModelResponse_createdByIamUser :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_createdByIamUser :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_createdByIamUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
createdByIamUser :: Maybe Text
$sel:createdByIamUser:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
createdByIamUser} -> Maybe Text
createdByIamUser) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:createdByIamUser:GetMLModelResponse' :: Maybe Text
createdByIamUser = Maybe Text
a} :: GetMLModelResponse)

-- | The current endpoint of the @MLModel@
getMLModelResponse_endpointInfo :: Lens.Lens' GetMLModelResponse (Prelude.Maybe RealtimeEndpointInfo)
getMLModelResponse_endpointInfo :: Lens' GetMLModelResponse (Maybe RealtimeEndpointInfo)
getMLModelResponse_endpointInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe RealtimeEndpointInfo
endpointInfo :: Maybe RealtimeEndpointInfo
$sel:endpointInfo:GetMLModelResponse' :: GetMLModelResponse -> Maybe RealtimeEndpointInfo
endpointInfo} -> Maybe RealtimeEndpointInfo
endpointInfo) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe RealtimeEndpointInfo
a -> GetMLModelResponse
s {$sel:endpointInfo:GetMLModelResponse' :: Maybe RealtimeEndpointInfo
endpointInfo = Maybe RealtimeEndpointInfo
a} :: GetMLModelResponse)

-- | The epoch time when Amazon Machine Learning marked the @MLModel@ as
-- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @MLModel@ is in the @COMPLETED@ or @FAILED@ state.
getMLModelResponse_finishedAt :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.UTCTime)
getMLModelResponse_finishedAt :: Lens' GetMLModelResponse (Maybe UTCTime)
getMLModelResponse_finishedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe POSIX
finishedAt :: Maybe POSIX
$sel:finishedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
finishedAt} -> Maybe POSIX
finishedAt) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe POSIX
a -> GetMLModelResponse
s {$sel:finishedAt:GetMLModelResponse' :: Maybe POSIX
finishedAt = Maybe POSIX
a} :: GetMLModelResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
getMLModelResponse_inputDataLocationS3 :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_inputDataLocationS3 :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_inputDataLocationS3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
inputDataLocationS3 :: Maybe Text
$sel:inputDataLocationS3:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
inputDataLocationS3} -> Maybe Text
inputDataLocationS3) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:inputDataLocationS3:GetMLModelResponse' :: Maybe Text
inputDataLocationS3 = Maybe Text
a} :: GetMLModelResponse)

-- | The time of the most recent edit to the @MLModel@. The time is expressed
-- in epoch time.
getMLModelResponse_lastUpdatedAt :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.UTCTime)
getMLModelResponse_lastUpdatedAt :: Lens' GetMLModelResponse (Maybe UTCTime)
getMLModelResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe POSIX
a -> GetMLModelResponse
s {$sel:lastUpdatedAt:GetMLModelResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetMLModelResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A link to the file that contains logs of the @CreateMLModel@ operation.
getMLModelResponse_logUri :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_logUri :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_logUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
logUri :: Maybe Text
$sel:logUri:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
logUri} -> Maybe Text
logUri) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:logUri:GetMLModelResponse' :: Maybe Text
logUri = Maybe Text
a} :: GetMLModelResponse)

-- | The MLModel ID, which is same as the @MLModelId@ in the request.
getMLModelResponse_mLModelId :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_mLModelId :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_mLModelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
mLModelId :: Maybe Text
$sel:mLModelId:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
mLModelId} -> Maybe Text
mLModelId) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:mLModelId:GetMLModelResponse' :: Maybe Text
mLModelId = Maybe Text
a} :: GetMLModelResponse)

-- | Identifies the @MLModel@ category. The following are the available
-- types:
--
-- -   REGRESSION -- Produces a numeric result. For example, \"What price
--     should a house be listed at?\"
--
-- -   BINARY -- Produces one of two possible results. For example, \"Is
--     this an e-commerce website?\"
--
-- -   MULTICLASS -- Produces one of several possible results. For example,
--     \"Is this a HIGH, LOW or MEDIUM risk trade?\"
getMLModelResponse_mLModelType :: Lens.Lens' GetMLModelResponse (Prelude.Maybe MLModelType)
getMLModelResponse_mLModelType :: Lens' GetMLModelResponse (Maybe MLModelType)
getMLModelResponse_mLModelType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe MLModelType
mLModelType :: Maybe MLModelType
$sel:mLModelType:GetMLModelResponse' :: GetMLModelResponse -> Maybe MLModelType
mLModelType} -> Maybe MLModelType
mLModelType) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe MLModelType
a -> GetMLModelResponse
s {$sel:mLModelType:GetMLModelResponse' :: Maybe MLModelType
mLModelType = Maybe MLModelType
a} :: GetMLModelResponse)

-- | A description of the most recent details about accessing the @MLModel@.
getMLModelResponse_message :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_message :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
message :: Maybe Text
$sel:message:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:message:GetMLModelResponse' :: Maybe Text
message = Maybe Text
a} :: GetMLModelResponse)

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

-- | The recipe to use when training the @MLModel@. The @Recipe@ provides
-- detailed information about the observation data to use during training,
-- and manipulations to perform on the observation data during training.
--
-- __Note:__ This parameter is provided as part of the verbose format.
getMLModelResponse_recipe :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_recipe :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_recipe = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
recipe :: Maybe Text
$sel:recipe:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
recipe} -> Maybe Text
recipe) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:recipe:GetMLModelResponse' :: Maybe Text
recipe = Maybe Text
a} :: GetMLModelResponse)

-- | The schema used by all of the data files referenced by the @DataSource@.
--
-- __Note:__ This parameter is provided as part of the verbose format.
getMLModelResponse_schema :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_schema :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
schema :: Maybe Text
$sel:schema:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
schema} -> Maybe Text
schema) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:schema:GetMLModelResponse' :: Maybe Text
schema = Maybe Text
a} :: GetMLModelResponse)

-- | The scoring threshold is used in binary classification @MLModel@ models.
-- It marks the boundary between a positive prediction and a negative
-- prediction.
--
-- Output values greater than or equal to the threshold receive a positive
-- result from the MLModel, such as @true@. Output values less than the
-- threshold receive a negative response from the MLModel, such as @false@.
getMLModelResponse_scoreThreshold :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Double)
getMLModelResponse_scoreThreshold :: Lens' GetMLModelResponse (Maybe Double)
getMLModelResponse_scoreThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Double
scoreThreshold :: Maybe Double
$sel:scoreThreshold:GetMLModelResponse' :: GetMLModelResponse -> Maybe Double
scoreThreshold} -> Maybe Double
scoreThreshold) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Double
a -> GetMLModelResponse
s {$sel:scoreThreshold:GetMLModelResponse' :: Maybe Double
scoreThreshold = Maybe Double
a} :: GetMLModelResponse)

-- | The time of the most recent edit to the @ScoreThreshold@. The time is
-- expressed in epoch time.
getMLModelResponse_scoreThresholdLastUpdatedAt :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.UTCTime)
getMLModelResponse_scoreThresholdLastUpdatedAt :: Lens' GetMLModelResponse (Maybe UTCTime)
getMLModelResponse_scoreThresholdLastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe POSIX
scoreThresholdLastUpdatedAt :: Maybe POSIX
$sel:scoreThresholdLastUpdatedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
scoreThresholdLastUpdatedAt} -> Maybe POSIX
scoreThresholdLastUpdatedAt) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe POSIX
a -> GetMLModelResponse
s {$sel:scoreThresholdLastUpdatedAt:GetMLModelResponse' :: Maybe POSIX
scoreThresholdLastUpdatedAt = Maybe POSIX
a} :: GetMLModelResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Undocumented member.
getMLModelResponse_sizeInBytes :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Integer)
getMLModelResponse_sizeInBytes :: Lens' GetMLModelResponse (Maybe Integer)
getMLModelResponse_sizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Integer
sizeInBytes :: Maybe Integer
$sel:sizeInBytes:GetMLModelResponse' :: GetMLModelResponse -> Maybe Integer
sizeInBytes} -> Maybe Integer
sizeInBytes) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Integer
a -> GetMLModelResponse
s {$sel:sizeInBytes:GetMLModelResponse' :: Maybe Integer
sizeInBytes = Maybe Integer
a} :: GetMLModelResponse)

-- | The epoch time when Amazon Machine Learning marked the @MLModel@ as
-- @INPROGRESS@. @StartedAt@ isn\'t available if the @MLModel@ is in the
-- @PENDING@ state.
getMLModelResponse_startedAt :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.UTCTime)
getMLModelResponse_startedAt :: Lens' GetMLModelResponse (Maybe UTCTime)
getMLModelResponse_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe POSIX
startedAt :: Maybe POSIX
$sel:startedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
startedAt} -> Maybe POSIX
startedAt) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe POSIX
a -> GetMLModelResponse
s {$sel:startedAt:GetMLModelResponse' :: Maybe POSIX
startedAt = Maybe POSIX
a} :: GetMLModelResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current status of the @MLModel@. This element can have one of the
-- following values:
--
-- -   @PENDING@ - Amazon Machine Learning (Amazon ML) submitted a request
--     to describe a @MLModel@.
--
-- -   @INPROGRESS@ - The request is processing.
--
-- -   @FAILED@ - The request did not run to completion. The ML model
--     isn\'t usable.
--
-- -   @COMPLETED@ - The request completed successfully.
--
-- -   @DELETED@ - The @MLModel@ is marked as deleted. It isn\'t usable.
getMLModelResponse_status :: Lens.Lens' GetMLModelResponse (Prelude.Maybe EntityStatus)
getMLModelResponse_status :: Lens' GetMLModelResponse (Maybe EntityStatus)
getMLModelResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe EntityStatus
status :: Maybe EntityStatus
$sel:status:GetMLModelResponse' :: GetMLModelResponse -> Maybe EntityStatus
status} -> Maybe EntityStatus
status) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe EntityStatus
a -> GetMLModelResponse
s {$sel:status:GetMLModelResponse' :: Maybe EntityStatus
status = Maybe EntityStatus
a} :: GetMLModelResponse)

-- | The ID of the training @DataSource@.
getMLModelResponse_trainingDataSourceId :: Lens.Lens' GetMLModelResponse (Prelude.Maybe Prelude.Text)
getMLModelResponse_trainingDataSourceId :: Lens' GetMLModelResponse (Maybe Text)
getMLModelResponse_trainingDataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe Text
trainingDataSourceId :: Maybe Text
$sel:trainingDataSourceId:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
trainingDataSourceId} -> Maybe Text
trainingDataSourceId) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe Text
a -> GetMLModelResponse
s {$sel:trainingDataSourceId:GetMLModelResponse' :: Maybe Text
trainingDataSourceId = Maybe Text
a} :: GetMLModelResponse)

-- | 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 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.
getMLModelResponse_trainingParameters :: Lens.Lens' GetMLModelResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getMLModelResponse_trainingParameters :: Lens' GetMLModelResponse (Maybe (HashMap Text Text))
getMLModelResponse_trainingParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Maybe (HashMap Text Text)
trainingParameters :: Maybe (HashMap Text Text)
$sel:trainingParameters:GetMLModelResponse' :: GetMLModelResponse -> Maybe (HashMap Text Text)
trainingParameters} -> Maybe (HashMap Text Text)
trainingParameters) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Maybe (HashMap Text Text)
a -> GetMLModelResponse
s {$sel:trainingParameters:GetMLModelResponse' :: Maybe (HashMap Text Text)
trainingParameters = Maybe (HashMap Text Text)
a} :: GetMLModelResponse) 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 response's http status code.
getMLModelResponse_httpStatus :: Lens.Lens' GetMLModelResponse Prelude.Int
getMLModelResponse_httpStatus :: Lens' GetMLModelResponse Int
getMLModelResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLModelResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetMLModelResponse' :: GetMLModelResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetMLModelResponse
s@GetMLModelResponse' {} Int
a -> GetMLModelResponse
s {$sel:httpStatus:GetMLModelResponse' :: Int
httpStatus = Int
a} :: GetMLModelResponse)

instance Prelude.NFData GetMLModelResponse where
  rnf :: GetMLModelResponse -> ()
rnf GetMLModelResponse' {Int
Maybe Double
Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe EntityStatus
Maybe MLModelType
Maybe RealtimeEndpointInfo
httpStatus :: Int
trainingParameters :: Maybe (HashMap Text Text)
trainingDataSourceId :: Maybe Text
status :: Maybe EntityStatus
startedAt :: Maybe POSIX
sizeInBytes :: Maybe Integer
scoreThresholdLastUpdatedAt :: Maybe POSIX
scoreThreshold :: Maybe Double
schema :: Maybe Text
recipe :: Maybe Text
name :: Maybe Text
message :: Maybe Text
mLModelType :: Maybe MLModelType
mLModelId :: Maybe Text
logUri :: Maybe Text
lastUpdatedAt :: Maybe POSIX
inputDataLocationS3 :: Maybe Text
finishedAt :: Maybe POSIX
endpointInfo :: Maybe RealtimeEndpointInfo
createdByIamUser :: Maybe Text
createdAt :: Maybe POSIX
computeTime :: Maybe Integer
$sel:httpStatus:GetMLModelResponse' :: GetMLModelResponse -> Int
$sel:trainingParameters:GetMLModelResponse' :: GetMLModelResponse -> Maybe (HashMap Text Text)
$sel:trainingDataSourceId:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:status:GetMLModelResponse' :: GetMLModelResponse -> Maybe EntityStatus
$sel:startedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
$sel:sizeInBytes:GetMLModelResponse' :: GetMLModelResponse -> Maybe Integer
$sel:scoreThresholdLastUpdatedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
$sel:scoreThreshold:GetMLModelResponse' :: GetMLModelResponse -> Maybe Double
$sel:schema:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:recipe:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:name:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:message:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:mLModelType:GetMLModelResponse' :: GetMLModelResponse -> Maybe MLModelType
$sel:mLModelId:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:logUri:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:lastUpdatedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
$sel:inputDataLocationS3:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:finishedAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
$sel:endpointInfo:GetMLModelResponse' :: GetMLModelResponse -> Maybe RealtimeEndpointInfo
$sel:createdByIamUser:GetMLModelResponse' :: GetMLModelResponse -> Maybe Text
$sel:createdAt:GetMLModelResponse' :: GetMLModelResponse -> Maybe POSIX
$sel:computeTime:GetMLModelResponse' :: GetMLModelResponse -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
computeTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdByIamUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RealtimeEndpointInfo
endpointInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
finishedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
inputDataLocationS3
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe MLModelType
mLModelType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      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
schema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
scoreThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe POSIX
scoreThresholdLastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
sizeInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntityStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
trainingDataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe (HashMap Text Text)
trainingParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus