{-# 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.CodePipeline.GetPipelineState
-- 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 information about the state of a pipeline, including the stages
-- and actions.
--
-- Values returned in the @revisionId@ and @revisionUrl@ fields indicate
-- the source revision information, such as the commit ID, for the current
-- state.
module Amazonka.CodePipeline.GetPipelineState
  ( -- * Creating a Request
    GetPipelineState (..),
    newGetPipelineState,

    -- * Request Lenses
    getPipelineState_name,

    -- * Destructuring the Response
    GetPipelineStateResponse (..),
    newGetPipelineStateResponse,

    -- * Response Lenses
    getPipelineStateResponse_created,
    getPipelineStateResponse_pipelineName,
    getPipelineStateResponse_pipelineVersion,
    getPipelineStateResponse_stageStates,
    getPipelineStateResponse_updated,
    getPipelineStateResponse_httpStatus,
  )
where

import Amazonka.CodePipeline.Types
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

-- | Represents the input of a @GetPipelineState@ action.
--
-- /See:/ 'newGetPipelineState' smart constructor.
data GetPipelineState = GetPipelineState'
  { -- | The name of the pipeline about which you want to get information.
    GetPipelineState -> Text
name :: Prelude.Text
  }
  deriving (GetPipelineState -> GetPipelineState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPipelineState -> GetPipelineState -> Bool
$c/= :: GetPipelineState -> GetPipelineState -> Bool
== :: GetPipelineState -> GetPipelineState -> Bool
$c== :: GetPipelineState -> GetPipelineState -> Bool
Prelude.Eq, ReadPrec [GetPipelineState]
ReadPrec GetPipelineState
Int -> ReadS GetPipelineState
ReadS [GetPipelineState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPipelineState]
$creadListPrec :: ReadPrec [GetPipelineState]
readPrec :: ReadPrec GetPipelineState
$creadPrec :: ReadPrec GetPipelineState
readList :: ReadS [GetPipelineState]
$creadList :: ReadS [GetPipelineState]
readsPrec :: Int -> ReadS GetPipelineState
$creadsPrec :: Int -> ReadS GetPipelineState
Prelude.Read, Int -> GetPipelineState -> ShowS
[GetPipelineState] -> ShowS
GetPipelineState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPipelineState] -> ShowS
$cshowList :: [GetPipelineState] -> ShowS
show :: GetPipelineState -> String
$cshow :: GetPipelineState -> String
showsPrec :: Int -> GetPipelineState -> ShowS
$cshowsPrec :: Int -> GetPipelineState -> ShowS
Prelude.Show, forall x. Rep GetPipelineState x -> GetPipelineState
forall x. GetPipelineState -> Rep GetPipelineState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPipelineState x -> GetPipelineState
$cfrom :: forall x. GetPipelineState -> Rep GetPipelineState x
Prelude.Generic)

-- |
-- Create a value of 'GetPipelineState' 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:
--
-- 'name', 'getPipelineState_name' - The name of the pipeline about which you want to get information.
newGetPipelineState ::
  -- | 'name'
  Prelude.Text ->
  GetPipelineState
newGetPipelineState :: Text -> GetPipelineState
newGetPipelineState Text
pName_ =
  GetPipelineState' {$sel:name:GetPipelineState' :: Text
name = Text
pName_}

-- | The name of the pipeline about which you want to get information.
getPipelineState_name :: Lens.Lens' GetPipelineState Prelude.Text
getPipelineState_name :: Lens' GetPipelineState Text
getPipelineState_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineState' {Text
name :: Text
$sel:name:GetPipelineState' :: GetPipelineState -> Text
name} -> Text
name) (\s :: GetPipelineState
s@GetPipelineState' {} Text
a -> GetPipelineState
s {$sel:name:GetPipelineState' :: Text
name = Text
a} :: GetPipelineState)

instance Core.AWSRequest GetPipelineState where
  type
    AWSResponse GetPipelineState =
      GetPipelineStateResponse
  request :: (Service -> Service)
-> GetPipelineState -> Request GetPipelineState
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 GetPipelineState
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPipelineState)))
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 POSIX
-> Maybe Text
-> Maybe Natural
-> Maybe [StageState]
-> Maybe POSIX
-> Int
-> GetPipelineStateResponse
GetPipelineStateResponse'
            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
"created")
            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
"pipelineName")
            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
"pipelineVersion")
            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
"stageStates" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"updated")
            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))
      )

instance Prelude.Hashable GetPipelineState where
  hashWithSalt :: Int -> GetPipelineState -> Int
hashWithSalt Int
_salt GetPipelineState' {Text
name :: Text
$sel:name:GetPipelineState' :: GetPipelineState -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetPipelineState where
  rnf :: GetPipelineState -> ()
rnf GetPipelineState' {Text
name :: Text
$sel:name:GetPipelineState' :: GetPipelineState -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders GetPipelineState where
  toHeaders :: GetPipelineState -> 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
"CodePipeline_20150709.GetPipelineState" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetPipelineState where
  toJSON :: GetPipelineState -> Value
toJSON GetPipelineState' {Text
name :: Text
$sel:name:GetPipelineState' :: GetPipelineState -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)]
      )

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

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

-- | Represents the output of a @GetPipelineState@ action.
--
-- /See:/ 'newGetPipelineStateResponse' smart constructor.
data GetPipelineStateResponse = GetPipelineStateResponse'
  { -- | The date and time the pipeline was created, in timestamp format.
    GetPipelineStateResponse -> Maybe POSIX
created :: Prelude.Maybe Data.POSIX,
    -- | The name of the pipeline for which you want to get the state.
    GetPipelineStateResponse -> Maybe Text
pipelineName :: Prelude.Maybe Prelude.Text,
    -- | The version number of the pipeline.
    --
    -- A newly created pipeline is always assigned a version number of @1@.
    GetPipelineStateResponse -> Maybe Natural
pipelineVersion :: Prelude.Maybe Prelude.Natural,
    -- | A list of the pipeline stage output information, including stage name,
    -- state, most recent run details, whether the stage is disabled, and other
    -- data.
    GetPipelineStateResponse -> Maybe [StageState]
stageStates :: Prelude.Maybe [StageState],
    -- | The date and time the pipeline was last updated, in timestamp format.
    GetPipelineStateResponse -> Maybe POSIX
updated :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    GetPipelineStateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPipelineStateResponse -> GetPipelineStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPipelineStateResponse -> GetPipelineStateResponse -> Bool
$c/= :: GetPipelineStateResponse -> GetPipelineStateResponse -> Bool
== :: GetPipelineStateResponse -> GetPipelineStateResponse -> Bool
$c== :: GetPipelineStateResponse -> GetPipelineStateResponse -> Bool
Prelude.Eq, ReadPrec [GetPipelineStateResponse]
ReadPrec GetPipelineStateResponse
Int -> ReadS GetPipelineStateResponse
ReadS [GetPipelineStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPipelineStateResponse]
$creadListPrec :: ReadPrec [GetPipelineStateResponse]
readPrec :: ReadPrec GetPipelineStateResponse
$creadPrec :: ReadPrec GetPipelineStateResponse
readList :: ReadS [GetPipelineStateResponse]
$creadList :: ReadS [GetPipelineStateResponse]
readsPrec :: Int -> ReadS GetPipelineStateResponse
$creadsPrec :: Int -> ReadS GetPipelineStateResponse
Prelude.Read, Int -> GetPipelineStateResponse -> ShowS
[GetPipelineStateResponse] -> ShowS
GetPipelineStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPipelineStateResponse] -> ShowS
$cshowList :: [GetPipelineStateResponse] -> ShowS
show :: GetPipelineStateResponse -> String
$cshow :: GetPipelineStateResponse -> String
showsPrec :: Int -> GetPipelineStateResponse -> ShowS
$cshowsPrec :: Int -> GetPipelineStateResponse -> ShowS
Prelude.Show, forall x.
Rep GetPipelineStateResponse x -> GetPipelineStateResponse
forall x.
GetPipelineStateResponse -> Rep GetPipelineStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPipelineStateResponse x -> GetPipelineStateResponse
$cfrom :: forall x.
GetPipelineStateResponse -> Rep GetPipelineStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPipelineStateResponse' 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:
--
-- 'created', 'getPipelineStateResponse_created' - The date and time the pipeline was created, in timestamp format.
--
-- 'pipelineName', 'getPipelineStateResponse_pipelineName' - The name of the pipeline for which you want to get the state.
--
-- 'pipelineVersion', 'getPipelineStateResponse_pipelineVersion' - The version number of the pipeline.
--
-- A newly created pipeline is always assigned a version number of @1@.
--
-- 'stageStates', 'getPipelineStateResponse_stageStates' - A list of the pipeline stage output information, including stage name,
-- state, most recent run details, whether the stage is disabled, and other
-- data.
--
-- 'updated', 'getPipelineStateResponse_updated' - The date and time the pipeline was last updated, in timestamp format.
--
-- 'httpStatus', 'getPipelineStateResponse_httpStatus' - The response's http status code.
newGetPipelineStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPipelineStateResponse
newGetPipelineStateResponse :: Int -> GetPipelineStateResponse
newGetPipelineStateResponse Int
pHttpStatus_ =
  GetPipelineStateResponse'
    { $sel:created:GetPipelineStateResponse' :: Maybe POSIX
created =
        forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineName:GetPipelineStateResponse' :: Maybe Text
pipelineName = forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineVersion:GetPipelineStateResponse' :: Maybe Natural
pipelineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:stageStates:GetPipelineStateResponse' :: Maybe [StageState]
stageStates = forall a. Maybe a
Prelude.Nothing,
      $sel:updated:GetPipelineStateResponse' :: Maybe POSIX
updated = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPipelineStateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time the pipeline was created, in timestamp format.
getPipelineStateResponse_created :: Lens.Lens' GetPipelineStateResponse (Prelude.Maybe Prelude.UTCTime)
getPipelineStateResponse_created :: Lens' GetPipelineStateResponse (Maybe UTCTime)
getPipelineStateResponse_created = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineStateResponse' {Maybe POSIX
created :: Maybe POSIX
$sel:created:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe POSIX
created} -> Maybe POSIX
created) (\s :: GetPipelineStateResponse
s@GetPipelineStateResponse' {} Maybe POSIX
a -> GetPipelineStateResponse
s {$sel:created:GetPipelineStateResponse' :: Maybe POSIX
created = Maybe POSIX
a} :: GetPipelineStateResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the pipeline for which you want to get the state.
getPipelineStateResponse_pipelineName :: Lens.Lens' GetPipelineStateResponse (Prelude.Maybe Prelude.Text)
getPipelineStateResponse_pipelineName :: Lens' GetPipelineStateResponse (Maybe Text)
getPipelineStateResponse_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineStateResponse' {Maybe Text
pipelineName :: Maybe Text
$sel:pipelineName:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe Text
pipelineName} -> Maybe Text
pipelineName) (\s :: GetPipelineStateResponse
s@GetPipelineStateResponse' {} Maybe Text
a -> GetPipelineStateResponse
s {$sel:pipelineName:GetPipelineStateResponse' :: Maybe Text
pipelineName = Maybe Text
a} :: GetPipelineStateResponse)

-- | The version number of the pipeline.
--
-- A newly created pipeline is always assigned a version number of @1@.
getPipelineStateResponse_pipelineVersion :: Lens.Lens' GetPipelineStateResponse (Prelude.Maybe Prelude.Natural)
getPipelineStateResponse_pipelineVersion :: Lens' GetPipelineStateResponse (Maybe Natural)
getPipelineStateResponse_pipelineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineStateResponse' {Maybe Natural
pipelineVersion :: Maybe Natural
$sel:pipelineVersion:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe Natural
pipelineVersion} -> Maybe Natural
pipelineVersion) (\s :: GetPipelineStateResponse
s@GetPipelineStateResponse' {} Maybe Natural
a -> GetPipelineStateResponse
s {$sel:pipelineVersion:GetPipelineStateResponse' :: Maybe Natural
pipelineVersion = Maybe Natural
a} :: GetPipelineStateResponse)

-- | A list of the pipeline stage output information, including stage name,
-- state, most recent run details, whether the stage is disabled, and other
-- data.
getPipelineStateResponse_stageStates :: Lens.Lens' GetPipelineStateResponse (Prelude.Maybe [StageState])
getPipelineStateResponse_stageStates :: Lens' GetPipelineStateResponse (Maybe [StageState])
getPipelineStateResponse_stageStates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineStateResponse' {Maybe [StageState]
stageStates :: Maybe [StageState]
$sel:stageStates:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe [StageState]
stageStates} -> Maybe [StageState]
stageStates) (\s :: GetPipelineStateResponse
s@GetPipelineStateResponse' {} Maybe [StageState]
a -> GetPipelineStateResponse
s {$sel:stageStates:GetPipelineStateResponse' :: Maybe [StageState]
stageStates = Maybe [StageState]
a} :: GetPipelineStateResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date and time the pipeline was last updated, in timestamp format.
getPipelineStateResponse_updated :: Lens.Lens' GetPipelineStateResponse (Prelude.Maybe Prelude.UTCTime)
getPipelineStateResponse_updated :: Lens' GetPipelineStateResponse (Maybe UTCTime)
getPipelineStateResponse_updated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPipelineStateResponse' {Maybe POSIX
updated :: Maybe POSIX
$sel:updated:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe POSIX
updated} -> Maybe POSIX
updated) (\s :: GetPipelineStateResponse
s@GetPipelineStateResponse' {} Maybe POSIX
a -> GetPipelineStateResponse
s {$sel:updated:GetPipelineStateResponse' :: Maybe POSIX
updated = Maybe POSIX
a} :: GetPipelineStateResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData GetPipelineStateResponse where
  rnf :: GetPipelineStateResponse -> ()
rnf GetPipelineStateResponse' {Int
Maybe Natural
Maybe [StageState]
Maybe Text
Maybe POSIX
httpStatus :: Int
updated :: Maybe POSIX
stageStates :: Maybe [StageState]
pipelineVersion :: Maybe Natural
pipelineName :: Maybe Text
created :: Maybe POSIX
$sel:httpStatus:GetPipelineStateResponse' :: GetPipelineStateResponse -> Int
$sel:updated:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe POSIX
$sel:stageStates:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe [StageState]
$sel:pipelineVersion:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe Natural
$sel:pipelineName:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe Text
$sel:created:GetPipelineStateResponse' :: GetPipelineStateResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
created
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pipelineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pipelineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StageState]
stageStates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus