{-# 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.Glue.Types.Workflow
-- 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.Glue.Types.Workflow where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types.BlueprintDetails
import Amazonka.Glue.Types.WorkflowGraph
import Amazonka.Glue.Types.WorkflowRun
import qualified Amazonka.Prelude as Prelude

-- | A workflow is a collection of multiple dependent Glue jobs and crawlers
-- that are run to complete a complex ETL task. A workflow manages the
-- execution and monitoring of all its jobs and crawlers.
--
-- /See:/ 'newWorkflow' smart constructor.
data Workflow = Workflow'
  { -- | This structure indicates the details of the blueprint that this
    -- particular workflow is created from.
    Workflow -> Maybe BlueprintDetails
blueprintDetails :: Prelude.Maybe BlueprintDetails,
    -- | The date and time when the workflow was created.
    Workflow -> Maybe POSIX
createdOn :: Prelude.Maybe Data.POSIX,
    -- | A collection of properties to be used as part of each execution of the
    -- workflow. The run properties are made available to each job in the
    -- workflow. A job can modify the properties for the next jobs in the flow.
    Workflow -> Maybe (HashMap Text Text)
defaultRunProperties :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A description of the workflow.
    Workflow -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The graph representing all the Glue components that belong to the
    -- workflow as nodes and directed connections between them as edges.
    Workflow -> Maybe WorkflowGraph
graph :: Prelude.Maybe WorkflowGraph,
    -- | The date and time when the workflow was last modified.
    Workflow -> Maybe POSIX
lastModifiedOn :: Prelude.Maybe Data.POSIX,
    -- | The information about the last execution of the workflow.
    Workflow -> Maybe WorkflowRun
lastRun :: Prelude.Maybe WorkflowRun,
    -- | You can use this parameter to prevent unwanted multiple updates to data,
    -- to control costs, or in some cases, to prevent exceeding the maximum
    -- number of concurrent runs of any of the component jobs. If you leave
    -- this parameter blank, there is no limit to the number of concurrent
    -- workflow runs.
    Workflow -> Maybe Int
maxConcurrentRuns :: Prelude.Maybe Prelude.Int,
    -- | The name of the workflow.
    Workflow -> Maybe Text
name :: Prelude.Maybe Prelude.Text
  }
  deriving (Workflow -> Workflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Workflow -> Workflow -> Bool
$c/= :: Workflow -> Workflow -> Bool
== :: Workflow -> Workflow -> Bool
$c== :: Workflow -> Workflow -> Bool
Prelude.Eq, ReadPrec [Workflow]
ReadPrec Workflow
Int -> ReadS Workflow
ReadS [Workflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Workflow]
$creadListPrec :: ReadPrec [Workflow]
readPrec :: ReadPrec Workflow
$creadPrec :: ReadPrec Workflow
readList :: ReadS [Workflow]
$creadList :: ReadS [Workflow]
readsPrec :: Int -> ReadS Workflow
$creadsPrec :: Int -> ReadS Workflow
Prelude.Read, Int -> Workflow -> ShowS
[Workflow] -> ShowS
Workflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Workflow] -> ShowS
$cshowList :: [Workflow] -> ShowS
show :: Workflow -> String
$cshow :: Workflow -> String
showsPrec :: Int -> Workflow -> ShowS
$cshowsPrec :: Int -> Workflow -> ShowS
Prelude.Show, forall x. Rep Workflow x -> Workflow
forall x. Workflow -> Rep Workflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Workflow x -> Workflow
$cfrom :: forall x. Workflow -> Rep Workflow x
Prelude.Generic)

-- |
-- Create a value of 'Workflow' 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:
--
-- 'blueprintDetails', 'workflow_blueprintDetails' - This structure indicates the details of the blueprint that this
-- particular workflow is created from.
--
-- 'createdOn', 'workflow_createdOn' - The date and time when the workflow was created.
--
-- 'defaultRunProperties', 'workflow_defaultRunProperties' - A collection of properties to be used as part of each execution of the
-- workflow. The run properties are made available to each job in the
-- workflow. A job can modify the properties for the next jobs in the flow.
--
-- 'description', 'workflow_description' - A description of the workflow.
--
-- 'graph', 'workflow_graph' - The graph representing all the Glue components that belong to the
-- workflow as nodes and directed connections between them as edges.
--
-- 'lastModifiedOn', 'workflow_lastModifiedOn' - The date and time when the workflow was last modified.
--
-- 'lastRun', 'workflow_lastRun' - The information about the last execution of the workflow.
--
-- 'maxConcurrentRuns', 'workflow_maxConcurrentRuns' - You can use this parameter to prevent unwanted multiple updates to data,
-- to control costs, or in some cases, to prevent exceeding the maximum
-- number of concurrent runs of any of the component jobs. If you leave
-- this parameter blank, there is no limit to the number of concurrent
-- workflow runs.
--
-- 'name', 'workflow_name' - The name of the workflow.
newWorkflow ::
  Workflow
newWorkflow :: Workflow
newWorkflow =
  Workflow'
    { $sel:blueprintDetails:Workflow' :: Maybe BlueprintDetails
blueprintDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:createdOn:Workflow' :: Maybe POSIX
createdOn = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultRunProperties:Workflow' :: Maybe (HashMap Text Text)
defaultRunProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Workflow' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:graph:Workflow' :: Maybe WorkflowGraph
graph = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedOn:Workflow' :: Maybe POSIX
lastModifiedOn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastRun:Workflow' :: Maybe WorkflowRun
lastRun = forall a. Maybe a
Prelude.Nothing,
      $sel:maxConcurrentRuns:Workflow' :: Maybe Int
maxConcurrentRuns = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Workflow' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing
    }

-- | This structure indicates the details of the blueprint that this
-- particular workflow is created from.
workflow_blueprintDetails :: Lens.Lens' Workflow (Prelude.Maybe BlueprintDetails)
workflow_blueprintDetails :: Lens' Workflow (Maybe BlueprintDetails)
workflow_blueprintDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe BlueprintDetails
blueprintDetails :: Maybe BlueprintDetails
$sel:blueprintDetails:Workflow' :: Workflow -> Maybe BlueprintDetails
blueprintDetails} -> Maybe BlueprintDetails
blueprintDetails) (\s :: Workflow
s@Workflow' {} Maybe BlueprintDetails
a -> Workflow
s {$sel:blueprintDetails:Workflow' :: Maybe BlueprintDetails
blueprintDetails = Maybe BlueprintDetails
a} :: Workflow)

-- | The date and time when the workflow was created.
workflow_createdOn :: Lens.Lens' Workflow (Prelude.Maybe Prelude.UTCTime)
workflow_createdOn :: Lens' Workflow (Maybe UTCTime)
workflow_createdOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe POSIX
createdOn :: Maybe POSIX
$sel:createdOn:Workflow' :: Workflow -> Maybe POSIX
createdOn} -> Maybe POSIX
createdOn) (\s :: Workflow
s@Workflow' {} Maybe POSIX
a -> Workflow
s {$sel:createdOn:Workflow' :: Maybe POSIX
createdOn = Maybe POSIX
a} :: Workflow) 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 collection of properties to be used as part of each execution of the
-- workflow. The run properties are made available to each job in the
-- workflow. A job can modify the properties for the next jobs in the flow.
workflow_defaultRunProperties :: Lens.Lens' Workflow (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
workflow_defaultRunProperties :: Lens' Workflow (Maybe (HashMap Text Text))
workflow_defaultRunProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe (HashMap Text Text)
defaultRunProperties :: Maybe (HashMap Text Text)
$sel:defaultRunProperties:Workflow' :: Workflow -> Maybe (HashMap Text Text)
defaultRunProperties} -> Maybe (HashMap Text Text)
defaultRunProperties) (\s :: Workflow
s@Workflow' {} Maybe (HashMap Text Text)
a -> Workflow
s {$sel:defaultRunProperties:Workflow' :: Maybe (HashMap Text Text)
defaultRunProperties = Maybe (HashMap Text Text)
a} :: Workflow) 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 description of the workflow.
workflow_description :: Lens.Lens' Workflow (Prelude.Maybe Prelude.Text)
workflow_description :: Lens' Workflow (Maybe Text)
workflow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe Text
description :: Maybe Text
$sel:description:Workflow' :: Workflow -> Maybe Text
description} -> Maybe Text
description) (\s :: Workflow
s@Workflow' {} Maybe Text
a -> Workflow
s {$sel:description:Workflow' :: Maybe Text
description = Maybe Text
a} :: Workflow)

-- | The graph representing all the Glue components that belong to the
-- workflow as nodes and directed connections between them as edges.
workflow_graph :: Lens.Lens' Workflow (Prelude.Maybe WorkflowGraph)
workflow_graph :: Lens' Workflow (Maybe WorkflowGraph)
workflow_graph = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe WorkflowGraph
graph :: Maybe WorkflowGraph
$sel:graph:Workflow' :: Workflow -> Maybe WorkflowGraph
graph} -> Maybe WorkflowGraph
graph) (\s :: Workflow
s@Workflow' {} Maybe WorkflowGraph
a -> Workflow
s {$sel:graph:Workflow' :: Maybe WorkflowGraph
graph = Maybe WorkflowGraph
a} :: Workflow)

-- | The date and time when the workflow was last modified.
workflow_lastModifiedOn :: Lens.Lens' Workflow (Prelude.Maybe Prelude.UTCTime)
workflow_lastModifiedOn :: Lens' Workflow (Maybe UTCTime)
workflow_lastModifiedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe POSIX
lastModifiedOn :: Maybe POSIX
$sel:lastModifiedOn:Workflow' :: Workflow -> Maybe POSIX
lastModifiedOn} -> Maybe POSIX
lastModifiedOn) (\s :: Workflow
s@Workflow' {} Maybe POSIX
a -> Workflow
s {$sel:lastModifiedOn:Workflow' :: Maybe POSIX
lastModifiedOn = Maybe POSIX
a} :: Workflow) 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 information about the last execution of the workflow.
workflow_lastRun :: Lens.Lens' Workflow (Prelude.Maybe WorkflowRun)
workflow_lastRun :: Lens' Workflow (Maybe WorkflowRun)
workflow_lastRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe WorkflowRun
lastRun :: Maybe WorkflowRun
$sel:lastRun:Workflow' :: Workflow -> Maybe WorkflowRun
lastRun} -> Maybe WorkflowRun
lastRun) (\s :: Workflow
s@Workflow' {} Maybe WorkflowRun
a -> Workflow
s {$sel:lastRun:Workflow' :: Maybe WorkflowRun
lastRun = Maybe WorkflowRun
a} :: Workflow)

-- | You can use this parameter to prevent unwanted multiple updates to data,
-- to control costs, or in some cases, to prevent exceeding the maximum
-- number of concurrent runs of any of the component jobs. If you leave
-- this parameter blank, there is no limit to the number of concurrent
-- workflow runs.
workflow_maxConcurrentRuns :: Lens.Lens' Workflow (Prelude.Maybe Prelude.Int)
workflow_maxConcurrentRuns :: Lens' Workflow (Maybe Int)
workflow_maxConcurrentRuns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe Int
maxConcurrentRuns :: Maybe Int
$sel:maxConcurrentRuns:Workflow' :: Workflow -> Maybe Int
maxConcurrentRuns} -> Maybe Int
maxConcurrentRuns) (\s :: Workflow
s@Workflow' {} Maybe Int
a -> Workflow
s {$sel:maxConcurrentRuns:Workflow' :: Maybe Int
maxConcurrentRuns = Maybe Int
a} :: Workflow)

-- | The name of the workflow.
workflow_name :: Lens.Lens' Workflow (Prelude.Maybe Prelude.Text)
workflow_name :: Lens' Workflow (Maybe Text)
workflow_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Workflow' {Maybe Text
name :: Maybe Text
$sel:name:Workflow' :: Workflow -> Maybe Text
name} -> Maybe Text
name) (\s :: Workflow
s@Workflow' {} Maybe Text
a -> Workflow
s {$sel:name:Workflow' :: Maybe Text
name = Maybe Text
a} :: Workflow)

instance Data.FromJSON Workflow where
  parseJSON :: Value -> Parser Workflow
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Workflow"
      ( \Object
x ->
          Maybe BlueprintDetails
-> Maybe POSIX
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe WorkflowGraph
-> Maybe POSIX
-> Maybe WorkflowRun
-> Maybe Int
-> Maybe Text
-> Workflow
Workflow'
            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
"BlueprintDetails")
            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
"CreatedOn")
            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
"DefaultRunProperties"
                            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
"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
"Graph")
            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
"LastModifiedOn")
            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
"LastRun")
            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
"MaxConcurrentRuns")
            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
"Name")
      )

instance Prelude.Hashable Workflow where
  hashWithSalt :: Int -> Workflow -> Int
hashWithSalt Int
_salt Workflow' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe BlueprintDetails
Maybe WorkflowGraph
Maybe WorkflowRun
name :: Maybe Text
maxConcurrentRuns :: Maybe Int
lastRun :: Maybe WorkflowRun
lastModifiedOn :: Maybe POSIX
graph :: Maybe WorkflowGraph
description :: Maybe Text
defaultRunProperties :: Maybe (HashMap Text Text)
createdOn :: Maybe POSIX
blueprintDetails :: Maybe BlueprintDetails
$sel:name:Workflow' :: Workflow -> Maybe Text
$sel:maxConcurrentRuns:Workflow' :: Workflow -> Maybe Int
$sel:lastRun:Workflow' :: Workflow -> Maybe WorkflowRun
$sel:lastModifiedOn:Workflow' :: Workflow -> Maybe POSIX
$sel:graph:Workflow' :: Workflow -> Maybe WorkflowGraph
$sel:description:Workflow' :: Workflow -> Maybe Text
$sel:defaultRunProperties:Workflow' :: Workflow -> Maybe (HashMap Text Text)
$sel:createdOn:Workflow' :: Workflow -> Maybe POSIX
$sel:blueprintDetails:Workflow' :: Workflow -> Maybe BlueprintDetails
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BlueprintDetails
blueprintDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
defaultRunProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowGraph
graph
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastModifiedOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowRun
lastRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxConcurrentRuns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name

instance Prelude.NFData Workflow where
  rnf :: Workflow -> ()
rnf Workflow' {Maybe Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe BlueprintDetails
Maybe WorkflowGraph
Maybe WorkflowRun
name :: Maybe Text
maxConcurrentRuns :: Maybe Int
lastRun :: Maybe WorkflowRun
lastModifiedOn :: Maybe POSIX
graph :: Maybe WorkflowGraph
description :: Maybe Text
defaultRunProperties :: Maybe (HashMap Text Text)
createdOn :: Maybe POSIX
blueprintDetails :: Maybe BlueprintDetails
$sel:name:Workflow' :: Workflow -> Maybe Text
$sel:maxConcurrentRuns:Workflow' :: Workflow -> Maybe Int
$sel:lastRun:Workflow' :: Workflow -> Maybe WorkflowRun
$sel:lastModifiedOn:Workflow' :: Workflow -> Maybe POSIX
$sel:graph:Workflow' :: Workflow -> Maybe WorkflowGraph
$sel:description:Workflow' :: Workflow -> Maybe Text
$sel:defaultRunProperties:Workflow' :: Workflow -> Maybe (HashMap Text Text)
$sel:createdOn:Workflow' :: Workflow -> Maybe POSIX
$sel:blueprintDetails:Workflow' :: Workflow -> Maybe BlueprintDetails
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BlueprintDetails
blueprintDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
defaultRunProperties
      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 WorkflowGraph
graph
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowRun
lastRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxConcurrentRuns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name