{-# 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.ListOpenWorkflowExecutions
-- 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 open 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.ListOpenWorkflowExecutions
  ( -- * Creating a Request
    ListOpenWorkflowExecutions (..),
    newListOpenWorkflowExecutions,

    -- * Request Lenses
    listOpenWorkflowExecutions_executionFilter,
    listOpenWorkflowExecutions_maximumPageSize,
    listOpenWorkflowExecutions_nextPageToken,
    listOpenWorkflowExecutions_reverseOrder,
    listOpenWorkflowExecutions_tagFilter,
    listOpenWorkflowExecutions_typeFilter,
    listOpenWorkflowExecutions_domain,
    listOpenWorkflowExecutions_startTimeFilter,

    -- * 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:/ 'newListOpenWorkflowExecutions' smart constructor.
data ListOpenWorkflowExecutions = ListOpenWorkflowExecutions'
  { -- | If specified, only workflow executions matching the workflow ID
    -- specified in the filter are returned.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    ListOpenWorkflowExecutions -> Maybe WorkflowExecutionFilter
executionFilter :: Prelude.Maybe WorkflowExecutionFilter,
    -- | The maximum number of results that are returned per call. Use
    -- @nextPageToken@ to obtain further pages of results.
    ListOpenWorkflowExecutions -> 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.
    ListOpenWorkflowExecutions -> 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 time of the
    -- executions.
    ListOpenWorkflowExecutions -> Maybe Bool
reverseOrder :: Prelude.Maybe Prelude.Bool,
    -- | If specified, only executions that have the matching tag are listed.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    ListOpenWorkflowExecutions -> Maybe TagFilter
tagFilter :: Prelude.Maybe TagFilter,
    -- | If specified, only executions of the type specified in the filter are
    -- returned.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    ListOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter :: Prelude.Maybe WorkflowTypeFilter,
    -- | The name of the domain that contains the workflow executions to list.
    ListOpenWorkflowExecutions -> Text
domain :: Prelude.Text,
    -- | Workflow executions are included in the returned results based on
    -- whether their start times are within the range specified by this filter.
    ListOpenWorkflowExecutions -> ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
  }
  deriving (ListOpenWorkflowExecutions -> ListOpenWorkflowExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOpenWorkflowExecutions -> ListOpenWorkflowExecutions -> Bool
$c/= :: ListOpenWorkflowExecutions -> ListOpenWorkflowExecutions -> Bool
== :: ListOpenWorkflowExecutions -> ListOpenWorkflowExecutions -> Bool
$c== :: ListOpenWorkflowExecutions -> ListOpenWorkflowExecutions -> Bool
Prelude.Eq, ReadPrec [ListOpenWorkflowExecutions]
ReadPrec ListOpenWorkflowExecutions
Int -> ReadS ListOpenWorkflowExecutions
ReadS [ListOpenWorkflowExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListOpenWorkflowExecutions]
$creadListPrec :: ReadPrec [ListOpenWorkflowExecutions]
readPrec :: ReadPrec ListOpenWorkflowExecutions
$creadPrec :: ReadPrec ListOpenWorkflowExecutions
readList :: ReadS [ListOpenWorkflowExecutions]
$creadList :: ReadS [ListOpenWorkflowExecutions]
readsPrec :: Int -> ReadS ListOpenWorkflowExecutions
$creadsPrec :: Int -> ReadS ListOpenWorkflowExecutions
Prelude.Read, Int -> ListOpenWorkflowExecutions -> ShowS
[ListOpenWorkflowExecutions] -> ShowS
ListOpenWorkflowExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListOpenWorkflowExecutions] -> ShowS
$cshowList :: [ListOpenWorkflowExecutions] -> ShowS
show :: ListOpenWorkflowExecutions -> String
$cshow :: ListOpenWorkflowExecutions -> String
showsPrec :: Int -> ListOpenWorkflowExecutions -> ShowS
$cshowsPrec :: Int -> ListOpenWorkflowExecutions -> ShowS
Prelude.Show, forall x.
Rep ListOpenWorkflowExecutions x -> ListOpenWorkflowExecutions
forall x.
ListOpenWorkflowExecutions -> Rep ListOpenWorkflowExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListOpenWorkflowExecutions x -> ListOpenWorkflowExecutions
$cfrom :: forall x.
ListOpenWorkflowExecutions -> Rep ListOpenWorkflowExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListOpenWorkflowExecutions' 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:
--
-- 'executionFilter', 'listOpenWorkflowExecutions_executionFilter' - If specified, only workflow executions matching the workflow ID
-- specified in the filter are returned.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'maximumPageSize', 'listOpenWorkflowExecutions_maximumPageSize' - The maximum number of results that are returned per call. Use
-- @nextPageToken@ to obtain further pages of results.
--
-- 'nextPageToken', 'listOpenWorkflowExecutions_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', 'listOpenWorkflowExecutions_reverseOrder' - When set to @true@, returns the results in reverse order. By default the
-- results are returned in descending order of the start time of the
-- executions.
--
-- 'tagFilter', 'listOpenWorkflowExecutions_tagFilter' - If specified, only executions that have the matching tag are listed.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'typeFilter', 'listOpenWorkflowExecutions_typeFilter' - If specified, only executions of the type specified in the filter are
-- returned.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'domain', 'listOpenWorkflowExecutions_domain' - The name of the domain that contains the workflow executions to list.
--
-- 'startTimeFilter', 'listOpenWorkflowExecutions_startTimeFilter' - Workflow executions are included in the returned results based on
-- whether their start times are within the range specified by this filter.
newListOpenWorkflowExecutions ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'startTimeFilter'
  ExecutionTimeFilter ->
  ListOpenWorkflowExecutions
newListOpenWorkflowExecutions :: Text -> ExecutionTimeFilter -> ListOpenWorkflowExecutions
newListOpenWorkflowExecutions
  Text
pDomain_
  ExecutionTimeFilter
pStartTimeFilter_ =
    ListOpenWorkflowExecutions'
      { $sel:executionFilter:ListOpenWorkflowExecutions' :: Maybe WorkflowExecutionFilter
executionFilter =
          forall a. Maybe a
Prelude.Nothing,
        $sel:maximumPageSize:ListOpenWorkflowExecutions' :: Maybe Natural
maximumPageSize = forall a. Maybe a
Prelude.Nothing,
        $sel:nextPageToken:ListOpenWorkflowExecutions' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
        $sel:reverseOrder:ListOpenWorkflowExecutions' :: Maybe Bool
reverseOrder = forall a. Maybe a
Prelude.Nothing,
        $sel:tagFilter:ListOpenWorkflowExecutions' :: Maybe TagFilter
tagFilter = forall a. Maybe a
Prelude.Nothing,
        $sel:typeFilter:ListOpenWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:ListOpenWorkflowExecutions' :: Text
domain = Text
pDomain_,
        $sel:startTimeFilter:ListOpenWorkflowExecutions' :: ExecutionTimeFilter
startTimeFilter = ExecutionTimeFilter
pStartTimeFilter_
      }

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

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

-- | 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.
listOpenWorkflowExecutions_nextPageToken :: Lens.Lens' ListOpenWorkflowExecutions (Prelude.Maybe Prelude.Text)
listOpenWorkflowExecutions_nextPageToken :: Lens' ListOpenWorkflowExecutions (Maybe Text)
listOpenWorkflowExecutions_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOpenWorkflowExecutions' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: ListOpenWorkflowExecutions
s@ListOpenWorkflowExecutions' {} Maybe Text
a -> ListOpenWorkflowExecutions
s {$sel:nextPageToken:ListOpenWorkflowExecutions' :: Maybe Text
nextPageToken = Maybe Text
a} :: ListOpenWorkflowExecutions)

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

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

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

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

-- | Workflow executions are included in the returned results based on
-- whether their start times are within the range specified by this filter.
listOpenWorkflowExecutions_startTimeFilter :: Lens.Lens' ListOpenWorkflowExecutions ExecutionTimeFilter
listOpenWorkflowExecutions_startTimeFilter :: Lens' ListOpenWorkflowExecutions ExecutionTimeFilter
listOpenWorkflowExecutions_startTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListOpenWorkflowExecutions' {ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
$sel:startTimeFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> ExecutionTimeFilter
startTimeFilter} -> ExecutionTimeFilter
startTimeFilter) (\s :: ListOpenWorkflowExecutions
s@ListOpenWorkflowExecutions' {} ExecutionTimeFilter
a -> ListOpenWorkflowExecutions
s {$sel:startTimeFilter:ListOpenWorkflowExecutions' :: ExecutionTimeFilter
startTimeFilter = ExecutionTimeFilter
a} :: ListOpenWorkflowExecutions)

instance Core.AWSPager ListOpenWorkflowExecutions where
  page :: ListOpenWorkflowExecutions
-> AWSResponse ListOpenWorkflowExecutions
-> Maybe ListOpenWorkflowExecutions
page ListOpenWorkflowExecutions
rq AWSResponse ListOpenWorkflowExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListOpenWorkflowExecutions
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 ListOpenWorkflowExecutions
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.$ ListOpenWorkflowExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListOpenWorkflowExecutions (Maybe Text)
listOpenWorkflowExecutions_nextPageToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListOpenWorkflowExecutions
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 ListOpenWorkflowExecutions where
  type
    AWSResponse ListOpenWorkflowExecutions =
      WorkflowExecutionInfos
  request :: (Service -> Service)
-> ListOpenWorkflowExecutions -> Request ListOpenWorkflowExecutions
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 ListOpenWorkflowExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListOpenWorkflowExecutions)))
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 ListOpenWorkflowExecutions where
  hashWithSalt :: Int -> ListOpenWorkflowExecutions -> Int
hashWithSalt Int
_salt ListOpenWorkflowExecutions' {Maybe Bool
Maybe Natural
Maybe Text
Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
reverseOrder :: Maybe Bool
nextPageToken :: Maybe Text
maximumPageSize :: Maybe Natural
executionFilter :: Maybe WorkflowExecutionFilter
$sel:startTimeFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> ExecutionTimeFilter
$sel:domain:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Text
$sel:typeFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe TagFilter
$sel:reverseOrder:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Bool
$sel:nextPageToken:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Text
$sel:maximumPageSize:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Natural
$sel:executionFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe WorkflowExecutionFilter
..} =
    Int
_salt
      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 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExecutionTimeFilter
startTimeFilter

instance Prelude.NFData ListOpenWorkflowExecutions where
  rnf :: ListOpenWorkflowExecutions -> ()
rnf ListOpenWorkflowExecutions' {Maybe Bool
Maybe Natural
Maybe Text
Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
reverseOrder :: Maybe Bool
nextPageToken :: Maybe Text
maximumPageSize :: Maybe Natural
executionFilter :: Maybe WorkflowExecutionFilter
$sel:startTimeFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> ExecutionTimeFilter
$sel:domain:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Text
$sel:typeFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe TagFilter
$sel:reverseOrder:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Bool
$sel:nextPageToken:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Text
$sel:maximumPageSize:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe Natural
$sel:executionFilter:ListOpenWorkflowExecutions' :: ListOpenWorkflowExecutions -> Maybe WorkflowExecutionFilter
..} =
    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 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExecutionTimeFilter
startTimeFilter

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

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

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