{-# 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.SageMaker.Types.InferenceSpecification
-- 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.SageMaker.Types.InferenceSpecification where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SageMaker.Types.ModelPackageContainerDefinition
import Amazonka.SageMaker.Types.ProductionVariantInstanceType
import Amazonka.SageMaker.Types.TransformInstanceType

-- | Defines how to perform inference generation after a training job is run.
--
-- /See:/ 'newInferenceSpecification' smart constructor.
data InferenceSpecification = InferenceSpecification'
  { -- | A list of the instance types that are used to generate inferences in
    -- real-time.
    --
    -- This parameter is required for unversioned models, and optional for
    -- versioned models.
    InferenceSpecification -> Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes :: Prelude.Maybe [ProductionVariantInstanceType],
    -- | A list of the instance types on which a transformation job can be run or
    -- on which an endpoint can be deployed.
    --
    -- This parameter is required for unversioned models, and optional for
    -- versioned models.
    InferenceSpecification -> Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes :: Prelude.Maybe (Prelude.NonEmpty TransformInstanceType),
    -- | The Amazon ECR registry path of the Docker image that contains the
    -- inference code.
    InferenceSpecification -> NonEmpty ModelPackageContainerDefinition
containers :: Prelude.NonEmpty ModelPackageContainerDefinition,
    -- | The supported MIME types for the input data.
    InferenceSpecification -> [Text]
supportedContentTypes :: [Prelude.Text],
    -- | The supported MIME types for the output data.
    InferenceSpecification -> [Text]
supportedResponseMIMETypes :: [Prelude.Text]
  }
  deriving (InferenceSpecification -> InferenceSpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InferenceSpecification -> InferenceSpecification -> Bool
$c/= :: InferenceSpecification -> InferenceSpecification -> Bool
== :: InferenceSpecification -> InferenceSpecification -> Bool
$c== :: InferenceSpecification -> InferenceSpecification -> Bool
Prelude.Eq, ReadPrec [InferenceSpecification]
ReadPrec InferenceSpecification
Int -> ReadS InferenceSpecification
ReadS [InferenceSpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InferenceSpecification]
$creadListPrec :: ReadPrec [InferenceSpecification]
readPrec :: ReadPrec InferenceSpecification
$creadPrec :: ReadPrec InferenceSpecification
readList :: ReadS [InferenceSpecification]
$creadList :: ReadS [InferenceSpecification]
readsPrec :: Int -> ReadS InferenceSpecification
$creadsPrec :: Int -> ReadS InferenceSpecification
Prelude.Read, Int -> InferenceSpecification -> ShowS
[InferenceSpecification] -> ShowS
InferenceSpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InferenceSpecification] -> ShowS
$cshowList :: [InferenceSpecification] -> ShowS
show :: InferenceSpecification -> String
$cshow :: InferenceSpecification -> String
showsPrec :: Int -> InferenceSpecification -> ShowS
$cshowsPrec :: Int -> InferenceSpecification -> ShowS
Prelude.Show, forall x. Rep InferenceSpecification x -> InferenceSpecification
forall x. InferenceSpecification -> Rep InferenceSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InferenceSpecification x -> InferenceSpecification
$cfrom :: forall x. InferenceSpecification -> Rep InferenceSpecification x
Prelude.Generic)

-- |
-- Create a value of 'InferenceSpecification' 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:
--
-- 'supportedRealtimeInferenceInstanceTypes', 'inferenceSpecification_supportedRealtimeInferenceInstanceTypes' - A list of the instance types that are used to generate inferences in
-- real-time.
--
-- This parameter is required for unversioned models, and optional for
-- versioned models.
--
-- 'supportedTransformInstanceTypes', 'inferenceSpecification_supportedTransformInstanceTypes' - A list of the instance types on which a transformation job can be run or
-- on which an endpoint can be deployed.
--
-- This parameter is required for unversioned models, and optional for
-- versioned models.
--
-- 'containers', 'inferenceSpecification_containers' - The Amazon ECR registry path of the Docker image that contains the
-- inference code.
--
-- 'supportedContentTypes', 'inferenceSpecification_supportedContentTypes' - The supported MIME types for the input data.
--
-- 'supportedResponseMIMETypes', 'inferenceSpecification_supportedResponseMIMETypes' - The supported MIME types for the output data.
newInferenceSpecification ::
  -- | 'containers'
  Prelude.NonEmpty ModelPackageContainerDefinition ->
  InferenceSpecification
newInferenceSpecification :: NonEmpty ModelPackageContainerDefinition -> InferenceSpecification
newInferenceSpecification NonEmpty ModelPackageContainerDefinition
pContainers_ =
  InferenceSpecification'
    { $sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:supportedTransformInstanceTypes:InferenceSpecification' :: Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:containers:InferenceSpecification' :: NonEmpty ModelPackageContainerDefinition
containers = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty ModelPackageContainerDefinition
pContainers_,
      $sel:supportedContentTypes:InferenceSpecification' :: [Text]
supportedContentTypes = forall a. Monoid a => a
Prelude.mempty,
      $sel:supportedResponseMIMETypes:InferenceSpecification' :: [Text]
supportedResponseMIMETypes = forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of the instance types that are used to generate inferences in
-- real-time.
--
-- This parameter is required for unversioned models, and optional for
-- versioned models.
inferenceSpecification_supportedRealtimeInferenceInstanceTypes :: Lens.Lens' InferenceSpecification (Prelude.Maybe [ProductionVariantInstanceType])
inferenceSpecification_supportedRealtimeInferenceInstanceTypes :: Lens'
  InferenceSpecification (Maybe [ProductionVariantInstanceType])
inferenceSpecification_supportedRealtimeInferenceInstanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferenceSpecification' {Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes :: Maybe [ProductionVariantInstanceType]
$sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes} -> Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes) (\s :: InferenceSpecification
s@InferenceSpecification' {} Maybe [ProductionVariantInstanceType]
a -> InferenceSpecification
s {$sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes = Maybe [ProductionVariantInstanceType]
a} :: InferenceSpecification) 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

-- | A list of the instance types on which a transformation job can be run or
-- on which an endpoint can be deployed.
--
-- This parameter is required for unversioned models, and optional for
-- versioned models.
inferenceSpecification_supportedTransformInstanceTypes :: Lens.Lens' InferenceSpecification (Prelude.Maybe (Prelude.NonEmpty TransformInstanceType))
inferenceSpecification_supportedTransformInstanceTypes :: Lens'
  InferenceSpecification (Maybe (NonEmpty TransformInstanceType))
inferenceSpecification_supportedTransformInstanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferenceSpecification' {Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes :: Maybe (NonEmpty TransformInstanceType)
$sel:supportedTransformInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes} -> Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes) (\s :: InferenceSpecification
s@InferenceSpecification' {} Maybe (NonEmpty TransformInstanceType)
a -> InferenceSpecification
s {$sel:supportedTransformInstanceTypes:InferenceSpecification' :: Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes = Maybe (NonEmpty TransformInstanceType)
a} :: InferenceSpecification) 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 Amazon ECR registry path of the Docker image that contains the
-- inference code.
inferenceSpecification_containers :: Lens.Lens' InferenceSpecification (Prelude.NonEmpty ModelPackageContainerDefinition)
inferenceSpecification_containers :: Lens'
  InferenceSpecification (NonEmpty ModelPackageContainerDefinition)
inferenceSpecification_containers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferenceSpecification' {NonEmpty ModelPackageContainerDefinition
containers :: NonEmpty ModelPackageContainerDefinition
$sel:containers:InferenceSpecification' :: InferenceSpecification -> NonEmpty ModelPackageContainerDefinition
containers} -> NonEmpty ModelPackageContainerDefinition
containers) (\s :: InferenceSpecification
s@InferenceSpecification' {} NonEmpty ModelPackageContainerDefinition
a -> InferenceSpecification
s {$sel:containers:InferenceSpecification' :: NonEmpty ModelPackageContainerDefinition
containers = NonEmpty ModelPackageContainerDefinition
a} :: InferenceSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The supported MIME types for the input data.
inferenceSpecification_supportedContentTypes :: Lens.Lens' InferenceSpecification [Prelude.Text]
inferenceSpecification_supportedContentTypes :: Lens' InferenceSpecification [Text]
inferenceSpecification_supportedContentTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferenceSpecification' {[Text]
supportedContentTypes :: [Text]
$sel:supportedContentTypes:InferenceSpecification' :: InferenceSpecification -> [Text]
supportedContentTypes} -> [Text]
supportedContentTypes) (\s :: InferenceSpecification
s@InferenceSpecification' {} [Text]
a -> InferenceSpecification
s {$sel:supportedContentTypes:InferenceSpecification' :: [Text]
supportedContentTypes = [Text]
a} :: InferenceSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The supported MIME types for the output data.
inferenceSpecification_supportedResponseMIMETypes :: Lens.Lens' InferenceSpecification [Prelude.Text]
inferenceSpecification_supportedResponseMIMETypes :: Lens' InferenceSpecification [Text]
inferenceSpecification_supportedResponseMIMETypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InferenceSpecification' {[Text]
supportedResponseMIMETypes :: [Text]
$sel:supportedResponseMIMETypes:InferenceSpecification' :: InferenceSpecification -> [Text]
supportedResponseMIMETypes} -> [Text]
supportedResponseMIMETypes) (\s :: InferenceSpecification
s@InferenceSpecification' {} [Text]
a -> InferenceSpecification
s {$sel:supportedResponseMIMETypes:InferenceSpecification' :: [Text]
supportedResponseMIMETypes = [Text]
a} :: InferenceSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromJSON InferenceSpecification where
  parseJSON :: Value -> Parser InferenceSpecification
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InferenceSpecification"
      ( \Object
x ->
          Maybe [ProductionVariantInstanceType]
-> Maybe (NonEmpty TransformInstanceType)
-> NonEmpty ModelPackageContainerDefinition
-> [Text]
-> [Text]
-> InferenceSpecification
InferenceSpecification'
            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
"SupportedRealtimeInferenceInstanceTypes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            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
"SupportedTransformInstanceTypes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Containers")
            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
"SupportedContentTypes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            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
"SupportedResponseMIMETypes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable InferenceSpecification where
  hashWithSalt :: Int -> InferenceSpecification -> Int
hashWithSalt Int
_salt InferenceSpecification' {[Text]
Maybe [ProductionVariantInstanceType]
Maybe (NonEmpty TransformInstanceType)
NonEmpty ModelPackageContainerDefinition
supportedResponseMIMETypes :: [Text]
supportedContentTypes :: [Text]
containers :: NonEmpty ModelPackageContainerDefinition
supportedTransformInstanceTypes :: Maybe (NonEmpty TransformInstanceType)
supportedRealtimeInferenceInstanceTypes :: Maybe [ProductionVariantInstanceType]
$sel:supportedResponseMIMETypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:supportedContentTypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:containers:InferenceSpecification' :: InferenceSpecification -> NonEmpty ModelPackageContainerDefinition
$sel:supportedTransformInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe (NonEmpty TransformInstanceType)
$sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe [ProductionVariantInstanceType]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty ModelPackageContainerDefinition
containers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
supportedContentTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
supportedResponseMIMETypes

instance Prelude.NFData InferenceSpecification where
  rnf :: InferenceSpecification -> ()
rnf InferenceSpecification' {[Text]
Maybe [ProductionVariantInstanceType]
Maybe (NonEmpty TransformInstanceType)
NonEmpty ModelPackageContainerDefinition
supportedResponseMIMETypes :: [Text]
supportedContentTypes :: [Text]
containers :: NonEmpty ModelPackageContainerDefinition
supportedTransformInstanceTypes :: Maybe (NonEmpty TransformInstanceType)
supportedRealtimeInferenceInstanceTypes :: Maybe [ProductionVariantInstanceType]
$sel:supportedResponseMIMETypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:supportedContentTypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:containers:InferenceSpecification' :: InferenceSpecification -> NonEmpty ModelPackageContainerDefinition
$sel:supportedTransformInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe (NonEmpty TransformInstanceType)
$sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe [ProductionVariantInstanceType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty ModelPackageContainerDefinition
containers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
supportedContentTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
supportedResponseMIMETypes

instance Data.ToJSON InferenceSpecification where
  toJSON :: InferenceSpecification -> Value
toJSON InferenceSpecification' {[Text]
Maybe [ProductionVariantInstanceType]
Maybe (NonEmpty TransformInstanceType)
NonEmpty ModelPackageContainerDefinition
supportedResponseMIMETypes :: [Text]
supportedContentTypes :: [Text]
containers :: NonEmpty ModelPackageContainerDefinition
supportedTransformInstanceTypes :: Maybe (NonEmpty TransformInstanceType)
supportedRealtimeInferenceInstanceTypes :: Maybe [ProductionVariantInstanceType]
$sel:supportedResponseMIMETypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:supportedContentTypes:InferenceSpecification' :: InferenceSpecification -> [Text]
$sel:containers:InferenceSpecification' :: InferenceSpecification -> NonEmpty ModelPackageContainerDefinition
$sel:supportedTransformInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe (NonEmpty TransformInstanceType)
$sel:supportedRealtimeInferenceInstanceTypes:InferenceSpecification' :: InferenceSpecification -> Maybe [ProductionVariantInstanceType]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SupportedRealtimeInferenceInstanceTypes" 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 [ProductionVariantInstanceType]
supportedRealtimeInferenceInstanceTypes,
            (Key
"SupportedTransformInstanceTypes" 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 (NonEmpty TransformInstanceType)
supportedTransformInstanceTypes,
            forall a. a -> Maybe a
Prelude.Just (Key
"Containers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty ModelPackageContainerDefinition
containers),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"SupportedContentTypes"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
supportedContentTypes
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"SupportedResponseMIMETypes"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
supportedResponseMIMETypes
              )
          ]
      )