{-# 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.MigrationHubOrchestrator.GetWorkflowStep
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get a step in the migration workflow.
module Amazonka.MigrationHubOrchestrator.GetWorkflowStep
  ( -- * Creating a Request
    GetWorkflowStep (..),
    newGetWorkflowStep,

    -- * Request Lenses
    getWorkflowStep_workflowId,
    getWorkflowStep_stepGroupId,
    getWorkflowStep_id,

    -- * Destructuring the Response
    GetWorkflowStepResponse (..),
    newGetWorkflowStepResponse,

    -- * Response Lenses
    getWorkflowStepResponse_creationTime,
    getWorkflowStepResponse_description,
    getWorkflowStepResponse_endTime,
    getWorkflowStepResponse_lastStartTime,
    getWorkflowStepResponse_name,
    getWorkflowStepResponse_next,
    getWorkflowStepResponse_noOfSrvCompleted,
    getWorkflowStepResponse_noOfSrvFailed,
    getWorkflowStepResponse_outputs,
    getWorkflowStepResponse_owner,
    getWorkflowStepResponse_previous,
    getWorkflowStepResponse_scriptOutputLocation,
    getWorkflowStepResponse_status,
    getWorkflowStepResponse_statusMessage,
    getWorkflowStepResponse_stepActionType,
    getWorkflowStepResponse_stepGroupId,
    getWorkflowStepResponse_stepId,
    getWorkflowStepResponse_stepTarget,
    getWorkflowStepResponse_totalNoOfSrv,
    getWorkflowStepResponse_workflowId,
    getWorkflowStepResponse_workflowStepAutomationConfiguration,
    getWorkflowStepResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MigrationHubOrchestrator.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetWorkflowStep' smart constructor.
data GetWorkflowStep = GetWorkflowStep'
  { -- | The ID of the migration workflow.
    GetWorkflowStep -> Text
workflowId :: Prelude.Text,
    -- | desThe ID of the step group.
    GetWorkflowStep -> Text
stepGroupId :: Prelude.Text,
    -- | The ID of the step.
    GetWorkflowStep -> Text
id :: Prelude.Text
  }
  deriving (GetWorkflowStep -> GetWorkflowStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowStep -> GetWorkflowStep -> Bool
$c/= :: GetWorkflowStep -> GetWorkflowStep -> Bool
== :: GetWorkflowStep -> GetWorkflowStep -> Bool
$c== :: GetWorkflowStep -> GetWorkflowStep -> Bool
Prelude.Eq, ReadPrec [GetWorkflowStep]
ReadPrec GetWorkflowStep
Int -> ReadS GetWorkflowStep
ReadS [GetWorkflowStep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowStep]
$creadListPrec :: ReadPrec [GetWorkflowStep]
readPrec :: ReadPrec GetWorkflowStep
$creadPrec :: ReadPrec GetWorkflowStep
readList :: ReadS [GetWorkflowStep]
$creadList :: ReadS [GetWorkflowStep]
readsPrec :: Int -> ReadS GetWorkflowStep
$creadsPrec :: Int -> ReadS GetWorkflowStep
Prelude.Read, Int -> GetWorkflowStep -> ShowS
[GetWorkflowStep] -> ShowS
GetWorkflowStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowStep] -> ShowS
$cshowList :: [GetWorkflowStep] -> ShowS
show :: GetWorkflowStep -> String
$cshow :: GetWorkflowStep -> String
showsPrec :: Int -> GetWorkflowStep -> ShowS
$cshowsPrec :: Int -> GetWorkflowStep -> ShowS
Prelude.Show, forall x. Rep GetWorkflowStep x -> GetWorkflowStep
forall x. GetWorkflowStep -> Rep GetWorkflowStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflowStep x -> GetWorkflowStep
$cfrom :: forall x. GetWorkflowStep -> Rep GetWorkflowStep x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowStep' 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:
--
-- 'workflowId', 'getWorkflowStep_workflowId' - The ID of the migration workflow.
--
-- 'stepGroupId', 'getWorkflowStep_stepGroupId' - desThe ID of the step group.
--
-- 'id', 'getWorkflowStep_id' - The ID of the step.
newGetWorkflowStep ::
  -- | 'workflowId'
  Prelude.Text ->
  -- | 'stepGroupId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  GetWorkflowStep
newGetWorkflowStep :: Text -> Text -> Text -> GetWorkflowStep
newGetWorkflowStep Text
pWorkflowId_ Text
pStepGroupId_ Text
pId_ =
  GetWorkflowStep'
    { $sel:workflowId:GetWorkflowStep' :: Text
workflowId = Text
pWorkflowId_,
      $sel:stepGroupId:GetWorkflowStep' :: Text
stepGroupId = Text
pStepGroupId_,
      $sel:id:GetWorkflowStep' :: Text
id = Text
pId_
    }

-- | The ID of the migration workflow.
getWorkflowStep_workflowId :: Lens.Lens' GetWorkflowStep Prelude.Text
getWorkflowStep_workflowId :: Lens' GetWorkflowStep Text
getWorkflowStep_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStep' {Text
workflowId :: Text
$sel:workflowId:GetWorkflowStep' :: GetWorkflowStep -> Text
workflowId} -> Text
workflowId) (\s :: GetWorkflowStep
s@GetWorkflowStep' {} Text
a -> GetWorkflowStep
s {$sel:workflowId:GetWorkflowStep' :: Text
workflowId = Text
a} :: GetWorkflowStep)

-- | desThe ID of the step group.
getWorkflowStep_stepGroupId :: Lens.Lens' GetWorkflowStep Prelude.Text
getWorkflowStep_stepGroupId :: Lens' GetWorkflowStep Text
getWorkflowStep_stepGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStep' {Text
stepGroupId :: Text
$sel:stepGroupId:GetWorkflowStep' :: GetWorkflowStep -> Text
stepGroupId} -> Text
stepGroupId) (\s :: GetWorkflowStep
s@GetWorkflowStep' {} Text
a -> GetWorkflowStep
s {$sel:stepGroupId:GetWorkflowStep' :: Text
stepGroupId = Text
a} :: GetWorkflowStep)

-- | The ID of the step.
getWorkflowStep_id :: Lens.Lens' GetWorkflowStep Prelude.Text
getWorkflowStep_id :: Lens' GetWorkflowStep Text
getWorkflowStep_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStep' {Text
id :: Text
$sel:id:GetWorkflowStep' :: GetWorkflowStep -> Text
id} -> Text
id) (\s :: GetWorkflowStep
s@GetWorkflowStep' {} Text
a -> GetWorkflowStep
s {$sel:id:GetWorkflowStep' :: Text
id = Text
a} :: GetWorkflowStep)

instance Core.AWSRequest GetWorkflowStep where
  type
    AWSResponse GetWorkflowStep =
      GetWorkflowStepResponse
  request :: (Service -> Service) -> GetWorkflowStep -> Request GetWorkflowStep
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetWorkflowStep
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetWorkflowStep)))
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 POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Int
-> Maybe [WorkflowStepOutput]
-> Maybe Owner
-> Maybe [Text]
-> Maybe Text
-> Maybe StepStatus
-> Maybe Text
-> Maybe StepActionType
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe WorkflowStepAutomationConfiguration
-> Int
-> GetWorkflowStepResponse
GetWorkflowStepResponse'
            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
"creationTime")
            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
"description")
            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
"endTime")
            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
"lastStartTime")
            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
"name")
            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
"next" 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
"noOfSrvCompleted")
            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
"noOfSrvFailed")
            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
"outputs" 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
"owner")
            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
"previous" 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
"scriptOutputLocation")
            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
"status")
            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
"statusMessage")
            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
"stepActionType")
            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
"stepGroupId")
            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
"stepId")
            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
"stepTarget" 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
"totalNoOfSrv")
            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
"workflowId")
            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
"workflowStepAutomationConfiguration")
            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 GetWorkflowStep where
  hashWithSalt :: Int -> GetWorkflowStep -> Int
hashWithSalt Int
_salt GetWorkflowStep' {Text
id :: Text
stepGroupId :: Text
workflowId :: Text
$sel:id:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:stepGroupId:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:workflowId:GetWorkflowStep' :: GetWorkflowStep -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workflowId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stepGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData GetWorkflowStep where
  rnf :: GetWorkflowStep -> ()
rnf GetWorkflowStep' {Text
id :: Text
stepGroupId :: Text
workflowId :: Text
$sel:id:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:stepGroupId:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:workflowId:GetWorkflowStep' :: GetWorkflowStep -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
workflowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stepGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders GetWorkflowStep where
  toHeaders :: GetWorkflowStep -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetWorkflowStep where
  toPath :: GetWorkflowStep -> ByteString
toPath GetWorkflowStep' {Text
id :: Text
stepGroupId :: Text
workflowId :: Text
$sel:id:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:stepGroupId:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:workflowId:GetWorkflowStep' :: GetWorkflowStep -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/workflowstep/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

instance Data.ToQuery GetWorkflowStep where
  toQuery :: GetWorkflowStep -> QueryString
toQuery GetWorkflowStep' {Text
id :: Text
stepGroupId :: Text
workflowId :: Text
$sel:id:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:stepGroupId:GetWorkflowStep' :: GetWorkflowStep -> Text
$sel:workflowId:GetWorkflowStep' :: GetWorkflowStep -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"workflowId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
workflowId,
        ByteString
"stepGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stepGroupId
      ]

-- | /See:/ 'newGetWorkflowStepResponse' smart constructor.
data GetWorkflowStepResponse = GetWorkflowStepResponse'
  { -- | The time at which the step was created.
    GetWorkflowStepResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the step.
    GetWorkflowStepResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The time at which the step ended.
    GetWorkflowStepResponse -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | The time at which the workflow was last started.
    GetWorkflowStepResponse -> Maybe POSIX
lastStartTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the step.
    GetWorkflowStepResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The next step.
    GetWorkflowStepResponse -> Maybe [Text]
next :: Prelude.Maybe [Prelude.Text],
    -- | The number of servers that have been migrated.
    GetWorkflowStepResponse -> Maybe Int
noOfSrvCompleted :: Prelude.Maybe Prelude.Int,
    -- | The number of servers that have failed to migrate.
    GetWorkflowStepResponse -> Maybe Int
noOfSrvFailed :: Prelude.Maybe Prelude.Int,
    -- | The outputs of the step.
    GetWorkflowStepResponse -> Maybe [WorkflowStepOutput]
outputs :: Prelude.Maybe [WorkflowStepOutput],
    -- | The owner of the step.
    GetWorkflowStepResponse -> Maybe Owner
owner :: Prelude.Maybe Owner,
    -- | The previous step.
    GetWorkflowStepResponse -> Maybe [Text]
previous :: Prelude.Maybe [Prelude.Text],
    -- | The output location of the script.
    GetWorkflowStepResponse -> Maybe Text
scriptOutputLocation :: Prelude.Maybe Prelude.Text,
    -- | The status of the step.
    GetWorkflowStepResponse -> Maybe StepStatus
status :: Prelude.Maybe StepStatus,
    -- | The status message of the migration workflow.
    GetWorkflowStepResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The action type of the step. You must run and update the status of a
    -- manual step for the workflow to continue after the completion of the
    -- step.
    GetWorkflowStepResponse -> Maybe StepActionType
stepActionType :: Prelude.Maybe StepActionType,
    -- | The ID of the step group.
    GetWorkflowStepResponse -> Maybe Text
stepGroupId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the step.
    GetWorkflowStepResponse -> Maybe Text
stepId :: Prelude.Maybe Prelude.Text,
    -- | The servers on which a step will be run.
    GetWorkflowStepResponse -> Maybe [Text]
stepTarget :: Prelude.Maybe [Prelude.Text],
    -- | The total number of servers that have been migrated.
    GetWorkflowStepResponse -> Maybe Int
totalNoOfSrv :: Prelude.Maybe Prelude.Int,
    -- | The ID of the migration workflow.
    GetWorkflowStepResponse -> Maybe Text
workflowId :: Prelude.Maybe Prelude.Text,
    -- | The custom script to run tests on source or target environments.
    GetWorkflowStepResponse
-> Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration :: Prelude.Maybe WorkflowStepAutomationConfiguration,
    -- | The response's http status code.
    GetWorkflowStepResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorkflowStepResponse -> GetWorkflowStepResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowStepResponse -> GetWorkflowStepResponse -> Bool
$c/= :: GetWorkflowStepResponse -> GetWorkflowStepResponse -> Bool
== :: GetWorkflowStepResponse -> GetWorkflowStepResponse -> Bool
$c== :: GetWorkflowStepResponse -> GetWorkflowStepResponse -> Bool
Prelude.Eq, ReadPrec [GetWorkflowStepResponse]
ReadPrec GetWorkflowStepResponse
Int -> ReadS GetWorkflowStepResponse
ReadS [GetWorkflowStepResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowStepResponse]
$creadListPrec :: ReadPrec [GetWorkflowStepResponse]
readPrec :: ReadPrec GetWorkflowStepResponse
$creadPrec :: ReadPrec GetWorkflowStepResponse
readList :: ReadS [GetWorkflowStepResponse]
$creadList :: ReadS [GetWorkflowStepResponse]
readsPrec :: Int -> ReadS GetWorkflowStepResponse
$creadsPrec :: Int -> ReadS GetWorkflowStepResponse
Prelude.Read, Int -> GetWorkflowStepResponse -> ShowS
[GetWorkflowStepResponse] -> ShowS
GetWorkflowStepResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowStepResponse] -> ShowS
$cshowList :: [GetWorkflowStepResponse] -> ShowS
show :: GetWorkflowStepResponse -> String
$cshow :: GetWorkflowStepResponse -> String
showsPrec :: Int -> GetWorkflowStepResponse -> ShowS
$cshowsPrec :: Int -> GetWorkflowStepResponse -> ShowS
Prelude.Show, forall x. Rep GetWorkflowStepResponse x -> GetWorkflowStepResponse
forall x. GetWorkflowStepResponse -> Rep GetWorkflowStepResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflowStepResponse x -> GetWorkflowStepResponse
$cfrom :: forall x. GetWorkflowStepResponse -> Rep GetWorkflowStepResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowStepResponse' 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:
--
-- 'creationTime', 'getWorkflowStepResponse_creationTime' - The time at which the step was created.
--
-- 'description', 'getWorkflowStepResponse_description' - The description of the step.
--
-- 'endTime', 'getWorkflowStepResponse_endTime' - The time at which the step ended.
--
-- 'lastStartTime', 'getWorkflowStepResponse_lastStartTime' - The time at which the workflow was last started.
--
-- 'name', 'getWorkflowStepResponse_name' - The name of the step.
--
-- 'next', 'getWorkflowStepResponse_next' - The next step.
--
-- 'noOfSrvCompleted', 'getWorkflowStepResponse_noOfSrvCompleted' - The number of servers that have been migrated.
--
-- 'noOfSrvFailed', 'getWorkflowStepResponse_noOfSrvFailed' - The number of servers that have failed to migrate.
--
-- 'outputs', 'getWorkflowStepResponse_outputs' - The outputs of the step.
--
-- 'owner', 'getWorkflowStepResponse_owner' - The owner of the step.
--
-- 'previous', 'getWorkflowStepResponse_previous' - The previous step.
--
-- 'scriptOutputLocation', 'getWorkflowStepResponse_scriptOutputLocation' - The output location of the script.
--
-- 'status', 'getWorkflowStepResponse_status' - The status of the step.
--
-- 'statusMessage', 'getWorkflowStepResponse_statusMessage' - The status message of the migration workflow.
--
-- 'stepActionType', 'getWorkflowStepResponse_stepActionType' - The action type of the step. You must run and update the status of a
-- manual step for the workflow to continue after the completion of the
-- step.
--
-- 'stepGroupId', 'getWorkflowStepResponse_stepGroupId' - The ID of the step group.
--
-- 'stepId', 'getWorkflowStepResponse_stepId' - The ID of the step.
--
-- 'stepTarget', 'getWorkflowStepResponse_stepTarget' - The servers on which a step will be run.
--
-- 'totalNoOfSrv', 'getWorkflowStepResponse_totalNoOfSrv' - The total number of servers that have been migrated.
--
-- 'workflowId', 'getWorkflowStepResponse_workflowId' - The ID of the migration workflow.
--
-- 'workflowStepAutomationConfiguration', 'getWorkflowStepResponse_workflowStepAutomationConfiguration' - The custom script to run tests on source or target environments.
--
-- 'httpStatus', 'getWorkflowStepResponse_httpStatus' - The response's http status code.
newGetWorkflowStepResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkflowStepResponse
newGetWorkflowStepResponse :: Int -> GetWorkflowStepResponse
newGetWorkflowStepResponse Int
pHttpStatus_ =
  GetWorkflowStepResponse'
    { $sel:creationTime:GetWorkflowStepResponse' :: Maybe POSIX
creationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetWorkflowStepResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:GetWorkflowStepResponse' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStartTime:GetWorkflowStepResponse' :: Maybe POSIX
lastStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetWorkflowStepResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:next:GetWorkflowStepResponse' :: Maybe [Text]
next = forall a. Maybe a
Prelude.Nothing,
      $sel:noOfSrvCompleted:GetWorkflowStepResponse' :: Maybe Int
noOfSrvCompleted = forall a. Maybe a
Prelude.Nothing,
      $sel:noOfSrvFailed:GetWorkflowStepResponse' :: Maybe Int
noOfSrvFailed = forall a. Maybe a
Prelude.Nothing,
      $sel:outputs:GetWorkflowStepResponse' :: Maybe [WorkflowStepOutput]
outputs = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:GetWorkflowStepResponse' :: Maybe Owner
owner = forall a. Maybe a
Prelude.Nothing,
      $sel:previous:GetWorkflowStepResponse' :: Maybe [Text]
previous = forall a. Maybe a
Prelude.Nothing,
      $sel:scriptOutputLocation:GetWorkflowStepResponse' :: Maybe Text
scriptOutputLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetWorkflowStepResponse' :: Maybe StepStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:GetWorkflowStepResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:stepActionType:GetWorkflowStepResponse' :: Maybe StepActionType
stepActionType = forall a. Maybe a
Prelude.Nothing,
      $sel:stepGroupId:GetWorkflowStepResponse' :: Maybe Text
stepGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:stepId:GetWorkflowStepResponse' :: Maybe Text
stepId = forall a. Maybe a
Prelude.Nothing,
      $sel:stepTarget:GetWorkflowStepResponse' :: Maybe [Text]
stepTarget = forall a. Maybe a
Prelude.Nothing,
      $sel:totalNoOfSrv:GetWorkflowStepResponse' :: Maybe Int
totalNoOfSrv = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowId:GetWorkflowStepResponse' :: Maybe Text
workflowId = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowStepAutomationConfiguration:GetWorkflowStepResponse' :: Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkflowStepResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The time at which the step was created.
getWorkflowStepResponse_creationTime :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowStepResponse_creationTime :: Lens' GetWorkflowStepResponse (Maybe UTCTime)
getWorkflowStepResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe POSIX
a -> GetWorkflowStepResponse
s {$sel:creationTime:GetWorkflowStepResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: GetWorkflowStepResponse) 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 description of the step.
getWorkflowStepResponse_description :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_description :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:description:GetWorkflowStepResponse' :: Maybe Text
description = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The time at which the step ended.
getWorkflowStepResponse_endTime :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowStepResponse_endTime :: Lens' GetWorkflowStepResponse (Maybe UTCTime)
getWorkflowStepResponse_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe POSIX
a -> GetWorkflowStepResponse
s {$sel:endTime:GetWorkflowStepResponse' :: Maybe POSIX
endTime = Maybe POSIX
a} :: GetWorkflowStepResponse) 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 time at which the workflow was last started.
getWorkflowStepResponse_lastStartTime :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowStepResponse_lastStartTime :: Lens' GetWorkflowStepResponse (Maybe UTCTime)
getWorkflowStepResponse_lastStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe POSIX
lastStartTime :: Maybe POSIX
$sel:lastStartTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
lastStartTime} -> Maybe POSIX
lastStartTime) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe POSIX
a -> GetWorkflowStepResponse
s {$sel:lastStartTime:GetWorkflowStepResponse' :: Maybe POSIX
lastStartTime = Maybe POSIX
a} :: GetWorkflowStepResponse) 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 step.
getWorkflowStepResponse_name :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_name :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:name:GetWorkflowStepResponse' :: Maybe Text
name = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The next step.
getWorkflowStepResponse_next :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe [Prelude.Text])
getWorkflowStepResponse_next :: Lens' GetWorkflowStepResponse (Maybe [Text])
getWorkflowStepResponse_next = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe [Text]
next :: Maybe [Text]
$sel:next:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
next} -> Maybe [Text]
next) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe [Text]
a -> GetWorkflowStepResponse
s {$sel:next:GetWorkflowStepResponse' :: Maybe [Text]
next = Maybe [Text]
a} :: GetWorkflowStepResponse) 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 number of servers that have been migrated.
getWorkflowStepResponse_noOfSrvCompleted :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Int)
getWorkflowStepResponse_noOfSrvCompleted :: Lens' GetWorkflowStepResponse (Maybe Int)
getWorkflowStepResponse_noOfSrvCompleted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Int
noOfSrvCompleted :: Maybe Int
$sel:noOfSrvCompleted:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
noOfSrvCompleted} -> Maybe Int
noOfSrvCompleted) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Int
a -> GetWorkflowStepResponse
s {$sel:noOfSrvCompleted:GetWorkflowStepResponse' :: Maybe Int
noOfSrvCompleted = Maybe Int
a} :: GetWorkflowStepResponse)

-- | The number of servers that have failed to migrate.
getWorkflowStepResponse_noOfSrvFailed :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Int)
getWorkflowStepResponse_noOfSrvFailed :: Lens' GetWorkflowStepResponse (Maybe Int)
getWorkflowStepResponse_noOfSrvFailed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Int
noOfSrvFailed :: Maybe Int
$sel:noOfSrvFailed:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
noOfSrvFailed} -> Maybe Int
noOfSrvFailed) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Int
a -> GetWorkflowStepResponse
s {$sel:noOfSrvFailed:GetWorkflowStepResponse' :: Maybe Int
noOfSrvFailed = Maybe Int
a} :: GetWorkflowStepResponse)

-- | The outputs of the step.
getWorkflowStepResponse_outputs :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe [WorkflowStepOutput])
getWorkflowStepResponse_outputs :: Lens' GetWorkflowStepResponse (Maybe [WorkflowStepOutput])
getWorkflowStepResponse_outputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe [WorkflowStepOutput]
outputs :: Maybe [WorkflowStepOutput]
$sel:outputs:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [WorkflowStepOutput]
outputs} -> Maybe [WorkflowStepOutput]
outputs) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe [WorkflowStepOutput]
a -> GetWorkflowStepResponse
s {$sel:outputs:GetWorkflowStepResponse' :: Maybe [WorkflowStepOutput]
outputs = Maybe [WorkflowStepOutput]
a} :: GetWorkflowStepResponse) 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 owner of the step.
getWorkflowStepResponse_owner :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Owner)
getWorkflowStepResponse_owner :: Lens' GetWorkflowStepResponse (Maybe Owner)
getWorkflowStepResponse_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Owner
owner :: Maybe Owner
$sel:owner:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Owner
owner} -> Maybe Owner
owner) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Owner
a -> GetWorkflowStepResponse
s {$sel:owner:GetWorkflowStepResponse' :: Maybe Owner
owner = Maybe Owner
a} :: GetWorkflowStepResponse)

-- | The previous step.
getWorkflowStepResponse_previous :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe [Prelude.Text])
getWorkflowStepResponse_previous :: Lens' GetWorkflowStepResponse (Maybe [Text])
getWorkflowStepResponse_previous = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe [Text]
previous :: Maybe [Text]
$sel:previous:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
previous} -> Maybe [Text]
previous) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe [Text]
a -> GetWorkflowStepResponse
s {$sel:previous:GetWorkflowStepResponse' :: Maybe [Text]
previous = Maybe [Text]
a} :: GetWorkflowStepResponse) 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 output location of the script.
getWorkflowStepResponse_scriptOutputLocation :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_scriptOutputLocation :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_scriptOutputLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
scriptOutputLocation :: Maybe Text
$sel:scriptOutputLocation:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
scriptOutputLocation} -> Maybe Text
scriptOutputLocation) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:scriptOutputLocation:GetWorkflowStepResponse' :: Maybe Text
scriptOutputLocation = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The status of the step.
getWorkflowStepResponse_status :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe StepStatus)
getWorkflowStepResponse_status :: Lens' GetWorkflowStepResponse (Maybe StepStatus)
getWorkflowStepResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe StepStatus
status :: Maybe StepStatus
$sel:status:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe StepStatus
status} -> Maybe StepStatus
status) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe StepStatus
a -> GetWorkflowStepResponse
s {$sel:status:GetWorkflowStepResponse' :: Maybe StepStatus
status = Maybe StepStatus
a} :: GetWorkflowStepResponse)

-- | The status message of the migration workflow.
getWorkflowStepResponse_statusMessage :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_statusMessage :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:statusMessage:GetWorkflowStepResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The action type of the step. You must run and update the status of a
-- manual step for the workflow to continue after the completion of the
-- step.
getWorkflowStepResponse_stepActionType :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe StepActionType)
getWorkflowStepResponse_stepActionType :: Lens' GetWorkflowStepResponse (Maybe StepActionType)
getWorkflowStepResponse_stepActionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe StepActionType
stepActionType :: Maybe StepActionType
$sel:stepActionType:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe StepActionType
stepActionType} -> Maybe StepActionType
stepActionType) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe StepActionType
a -> GetWorkflowStepResponse
s {$sel:stepActionType:GetWorkflowStepResponse' :: Maybe StepActionType
stepActionType = Maybe StepActionType
a} :: GetWorkflowStepResponse)

-- | The ID of the step group.
getWorkflowStepResponse_stepGroupId :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_stepGroupId :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_stepGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
stepGroupId :: Maybe Text
$sel:stepGroupId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
stepGroupId} -> Maybe Text
stepGroupId) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:stepGroupId:GetWorkflowStepResponse' :: Maybe Text
stepGroupId = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The ID of the step.
getWorkflowStepResponse_stepId :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_stepId :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_stepId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
stepId :: Maybe Text
$sel:stepId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
stepId} -> Maybe Text
stepId) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:stepId:GetWorkflowStepResponse' :: Maybe Text
stepId = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The servers on which a step will be run.
getWorkflowStepResponse_stepTarget :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe [Prelude.Text])
getWorkflowStepResponse_stepTarget :: Lens' GetWorkflowStepResponse (Maybe [Text])
getWorkflowStepResponse_stepTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe [Text]
stepTarget :: Maybe [Text]
$sel:stepTarget:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
stepTarget} -> Maybe [Text]
stepTarget) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe [Text]
a -> GetWorkflowStepResponse
s {$sel:stepTarget:GetWorkflowStepResponse' :: Maybe [Text]
stepTarget = Maybe [Text]
a} :: GetWorkflowStepResponse) 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 total number of servers that have been migrated.
getWorkflowStepResponse_totalNoOfSrv :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Int)
getWorkflowStepResponse_totalNoOfSrv :: Lens' GetWorkflowStepResponse (Maybe Int)
getWorkflowStepResponse_totalNoOfSrv = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Int
totalNoOfSrv :: Maybe Int
$sel:totalNoOfSrv:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
totalNoOfSrv} -> Maybe Int
totalNoOfSrv) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Int
a -> GetWorkflowStepResponse
s {$sel:totalNoOfSrv:GetWorkflowStepResponse' :: Maybe Int
totalNoOfSrv = Maybe Int
a} :: GetWorkflowStepResponse)

-- | The ID of the migration workflow.
getWorkflowStepResponse_workflowId :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe Prelude.Text)
getWorkflowStepResponse_workflowId :: Lens' GetWorkflowStepResponse (Maybe Text)
getWorkflowStepResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe Text
workflowId :: Maybe Text
$sel:workflowId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
workflowId} -> Maybe Text
workflowId) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe Text
a -> GetWorkflowStepResponse
s {$sel:workflowId:GetWorkflowStepResponse' :: Maybe Text
workflowId = Maybe Text
a} :: GetWorkflowStepResponse)

-- | The custom script to run tests on source or target environments.
getWorkflowStepResponse_workflowStepAutomationConfiguration :: Lens.Lens' GetWorkflowStepResponse (Prelude.Maybe WorkflowStepAutomationConfiguration)
getWorkflowStepResponse_workflowStepAutomationConfiguration :: Lens'
  GetWorkflowStepResponse (Maybe WorkflowStepAutomationConfiguration)
getWorkflowStepResponse_workflowStepAutomationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowStepResponse' {Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration :: Maybe WorkflowStepAutomationConfiguration
$sel:workflowStepAutomationConfiguration:GetWorkflowStepResponse' :: GetWorkflowStepResponse
-> Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration} -> Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration) (\s :: GetWorkflowStepResponse
s@GetWorkflowStepResponse' {} Maybe WorkflowStepAutomationConfiguration
a -> GetWorkflowStepResponse
s {$sel:workflowStepAutomationConfiguration:GetWorkflowStepResponse' :: Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration = Maybe WorkflowStepAutomationConfiguration
a} :: GetWorkflowStepResponse)

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

instance Prelude.NFData GetWorkflowStepResponse where
  rnf :: GetWorkflowStepResponse -> ()
rnf GetWorkflowStepResponse' {Int
Maybe Int
Maybe [Text]
Maybe [WorkflowStepOutput]
Maybe Text
Maybe POSIX
Maybe Owner
Maybe StepActionType
Maybe StepStatus
Maybe WorkflowStepAutomationConfiguration
httpStatus :: Int
workflowStepAutomationConfiguration :: Maybe WorkflowStepAutomationConfiguration
workflowId :: Maybe Text
totalNoOfSrv :: Maybe Int
stepTarget :: Maybe [Text]
stepId :: Maybe Text
stepGroupId :: Maybe Text
stepActionType :: Maybe StepActionType
statusMessage :: Maybe Text
status :: Maybe StepStatus
scriptOutputLocation :: Maybe Text
previous :: Maybe [Text]
owner :: Maybe Owner
outputs :: Maybe [WorkflowStepOutput]
noOfSrvFailed :: Maybe Int
noOfSrvCompleted :: Maybe Int
next :: Maybe [Text]
name :: Maybe Text
lastStartTime :: Maybe POSIX
endTime :: Maybe POSIX
description :: Maybe Text
creationTime :: Maybe POSIX
$sel:httpStatus:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Int
$sel:workflowStepAutomationConfiguration:GetWorkflowStepResponse' :: GetWorkflowStepResponse
-> Maybe WorkflowStepAutomationConfiguration
$sel:workflowId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:totalNoOfSrv:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
$sel:stepTarget:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
$sel:stepId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:stepGroupId:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:stepActionType:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe StepActionType
$sel:statusMessage:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:status:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe StepStatus
$sel:scriptOutputLocation:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:previous:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
$sel:owner:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Owner
$sel:outputs:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [WorkflowStepOutput]
$sel:noOfSrvFailed:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
$sel:noOfSrvCompleted:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Int
$sel:next:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe [Text]
$sel:name:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:lastStartTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
$sel:endTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
$sel:description:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe Text
$sel:creationTime:GetWorkflowStepResponse' :: GetWorkflowStepResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
next
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
noOfSrvCompleted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
noOfSrvFailed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [WorkflowStepOutput]
outputs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Owner
owner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
previous
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scriptOutputLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StepActionType
stepActionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stepGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stepId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
stepTarget
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalNoOfSrv
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
workflowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe WorkflowStepAutomationConfiguration
workflowStepAutomationConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus