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

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

-- |
-- Module      : Amazonka.SWF.ListClosedWorkflowExecutions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of closed workflow executions in the specified domain
-- that meet the filtering criteria. The results may be split into multiple
-- pages. To retrieve subsequent pages, make the call again using the
-- nextPageToken returned by the initial call.
--
-- This operation is eventually consistent. The results are best effort and
-- may not exactly reflect recent updates and changes.
--
-- __Access Control__
--
-- You can use IAM policies to control this action\'s access to Amazon SWF
-- resources as follows:
--
-- -   Use a @Resource@ element with the domain name to limit the action to
--     only specified domains.
--
-- -   Use an @Action@ element to allow or deny permission to call this
--     action.
--
-- -   Constrain the following parameters by using a @Condition@ element
--     with the appropriate keys.
--
--     -   @tagFilter.tag@: String constraint. The key is
--         @swf:tagFilter.tag@.
--
--     -   @typeFilter.name@: String constraint. The key is
--         @swf:typeFilter.name@.
--
--     -   @typeFilter.version@: String constraint. The key is
--         @swf:typeFilter.version@.
--
-- If the caller doesn\'t have sufficient permissions to invoke the action,
-- or the parameter values fall outside the specified constraints, the
-- action fails. The associated event attribute\'s @cause@ parameter is set
-- to @OPERATION_NOT_PERMITTED@. For details and example IAM policies, see
-- <https://docs.aws.amazon.com/amazonswf/latest/developerguide/swf-dev-iam.html Using IAM to Manage Access to Amazon SWF Workflows>
-- in the /Amazon SWF Developer Guide/.
--
-- This operation returns paginated results.
module Amazonka.SWF.ListClosedWorkflowExecutions
  ( -- * Creating a Request
    ListClosedWorkflowExecutions (..),
    newListClosedWorkflowExecutions,

    -- * Request Lenses
    listClosedWorkflowExecutions_closeStatusFilter,
    listClosedWorkflowExecutions_closeTimeFilter,
    listClosedWorkflowExecutions_executionFilter,
    listClosedWorkflowExecutions_maximumPageSize,
    listClosedWorkflowExecutions_nextPageToken,
    listClosedWorkflowExecutions_reverseOrder,
    listClosedWorkflowExecutions_startTimeFilter,
    listClosedWorkflowExecutions_tagFilter,
    listClosedWorkflowExecutions_typeFilter,
    listClosedWorkflowExecutions_domain,

    -- * Destructuring the Response
    WorkflowExecutionInfos (..),
    newWorkflowExecutionInfos,

    -- * Response Lenses
    workflowExecutionInfos_nextPageToken,
    workflowExecutionInfos_executionInfos,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SWF.Types

-- | /See:/ 'newListClosedWorkflowExecutions' smart constructor.
data ListClosedWorkflowExecutions = ListClosedWorkflowExecutions'
  { -- | If specified, only workflow executions that match this /close status/
    -- are listed. For example, if TERMINATED is specified, then only
    -- TERMINATED workflow executions are listed.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    ListClosedWorkflowExecutions -> Maybe CloseStatusFilter
closeStatusFilter :: Prelude.Maybe CloseStatusFilter,
    -- | If specified, the workflow executions are included in the returned
    -- results based on whether their close times are within the range
    -- specified by this filter. Also, if this parameter is specified, the
    -- returned results are ordered by their close times.
    --
    -- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
    -- specify one of these in a request but not both.
    ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
closeTimeFilter :: Prelude.Maybe ExecutionTimeFilter,
    -- | If specified, only workflow executions matching the workflow ID
    -- specified in the filter are returned.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    ListClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
executionFilter :: Prelude.Maybe WorkflowExecutionFilter,
    -- | The maximum number of results that are returned per call. Use
    -- @nextPageToken@ to obtain further pages of results.
    ListClosedWorkflowExecutions -> Maybe Natural
maximumPageSize :: Prelude.Maybe Prelude.Natural,
    -- | If @NextPageToken@ is returned there are more results available. The
    -- value of @NextPageToken@ is a unique pagination token for each page.
    -- Make the call again using the returned token to retrieve the next page.
    -- Keep all other arguments unchanged. Each pagination token expires after
    -- 60 seconds. Using an expired pagination token will return a @400@ error:
    -- \"@Specified token has exceeded its maximum lifetime@\".
    --
    -- The configured @maximumPageSize@ determines how many results can be
    -- returned in a single call.
    ListClosedWorkflowExecutions -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | When set to @true@, returns the results in reverse order. By default the
    -- results are returned in descending order of the start or the close time
    -- of the executions.
    ListClosedWorkflowExecutions -> Maybe Bool
reverseOrder :: Prelude.Maybe Prelude.Bool,
    -- | If specified, the workflow executions are included in the returned
    -- results based on whether their start times are within the range
    -- specified by this filter. Also, if this parameter is specified, the
    -- returned results are ordered by their start times.
    --
    -- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
    -- specify one of these in a request but not both.
    ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
startTimeFilter :: Prelude.Maybe ExecutionTimeFilter,
    -- | If specified, only executions that have the matching tag are listed.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    ListClosedWorkflowExecutions -> Maybe TagFilter
tagFilter :: Prelude.Maybe TagFilter,
    -- | If specified, only executions of the type specified in the filter are
    -- returned.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    ListClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter :: Prelude.Maybe WorkflowTypeFilter,
    -- | The name of the domain that contains the workflow executions to list.
    ListClosedWorkflowExecutions -> Text
domain :: Prelude.Text
  }
  deriving (ListClosedWorkflowExecutions
-> ListClosedWorkflowExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListClosedWorkflowExecutions
-> ListClosedWorkflowExecutions -> Bool
$c/= :: ListClosedWorkflowExecutions
-> ListClosedWorkflowExecutions -> Bool
== :: ListClosedWorkflowExecutions
-> ListClosedWorkflowExecutions -> Bool
$c== :: ListClosedWorkflowExecutions
-> ListClosedWorkflowExecutions -> Bool
Prelude.Eq, ReadPrec [ListClosedWorkflowExecutions]
ReadPrec ListClosedWorkflowExecutions
Int -> ReadS ListClosedWorkflowExecutions
ReadS [ListClosedWorkflowExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListClosedWorkflowExecutions]
$creadListPrec :: ReadPrec [ListClosedWorkflowExecutions]
readPrec :: ReadPrec ListClosedWorkflowExecutions
$creadPrec :: ReadPrec ListClosedWorkflowExecutions
readList :: ReadS [ListClosedWorkflowExecutions]
$creadList :: ReadS [ListClosedWorkflowExecutions]
readsPrec :: Int -> ReadS ListClosedWorkflowExecutions
$creadsPrec :: Int -> ReadS ListClosedWorkflowExecutions
Prelude.Read, Int -> ListClosedWorkflowExecutions -> ShowS
[ListClosedWorkflowExecutions] -> ShowS
ListClosedWorkflowExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListClosedWorkflowExecutions] -> ShowS
$cshowList :: [ListClosedWorkflowExecutions] -> ShowS
show :: ListClosedWorkflowExecutions -> String
$cshow :: ListClosedWorkflowExecutions -> String
showsPrec :: Int -> ListClosedWorkflowExecutions -> ShowS
$cshowsPrec :: Int -> ListClosedWorkflowExecutions -> ShowS
Prelude.Show, forall x.
Rep ListClosedWorkflowExecutions x -> ListClosedWorkflowExecutions
forall x.
ListClosedWorkflowExecutions -> Rep ListClosedWorkflowExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListClosedWorkflowExecutions x -> ListClosedWorkflowExecutions
$cfrom :: forall x.
ListClosedWorkflowExecutions -> Rep ListClosedWorkflowExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListClosedWorkflowExecutions' 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:
--
-- 'closeStatusFilter', 'listClosedWorkflowExecutions_closeStatusFilter' - If specified, only workflow executions that match this /close status/
-- are listed. For example, if TERMINATED is specified, then only
-- TERMINATED workflow executions are listed.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'closeTimeFilter', 'listClosedWorkflowExecutions_closeTimeFilter' - If specified, the workflow executions are included in the returned
-- results based on whether their close times are within the range
-- specified by this filter. Also, if this parameter is specified, the
-- returned results are ordered by their close times.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
--
-- 'executionFilter', 'listClosedWorkflowExecutions_executionFilter' - If specified, only workflow executions matching the workflow ID
-- specified in the filter are returned.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'maximumPageSize', 'listClosedWorkflowExecutions_maximumPageSize' - The maximum number of results that are returned per call. Use
-- @nextPageToken@ to obtain further pages of results.
--
-- 'nextPageToken', 'listClosedWorkflowExecutions_nextPageToken' - If @NextPageToken@ is returned there are more results available. The
-- value of @NextPageToken@ is a unique pagination token for each page.
-- Make the call again using the returned token to retrieve the next page.
-- Keep all other arguments unchanged. Each pagination token expires after
-- 60 seconds. Using an expired pagination token will return a @400@ error:
-- \"@Specified token has exceeded its maximum lifetime@\".
--
-- The configured @maximumPageSize@ determines how many results can be
-- returned in a single call.
--
-- 'reverseOrder', 'listClosedWorkflowExecutions_reverseOrder' - When set to @true@, returns the results in reverse order. By default the
-- results are returned in descending order of the start or the close time
-- of the executions.
--
-- 'startTimeFilter', 'listClosedWorkflowExecutions_startTimeFilter' - If specified, the workflow executions are included in the returned
-- results based on whether their start times are within the range
-- specified by this filter. Also, if this parameter is specified, the
-- returned results are ordered by their start times.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
--
-- 'tagFilter', 'listClosedWorkflowExecutions_tagFilter' - If specified, only executions that have the matching tag are listed.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'typeFilter', 'listClosedWorkflowExecutions_typeFilter' - If specified, only executions of the type specified in the filter are
-- returned.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'domain', 'listClosedWorkflowExecutions_domain' - The name of the domain that contains the workflow executions to list.
newListClosedWorkflowExecutions ::
  -- | 'domain'
  Prelude.Text ->
  ListClosedWorkflowExecutions
newListClosedWorkflowExecutions :: Text -> ListClosedWorkflowExecutions
newListClosedWorkflowExecutions Text
pDomain_ =
  ListClosedWorkflowExecutions'
    { $sel:closeStatusFilter:ListClosedWorkflowExecutions' :: Maybe CloseStatusFilter
closeStatusFilter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:closeTimeFilter:ListClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
closeTimeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:executionFilter:ListClosedWorkflowExecutions' :: Maybe WorkflowExecutionFilter
executionFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumPageSize:ListClosedWorkflowExecutions' :: Maybe Natural
maximumPageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:ListClosedWorkflowExecutions' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:reverseOrder:ListClosedWorkflowExecutions' :: Maybe Bool
reverseOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimeFilter:ListClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
startTimeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:tagFilter:ListClosedWorkflowExecutions' :: Maybe TagFilter
tagFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:typeFilter:ListClosedWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:ListClosedWorkflowExecutions' :: Text
domain = Text
pDomain_
    }

-- | If specified, only workflow executions that match this /close status/
-- are listed. For example, if TERMINATED is specified, then only
-- TERMINATED workflow executions are listed.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
listClosedWorkflowExecutions_closeStatusFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe CloseStatusFilter)
listClosedWorkflowExecutions_closeStatusFilter :: Lens' ListClosedWorkflowExecutions (Maybe CloseStatusFilter)
listClosedWorkflowExecutions_closeStatusFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe CloseStatusFilter
closeStatusFilter :: Maybe CloseStatusFilter
$sel:closeStatusFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe CloseStatusFilter
closeStatusFilter} -> Maybe CloseStatusFilter
closeStatusFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe CloseStatusFilter
a -> ListClosedWorkflowExecutions
s {$sel:closeStatusFilter:ListClosedWorkflowExecutions' :: Maybe CloseStatusFilter
closeStatusFilter = Maybe CloseStatusFilter
a} :: ListClosedWorkflowExecutions)

-- | If specified, the workflow executions are included in the returned
-- results based on whether their close times are within the range
-- specified by this filter. Also, if this parameter is specified, the
-- returned results are ordered by their close times.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
listClosedWorkflowExecutions_closeTimeFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe ExecutionTimeFilter)
listClosedWorkflowExecutions_closeTimeFilter :: Lens' ListClosedWorkflowExecutions (Maybe ExecutionTimeFilter)
listClosedWorkflowExecutions_closeTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe ExecutionTimeFilter
closeTimeFilter :: Maybe ExecutionTimeFilter
$sel:closeTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
closeTimeFilter} -> Maybe ExecutionTimeFilter
closeTimeFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe ExecutionTimeFilter
a -> ListClosedWorkflowExecutions
s {$sel:closeTimeFilter:ListClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
closeTimeFilter = Maybe ExecutionTimeFilter
a} :: ListClosedWorkflowExecutions)

-- | If specified, only workflow executions matching the workflow ID
-- specified in the filter are returned.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
listClosedWorkflowExecutions_executionFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe WorkflowExecutionFilter)
listClosedWorkflowExecutions_executionFilter :: Lens' ListClosedWorkflowExecutions (Maybe WorkflowExecutionFilter)
listClosedWorkflowExecutions_executionFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe WorkflowExecutionFilter
executionFilter :: Maybe WorkflowExecutionFilter
$sel:executionFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
executionFilter} -> Maybe WorkflowExecutionFilter
executionFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe WorkflowExecutionFilter
a -> ListClosedWorkflowExecutions
s {$sel:executionFilter:ListClosedWorkflowExecutions' :: Maybe WorkflowExecutionFilter
executionFilter = Maybe WorkflowExecutionFilter
a} :: ListClosedWorkflowExecutions)

-- | The maximum number of results that are returned per call. Use
-- @nextPageToken@ to obtain further pages of results.
listClosedWorkflowExecutions_maximumPageSize :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe Prelude.Natural)
listClosedWorkflowExecutions_maximumPageSize :: Lens' ListClosedWorkflowExecutions (Maybe Natural)
listClosedWorkflowExecutions_maximumPageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe Natural
maximumPageSize :: Maybe Natural
$sel:maximumPageSize:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Natural
maximumPageSize} -> Maybe Natural
maximumPageSize) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe Natural
a -> ListClosedWorkflowExecutions
s {$sel:maximumPageSize:ListClosedWorkflowExecutions' :: Maybe Natural
maximumPageSize = Maybe Natural
a} :: ListClosedWorkflowExecutions)

-- | If @NextPageToken@ is returned there are more results available. The
-- value of @NextPageToken@ is a unique pagination token for each page.
-- Make the call again using the returned token to retrieve the next page.
-- Keep all other arguments unchanged. Each pagination token expires after
-- 60 seconds. Using an expired pagination token will return a @400@ error:
-- \"@Specified token has exceeded its maximum lifetime@\".
--
-- The configured @maximumPageSize@ determines how many results can be
-- returned in a single call.
listClosedWorkflowExecutions_nextPageToken :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe Prelude.Text)
listClosedWorkflowExecutions_nextPageToken :: Lens' ListClosedWorkflowExecutions (Maybe Text)
listClosedWorkflowExecutions_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe Text
a -> ListClosedWorkflowExecutions
s {$sel:nextPageToken:ListClosedWorkflowExecutions' :: Maybe Text
nextPageToken = Maybe Text
a} :: ListClosedWorkflowExecutions)

-- | When set to @true@, returns the results in reverse order. By default the
-- results are returned in descending order of the start or the close time
-- of the executions.
listClosedWorkflowExecutions_reverseOrder :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe Prelude.Bool)
listClosedWorkflowExecutions_reverseOrder :: Lens' ListClosedWorkflowExecutions (Maybe Bool)
listClosedWorkflowExecutions_reverseOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe Bool
reverseOrder :: Maybe Bool
$sel:reverseOrder:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Bool
reverseOrder} -> Maybe Bool
reverseOrder) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe Bool
a -> ListClosedWorkflowExecutions
s {$sel:reverseOrder:ListClosedWorkflowExecutions' :: Maybe Bool
reverseOrder = Maybe Bool
a} :: ListClosedWorkflowExecutions)

-- | If specified, the workflow executions are included in the returned
-- results based on whether their start times are within the range
-- specified by this filter. Also, if this parameter is specified, the
-- returned results are ordered by their start times.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
listClosedWorkflowExecutions_startTimeFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe ExecutionTimeFilter)
listClosedWorkflowExecutions_startTimeFilter :: Lens' ListClosedWorkflowExecutions (Maybe ExecutionTimeFilter)
listClosedWorkflowExecutions_startTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe ExecutionTimeFilter
startTimeFilter :: Maybe ExecutionTimeFilter
$sel:startTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
startTimeFilter} -> Maybe ExecutionTimeFilter
startTimeFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe ExecutionTimeFilter
a -> ListClosedWorkflowExecutions
s {$sel:startTimeFilter:ListClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
startTimeFilter = Maybe ExecutionTimeFilter
a} :: ListClosedWorkflowExecutions)

-- | If specified, only executions that have the matching tag are listed.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
listClosedWorkflowExecutions_tagFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe TagFilter)
listClosedWorkflowExecutions_tagFilter :: Lens' ListClosedWorkflowExecutions (Maybe TagFilter)
listClosedWorkflowExecutions_tagFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe TagFilter
tagFilter :: Maybe TagFilter
$sel:tagFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe TagFilter
tagFilter} -> Maybe TagFilter
tagFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe TagFilter
a -> ListClosedWorkflowExecutions
s {$sel:tagFilter:ListClosedWorkflowExecutions' :: Maybe TagFilter
tagFilter = Maybe TagFilter
a} :: ListClosedWorkflowExecutions)

-- | If specified, only executions of the type specified in the filter are
-- returned.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
listClosedWorkflowExecutions_typeFilter :: Lens.Lens' ListClosedWorkflowExecutions (Prelude.Maybe WorkflowTypeFilter)
listClosedWorkflowExecutions_typeFilter :: Lens' ListClosedWorkflowExecutions (Maybe WorkflowTypeFilter)
listClosedWorkflowExecutions_typeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Maybe WorkflowTypeFilter
typeFilter :: Maybe WorkflowTypeFilter
$sel:typeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter} -> Maybe WorkflowTypeFilter
typeFilter) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Maybe WorkflowTypeFilter
a -> ListClosedWorkflowExecutions
s {$sel:typeFilter:ListClosedWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = Maybe WorkflowTypeFilter
a} :: ListClosedWorkflowExecutions)

-- | The name of the domain that contains the workflow executions to list.
listClosedWorkflowExecutions_domain :: Lens.Lens' ListClosedWorkflowExecutions Prelude.Text
listClosedWorkflowExecutions_domain :: Lens' ListClosedWorkflowExecutions Text
listClosedWorkflowExecutions_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListClosedWorkflowExecutions' {Text
domain :: Text
$sel:domain:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Text
domain} -> Text
domain) (\s :: ListClosedWorkflowExecutions
s@ListClosedWorkflowExecutions' {} Text
a -> ListClosedWorkflowExecutions
s {$sel:domain:ListClosedWorkflowExecutions' :: Text
domain = Text
a} :: ListClosedWorkflowExecutions)

instance Core.AWSPager ListClosedWorkflowExecutions where
  page :: ListClosedWorkflowExecutions
-> AWSResponse ListClosedWorkflowExecutions
-> Maybe ListClosedWorkflowExecutions
page ListClosedWorkflowExecutions
rq AWSResponse ListClosedWorkflowExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListClosedWorkflowExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' WorkflowExecutionInfos (Maybe Text)
workflowExecutionInfos_nextPageToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        (AWSResponse ListClosedWorkflowExecutions
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' WorkflowExecutionInfos [WorkflowExecutionInfo]
workflowExecutionInfos_executionInfos) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListClosedWorkflowExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListClosedWorkflowExecutions (Maybe Text)
listClosedWorkflowExecutions_nextPageToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListClosedWorkflowExecutions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' WorkflowExecutionInfos (Maybe Text)
workflowExecutionInfos_nextPageToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListClosedWorkflowExecutions where
  type
    AWSResponse ListClosedWorkflowExecutions =
      WorkflowExecutionInfos
  request :: (Service -> Service)
-> ListClosedWorkflowExecutions
-> Request ListClosedWorkflowExecutions
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListClosedWorkflowExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListClosedWorkflowExecutions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance
  Prelude.Hashable
    ListClosedWorkflowExecutions
  where
  hashWithSalt :: Int -> ListClosedWorkflowExecutions -> Int
hashWithSalt Int
_salt ListClosedWorkflowExecutions' {Maybe Bool
Maybe Natural
Maybe Text
Maybe CloseStatusFilter
Maybe ExecutionTimeFilter
Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
startTimeFilter :: Maybe ExecutionTimeFilter
reverseOrder :: Maybe Bool
nextPageToken :: Maybe Text
maximumPageSize :: Maybe Natural
executionFilter :: Maybe WorkflowExecutionFilter
closeTimeFilter :: Maybe ExecutionTimeFilter
closeStatusFilter :: Maybe CloseStatusFilter
$sel:domain:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Text
$sel:typeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe TagFilter
$sel:startTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:reverseOrder:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Bool
$sel:nextPageToken:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Text
$sel:maximumPageSize:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Natural
$sel:executionFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
$sel:closeTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:closeStatusFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe CloseStatusFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloseStatusFilter
closeStatusFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionTimeFilter
closeTimeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowExecutionFilter
executionFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maximumPageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextPageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
reverseOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionTimeFilter
startTimeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TagFilter
tagFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowTypeFilter
typeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain

instance Prelude.NFData ListClosedWorkflowExecutions where
  rnf :: ListClosedWorkflowExecutions -> ()
rnf ListClosedWorkflowExecutions' {Maybe Bool
Maybe Natural
Maybe Text
Maybe CloseStatusFilter
Maybe ExecutionTimeFilter
Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
startTimeFilter :: Maybe ExecutionTimeFilter
reverseOrder :: Maybe Bool
nextPageToken :: Maybe Text
maximumPageSize :: Maybe Natural
executionFilter :: Maybe WorkflowExecutionFilter
closeTimeFilter :: Maybe ExecutionTimeFilter
closeStatusFilter :: Maybe CloseStatusFilter
$sel:domain:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Text
$sel:typeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe TagFilter
$sel:startTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:reverseOrder:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Bool
$sel:nextPageToken:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Text
$sel:maximumPageSize:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Natural
$sel:executionFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
$sel:closeTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:closeStatusFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe CloseStatusFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CloseStatusFilter
closeStatusFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionTimeFilter
closeTimeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowExecutionFilter
executionFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maximumPageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
reverseOrder
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionTimeFilter
startTimeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TagFilter
tagFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowTypeFilter
typeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain

instance Data.ToHeaders ListClosedWorkflowExecutions where
  toHeaders :: ListClosedWorkflowExecutions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"SimpleWorkflowService.ListClosedWorkflowExecutions" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListClosedWorkflowExecutions where
  toJSON :: ListClosedWorkflowExecutions -> Value
toJSON ListClosedWorkflowExecutions' {Maybe Bool
Maybe Natural
Maybe Text
Maybe CloseStatusFilter
Maybe ExecutionTimeFilter
Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
startTimeFilter :: Maybe ExecutionTimeFilter
reverseOrder :: Maybe Bool
nextPageToken :: Maybe Text
maximumPageSize :: Maybe Natural
executionFilter :: Maybe WorkflowExecutionFilter
closeTimeFilter :: Maybe ExecutionTimeFilter
closeStatusFilter :: Maybe CloseStatusFilter
$sel:domain:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Text
$sel:typeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe TagFilter
$sel:startTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:reverseOrder:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Bool
$sel:nextPageToken:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Text
$sel:maximumPageSize:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe Natural
$sel:executionFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
$sel:closeTimeFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
$sel:closeStatusFilter:ListClosedWorkflowExecutions' :: ListClosedWorkflowExecutions -> Maybe CloseStatusFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"closeStatusFilter" 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 CloseStatusFilter
closeStatusFilter,
            (Key
"closeTimeFilter" 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 ExecutionTimeFilter
closeTimeFilter,
            (Key
"executionFilter" 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 WorkflowExecutionFilter
executionFilter,
            (Key
"maximumPageSize" 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 Natural
maximumPageSize,
            (Key
"nextPageToken" 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
nextPageToken,
            (Key
"reverseOrder" 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
reverseOrder,
            (Key
"startTimeFilter" 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 ExecutionTimeFilter
startTimeFilter,
            (Key
"tagFilter" 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 TagFilter
tagFilter,
            (Key
"typeFilter" 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 WorkflowTypeFilter
typeFilter,
            forall a. a -> Maybe a
Prelude.Just (Key
"domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domain)
          ]
      )

instance Data.ToPath ListClosedWorkflowExecutions where
  toPath :: ListClosedWorkflowExecutions -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery ListClosedWorkflowExecutions where
  toQuery :: ListClosedWorkflowExecutions -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty