{-# 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.AppFlow.Types.Task
-- 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.AppFlow.Types.Task where

import Amazonka.AppFlow.Types.ConnectorOperator
import Amazonka.AppFlow.Types.OperatorPropertiesKeys
import Amazonka.AppFlow.Types.TaskType
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

-- | A class for modeling different type of tasks. Task implementation varies
-- based on the @TaskType@.
--
-- /See:/ 'newTask' smart constructor.
data Task = Task'
  { -- | The operation to be performed on the provided source fields.
    Task -> Maybe ConnectorOperator
connectorOperator :: Prelude.Maybe ConnectorOperator,
    -- | A field in a destination connector, or a field value against which
    -- Amazon AppFlow validates a source field.
    Task -> Maybe Text
destinationField :: Prelude.Maybe Prelude.Text,
    -- | A map used to store task-related information. The execution service
    -- looks for particular information based on the @TaskType@.
    Task -> Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties :: Prelude.Maybe (Prelude.HashMap OperatorPropertiesKeys Prelude.Text),
    -- | The source fields to which a particular task is applied.
    Task -> [Text]
sourceFields :: [Prelude.Text],
    -- | Specifies the particular task implementation that Amazon AppFlow
    -- performs.
    Task -> TaskType
taskType :: TaskType
  }
  deriving (Task -> Task -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Prelude.Eq, ReadPrec [Task]
ReadPrec Task
Int -> ReadS Task
ReadS [Task]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Task]
$creadListPrec :: ReadPrec [Task]
readPrec :: ReadPrec Task
$creadPrec :: ReadPrec Task
readList :: ReadS [Task]
$creadList :: ReadS [Task]
readsPrec :: Int -> ReadS Task
$creadsPrec :: Int -> ReadS Task
Prelude.Read, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Prelude.Show, forall x. Rep Task x -> Task
forall x. Task -> Rep Task x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Task x -> Task
$cfrom :: forall x. Task -> Rep Task x
Prelude.Generic)

-- |
-- Create a value of 'Task' 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:
--
-- 'connectorOperator', 'task_connectorOperator' - The operation to be performed on the provided source fields.
--
-- 'destinationField', 'task_destinationField' - A field in a destination connector, or a field value against which
-- Amazon AppFlow validates a source field.
--
-- 'taskProperties', 'task_taskProperties' - A map used to store task-related information. The execution service
-- looks for particular information based on the @TaskType@.
--
-- 'sourceFields', 'task_sourceFields' - The source fields to which a particular task is applied.
--
-- 'taskType', 'task_taskType' - Specifies the particular task implementation that Amazon AppFlow
-- performs.
newTask ::
  -- | 'taskType'
  TaskType ->
  Task
newTask :: TaskType -> Task
newTask TaskType
pTaskType_ =
  Task'
    { $sel:connectorOperator:Task' :: Maybe ConnectorOperator
connectorOperator = forall a. Maybe a
Prelude.Nothing,
      $sel:destinationField:Task' :: Maybe Text
destinationField = forall a. Maybe a
Prelude.Nothing,
      $sel:taskProperties:Task' :: Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceFields:Task' :: [Text]
sourceFields = forall a. Monoid a => a
Prelude.mempty,
      $sel:taskType:Task' :: TaskType
taskType = TaskType
pTaskType_
    }

-- | The operation to be performed on the provided source fields.
task_connectorOperator :: Lens.Lens' Task (Prelude.Maybe ConnectorOperator)
task_connectorOperator :: Lens' Task (Maybe ConnectorOperator)
task_connectorOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe ConnectorOperator
connectorOperator :: Maybe ConnectorOperator
$sel:connectorOperator:Task' :: Task -> Maybe ConnectorOperator
connectorOperator} -> Maybe ConnectorOperator
connectorOperator) (\s :: Task
s@Task' {} Maybe ConnectorOperator
a -> Task
s {$sel:connectorOperator:Task' :: Maybe ConnectorOperator
connectorOperator = Maybe ConnectorOperator
a} :: Task)

-- | A field in a destination connector, or a field value against which
-- Amazon AppFlow validates a source field.
task_destinationField :: Lens.Lens' Task (Prelude.Maybe Prelude.Text)
task_destinationField :: Lens' Task (Maybe Text)
task_destinationField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe Text
destinationField :: Maybe Text
$sel:destinationField:Task' :: Task -> Maybe Text
destinationField} -> Maybe Text
destinationField) (\s :: Task
s@Task' {} Maybe Text
a -> Task
s {$sel:destinationField:Task' :: Maybe Text
destinationField = Maybe Text
a} :: Task)

-- | A map used to store task-related information. The execution service
-- looks for particular information based on the @TaskType@.
task_taskProperties :: Lens.Lens' Task (Prelude.Maybe (Prelude.HashMap OperatorPropertiesKeys Prelude.Text))
task_taskProperties :: Lens' Task (Maybe (HashMap OperatorPropertiesKeys Text))
task_taskProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties :: Maybe (HashMap OperatorPropertiesKeys Text)
$sel:taskProperties:Task' :: Task -> Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties} -> Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties) (\s :: Task
s@Task' {} Maybe (HashMap OperatorPropertiesKeys Text)
a -> Task
s {$sel:taskProperties:Task' :: Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties = Maybe (HashMap OperatorPropertiesKeys Text)
a} :: Task) 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 source fields to which a particular task is applied.
task_sourceFields :: Lens.Lens' Task [Prelude.Text]
task_sourceFields :: Lens' Task [Text]
task_sourceFields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {[Text]
sourceFields :: [Text]
$sel:sourceFields:Task' :: Task -> [Text]
sourceFields} -> [Text]
sourceFields) (\s :: Task
s@Task' {} [Text]
a -> Task
s {$sel:sourceFields:Task' :: [Text]
sourceFields = [Text]
a} :: Task) 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

-- | Specifies the particular task implementation that Amazon AppFlow
-- performs.
task_taskType :: Lens.Lens' Task TaskType
task_taskType :: Lens' Task TaskType
task_taskType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Task' {TaskType
taskType :: TaskType
$sel:taskType:Task' :: Task -> TaskType
taskType} -> TaskType
taskType) (\s :: Task
s@Task' {} TaskType
a -> Task
s {$sel:taskType:Task' :: TaskType
taskType = TaskType
a} :: Task)

instance Data.FromJSON Task where
  parseJSON :: Value -> Parser Task
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Task"
      ( \Object
x ->
          Maybe ConnectorOperator
-> Maybe Text
-> Maybe (HashMap OperatorPropertiesKeys Text)
-> [Text]
-> TaskType
-> Task
Task'
            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
"connectorOperator")
            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
"destinationField")
            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
"taskProperties" 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
"sourceFields" 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 a
Data..: Key
"taskType")
      )

instance Prelude.Hashable Task where
  hashWithSalt :: Int -> Task -> Int
hashWithSalt Int
_salt Task' {[Text]
Maybe Text
Maybe (HashMap OperatorPropertiesKeys Text)
Maybe ConnectorOperator
TaskType
taskType :: TaskType
sourceFields :: [Text]
taskProperties :: Maybe (HashMap OperatorPropertiesKeys Text)
destinationField :: Maybe Text
connectorOperator :: Maybe ConnectorOperator
$sel:taskType:Task' :: Task -> TaskType
$sel:sourceFields:Task' :: Task -> [Text]
$sel:taskProperties:Task' :: Task -> Maybe (HashMap OperatorPropertiesKeys Text)
$sel:destinationField:Task' :: Task -> Maybe Text
$sel:connectorOperator:Task' :: Task -> Maybe ConnectorOperator
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectorOperator
connectorOperator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationField
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
sourceFields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TaskType
taskType

instance Prelude.NFData Task where
  rnf :: Task -> ()
rnf Task' {[Text]
Maybe Text
Maybe (HashMap OperatorPropertiesKeys Text)
Maybe ConnectorOperator
TaskType
taskType :: TaskType
sourceFields :: [Text]
taskProperties :: Maybe (HashMap OperatorPropertiesKeys Text)
destinationField :: Maybe Text
connectorOperator :: Maybe ConnectorOperator
$sel:taskType:Task' :: Task -> TaskType
$sel:sourceFields:Task' :: Task -> [Text]
$sel:taskProperties:Task' :: Task -> Maybe (HashMap OperatorPropertiesKeys Text)
$sel:destinationField:Task' :: Task -> Maybe Text
$sel:connectorOperator:Task' :: Task -> Maybe ConnectorOperator
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectorOperator
connectorOperator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationField
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
sourceFields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TaskType
taskType

instance Data.ToJSON Task where
  toJSON :: Task -> Value
toJSON Task' {[Text]
Maybe Text
Maybe (HashMap OperatorPropertiesKeys Text)
Maybe ConnectorOperator
TaskType
taskType :: TaskType
sourceFields :: [Text]
taskProperties :: Maybe (HashMap OperatorPropertiesKeys Text)
destinationField :: Maybe Text
connectorOperator :: Maybe ConnectorOperator
$sel:taskType:Task' :: Task -> TaskType
$sel:sourceFields:Task' :: Task -> [Text]
$sel:taskProperties:Task' :: Task -> Maybe (HashMap OperatorPropertiesKeys Text)
$sel:destinationField:Task' :: Task -> Maybe Text
$sel:connectorOperator:Task' :: Task -> Maybe ConnectorOperator
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"connectorOperator" 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 ConnectorOperator
connectorOperator,
            (Key
"destinationField" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
destinationField,
            (Key
"taskProperties" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap OperatorPropertiesKeys Text)
taskProperties,
            forall a. a -> Maybe a
Prelude.Just (Key
"sourceFields" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
sourceFields),
            forall a. a -> Maybe a
Prelude.Just (Key
"taskType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TaskType
taskType)
          ]
      )