{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.LookoutVision.Types.ModelDescription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.LookoutVision.Types.ModelDescription where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LookoutVision.Types.ModelPerformance
import Amazonka.LookoutVision.Types.ModelStatus
import Amazonka.LookoutVision.Types.OutputConfig
import Amazonka.LookoutVision.Types.OutputS3Object
import qualified Amazonka.Prelude as Prelude

-- | Describes an Amazon Lookout for Vision model.
--
-- /See:/ 'newModelDescription' smart constructor.
data ModelDescription = ModelDescription'
  { -- | The unix timestamp for the date and time that the model was created.
    ModelDescription -> Maybe POSIX
creationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The description for the model.
    ModelDescription -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unix timestamp for the date and time that the evaluation ended.
    ModelDescription -> Maybe POSIX
evaluationEndTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The S3 location where Amazon Lookout for Vision saves the manifest file
    -- that was used to test the trained model and generate the performance
    -- scores.
    ModelDescription -> Maybe OutputS3Object
evaluationManifest :: Prelude.Maybe OutputS3Object,
    -- | The S3 location where Amazon Lookout for Vision saves the performance
    -- metrics.
    ModelDescription -> Maybe OutputS3Object
evaluationResult :: Prelude.Maybe OutputS3Object,
    -- | The identifer for the AWS Key Management Service (AWS KMS) key that was
    -- used to encrypt the model during training.
    ModelDescription -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of inference units Amazon Lookout for Vision uses to
    -- auto-scale the model. For more information, see StartModel.
    ModelDescription -> Maybe Natural
maxInferenceUnits :: Prelude.Maybe Prelude.Natural,
    -- | The minimum number of inference units used by the model. For more
    -- information, see StartModel
    ModelDescription -> Maybe Natural
minInferenceUnits :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the model.
    ModelDescription -> Maybe Text
modelArn :: Prelude.Maybe Prelude.Text,
    -- | The version of the model
    ModelDescription -> Maybe Text
modelVersion :: Prelude.Maybe Prelude.Text,
    -- | The S3 location where Amazon Lookout for Vision saves model training
    -- files.
    ModelDescription -> Maybe OutputConfig
outputConfig :: Prelude.Maybe OutputConfig,
    -- | Performance metrics for the model. Created during training.
    ModelDescription -> Maybe ModelPerformance
performance :: Prelude.Maybe ModelPerformance,
    -- | The status of the model.
    ModelDescription -> Maybe ModelStatus
status :: Prelude.Maybe ModelStatus,
    -- | The status message for the model.
    ModelDescription -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text
  }
  deriving (ModelDescription -> ModelDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelDescription -> ModelDescription -> Bool
$c/= :: ModelDescription -> ModelDescription -> Bool
== :: ModelDescription -> ModelDescription -> Bool
$c== :: ModelDescription -> ModelDescription -> Bool
Prelude.Eq, ReadPrec [ModelDescription]
ReadPrec ModelDescription
Int -> ReadS ModelDescription
ReadS [ModelDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModelDescription]
$creadListPrec :: ReadPrec [ModelDescription]
readPrec :: ReadPrec ModelDescription
$creadPrec :: ReadPrec ModelDescription
readList :: ReadS [ModelDescription]
$creadList :: ReadS [ModelDescription]
readsPrec :: Int -> ReadS ModelDescription
$creadsPrec :: Int -> ReadS ModelDescription
Prelude.Read, Int -> ModelDescription -> ShowS
[ModelDescription] -> ShowS
ModelDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelDescription] -> ShowS
$cshowList :: [ModelDescription] -> ShowS
show :: ModelDescription -> String
$cshow :: ModelDescription -> String
showsPrec :: Int -> ModelDescription -> ShowS
$cshowsPrec :: Int -> ModelDescription -> ShowS
Prelude.Show, forall x. Rep ModelDescription x -> ModelDescription
forall x. ModelDescription -> Rep ModelDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModelDescription x -> ModelDescription
$cfrom :: forall x. ModelDescription -> Rep ModelDescription x
Prelude.Generic)

-- |
-- Create a value of 'ModelDescription' 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:
--
-- 'creationTimestamp', 'modelDescription_creationTimestamp' - The unix timestamp for the date and time that the model was created.
--
-- 'description', 'modelDescription_description' - The description for the model.
--
-- 'evaluationEndTimestamp', 'modelDescription_evaluationEndTimestamp' - The unix timestamp for the date and time that the evaluation ended.
--
-- 'evaluationManifest', 'modelDescription_evaluationManifest' - The S3 location where Amazon Lookout for Vision saves the manifest file
-- that was used to test the trained model and generate the performance
-- scores.
--
-- 'evaluationResult', 'modelDescription_evaluationResult' - The S3 location where Amazon Lookout for Vision saves the performance
-- metrics.
--
-- 'kmsKeyId', 'modelDescription_kmsKeyId' - The identifer for the AWS Key Management Service (AWS KMS) key that was
-- used to encrypt the model during training.
--
-- 'maxInferenceUnits', 'modelDescription_maxInferenceUnits' - The maximum number of inference units Amazon Lookout for Vision uses to
-- auto-scale the model. For more information, see StartModel.
--
-- 'minInferenceUnits', 'modelDescription_minInferenceUnits' - The minimum number of inference units used by the model. For more
-- information, see StartModel
--
-- 'modelArn', 'modelDescription_modelArn' - The Amazon Resource Name (ARN) of the model.
--
-- 'modelVersion', 'modelDescription_modelVersion' - The version of the model
--
-- 'outputConfig', 'modelDescription_outputConfig' - The S3 location where Amazon Lookout for Vision saves model training
-- files.
--
-- 'performance', 'modelDescription_performance' - Performance metrics for the model. Created during training.
--
-- 'status', 'modelDescription_status' - The status of the model.
--
-- 'statusMessage', 'modelDescription_statusMessage' - The status message for the model.
newModelDescription ::
  ModelDescription
newModelDescription :: ModelDescription
newModelDescription =
  ModelDescription'
    { $sel:creationTimestamp:ModelDescription' :: Maybe POSIX
creationTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:ModelDescription' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationEndTimestamp:ModelDescription' :: Maybe POSIX
evaluationEndTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationManifest:ModelDescription' :: Maybe OutputS3Object
evaluationManifest = forall a. Maybe a
Prelude.Nothing,
      $sel:evaluationResult:ModelDescription' :: Maybe OutputS3Object
evaluationResult = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:ModelDescription' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxInferenceUnits:ModelDescription' :: Maybe Natural
maxInferenceUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:minInferenceUnits:ModelDescription' :: Maybe Natural
minInferenceUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:modelArn:ModelDescription' :: Maybe Text
modelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:modelVersion:ModelDescription' :: Maybe Text
modelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:outputConfig:ModelDescription' :: Maybe OutputConfig
outputConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:performance:ModelDescription' :: Maybe ModelPerformance
performance = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ModelDescription' :: Maybe ModelStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:ModelDescription' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing
    }

-- | The unix timestamp for the date and time that the model was created.
modelDescription_creationTimestamp :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.UTCTime)
modelDescription_creationTimestamp :: Lens' ModelDescription (Maybe UTCTime)
modelDescription_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe POSIX
creationTimestamp :: Maybe POSIX
$sel:creationTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
creationTimestamp} -> Maybe POSIX
creationTimestamp) (\s :: ModelDescription
s@ModelDescription' {} Maybe POSIX
a -> ModelDescription
s {$sel:creationTimestamp:ModelDescription' :: Maybe POSIX
creationTimestamp = Maybe POSIX
a} :: ModelDescription) 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 description for the model.
modelDescription_description :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Text)
modelDescription_description :: Lens' ModelDescription (Maybe Text)
modelDescription_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Text
description :: Maybe Text
$sel:description:ModelDescription' :: ModelDescription -> Maybe Text
description} -> Maybe Text
description) (\s :: ModelDescription
s@ModelDescription' {} Maybe Text
a -> ModelDescription
s {$sel:description:ModelDescription' :: Maybe Text
description = Maybe Text
a} :: ModelDescription)

-- | The unix timestamp for the date and time that the evaluation ended.
modelDescription_evaluationEndTimestamp :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.UTCTime)
modelDescription_evaluationEndTimestamp :: Lens' ModelDescription (Maybe UTCTime)
modelDescription_evaluationEndTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe POSIX
evaluationEndTimestamp :: Maybe POSIX
$sel:evaluationEndTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
evaluationEndTimestamp} -> Maybe POSIX
evaluationEndTimestamp) (\s :: ModelDescription
s@ModelDescription' {} Maybe POSIX
a -> ModelDescription
s {$sel:evaluationEndTimestamp:ModelDescription' :: Maybe POSIX
evaluationEndTimestamp = Maybe POSIX
a} :: ModelDescription) 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 S3 location where Amazon Lookout for Vision saves the manifest file
-- that was used to test the trained model and generate the performance
-- scores.
modelDescription_evaluationManifest :: Lens.Lens' ModelDescription (Prelude.Maybe OutputS3Object)
modelDescription_evaluationManifest :: Lens' ModelDescription (Maybe OutputS3Object)
modelDescription_evaluationManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe OutputS3Object
evaluationManifest :: Maybe OutputS3Object
$sel:evaluationManifest:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
evaluationManifest} -> Maybe OutputS3Object
evaluationManifest) (\s :: ModelDescription
s@ModelDescription' {} Maybe OutputS3Object
a -> ModelDescription
s {$sel:evaluationManifest:ModelDescription' :: Maybe OutputS3Object
evaluationManifest = Maybe OutputS3Object
a} :: ModelDescription)

-- | The S3 location where Amazon Lookout for Vision saves the performance
-- metrics.
modelDescription_evaluationResult :: Lens.Lens' ModelDescription (Prelude.Maybe OutputS3Object)
modelDescription_evaluationResult :: Lens' ModelDescription (Maybe OutputS3Object)
modelDescription_evaluationResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe OutputS3Object
evaluationResult :: Maybe OutputS3Object
$sel:evaluationResult:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
evaluationResult} -> Maybe OutputS3Object
evaluationResult) (\s :: ModelDescription
s@ModelDescription' {} Maybe OutputS3Object
a -> ModelDescription
s {$sel:evaluationResult:ModelDescription' :: Maybe OutputS3Object
evaluationResult = Maybe OutputS3Object
a} :: ModelDescription)

-- | The identifer for the AWS Key Management Service (AWS KMS) key that was
-- used to encrypt the model during training.
modelDescription_kmsKeyId :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Text)
modelDescription_kmsKeyId :: Lens' ModelDescription (Maybe Text)
modelDescription_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:ModelDescription' :: ModelDescription -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: ModelDescription
s@ModelDescription' {} Maybe Text
a -> ModelDescription
s {$sel:kmsKeyId:ModelDescription' :: Maybe Text
kmsKeyId = Maybe Text
a} :: ModelDescription)

-- | The maximum number of inference units Amazon Lookout for Vision uses to
-- auto-scale the model. For more information, see StartModel.
modelDescription_maxInferenceUnits :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Natural)
modelDescription_maxInferenceUnits :: Lens' ModelDescription (Maybe Natural)
modelDescription_maxInferenceUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Natural
maxInferenceUnits :: Maybe Natural
$sel:maxInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
maxInferenceUnits} -> Maybe Natural
maxInferenceUnits) (\s :: ModelDescription
s@ModelDescription' {} Maybe Natural
a -> ModelDescription
s {$sel:maxInferenceUnits:ModelDescription' :: Maybe Natural
maxInferenceUnits = Maybe Natural
a} :: ModelDescription)

-- | The minimum number of inference units used by the model. For more
-- information, see StartModel
modelDescription_minInferenceUnits :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Natural)
modelDescription_minInferenceUnits :: Lens' ModelDescription (Maybe Natural)
modelDescription_minInferenceUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Natural
minInferenceUnits :: Maybe Natural
$sel:minInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
minInferenceUnits} -> Maybe Natural
minInferenceUnits) (\s :: ModelDescription
s@ModelDescription' {} Maybe Natural
a -> ModelDescription
s {$sel:minInferenceUnits:ModelDescription' :: Maybe Natural
minInferenceUnits = Maybe Natural
a} :: ModelDescription)

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

-- | The version of the model
modelDescription_modelVersion :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Text)
modelDescription_modelVersion :: Lens' ModelDescription (Maybe Text)
modelDescription_modelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Text
modelVersion :: Maybe Text
$sel:modelVersion:ModelDescription' :: ModelDescription -> Maybe Text
modelVersion} -> Maybe Text
modelVersion) (\s :: ModelDescription
s@ModelDescription' {} Maybe Text
a -> ModelDescription
s {$sel:modelVersion:ModelDescription' :: Maybe Text
modelVersion = Maybe Text
a} :: ModelDescription)

-- | The S3 location where Amazon Lookout for Vision saves model training
-- files.
modelDescription_outputConfig :: Lens.Lens' ModelDescription (Prelude.Maybe OutputConfig)
modelDescription_outputConfig :: Lens' ModelDescription (Maybe OutputConfig)
modelDescription_outputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe OutputConfig
outputConfig :: Maybe OutputConfig
$sel:outputConfig:ModelDescription' :: ModelDescription -> Maybe OutputConfig
outputConfig} -> Maybe OutputConfig
outputConfig) (\s :: ModelDescription
s@ModelDescription' {} Maybe OutputConfig
a -> ModelDescription
s {$sel:outputConfig:ModelDescription' :: Maybe OutputConfig
outputConfig = Maybe OutputConfig
a} :: ModelDescription)

-- | Performance metrics for the model. Created during training.
modelDescription_performance :: Lens.Lens' ModelDescription (Prelude.Maybe ModelPerformance)
modelDescription_performance :: Lens' ModelDescription (Maybe ModelPerformance)
modelDescription_performance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe ModelPerformance
performance :: Maybe ModelPerformance
$sel:performance:ModelDescription' :: ModelDescription -> Maybe ModelPerformance
performance} -> Maybe ModelPerformance
performance) (\s :: ModelDescription
s@ModelDescription' {} Maybe ModelPerformance
a -> ModelDescription
s {$sel:performance:ModelDescription' :: Maybe ModelPerformance
performance = Maybe ModelPerformance
a} :: ModelDescription)

-- | The status of the model.
modelDescription_status :: Lens.Lens' ModelDescription (Prelude.Maybe ModelStatus)
modelDescription_status :: Lens' ModelDescription (Maybe ModelStatus)
modelDescription_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe ModelStatus
status :: Maybe ModelStatus
$sel:status:ModelDescription' :: ModelDescription -> Maybe ModelStatus
status} -> Maybe ModelStatus
status) (\s :: ModelDescription
s@ModelDescription' {} Maybe ModelStatus
a -> ModelDescription
s {$sel:status:ModelDescription' :: Maybe ModelStatus
status = Maybe ModelStatus
a} :: ModelDescription)

-- | The status message for the model.
modelDescription_statusMessage :: Lens.Lens' ModelDescription (Prelude.Maybe Prelude.Text)
modelDescription_statusMessage :: Lens' ModelDescription (Maybe Text)
modelDescription_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelDescription' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:ModelDescription' :: ModelDescription -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: ModelDescription
s@ModelDescription' {} Maybe Text
a -> ModelDescription
s {$sel:statusMessage:ModelDescription' :: Maybe Text
statusMessage = Maybe Text
a} :: ModelDescription)

instance Data.FromJSON ModelDescription where
  parseJSON :: Value -> Parser ModelDescription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ModelDescription"
      ( \Object
x ->
          Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe OutputS3Object
-> Maybe OutputS3Object
-> Maybe Text
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe OutputConfig
-> Maybe ModelPerformance
-> Maybe ModelStatus
-> Maybe Text
-> ModelDescription
ModelDescription'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreationTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EvaluationEndTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EvaluationManifest")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EvaluationResult")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MaxInferenceUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MinInferenceUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ModelArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ModelVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OutputConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Performance")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (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 -> Parser (Maybe a)
Data..:? Key
"StatusMessage")
      )

instance Prelude.Hashable ModelDescription where
  hashWithSalt :: Int -> ModelDescription -> Int
hashWithSalt Int
_salt ModelDescription' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe ModelPerformance
Maybe ModelStatus
Maybe OutputS3Object
Maybe OutputConfig
statusMessage :: Maybe Text
status :: Maybe ModelStatus
performance :: Maybe ModelPerformance
outputConfig :: Maybe OutputConfig
modelVersion :: Maybe Text
modelArn :: Maybe Text
minInferenceUnits :: Maybe Natural
maxInferenceUnits :: Maybe Natural
kmsKeyId :: Maybe Text
evaluationResult :: Maybe OutputS3Object
evaluationManifest :: Maybe OutputS3Object
evaluationEndTimestamp :: Maybe POSIX
description :: Maybe Text
creationTimestamp :: Maybe POSIX
$sel:statusMessage:ModelDescription' :: ModelDescription -> Maybe Text
$sel:status:ModelDescription' :: ModelDescription -> Maybe ModelStatus
$sel:performance:ModelDescription' :: ModelDescription -> Maybe ModelPerformance
$sel:outputConfig:ModelDescription' :: ModelDescription -> Maybe OutputConfig
$sel:modelVersion:ModelDescription' :: ModelDescription -> Maybe Text
$sel:modelArn:ModelDescription' :: ModelDescription -> Maybe Text
$sel:minInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
$sel:maxInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
$sel:kmsKeyId:ModelDescription' :: ModelDescription -> Maybe Text
$sel:evaluationResult:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
$sel:evaluationManifest:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
$sel:evaluationEndTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
$sel:description:ModelDescription' :: ModelDescription -> Maybe Text
$sel:creationTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
evaluationEndTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputS3Object
evaluationManifest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputS3Object
evaluationResult
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxInferenceUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minInferenceUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputConfig
outputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelPerformance
performance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusMessage

instance Prelude.NFData ModelDescription where
  rnf :: ModelDescription -> ()
rnf ModelDescription' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe ModelPerformance
Maybe ModelStatus
Maybe OutputS3Object
Maybe OutputConfig
statusMessage :: Maybe Text
status :: Maybe ModelStatus
performance :: Maybe ModelPerformance
outputConfig :: Maybe OutputConfig
modelVersion :: Maybe Text
modelArn :: Maybe Text
minInferenceUnits :: Maybe Natural
maxInferenceUnits :: Maybe Natural
kmsKeyId :: Maybe Text
evaluationResult :: Maybe OutputS3Object
evaluationManifest :: Maybe OutputS3Object
evaluationEndTimestamp :: Maybe POSIX
description :: Maybe Text
creationTimestamp :: Maybe POSIX
$sel:statusMessage:ModelDescription' :: ModelDescription -> Maybe Text
$sel:status:ModelDescription' :: ModelDescription -> Maybe ModelStatus
$sel:performance:ModelDescription' :: ModelDescription -> Maybe ModelPerformance
$sel:outputConfig:ModelDescription' :: ModelDescription -> Maybe OutputConfig
$sel:modelVersion:ModelDescription' :: ModelDescription -> Maybe Text
$sel:modelArn:ModelDescription' :: ModelDescription -> Maybe Text
$sel:minInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
$sel:maxInferenceUnits:ModelDescription' :: ModelDescription -> Maybe Natural
$sel:kmsKeyId:ModelDescription' :: ModelDescription -> Maybe Text
$sel:evaluationResult:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
$sel:evaluationManifest:ModelDescription' :: ModelDescription -> Maybe OutputS3Object
$sel:evaluationEndTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
$sel:description:ModelDescription' :: ModelDescription -> Maybe Text
$sel:creationTimestamp:ModelDescription' :: ModelDescription -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
evaluationEndTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputS3Object
evaluationManifest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputS3Object
evaluationResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxInferenceUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minInferenceUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputConfig
outputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelPerformance
performance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage