{-# 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.CountOpenWorkflowExecutions
-- 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 the number of open workflow executions within the given domain
-- that meet the specified filtering criteria.
--
-- 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/.
module Amazonka.SWF.CountOpenWorkflowExecutions
  ( -- * Creating a Request
    CountOpenWorkflowExecutions (..),
    newCountOpenWorkflowExecutions,

    -- * Request Lenses
    countOpenWorkflowExecutions_executionFilter,
    countOpenWorkflowExecutions_tagFilter,
    countOpenWorkflowExecutions_typeFilter,
    countOpenWorkflowExecutions_domain,
    countOpenWorkflowExecutions_startTimeFilter,

    -- * Destructuring the Response
    WorkflowExecutionCount (..),
    newWorkflowExecutionCount,

    -- * Response Lenses
    workflowExecutionCount_truncated,
    workflowExecutionCount_count,
  )
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:/ 'newCountOpenWorkflowExecutions' smart constructor.
data CountOpenWorkflowExecutions = CountOpenWorkflowExecutions'
  { -- | If specified, only workflow executions matching the @WorkflowId@ in the
    -- filter are counted.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    CountOpenWorkflowExecutions -> Maybe WorkflowExecutionFilter
executionFilter :: Prelude.Maybe WorkflowExecutionFilter,
    -- | If specified, only executions that have a tag that matches the filter
    -- are counted.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    CountOpenWorkflowExecutions -> Maybe TagFilter
tagFilter :: Prelude.Maybe TagFilter,
    -- | Specifies the type of the workflow executions to be counted.
    --
    -- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
    -- You can specify at most one of these in a request.
    CountOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter :: Prelude.Maybe WorkflowTypeFilter,
    -- | The name of the domain containing the workflow executions to count.
    CountOpenWorkflowExecutions -> Text
domain :: Prelude.Text,
    -- | Specifies the start time criteria that workflow executions must meet in
    -- order to be counted.
    CountOpenWorkflowExecutions -> ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
  }
  deriving (CountOpenWorkflowExecutions -> CountOpenWorkflowExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CountOpenWorkflowExecutions -> CountOpenWorkflowExecutions -> Bool
$c/= :: CountOpenWorkflowExecutions -> CountOpenWorkflowExecutions -> Bool
== :: CountOpenWorkflowExecutions -> CountOpenWorkflowExecutions -> Bool
$c== :: CountOpenWorkflowExecutions -> CountOpenWorkflowExecutions -> Bool
Prelude.Eq, ReadPrec [CountOpenWorkflowExecutions]
ReadPrec CountOpenWorkflowExecutions
Int -> ReadS CountOpenWorkflowExecutions
ReadS [CountOpenWorkflowExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CountOpenWorkflowExecutions]
$creadListPrec :: ReadPrec [CountOpenWorkflowExecutions]
readPrec :: ReadPrec CountOpenWorkflowExecutions
$creadPrec :: ReadPrec CountOpenWorkflowExecutions
readList :: ReadS [CountOpenWorkflowExecutions]
$creadList :: ReadS [CountOpenWorkflowExecutions]
readsPrec :: Int -> ReadS CountOpenWorkflowExecutions
$creadsPrec :: Int -> ReadS CountOpenWorkflowExecutions
Prelude.Read, Int -> CountOpenWorkflowExecutions -> ShowS
[CountOpenWorkflowExecutions] -> ShowS
CountOpenWorkflowExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CountOpenWorkflowExecutions] -> ShowS
$cshowList :: [CountOpenWorkflowExecutions] -> ShowS
show :: CountOpenWorkflowExecutions -> String
$cshow :: CountOpenWorkflowExecutions -> String
showsPrec :: Int -> CountOpenWorkflowExecutions -> ShowS
$cshowsPrec :: Int -> CountOpenWorkflowExecutions -> ShowS
Prelude.Show, forall x.
Rep CountOpenWorkflowExecutions x -> CountOpenWorkflowExecutions
forall x.
CountOpenWorkflowExecutions -> Rep CountOpenWorkflowExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CountOpenWorkflowExecutions x -> CountOpenWorkflowExecutions
$cfrom :: forall x.
CountOpenWorkflowExecutions -> Rep CountOpenWorkflowExecutions x
Prelude.Generic)

-- |
-- Create a value of 'CountOpenWorkflowExecutions' 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', 'countOpenWorkflowExecutions_executionFilter' - If specified, only workflow executions matching the @WorkflowId@ in the
-- filter are counted.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'tagFilter', 'countOpenWorkflowExecutions_tagFilter' - If specified, only executions that have a tag that matches the filter
-- are counted.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'typeFilter', 'countOpenWorkflowExecutions_typeFilter' - Specifies the type of the workflow executions to be counted.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
--
-- 'domain', 'countOpenWorkflowExecutions_domain' - The name of the domain containing the workflow executions to count.
--
-- 'startTimeFilter', 'countOpenWorkflowExecutions_startTimeFilter' - Specifies the start time criteria that workflow executions must meet in
-- order to be counted.
newCountOpenWorkflowExecutions ::
  -- | 'domain'
  Prelude.Text ->
  -- | 'startTimeFilter'
  ExecutionTimeFilter ->
  CountOpenWorkflowExecutions
newCountOpenWorkflowExecutions :: Text -> ExecutionTimeFilter -> CountOpenWorkflowExecutions
newCountOpenWorkflowExecutions
  Text
pDomain_
  ExecutionTimeFilter
pStartTimeFilter_ =
    CountOpenWorkflowExecutions'
      { $sel:executionFilter:CountOpenWorkflowExecutions' :: Maybe WorkflowExecutionFilter
executionFilter =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tagFilter:CountOpenWorkflowExecutions' :: Maybe TagFilter
tagFilter = forall a. Maybe a
Prelude.Nothing,
        $sel:typeFilter:CountOpenWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:CountOpenWorkflowExecutions' :: Text
domain = Text
pDomain_,
        $sel:startTimeFilter:CountOpenWorkflowExecutions' :: ExecutionTimeFilter
startTimeFilter = ExecutionTimeFilter
pStartTimeFilter_
      }

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

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

-- | Specifies the type of the workflow executions to be counted.
--
-- @executionFilter@, @typeFilter@ and @tagFilter@ are mutually exclusive.
-- You can specify at most one of these in a request.
countOpenWorkflowExecutions_typeFilter :: Lens.Lens' CountOpenWorkflowExecutions (Prelude.Maybe WorkflowTypeFilter)
countOpenWorkflowExecutions_typeFilter :: Lens' CountOpenWorkflowExecutions (Maybe WorkflowTypeFilter)
countOpenWorkflowExecutions_typeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountOpenWorkflowExecutions' {Maybe WorkflowTypeFilter
typeFilter :: Maybe WorkflowTypeFilter
$sel:typeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter} -> Maybe WorkflowTypeFilter
typeFilter) (\s :: CountOpenWorkflowExecutions
s@CountOpenWorkflowExecutions' {} Maybe WorkflowTypeFilter
a -> CountOpenWorkflowExecutions
s {$sel:typeFilter:CountOpenWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = Maybe WorkflowTypeFilter
a} :: CountOpenWorkflowExecutions)

-- | The name of the domain containing the workflow executions to count.
countOpenWorkflowExecutions_domain :: Lens.Lens' CountOpenWorkflowExecutions Prelude.Text
countOpenWorkflowExecutions_domain :: Lens' CountOpenWorkflowExecutions Text
countOpenWorkflowExecutions_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountOpenWorkflowExecutions' {Text
domain :: Text
$sel:domain:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Text
domain} -> Text
domain) (\s :: CountOpenWorkflowExecutions
s@CountOpenWorkflowExecutions' {} Text
a -> CountOpenWorkflowExecutions
s {$sel:domain:CountOpenWorkflowExecutions' :: Text
domain = Text
a} :: CountOpenWorkflowExecutions)

-- | Specifies the start time criteria that workflow executions must meet in
-- order to be counted.
countOpenWorkflowExecutions_startTimeFilter :: Lens.Lens' CountOpenWorkflowExecutions ExecutionTimeFilter
countOpenWorkflowExecutions_startTimeFilter :: Lens' CountOpenWorkflowExecutions ExecutionTimeFilter
countOpenWorkflowExecutions_startTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountOpenWorkflowExecutions' {ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
$sel:startTimeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> ExecutionTimeFilter
startTimeFilter} -> ExecutionTimeFilter
startTimeFilter) (\s :: CountOpenWorkflowExecutions
s@CountOpenWorkflowExecutions' {} ExecutionTimeFilter
a -> CountOpenWorkflowExecutions
s {$sel:startTimeFilter:CountOpenWorkflowExecutions' :: ExecutionTimeFilter
startTimeFilter = ExecutionTimeFilter
a} :: CountOpenWorkflowExecutions)

instance Core.AWSRequest CountOpenWorkflowExecutions where
  type
    AWSResponse CountOpenWorkflowExecutions =
      WorkflowExecutionCount
  request :: (Service -> Service)
-> CountOpenWorkflowExecutions
-> Request CountOpenWorkflowExecutions
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 CountOpenWorkflowExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CountOpenWorkflowExecutions)))
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 CountOpenWorkflowExecutions where
  hashWithSalt :: Int -> CountOpenWorkflowExecutions -> Int
hashWithSalt Int
_salt CountOpenWorkflowExecutions' {Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
executionFilter :: Maybe WorkflowExecutionFilter
$sel:startTimeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> ExecutionTimeFilter
$sel:domain:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Text
$sel:typeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe TagFilter
$sel:executionFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> 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 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 CountOpenWorkflowExecutions where
  rnf :: CountOpenWorkflowExecutions -> ()
rnf CountOpenWorkflowExecutions' {Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
executionFilter :: Maybe WorkflowExecutionFilter
$sel:startTimeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> ExecutionTimeFilter
$sel:domain:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Text
$sel:typeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe TagFilter
$sel:executionFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> 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 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 CountOpenWorkflowExecutions where
  toHeaders :: CountOpenWorkflowExecutions -> 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.CountOpenWorkflowExecutions" ::
                          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 CountOpenWorkflowExecutions where
  toJSON :: CountOpenWorkflowExecutions -> Value
toJSON CountOpenWorkflowExecutions' {Maybe TagFilter
Maybe WorkflowExecutionFilter
Maybe WorkflowTypeFilter
Text
ExecutionTimeFilter
startTimeFilter :: ExecutionTimeFilter
domain :: Text
typeFilter :: Maybe WorkflowTypeFilter
tagFilter :: Maybe TagFilter
executionFilter :: Maybe WorkflowExecutionFilter
$sel:startTimeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> ExecutionTimeFilter
$sel:domain:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Text
$sel:typeFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe WorkflowTypeFilter
$sel:tagFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> Maybe TagFilter
$sel:executionFilter:CountOpenWorkflowExecutions' :: CountOpenWorkflowExecutions -> 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
"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 CountOpenWorkflowExecutions where
  toPath :: CountOpenWorkflowExecutions -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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