{-# 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.ProcessingInput
-- 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.ProcessingInput 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.DatasetDefinition
import Amazonka.SageMaker.Types.ProcessingS3Input

-- | The inputs for a processing job. The processing input must specify
-- exactly one of either @S3Input@ or @DatasetDefinition@ types.
--
-- /See:/ 'newProcessingInput' smart constructor.
data ProcessingInput = ProcessingInput'
  { -- | When @True@, input operations such as data download are managed natively
    -- by the processing job application. When @False@ (default), input
    -- operations are managed by Amazon SageMaker.
    ProcessingInput -> Maybe Bool
appManaged :: Prelude.Maybe Prelude.Bool,
    -- | Configuration for a Dataset Definition input.
    ProcessingInput -> Maybe DatasetDefinition
datasetDefinition :: Prelude.Maybe DatasetDefinition,
    -- | Configuration for downloading input data from Amazon S3 into the
    -- processing container.
    ProcessingInput -> Maybe ProcessingS3Input
s3Input :: Prelude.Maybe ProcessingS3Input,
    -- | The name for the processing job input.
    ProcessingInput -> Text
inputName :: Prelude.Text
  }
  deriving (ProcessingInput -> ProcessingInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessingInput -> ProcessingInput -> Bool
$c/= :: ProcessingInput -> ProcessingInput -> Bool
== :: ProcessingInput -> ProcessingInput -> Bool
$c== :: ProcessingInput -> ProcessingInput -> Bool
Prelude.Eq, ReadPrec [ProcessingInput]
ReadPrec ProcessingInput
Int -> ReadS ProcessingInput
ReadS [ProcessingInput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProcessingInput]
$creadListPrec :: ReadPrec [ProcessingInput]
readPrec :: ReadPrec ProcessingInput
$creadPrec :: ReadPrec ProcessingInput
readList :: ReadS [ProcessingInput]
$creadList :: ReadS [ProcessingInput]
readsPrec :: Int -> ReadS ProcessingInput
$creadsPrec :: Int -> ReadS ProcessingInput
Prelude.Read, Int -> ProcessingInput -> ShowS
[ProcessingInput] -> ShowS
ProcessingInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessingInput] -> ShowS
$cshowList :: [ProcessingInput] -> ShowS
show :: ProcessingInput -> String
$cshow :: ProcessingInput -> String
showsPrec :: Int -> ProcessingInput -> ShowS
$cshowsPrec :: Int -> ProcessingInput -> ShowS
Prelude.Show, forall x. Rep ProcessingInput x -> ProcessingInput
forall x. ProcessingInput -> Rep ProcessingInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcessingInput x -> ProcessingInput
$cfrom :: forall x. ProcessingInput -> Rep ProcessingInput x
Prelude.Generic)

-- |
-- Create a value of 'ProcessingInput' 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:
--
-- 'appManaged', 'processingInput_appManaged' - When @True@, input operations such as data download are managed natively
-- by the processing job application. When @False@ (default), input
-- operations are managed by Amazon SageMaker.
--
-- 'datasetDefinition', 'processingInput_datasetDefinition' - Configuration for a Dataset Definition input.
--
-- 's3Input', 'processingInput_s3Input' - Configuration for downloading input data from Amazon S3 into the
-- processing container.
--
-- 'inputName', 'processingInput_inputName' - The name for the processing job input.
newProcessingInput ::
  -- | 'inputName'
  Prelude.Text ->
  ProcessingInput
newProcessingInput :: Text -> ProcessingInput
newProcessingInput Text
pInputName_ =
  ProcessingInput'
    { $sel:appManaged:ProcessingInput' :: Maybe Bool
appManaged = forall a. Maybe a
Prelude.Nothing,
      $sel:datasetDefinition:ProcessingInput' :: Maybe DatasetDefinition
datasetDefinition = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Input:ProcessingInput' :: Maybe ProcessingS3Input
s3Input = forall a. Maybe a
Prelude.Nothing,
      $sel:inputName:ProcessingInput' :: Text
inputName = Text
pInputName_
    }

-- | When @True@, input operations such as data download are managed natively
-- by the processing job application. When @False@ (default), input
-- operations are managed by Amazon SageMaker.
processingInput_appManaged :: Lens.Lens' ProcessingInput (Prelude.Maybe Prelude.Bool)
processingInput_appManaged :: Lens' ProcessingInput (Maybe Bool)
processingInput_appManaged = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProcessingInput' {Maybe Bool
appManaged :: Maybe Bool
$sel:appManaged:ProcessingInput' :: ProcessingInput -> Maybe Bool
appManaged} -> Maybe Bool
appManaged) (\s :: ProcessingInput
s@ProcessingInput' {} Maybe Bool
a -> ProcessingInput
s {$sel:appManaged:ProcessingInput' :: Maybe Bool
appManaged = Maybe Bool
a} :: ProcessingInput)

-- | Configuration for a Dataset Definition input.
processingInput_datasetDefinition :: Lens.Lens' ProcessingInput (Prelude.Maybe DatasetDefinition)
processingInput_datasetDefinition :: Lens' ProcessingInput (Maybe DatasetDefinition)
processingInput_datasetDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProcessingInput' {Maybe DatasetDefinition
datasetDefinition :: Maybe DatasetDefinition
$sel:datasetDefinition:ProcessingInput' :: ProcessingInput -> Maybe DatasetDefinition
datasetDefinition} -> Maybe DatasetDefinition
datasetDefinition) (\s :: ProcessingInput
s@ProcessingInput' {} Maybe DatasetDefinition
a -> ProcessingInput
s {$sel:datasetDefinition:ProcessingInput' :: Maybe DatasetDefinition
datasetDefinition = Maybe DatasetDefinition
a} :: ProcessingInput)

-- | Configuration for downloading input data from Amazon S3 into the
-- processing container.
processingInput_s3Input :: Lens.Lens' ProcessingInput (Prelude.Maybe ProcessingS3Input)
processingInput_s3Input :: Lens' ProcessingInput (Maybe ProcessingS3Input)
processingInput_s3Input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProcessingInput' {Maybe ProcessingS3Input
s3Input :: Maybe ProcessingS3Input
$sel:s3Input:ProcessingInput' :: ProcessingInput -> Maybe ProcessingS3Input
s3Input} -> Maybe ProcessingS3Input
s3Input) (\s :: ProcessingInput
s@ProcessingInput' {} Maybe ProcessingS3Input
a -> ProcessingInput
s {$sel:s3Input:ProcessingInput' :: Maybe ProcessingS3Input
s3Input = Maybe ProcessingS3Input
a} :: ProcessingInput)

-- | The name for the processing job input.
processingInput_inputName :: Lens.Lens' ProcessingInput Prelude.Text
processingInput_inputName :: Lens' ProcessingInput Text
processingInput_inputName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProcessingInput' {Text
inputName :: Text
$sel:inputName:ProcessingInput' :: ProcessingInput -> Text
inputName} -> Text
inputName) (\s :: ProcessingInput
s@ProcessingInput' {} Text
a -> ProcessingInput
s {$sel:inputName:ProcessingInput' :: Text
inputName = Text
a} :: ProcessingInput)

instance Data.FromJSON ProcessingInput where
  parseJSON :: Value -> Parser ProcessingInput
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ProcessingInput"
      ( \Object
x ->
          Maybe Bool
-> Maybe DatasetDefinition
-> Maybe ProcessingS3Input
-> Text
-> ProcessingInput
ProcessingInput'
            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
"AppManaged")
            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
"DatasetDefinition")
            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
"S3Input")
            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
"InputName")
      )

instance Prelude.Hashable ProcessingInput where
  hashWithSalt :: Int -> ProcessingInput -> Int
hashWithSalt Int
_salt ProcessingInput' {Maybe Bool
Maybe ProcessingS3Input
Maybe DatasetDefinition
Text
inputName :: Text
s3Input :: Maybe ProcessingS3Input
datasetDefinition :: Maybe DatasetDefinition
appManaged :: Maybe Bool
$sel:inputName:ProcessingInput' :: ProcessingInput -> Text
$sel:s3Input:ProcessingInput' :: ProcessingInput -> Maybe ProcessingS3Input
$sel:datasetDefinition:ProcessingInput' :: ProcessingInput -> Maybe DatasetDefinition
$sel:appManaged:ProcessingInput' :: ProcessingInput -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
appManaged
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DatasetDefinition
datasetDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProcessingS3Input
s3Input
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputName

instance Prelude.NFData ProcessingInput where
  rnf :: ProcessingInput -> ()
rnf ProcessingInput' {Maybe Bool
Maybe ProcessingS3Input
Maybe DatasetDefinition
Text
inputName :: Text
s3Input :: Maybe ProcessingS3Input
datasetDefinition :: Maybe DatasetDefinition
appManaged :: Maybe Bool
$sel:inputName:ProcessingInput' :: ProcessingInput -> Text
$sel:s3Input:ProcessingInput' :: ProcessingInput -> Maybe ProcessingS3Input
$sel:datasetDefinition:ProcessingInput' :: ProcessingInput -> Maybe DatasetDefinition
$sel:appManaged:ProcessingInput' :: ProcessingInput -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
appManaged
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DatasetDefinition
datasetDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProcessingS3Input
s3Input
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inputName

instance Data.ToJSON ProcessingInput where
  toJSON :: ProcessingInput -> Value
toJSON ProcessingInput' {Maybe Bool
Maybe ProcessingS3Input
Maybe DatasetDefinition
Text
inputName :: Text
s3Input :: Maybe ProcessingS3Input
datasetDefinition :: Maybe DatasetDefinition
appManaged :: Maybe Bool
$sel:inputName:ProcessingInput' :: ProcessingInput -> Text
$sel:s3Input:ProcessingInput' :: ProcessingInput -> Maybe ProcessingS3Input
$sel:datasetDefinition:ProcessingInput' :: ProcessingInput -> Maybe DatasetDefinition
$sel:appManaged:ProcessingInput' :: ProcessingInput -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AppManaged" 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
appManaged,
            (Key
"DatasetDefinition" 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 DatasetDefinition
datasetDefinition,
            (Key
"S3Input" 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 ProcessingS3Input
s3Input,
            forall a. a -> Maybe a
Prelude.Just (Key
"InputName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
inputName)
          ]
      )