{-# 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.StepFunctions.GetExecutionHistory
-- 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 history of the specified execution as a list of events. By
-- default, the results are returned in ascending order of the @timeStamp@
-- of the events. Use the @reverseOrder@ parameter to get the latest events
-- first.
--
-- If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ 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 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
--
-- This API action is not supported by @EXPRESS@ state machines.
--
-- This operation returns paginated results.
module Amazonka.StepFunctions.GetExecutionHistory
  ( -- * Creating a Request
    GetExecutionHistory (..),
    newGetExecutionHistory,

    -- * Request Lenses
    getExecutionHistory_includeExecutionData,
    getExecutionHistory_maxResults,
    getExecutionHistory_nextToken,
    getExecutionHistory_reverseOrder,
    getExecutionHistory_executionArn,

    -- * Destructuring the Response
    GetExecutionHistoryResponse (..),
    newGetExecutionHistoryResponse,

    -- * Response Lenses
    getExecutionHistoryResponse_nextToken,
    getExecutionHistoryResponse_httpStatus,
    getExecutionHistoryResponse_events,
  )
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.StepFunctions.Types

-- | /See:/ 'newGetExecutionHistory' smart constructor.
data GetExecutionHistory = GetExecutionHistory'
  { -- | You can select whether execution data (input or output of a history
    -- event) is returned. The default is @true@.
    GetExecutionHistory -> Maybe Bool
includeExecutionData :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of results that are returned per call. You can use
    -- @nextToken@ to obtain further pages of results. The default is 100 and
    -- the maximum allowed page size is 1000. A value of 0 uses the default.
    --
    -- This is only an upper limit. The actual number of results returned per
    -- call might be fewer than the specified maximum.
    GetExecutionHistory -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ 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 24 hours. Using
    -- an expired pagination token will return an /HTTP 400 InvalidToken/
    -- error.
    GetExecutionHistory -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Lists events in descending order of their @timeStamp@.
    GetExecutionHistory -> Maybe Bool
reverseOrder :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the execution.
    GetExecutionHistory -> Text
executionArn :: Prelude.Text
  }
  deriving (GetExecutionHistory -> GetExecutionHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExecutionHistory -> GetExecutionHistory -> Bool
$c/= :: GetExecutionHistory -> GetExecutionHistory -> Bool
== :: GetExecutionHistory -> GetExecutionHistory -> Bool
$c== :: GetExecutionHistory -> GetExecutionHistory -> Bool
Prelude.Eq, ReadPrec [GetExecutionHistory]
ReadPrec GetExecutionHistory
Int -> ReadS GetExecutionHistory
ReadS [GetExecutionHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExecutionHistory]
$creadListPrec :: ReadPrec [GetExecutionHistory]
readPrec :: ReadPrec GetExecutionHistory
$creadPrec :: ReadPrec GetExecutionHistory
readList :: ReadS [GetExecutionHistory]
$creadList :: ReadS [GetExecutionHistory]
readsPrec :: Int -> ReadS GetExecutionHistory
$creadsPrec :: Int -> ReadS GetExecutionHistory
Prelude.Read, Int -> GetExecutionHistory -> ShowS
[GetExecutionHistory] -> ShowS
GetExecutionHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExecutionHistory] -> ShowS
$cshowList :: [GetExecutionHistory] -> ShowS
show :: GetExecutionHistory -> String
$cshow :: GetExecutionHistory -> String
showsPrec :: Int -> GetExecutionHistory -> ShowS
$cshowsPrec :: Int -> GetExecutionHistory -> ShowS
Prelude.Show, forall x. Rep GetExecutionHistory x -> GetExecutionHistory
forall x. GetExecutionHistory -> Rep GetExecutionHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExecutionHistory x -> GetExecutionHistory
$cfrom :: forall x. GetExecutionHistory -> Rep GetExecutionHistory x
Prelude.Generic)

-- |
-- Create a value of 'GetExecutionHistory' 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:
--
-- 'includeExecutionData', 'getExecutionHistory_includeExecutionData' - You can select whether execution data (input or output of a history
-- event) is returned. The default is @true@.
--
-- 'maxResults', 'getExecutionHistory_maxResults' - The maximum number of results that are returned per call. You can use
-- @nextToken@ to obtain further pages of results. The default is 100 and
-- the maximum allowed page size is 1000. A value of 0 uses the default.
--
-- This is only an upper limit. The actual number of results returned per
-- call might be fewer than the specified maximum.
--
-- 'nextToken', 'getExecutionHistory_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ 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 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
--
-- 'reverseOrder', 'getExecutionHistory_reverseOrder' - Lists events in descending order of their @timeStamp@.
--
-- 'executionArn', 'getExecutionHistory_executionArn' - The Amazon Resource Name (ARN) of the execution.
newGetExecutionHistory ::
  -- | 'executionArn'
  Prelude.Text ->
  GetExecutionHistory
newGetExecutionHistory :: Text -> GetExecutionHistory
newGetExecutionHistory Text
pExecutionArn_ =
  GetExecutionHistory'
    { $sel:includeExecutionData:GetExecutionHistory' :: Maybe Bool
includeExecutionData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetExecutionHistory' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetExecutionHistory' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:reverseOrder:GetExecutionHistory' :: Maybe Bool
reverseOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:executionArn:GetExecutionHistory' :: Text
executionArn = Text
pExecutionArn_
    }

-- | You can select whether execution data (input or output of a history
-- event) is returned. The default is @true@.
getExecutionHistory_includeExecutionData :: Lens.Lens' GetExecutionHistory (Prelude.Maybe Prelude.Bool)
getExecutionHistory_includeExecutionData :: Lens' GetExecutionHistory (Maybe Bool)
getExecutionHistory_includeExecutionData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistory' {Maybe Bool
includeExecutionData :: Maybe Bool
$sel:includeExecutionData:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
includeExecutionData} -> Maybe Bool
includeExecutionData) (\s :: GetExecutionHistory
s@GetExecutionHistory' {} Maybe Bool
a -> GetExecutionHistory
s {$sel:includeExecutionData:GetExecutionHistory' :: Maybe Bool
includeExecutionData = Maybe Bool
a} :: GetExecutionHistory)

-- | The maximum number of results that are returned per call. You can use
-- @nextToken@ to obtain further pages of results. The default is 100 and
-- the maximum allowed page size is 1000. A value of 0 uses the default.
--
-- This is only an upper limit. The actual number of results returned per
-- call might be fewer than the specified maximum.
getExecutionHistory_maxResults :: Lens.Lens' GetExecutionHistory (Prelude.Maybe Prelude.Natural)
getExecutionHistory_maxResults :: Lens' GetExecutionHistory (Maybe Natural)
getExecutionHistory_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistory' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetExecutionHistory' :: GetExecutionHistory -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetExecutionHistory
s@GetExecutionHistory' {} Maybe Natural
a -> GetExecutionHistory
s {$sel:maxResults:GetExecutionHistory' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetExecutionHistory)

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ 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 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
getExecutionHistory_nextToken :: Lens.Lens' GetExecutionHistory (Prelude.Maybe Prelude.Text)
getExecutionHistory_nextToken :: Lens' GetExecutionHistory (Maybe Text)
getExecutionHistory_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistory' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetExecutionHistory' :: GetExecutionHistory -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetExecutionHistory
s@GetExecutionHistory' {} Maybe Text
a -> GetExecutionHistory
s {$sel:nextToken:GetExecutionHistory' :: Maybe Text
nextToken = Maybe Text
a} :: GetExecutionHistory)

-- | Lists events in descending order of their @timeStamp@.
getExecutionHistory_reverseOrder :: Lens.Lens' GetExecutionHistory (Prelude.Maybe Prelude.Bool)
getExecutionHistory_reverseOrder :: Lens' GetExecutionHistory (Maybe Bool)
getExecutionHistory_reverseOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistory' {Maybe Bool
reverseOrder :: Maybe Bool
$sel:reverseOrder:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
reverseOrder} -> Maybe Bool
reverseOrder) (\s :: GetExecutionHistory
s@GetExecutionHistory' {} Maybe Bool
a -> GetExecutionHistory
s {$sel:reverseOrder:GetExecutionHistory' :: Maybe Bool
reverseOrder = Maybe Bool
a} :: GetExecutionHistory)

-- | The Amazon Resource Name (ARN) of the execution.
getExecutionHistory_executionArn :: Lens.Lens' GetExecutionHistory Prelude.Text
getExecutionHistory_executionArn :: Lens' GetExecutionHistory Text
getExecutionHistory_executionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistory' {Text
executionArn :: Text
$sel:executionArn:GetExecutionHistory' :: GetExecutionHistory -> Text
executionArn} -> Text
executionArn) (\s :: GetExecutionHistory
s@GetExecutionHistory' {} Text
a -> GetExecutionHistory
s {$sel:executionArn:GetExecutionHistory' :: Text
executionArn = Text
a} :: GetExecutionHistory)

instance Core.AWSPager GetExecutionHistory where
  page :: GetExecutionHistory
-> AWSResponse GetExecutionHistory -> Maybe GetExecutionHistory
page GetExecutionHistory
rq AWSResponse GetExecutionHistory
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetExecutionHistory
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetExecutionHistoryResponse (Maybe Text)
getExecutionHistoryResponse_nextToken
            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 GetExecutionHistory
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' GetExecutionHistoryResponse [HistoryEvent]
getExecutionHistoryResponse_events) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetExecutionHistory
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetExecutionHistory (Maybe Text)
getExecutionHistory_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetExecutionHistory
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetExecutionHistoryResponse (Maybe Text)
getExecutionHistoryResponse_nextToken
          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 GetExecutionHistory where
  type
    AWSResponse GetExecutionHistory =
      GetExecutionHistoryResponse
  request :: (Service -> Service)
-> GetExecutionHistory -> Request GetExecutionHistory
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 GetExecutionHistory
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetExecutionHistory)))
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 ->
          Maybe Text -> Int -> [HistoryEvent] -> GetExecutionHistoryResponse
GetExecutionHistoryResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"events" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable GetExecutionHistory where
  hashWithSalt :: Int -> GetExecutionHistory -> Int
hashWithSalt Int
_salt GetExecutionHistory' {Maybe Bool
Maybe Natural
Maybe Text
Text
executionArn :: Text
reverseOrder :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeExecutionData :: Maybe Bool
$sel:executionArn:GetExecutionHistory' :: GetExecutionHistory -> Text
$sel:reverseOrder:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
$sel:nextToken:GetExecutionHistory' :: GetExecutionHistory -> Maybe Text
$sel:maxResults:GetExecutionHistory' :: GetExecutionHistory -> Maybe Natural
$sel:includeExecutionData:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeExecutionData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
reverseOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionArn

instance Prelude.NFData GetExecutionHistory where
  rnf :: GetExecutionHistory -> ()
rnf GetExecutionHistory' {Maybe Bool
Maybe Natural
Maybe Text
Text
executionArn :: Text
reverseOrder :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeExecutionData :: Maybe Bool
$sel:executionArn:GetExecutionHistory' :: GetExecutionHistory -> Text
$sel:reverseOrder:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
$sel:nextToken:GetExecutionHistory' :: GetExecutionHistory -> Maybe Text
$sel:maxResults:GetExecutionHistory' :: GetExecutionHistory -> Maybe Natural
$sel:includeExecutionData:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeExecutionData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      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 Text
executionArn

instance Data.ToHeaders GetExecutionHistory where
  toHeaders :: GetExecutionHistory -> 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
"AWSStepFunctions.GetExecutionHistory" ::
                          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 GetExecutionHistory where
  toJSON :: GetExecutionHistory -> Value
toJSON GetExecutionHistory' {Maybe Bool
Maybe Natural
Maybe Text
Text
executionArn :: Text
reverseOrder :: Maybe Bool
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeExecutionData :: Maybe Bool
$sel:executionArn:GetExecutionHistory' :: GetExecutionHistory -> Text
$sel:reverseOrder:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
$sel:nextToken:GetExecutionHistory' :: GetExecutionHistory -> Maybe Text
$sel:maxResults:GetExecutionHistory' :: GetExecutionHistory -> Maybe Natural
$sel:includeExecutionData:GetExecutionHistory' :: GetExecutionHistory -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"includeExecutionData" 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
includeExecutionData,
            (Key
"maxResults" 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
maxResults,
            (Key
"nextToken" 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
nextToken,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"executionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionArn)
          ]
      )

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

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

-- | /See:/ 'newGetExecutionHistoryResponse' smart constructor.
data GetExecutionHistoryResponse = GetExecutionHistoryResponse'
  { -- | If @nextToken@ is returned, there are more results available. The value
    -- of @nextToken@ 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 24 hours. Using
    -- an expired pagination token will return an /HTTP 400 InvalidToken/
    -- error.
    GetExecutionHistoryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetExecutionHistoryResponse -> Int
httpStatus :: Prelude.Int,
    -- | The list of events that occurred in the execution.
    GetExecutionHistoryResponse -> [HistoryEvent]
events :: [HistoryEvent]
  }
  deriving (GetExecutionHistoryResponse -> GetExecutionHistoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExecutionHistoryResponse -> GetExecutionHistoryResponse -> Bool
$c/= :: GetExecutionHistoryResponse -> GetExecutionHistoryResponse -> Bool
== :: GetExecutionHistoryResponse -> GetExecutionHistoryResponse -> Bool
$c== :: GetExecutionHistoryResponse -> GetExecutionHistoryResponse -> Bool
Prelude.Eq, Int -> GetExecutionHistoryResponse -> ShowS
[GetExecutionHistoryResponse] -> ShowS
GetExecutionHistoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExecutionHistoryResponse] -> ShowS
$cshowList :: [GetExecutionHistoryResponse] -> ShowS
show :: GetExecutionHistoryResponse -> String
$cshow :: GetExecutionHistoryResponse -> String
showsPrec :: Int -> GetExecutionHistoryResponse -> ShowS
$cshowsPrec :: Int -> GetExecutionHistoryResponse -> ShowS
Prelude.Show, forall x.
Rep GetExecutionHistoryResponse x -> GetExecutionHistoryResponse
forall x.
GetExecutionHistoryResponse -> Rep GetExecutionHistoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetExecutionHistoryResponse x -> GetExecutionHistoryResponse
$cfrom :: forall x.
GetExecutionHistoryResponse -> Rep GetExecutionHistoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetExecutionHistoryResponse' 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:
--
-- 'nextToken', 'getExecutionHistoryResponse_nextToken' - If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ 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 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
--
-- 'httpStatus', 'getExecutionHistoryResponse_httpStatus' - The response's http status code.
--
-- 'events', 'getExecutionHistoryResponse_events' - The list of events that occurred in the execution.
newGetExecutionHistoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetExecutionHistoryResponse
newGetExecutionHistoryResponse :: Int -> GetExecutionHistoryResponse
newGetExecutionHistoryResponse Int
pHttpStatus_ =
  GetExecutionHistoryResponse'
    { $sel:nextToken:GetExecutionHistoryResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetExecutionHistoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:events:GetExecutionHistoryResponse' :: [HistoryEvent]
events = forall a. Monoid a => a
Prelude.mempty
    }

-- | If @nextToken@ is returned, there are more results available. The value
-- of @nextToken@ 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 24 hours. Using
-- an expired pagination token will return an /HTTP 400 InvalidToken/
-- error.
getExecutionHistoryResponse_nextToken :: Lens.Lens' GetExecutionHistoryResponse (Prelude.Maybe Prelude.Text)
getExecutionHistoryResponse_nextToken :: Lens' GetExecutionHistoryResponse (Maybe Text)
getExecutionHistoryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistoryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetExecutionHistoryResponse
s@GetExecutionHistoryResponse' {} Maybe Text
a -> GetExecutionHistoryResponse
s {$sel:nextToken:GetExecutionHistoryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetExecutionHistoryResponse)

-- | The response's http status code.
getExecutionHistoryResponse_httpStatus :: Lens.Lens' GetExecutionHistoryResponse Prelude.Int
getExecutionHistoryResponse_httpStatus :: Lens' GetExecutionHistoryResponse Int
getExecutionHistoryResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistoryResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetExecutionHistoryResponse
s@GetExecutionHistoryResponse' {} Int
a -> GetExecutionHistoryResponse
s {$sel:httpStatus:GetExecutionHistoryResponse' :: Int
httpStatus = Int
a} :: GetExecutionHistoryResponse)

-- | The list of events that occurred in the execution.
getExecutionHistoryResponse_events :: Lens.Lens' GetExecutionHistoryResponse [HistoryEvent]
getExecutionHistoryResponse_events :: Lens' GetExecutionHistoryResponse [HistoryEvent]
getExecutionHistoryResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExecutionHistoryResponse' {[HistoryEvent]
events :: [HistoryEvent]
$sel:events:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> [HistoryEvent]
events} -> [HistoryEvent]
events) (\s :: GetExecutionHistoryResponse
s@GetExecutionHistoryResponse' {} [HistoryEvent]
a -> GetExecutionHistoryResponse
s {$sel:events:GetExecutionHistoryResponse' :: [HistoryEvent]
events = [HistoryEvent]
a} :: GetExecutionHistoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetExecutionHistoryResponse where
  rnf :: GetExecutionHistoryResponse -> ()
rnf GetExecutionHistoryResponse' {Int
[HistoryEvent]
Maybe Text
events :: [HistoryEvent]
httpStatus :: Int
nextToken :: Maybe Text
$sel:events:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> [HistoryEvent]
$sel:httpStatus:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> Int
$sel:nextToken:GetExecutionHistoryResponse' :: GetExecutionHistoryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [HistoryEvent]
events