{-# 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.CustomerProfiles.GetWorkflow
-- 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 details of specified workflow.
module Amazonka.CustomerProfiles.GetWorkflow
  ( -- * Creating a Request
    GetWorkflow (..),
    newGetWorkflow,

    -- * Request Lenses
    getWorkflow_domainName,
    getWorkflow_workflowId,

    -- * Destructuring the Response
    GetWorkflowResponse (..),
    newGetWorkflowResponse,

    -- * Response Lenses
    getWorkflowResponse_attributes,
    getWorkflowResponse_errorDescription,
    getWorkflowResponse_lastUpdatedAt,
    getWorkflowResponse_metrics,
    getWorkflowResponse_startDate,
    getWorkflowResponse_status,
    getWorkflowResponse_workflowId,
    getWorkflowResponse_workflowType,
    getWorkflowResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetWorkflow' smart constructor.
data GetWorkflow = GetWorkflow'
  { -- | The unique name of the domain.
    GetWorkflow -> Text
domainName :: Prelude.Text,
    -- | Unique identifier for the workflow.
    GetWorkflow -> Text
workflowId :: Prelude.Text
  }
  deriving (GetWorkflow -> GetWorkflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflow -> GetWorkflow -> Bool
$c/= :: GetWorkflow -> GetWorkflow -> Bool
== :: GetWorkflow -> GetWorkflow -> Bool
$c== :: GetWorkflow -> GetWorkflow -> Bool
Prelude.Eq, ReadPrec [GetWorkflow]
ReadPrec GetWorkflow
Int -> ReadS GetWorkflow
ReadS [GetWorkflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflow]
$creadListPrec :: ReadPrec [GetWorkflow]
readPrec :: ReadPrec GetWorkflow
$creadPrec :: ReadPrec GetWorkflow
readList :: ReadS [GetWorkflow]
$creadList :: ReadS [GetWorkflow]
readsPrec :: Int -> ReadS GetWorkflow
$creadsPrec :: Int -> ReadS GetWorkflow
Prelude.Read, Int -> GetWorkflow -> ShowS
[GetWorkflow] -> ShowS
GetWorkflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflow] -> ShowS
$cshowList :: [GetWorkflow] -> ShowS
show :: GetWorkflow -> String
$cshow :: GetWorkflow -> String
showsPrec :: Int -> GetWorkflow -> ShowS
$cshowsPrec :: Int -> GetWorkflow -> ShowS
Prelude.Show, forall x. Rep GetWorkflow x -> GetWorkflow
forall x. GetWorkflow -> Rep GetWorkflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflow x -> GetWorkflow
$cfrom :: forall x. GetWorkflow -> Rep GetWorkflow x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflow' 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:
--
-- 'domainName', 'getWorkflow_domainName' - The unique name of the domain.
--
-- 'workflowId', 'getWorkflow_workflowId' - Unique identifier for the workflow.
newGetWorkflow ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'workflowId'
  Prelude.Text ->
  GetWorkflow
newGetWorkflow :: Text -> Text -> GetWorkflow
newGetWorkflow Text
pDomainName_ Text
pWorkflowId_ =
  GetWorkflow'
    { $sel:domainName:GetWorkflow' :: Text
domainName = Text
pDomainName_,
      $sel:workflowId:GetWorkflow' :: Text
workflowId = Text
pWorkflowId_
    }

-- | The unique name of the domain.
getWorkflow_domainName :: Lens.Lens' GetWorkflow Prelude.Text
getWorkflow_domainName :: Lens' GetWorkflow Text
getWorkflow_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflow' {Text
domainName :: Text
$sel:domainName:GetWorkflow' :: GetWorkflow -> Text
domainName} -> Text
domainName) (\s :: GetWorkflow
s@GetWorkflow' {} Text
a -> GetWorkflow
s {$sel:domainName:GetWorkflow' :: Text
domainName = Text
a} :: GetWorkflow)

-- | Unique identifier for the workflow.
getWorkflow_workflowId :: Lens.Lens' GetWorkflow Prelude.Text
getWorkflow_workflowId :: Lens' GetWorkflow Text
getWorkflow_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflow' {Text
workflowId :: Text
$sel:workflowId:GetWorkflow' :: GetWorkflow -> Text
workflowId} -> Text
workflowId) (\s :: GetWorkflow
s@GetWorkflow' {} Text
a -> GetWorkflow
s {$sel:workflowId:GetWorkflow' :: Text
workflowId = Text
a} :: GetWorkflow)

instance Core.AWSRequest GetWorkflow where
  type AWSResponse GetWorkflow = GetWorkflowResponse
  request :: (Service -> Service) -> GetWorkflow -> Request GetWorkflow
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 GetWorkflow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetWorkflow)))
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 WorkflowAttributes
-> Maybe Text
-> Maybe POSIX
-> Maybe WorkflowMetrics
-> Maybe POSIX
-> Maybe Status
-> Maybe Text
-> Maybe WorkflowType
-> Int
-> GetWorkflowResponse
GetWorkflowResponse'
            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
"Attributes")
            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
"ErrorDescription")
            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
"LastUpdatedAt")
            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
"Metrics")
            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
"StartDate")
            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
"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
"WorkflowType")
            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 GetWorkflow where
  hashWithSalt :: Int -> GetWorkflow -> Int
hashWithSalt Int
_salt GetWorkflow' {Text
workflowId :: Text
domainName :: Text
$sel:workflowId:GetWorkflow' :: GetWorkflow -> Text
$sel:domainName:GetWorkflow' :: GetWorkflow -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workflowId

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

instance Data.ToHeaders GetWorkflow where
  toHeaders :: GetWorkflow -> 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 GetWorkflow where
  toPath :: GetWorkflow -> ByteString
toPath GetWorkflow' {Text
workflowId :: Text
domainName :: Text
$sel:workflowId:GetWorkflow' :: GetWorkflow -> Text
$sel:domainName:GetWorkflow' :: GetWorkflow -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/workflows/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workflowId
      ]

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

-- | /See:/ 'newGetWorkflowResponse' smart constructor.
data GetWorkflowResponse = GetWorkflowResponse'
  { -- | Attributes provided for workflow execution.
    GetWorkflowResponse -> Maybe WorkflowAttributes
attributes :: Prelude.Maybe WorkflowAttributes,
    -- | Workflow error messages during execution (if any).
    GetWorkflowResponse -> Maybe Text
errorDescription :: Prelude.Maybe Prelude.Text,
    -- | The timestamp that represents when workflow execution last updated.
    GetWorkflowResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | Workflow specific execution metrics.
    GetWorkflowResponse -> Maybe WorkflowMetrics
metrics :: Prelude.Maybe WorkflowMetrics,
    -- | The timestamp that represents when workflow execution started.
    GetWorkflowResponse -> Maybe POSIX
startDate :: Prelude.Maybe Data.POSIX,
    -- | Status of workflow execution.
    GetWorkflowResponse -> Maybe Status
status :: Prelude.Maybe Status,
    -- | Unique identifier for the workflow.
    GetWorkflowResponse -> Maybe Text
workflowId :: Prelude.Maybe Prelude.Text,
    -- | The type of workflow. The only supported value is APPFLOW_INTEGRATION.
    GetWorkflowResponse -> Maybe WorkflowType
workflowType :: Prelude.Maybe WorkflowType,
    -- | The response's http status code.
    GetWorkflowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorkflowResponse -> GetWorkflowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
$c/= :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
== :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
$c== :: GetWorkflowResponse -> GetWorkflowResponse -> Bool
Prelude.Eq, ReadPrec [GetWorkflowResponse]
ReadPrec GetWorkflowResponse
Int -> ReadS GetWorkflowResponse
ReadS [GetWorkflowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowResponse]
$creadListPrec :: ReadPrec [GetWorkflowResponse]
readPrec :: ReadPrec GetWorkflowResponse
$creadPrec :: ReadPrec GetWorkflowResponse
readList :: ReadS [GetWorkflowResponse]
$creadList :: ReadS [GetWorkflowResponse]
readsPrec :: Int -> ReadS GetWorkflowResponse
$creadsPrec :: Int -> ReadS GetWorkflowResponse
Prelude.Read, Int -> GetWorkflowResponse -> ShowS
[GetWorkflowResponse] -> ShowS
GetWorkflowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowResponse] -> ShowS
$cshowList :: [GetWorkflowResponse] -> ShowS
show :: GetWorkflowResponse -> String
$cshow :: GetWorkflowResponse -> String
showsPrec :: Int -> GetWorkflowResponse -> ShowS
$cshowsPrec :: Int -> GetWorkflowResponse -> ShowS
Prelude.Show, forall x. Rep GetWorkflowResponse x -> GetWorkflowResponse
forall x. GetWorkflowResponse -> Rep GetWorkflowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWorkflowResponse x -> GetWorkflowResponse
$cfrom :: forall x. GetWorkflowResponse -> Rep GetWorkflowResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowResponse' 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:
--
-- 'attributes', 'getWorkflowResponse_attributes' - Attributes provided for workflow execution.
--
-- 'errorDescription', 'getWorkflowResponse_errorDescription' - Workflow error messages during execution (if any).
--
-- 'lastUpdatedAt', 'getWorkflowResponse_lastUpdatedAt' - The timestamp that represents when workflow execution last updated.
--
-- 'metrics', 'getWorkflowResponse_metrics' - Workflow specific execution metrics.
--
-- 'startDate', 'getWorkflowResponse_startDate' - The timestamp that represents when workflow execution started.
--
-- 'status', 'getWorkflowResponse_status' - Status of workflow execution.
--
-- 'workflowId', 'getWorkflowResponse_workflowId' - Unique identifier for the workflow.
--
-- 'workflowType', 'getWorkflowResponse_workflowType' - The type of workflow. The only supported value is APPFLOW_INTEGRATION.
--
-- 'httpStatus', 'getWorkflowResponse_httpStatus' - The response's http status code.
newGetWorkflowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkflowResponse
newGetWorkflowResponse :: Int -> GetWorkflowResponse
newGetWorkflowResponse Int
pHttpStatus_ =
  GetWorkflowResponse'
    { $sel:attributes:GetWorkflowResponse' :: Maybe WorkflowAttributes
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:errorDescription:GetWorkflowResponse' :: Maybe Text
errorDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:GetWorkflowResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:metrics:GetWorkflowResponse' :: Maybe WorkflowMetrics
metrics = forall a. Maybe a
Prelude.Nothing,
      $sel:startDate:GetWorkflowResponse' :: Maybe POSIX
startDate = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetWorkflowResponse' :: Maybe Status
status = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowId:GetWorkflowResponse' :: Maybe Text
workflowId = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowType:GetWorkflowResponse' :: Maybe WorkflowType
workflowType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkflowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Attributes provided for workflow execution.
getWorkflowResponse_attributes :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowAttributes)
getWorkflowResponse_attributes :: Lens' GetWorkflowResponse (Maybe WorkflowAttributes)
getWorkflowResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowAttributes
attributes :: Maybe WorkflowAttributes
$sel:attributes:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowAttributes
attributes} -> Maybe WorkflowAttributes
attributes) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowAttributes
a -> GetWorkflowResponse
s {$sel:attributes:GetWorkflowResponse' :: Maybe WorkflowAttributes
attributes = Maybe WorkflowAttributes
a} :: GetWorkflowResponse)

-- | Workflow error messages during execution (if any).
getWorkflowResponse_errorDescription :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_errorDescription :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_errorDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
errorDescription :: Maybe Text
$sel:errorDescription:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
errorDescription} -> Maybe Text
errorDescription) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:errorDescription:GetWorkflowResponse' :: Maybe Text
errorDescription = Maybe Text
a} :: GetWorkflowResponse)

-- | The timestamp that represents when workflow execution last updated.
getWorkflowResponse_lastUpdatedAt :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowResponse_lastUpdatedAt :: Lens' GetWorkflowResponse (Maybe UTCTime)
getWorkflowResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe POSIX
a -> GetWorkflowResponse
s {$sel:lastUpdatedAt:GetWorkflowResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetWorkflowResponse) 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

-- | Workflow specific execution metrics.
getWorkflowResponse_metrics :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowMetrics)
getWorkflowResponse_metrics :: Lens' GetWorkflowResponse (Maybe WorkflowMetrics)
getWorkflowResponse_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowMetrics
metrics :: Maybe WorkflowMetrics
$sel:metrics:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowMetrics
metrics} -> Maybe WorkflowMetrics
metrics) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowMetrics
a -> GetWorkflowResponse
s {$sel:metrics:GetWorkflowResponse' :: Maybe WorkflowMetrics
metrics = Maybe WorkflowMetrics
a} :: GetWorkflowResponse)

-- | The timestamp that represents when workflow execution started.
getWorkflowResponse_startDate :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.UTCTime)
getWorkflowResponse_startDate :: Lens' GetWorkflowResponse (Maybe UTCTime)
getWorkflowResponse_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe POSIX
startDate :: Maybe POSIX
$sel:startDate:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe POSIX
startDate} -> Maybe POSIX
startDate) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe POSIX
a -> GetWorkflowResponse
s {$sel:startDate:GetWorkflowResponse' :: Maybe POSIX
startDate = Maybe POSIX
a} :: GetWorkflowResponse) 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

-- | Status of workflow execution.
getWorkflowResponse_status :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Status)
getWorkflowResponse_status :: Lens' GetWorkflowResponse (Maybe Status)
getWorkflowResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Status
status :: Maybe Status
$sel:status:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Status
status} -> Maybe Status
status) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Status
a -> GetWorkflowResponse
s {$sel:status:GetWorkflowResponse' :: Maybe Status
status = Maybe Status
a} :: GetWorkflowResponse)

-- | Unique identifier for the workflow.
getWorkflowResponse_workflowId :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe Prelude.Text)
getWorkflowResponse_workflowId :: Lens' GetWorkflowResponse (Maybe Text)
getWorkflowResponse_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe Text
workflowId :: Maybe Text
$sel:workflowId:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
workflowId} -> Maybe Text
workflowId) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe Text
a -> GetWorkflowResponse
s {$sel:workflowId:GetWorkflowResponse' :: Maybe Text
workflowId = Maybe Text
a} :: GetWorkflowResponse)

-- | The type of workflow. The only supported value is APPFLOW_INTEGRATION.
getWorkflowResponse_workflowType :: Lens.Lens' GetWorkflowResponse (Prelude.Maybe WorkflowType)
getWorkflowResponse_workflowType :: Lens' GetWorkflowResponse (Maybe WorkflowType)
getWorkflowResponse_workflowType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowResponse' {Maybe WorkflowType
workflowType :: Maybe WorkflowType
$sel:workflowType:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowType
workflowType} -> Maybe WorkflowType
workflowType) (\s :: GetWorkflowResponse
s@GetWorkflowResponse' {} Maybe WorkflowType
a -> GetWorkflowResponse
s {$sel:workflowType:GetWorkflowResponse' :: Maybe WorkflowType
workflowType = Maybe WorkflowType
a} :: GetWorkflowResponse)

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

instance Prelude.NFData GetWorkflowResponse where
  rnf :: GetWorkflowResponse -> ()
rnf GetWorkflowResponse' {Int
Maybe Text
Maybe POSIX
Maybe Status
Maybe WorkflowAttributes
Maybe WorkflowMetrics
Maybe WorkflowType
httpStatus :: Int
workflowType :: Maybe WorkflowType
workflowId :: Maybe Text
status :: Maybe Status
startDate :: Maybe POSIX
metrics :: Maybe WorkflowMetrics
lastUpdatedAt :: Maybe POSIX
errorDescription :: Maybe Text
attributes :: Maybe WorkflowAttributes
$sel:httpStatus:GetWorkflowResponse' :: GetWorkflowResponse -> Int
$sel:workflowType:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowType
$sel:workflowId:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:status:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Status
$sel:startDate:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe POSIX
$sel:metrics:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowMetrics
$sel:lastUpdatedAt:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe POSIX
$sel:errorDescription:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe Text
$sel:attributes:GetWorkflowResponse' :: GetWorkflowResponse -> Maybe WorkflowAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowAttributes
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowMetrics
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Status
status
      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 WorkflowType
workflowType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus