{-# 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.CountClosedWorkflowExecutions
-- 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 closed 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.CountClosedWorkflowExecutions
  ( -- * Creating a Request
    CountClosedWorkflowExecutions (..),
    newCountClosedWorkflowExecutions,

    -- * Request Lenses
    countClosedWorkflowExecutions_closeStatusFilter,
    countClosedWorkflowExecutions_closeTimeFilter,
    countClosedWorkflowExecutions_executionFilter,
    countClosedWorkflowExecutions_startTimeFilter,
    countClosedWorkflowExecutions_tagFilter,
    countClosedWorkflowExecutions_typeFilter,
    countClosedWorkflowExecutions_domain,

    -- * 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:/ 'newCountClosedWorkflowExecutions' smart constructor.
data CountClosedWorkflowExecutions = CountClosedWorkflowExecutions'
  { -- | If specified, only workflow executions that match this close status are
    -- counted. This filter has an affect only if @executionStatus@ is
    -- specified as @CLOSED@.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    CountClosedWorkflowExecutions -> Maybe CloseStatusFilter
closeStatusFilter :: Prelude.Maybe CloseStatusFilter,
    -- | If specified, only workflow executions that meet the close time criteria
    -- of the filter are counted.
    --
    -- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
    -- specify one of these in a request but not both.
    CountClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
closeTimeFilter :: Prelude.Maybe ExecutionTimeFilter,
    -- | If specified, only workflow executions matching the @WorkflowId@ in the
    -- filter are counted.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    CountClosedWorkflowExecutions -> Maybe WorkflowExecutionFilter
executionFilter :: Prelude.Maybe WorkflowExecutionFilter,
    -- | If specified, only workflow executions that meet the start time criteria
    -- of the filter are counted.
    --
    -- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
    -- specify one of these in a request but not both.
    CountClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
startTimeFilter :: Prelude.Maybe ExecutionTimeFilter,
    -- | If specified, only executions that have a tag that matches the filter
    -- are counted.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    CountClosedWorkflowExecutions -> Maybe TagFilter
tagFilter :: Prelude.Maybe TagFilter,
    -- | If specified, indicates the type of the workflow executions to be
    -- counted.
    --
    -- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
    -- mutually exclusive. You can specify at most one of these in a request.
    CountClosedWorkflowExecutions -> Maybe WorkflowTypeFilter
typeFilter :: Prelude.Maybe WorkflowTypeFilter,
    -- | The name of the domain containing the workflow executions to count.
    CountClosedWorkflowExecutions -> Text
domain :: Prelude.Text
  }
  deriving (CountClosedWorkflowExecutions
-> CountClosedWorkflowExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CountClosedWorkflowExecutions
-> CountClosedWorkflowExecutions -> Bool
$c/= :: CountClosedWorkflowExecutions
-> CountClosedWorkflowExecutions -> Bool
== :: CountClosedWorkflowExecutions
-> CountClosedWorkflowExecutions -> Bool
$c== :: CountClosedWorkflowExecutions
-> CountClosedWorkflowExecutions -> Bool
Prelude.Eq, ReadPrec [CountClosedWorkflowExecutions]
ReadPrec CountClosedWorkflowExecutions
Int -> ReadS CountClosedWorkflowExecutions
ReadS [CountClosedWorkflowExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CountClosedWorkflowExecutions]
$creadListPrec :: ReadPrec [CountClosedWorkflowExecutions]
readPrec :: ReadPrec CountClosedWorkflowExecutions
$creadPrec :: ReadPrec CountClosedWorkflowExecutions
readList :: ReadS [CountClosedWorkflowExecutions]
$creadList :: ReadS [CountClosedWorkflowExecutions]
readsPrec :: Int -> ReadS CountClosedWorkflowExecutions
$creadsPrec :: Int -> ReadS CountClosedWorkflowExecutions
Prelude.Read, Int -> CountClosedWorkflowExecutions -> ShowS
[CountClosedWorkflowExecutions] -> ShowS
CountClosedWorkflowExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CountClosedWorkflowExecutions] -> ShowS
$cshowList :: [CountClosedWorkflowExecutions] -> ShowS
show :: CountClosedWorkflowExecutions -> String
$cshow :: CountClosedWorkflowExecutions -> String
showsPrec :: Int -> CountClosedWorkflowExecutions -> ShowS
$cshowsPrec :: Int -> CountClosedWorkflowExecutions -> ShowS
Prelude.Show, forall x.
Rep CountClosedWorkflowExecutions x
-> CountClosedWorkflowExecutions
forall x.
CountClosedWorkflowExecutions
-> Rep CountClosedWorkflowExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CountClosedWorkflowExecutions x
-> CountClosedWorkflowExecutions
$cfrom :: forall x.
CountClosedWorkflowExecutions
-> Rep CountClosedWorkflowExecutions x
Prelude.Generic)

-- |
-- Create a value of 'CountClosedWorkflowExecutions' 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', 'countClosedWorkflowExecutions_closeStatusFilter' - If specified, only workflow executions that match this close status are
-- counted. This filter has an affect only if @executionStatus@ is
-- specified as @CLOSED@.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'closeTimeFilter', 'countClosedWorkflowExecutions_closeTimeFilter' - If specified, only workflow executions that meet the close time criteria
-- of the filter are counted.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
--
-- 'executionFilter', 'countClosedWorkflowExecutions_executionFilter' - If specified, only workflow executions matching the @WorkflowId@ in the
-- filter are counted.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'startTimeFilter', 'countClosedWorkflowExecutions_startTimeFilter' - If specified, only workflow executions that meet the start time criteria
-- of the filter are counted.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
--
-- 'tagFilter', 'countClosedWorkflowExecutions_tagFilter' - If specified, only executions that have a tag that matches the filter
-- are counted.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'typeFilter', 'countClosedWorkflowExecutions_typeFilter' - If specified, indicates the type of the workflow executions to be
-- counted.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
--
-- 'domain', 'countClosedWorkflowExecutions_domain' - The name of the domain containing the workflow executions to count.
newCountClosedWorkflowExecutions ::
  -- | 'domain'
  Prelude.Text ->
  CountClosedWorkflowExecutions
newCountClosedWorkflowExecutions :: Text -> CountClosedWorkflowExecutions
newCountClosedWorkflowExecutions Text
pDomain_ =
  CountClosedWorkflowExecutions'
    { $sel:closeStatusFilter:CountClosedWorkflowExecutions' :: Maybe CloseStatusFilter
closeStatusFilter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:closeTimeFilter:CountClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
closeTimeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:executionFilter:CountClosedWorkflowExecutions' :: Maybe WorkflowExecutionFilter
executionFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimeFilter:CountClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
startTimeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:tagFilter:CountClosedWorkflowExecutions' :: Maybe TagFilter
tagFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:typeFilter:CountClosedWorkflowExecutions' :: Maybe WorkflowTypeFilter
typeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:CountClosedWorkflowExecutions' :: Text
domain = Text
pDomain_
    }

-- | If specified, only workflow executions that match this close status are
-- counted. This filter has an affect only if @executionStatus@ is
-- specified as @CLOSED@.
--
-- @closeStatusFilter@, @executionFilter@, @typeFilter@ and @tagFilter@ are
-- mutually exclusive. You can specify at most one of these in a request.
countClosedWorkflowExecutions_closeStatusFilter :: Lens.Lens' CountClosedWorkflowExecutions (Prelude.Maybe CloseStatusFilter)
countClosedWorkflowExecutions_closeStatusFilter :: Lens' CountClosedWorkflowExecutions (Maybe CloseStatusFilter)
countClosedWorkflowExecutions_closeStatusFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountClosedWorkflowExecutions' {Maybe CloseStatusFilter
closeStatusFilter :: Maybe CloseStatusFilter
$sel:closeStatusFilter:CountClosedWorkflowExecutions' :: CountClosedWorkflowExecutions -> Maybe CloseStatusFilter
closeStatusFilter} -> Maybe CloseStatusFilter
closeStatusFilter) (\s :: CountClosedWorkflowExecutions
s@CountClosedWorkflowExecutions' {} Maybe CloseStatusFilter
a -> CountClosedWorkflowExecutions
s {$sel:closeStatusFilter:CountClosedWorkflowExecutions' :: Maybe CloseStatusFilter
closeStatusFilter = Maybe CloseStatusFilter
a} :: CountClosedWorkflowExecutions)

-- | If specified, only workflow executions that meet the close time criteria
-- of the filter are counted.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
countClosedWorkflowExecutions_closeTimeFilter :: Lens.Lens' CountClosedWorkflowExecutions (Prelude.Maybe ExecutionTimeFilter)
countClosedWorkflowExecutions_closeTimeFilter :: Lens' CountClosedWorkflowExecutions (Maybe ExecutionTimeFilter)
countClosedWorkflowExecutions_closeTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountClosedWorkflowExecutions' {Maybe ExecutionTimeFilter
closeTimeFilter :: Maybe ExecutionTimeFilter
$sel:closeTimeFilter:CountClosedWorkflowExecutions' :: CountClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
closeTimeFilter} -> Maybe ExecutionTimeFilter
closeTimeFilter) (\s :: CountClosedWorkflowExecutions
s@CountClosedWorkflowExecutions' {} Maybe ExecutionTimeFilter
a -> CountClosedWorkflowExecutions
s {$sel:closeTimeFilter:CountClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
closeTimeFilter = Maybe ExecutionTimeFilter
a} :: CountClosedWorkflowExecutions)

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

-- | If specified, only workflow executions that meet the start time criteria
-- of the filter are counted.
--
-- @startTimeFilter@ and @closeTimeFilter@ are mutually exclusive. You must
-- specify one of these in a request but not both.
countClosedWorkflowExecutions_startTimeFilter :: Lens.Lens' CountClosedWorkflowExecutions (Prelude.Maybe ExecutionTimeFilter)
countClosedWorkflowExecutions_startTimeFilter :: Lens' CountClosedWorkflowExecutions (Maybe ExecutionTimeFilter)
countClosedWorkflowExecutions_startTimeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CountClosedWorkflowExecutions' {Maybe ExecutionTimeFilter
startTimeFilter :: Maybe ExecutionTimeFilter
$sel:startTimeFilter:CountClosedWorkflowExecutions' :: CountClosedWorkflowExecutions -> Maybe ExecutionTimeFilter
startTimeFilter} -> Maybe ExecutionTimeFilter
startTimeFilter) (\s :: CountClosedWorkflowExecutions
s@CountClosedWorkflowExecutions' {} Maybe ExecutionTimeFilter
a -> CountClosedWorkflowExecutions
s {$sel:startTimeFilter:CountClosedWorkflowExecutions' :: Maybe ExecutionTimeFilter
startTimeFilter = Maybe ExecutionTimeFilter
a} :: CountClosedWorkflowExecutions)

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

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

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

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

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