{-# 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.AppFlow.UpdateFlow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing flow.
module Amazonka.AppFlow.UpdateFlow
  ( -- * Creating a Request
    UpdateFlow (..),
    newUpdateFlow,

    -- * Request Lenses
    updateFlow_description,
    updateFlow_metadataCatalogConfig,
    updateFlow_flowName,
    updateFlow_triggerConfig,
    updateFlow_sourceFlowConfig,
    updateFlow_destinationFlowConfigList,
    updateFlow_tasks,

    -- * Destructuring the Response
    UpdateFlowResponse (..),
    newUpdateFlowResponse,

    -- * Response Lenses
    updateFlowResponse_flowStatus,
    updateFlowResponse_httpStatus,
  )
where

import Amazonka.AppFlow.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

-- | /See:/ 'newUpdateFlow' smart constructor.
data UpdateFlow = UpdateFlow'
  { -- | A description of the flow.
    UpdateFlow -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies the configuration that Amazon AppFlow uses when it catalogs
    -- the data that\'s transferred by the associated flow. When Amazon AppFlow
    -- catalogs the data from a flow, it stores metadata in a data catalog.
    UpdateFlow -> Maybe MetadataCatalogConfig
metadataCatalogConfig :: Prelude.Maybe MetadataCatalogConfig,
    -- | The specified name of the flow. Spaces are not allowed. Use underscores
    -- (_) or hyphens (-) only.
    UpdateFlow -> Text
flowName :: Prelude.Text,
    -- | The trigger settings that determine how and when the flow runs.
    UpdateFlow -> TriggerConfig
triggerConfig :: TriggerConfig,
    UpdateFlow -> SourceFlowConfig
sourceFlowConfig :: SourceFlowConfig,
    -- | The configuration that controls how Amazon AppFlow transfers data to the
    -- destination connector.
    UpdateFlow -> [DestinationFlowConfig]
destinationFlowConfigList :: [DestinationFlowConfig],
    -- | A list of tasks that Amazon AppFlow performs while transferring the data
    -- in the flow run.
    UpdateFlow -> [Task]
tasks :: [Task]
  }
  deriving (UpdateFlow -> UpdateFlow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlow -> UpdateFlow -> Bool
$c/= :: UpdateFlow -> UpdateFlow -> Bool
== :: UpdateFlow -> UpdateFlow -> Bool
$c== :: UpdateFlow -> UpdateFlow -> Bool
Prelude.Eq, ReadPrec [UpdateFlow]
ReadPrec UpdateFlow
Int -> ReadS UpdateFlow
ReadS [UpdateFlow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlow]
$creadListPrec :: ReadPrec [UpdateFlow]
readPrec :: ReadPrec UpdateFlow
$creadPrec :: ReadPrec UpdateFlow
readList :: ReadS [UpdateFlow]
$creadList :: ReadS [UpdateFlow]
readsPrec :: Int -> ReadS UpdateFlow
$creadsPrec :: Int -> ReadS UpdateFlow
Prelude.Read, Int -> UpdateFlow -> ShowS
[UpdateFlow] -> ShowS
UpdateFlow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlow] -> ShowS
$cshowList :: [UpdateFlow] -> ShowS
show :: UpdateFlow -> String
$cshow :: UpdateFlow -> String
showsPrec :: Int -> UpdateFlow -> ShowS
$cshowsPrec :: Int -> UpdateFlow -> ShowS
Prelude.Show, forall x. Rep UpdateFlow x -> UpdateFlow
forall x. UpdateFlow -> Rep UpdateFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFlow x -> UpdateFlow
$cfrom :: forall x. UpdateFlow -> Rep UpdateFlow x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlow' 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:
--
-- 'description', 'updateFlow_description' - A description of the flow.
--
-- 'metadataCatalogConfig', 'updateFlow_metadataCatalogConfig' - Specifies the configuration that Amazon AppFlow uses when it catalogs
-- the data that\'s transferred by the associated flow. When Amazon AppFlow
-- catalogs the data from a flow, it stores metadata in a data catalog.
--
-- 'flowName', 'updateFlow_flowName' - The specified name of the flow. Spaces are not allowed. Use underscores
-- (_) or hyphens (-) only.
--
-- 'triggerConfig', 'updateFlow_triggerConfig' - The trigger settings that determine how and when the flow runs.
--
-- 'sourceFlowConfig', 'updateFlow_sourceFlowConfig' - Undocumented member.
--
-- 'destinationFlowConfigList', 'updateFlow_destinationFlowConfigList' - The configuration that controls how Amazon AppFlow transfers data to the
-- destination connector.
--
-- 'tasks', 'updateFlow_tasks' - A list of tasks that Amazon AppFlow performs while transferring the data
-- in the flow run.
newUpdateFlow ::
  -- | 'flowName'
  Prelude.Text ->
  -- | 'triggerConfig'
  TriggerConfig ->
  -- | 'sourceFlowConfig'
  SourceFlowConfig ->
  UpdateFlow
newUpdateFlow :: Text -> TriggerConfig -> SourceFlowConfig -> UpdateFlow
newUpdateFlow
  Text
pFlowName_
  TriggerConfig
pTriggerConfig_
  SourceFlowConfig
pSourceFlowConfig_ =
    UpdateFlow'
      { $sel:description:UpdateFlow' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:metadataCatalogConfig:UpdateFlow' :: Maybe MetadataCatalogConfig
metadataCatalogConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:flowName:UpdateFlow' :: Text
flowName = Text
pFlowName_,
        $sel:triggerConfig:UpdateFlow' :: TriggerConfig
triggerConfig = TriggerConfig
pTriggerConfig_,
        $sel:sourceFlowConfig:UpdateFlow' :: SourceFlowConfig
sourceFlowConfig = SourceFlowConfig
pSourceFlowConfig_,
        $sel:destinationFlowConfigList:UpdateFlow' :: [DestinationFlowConfig]
destinationFlowConfigList = forall a. Monoid a => a
Prelude.mempty,
        $sel:tasks:UpdateFlow' :: [Task]
tasks = forall a. Monoid a => a
Prelude.mempty
      }

-- | A description of the flow.
updateFlow_description :: Lens.Lens' UpdateFlow (Prelude.Maybe Prelude.Text)
updateFlow_description :: Lens' UpdateFlow (Maybe Text)
updateFlow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFlow' :: UpdateFlow -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFlow
s@UpdateFlow' {} Maybe Text
a -> UpdateFlow
s {$sel:description:UpdateFlow' :: Maybe Text
description = Maybe Text
a} :: UpdateFlow)

-- | Specifies the configuration that Amazon AppFlow uses when it catalogs
-- the data that\'s transferred by the associated flow. When Amazon AppFlow
-- catalogs the data from a flow, it stores metadata in a data catalog.
updateFlow_metadataCatalogConfig :: Lens.Lens' UpdateFlow (Prelude.Maybe MetadataCatalogConfig)
updateFlow_metadataCatalogConfig :: Lens' UpdateFlow (Maybe MetadataCatalogConfig)
updateFlow_metadataCatalogConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {Maybe MetadataCatalogConfig
metadataCatalogConfig :: Maybe MetadataCatalogConfig
$sel:metadataCatalogConfig:UpdateFlow' :: UpdateFlow -> Maybe MetadataCatalogConfig
metadataCatalogConfig} -> Maybe MetadataCatalogConfig
metadataCatalogConfig) (\s :: UpdateFlow
s@UpdateFlow' {} Maybe MetadataCatalogConfig
a -> UpdateFlow
s {$sel:metadataCatalogConfig:UpdateFlow' :: Maybe MetadataCatalogConfig
metadataCatalogConfig = Maybe MetadataCatalogConfig
a} :: UpdateFlow)

-- | The specified name of the flow. Spaces are not allowed. Use underscores
-- (_) or hyphens (-) only.
updateFlow_flowName :: Lens.Lens' UpdateFlow Prelude.Text
updateFlow_flowName :: Lens' UpdateFlow Text
updateFlow_flowName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {Text
flowName :: Text
$sel:flowName:UpdateFlow' :: UpdateFlow -> Text
flowName} -> Text
flowName) (\s :: UpdateFlow
s@UpdateFlow' {} Text
a -> UpdateFlow
s {$sel:flowName:UpdateFlow' :: Text
flowName = Text
a} :: UpdateFlow)

-- | The trigger settings that determine how and when the flow runs.
updateFlow_triggerConfig :: Lens.Lens' UpdateFlow TriggerConfig
updateFlow_triggerConfig :: Lens' UpdateFlow TriggerConfig
updateFlow_triggerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {TriggerConfig
triggerConfig :: TriggerConfig
$sel:triggerConfig:UpdateFlow' :: UpdateFlow -> TriggerConfig
triggerConfig} -> TriggerConfig
triggerConfig) (\s :: UpdateFlow
s@UpdateFlow' {} TriggerConfig
a -> UpdateFlow
s {$sel:triggerConfig:UpdateFlow' :: TriggerConfig
triggerConfig = TriggerConfig
a} :: UpdateFlow)

-- | Undocumented member.
updateFlow_sourceFlowConfig :: Lens.Lens' UpdateFlow SourceFlowConfig
updateFlow_sourceFlowConfig :: Lens' UpdateFlow SourceFlowConfig
updateFlow_sourceFlowConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {SourceFlowConfig
sourceFlowConfig :: SourceFlowConfig
$sel:sourceFlowConfig:UpdateFlow' :: UpdateFlow -> SourceFlowConfig
sourceFlowConfig} -> SourceFlowConfig
sourceFlowConfig) (\s :: UpdateFlow
s@UpdateFlow' {} SourceFlowConfig
a -> UpdateFlow
s {$sel:sourceFlowConfig:UpdateFlow' :: SourceFlowConfig
sourceFlowConfig = SourceFlowConfig
a} :: UpdateFlow)

-- | The configuration that controls how Amazon AppFlow transfers data to the
-- destination connector.
updateFlow_destinationFlowConfigList :: Lens.Lens' UpdateFlow [DestinationFlowConfig]
updateFlow_destinationFlowConfigList :: Lens' UpdateFlow [DestinationFlowConfig]
updateFlow_destinationFlowConfigList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {[DestinationFlowConfig]
destinationFlowConfigList :: [DestinationFlowConfig]
$sel:destinationFlowConfigList:UpdateFlow' :: UpdateFlow -> [DestinationFlowConfig]
destinationFlowConfigList} -> [DestinationFlowConfig]
destinationFlowConfigList) (\s :: UpdateFlow
s@UpdateFlow' {} [DestinationFlowConfig]
a -> UpdateFlow
s {$sel:destinationFlowConfigList:UpdateFlow' :: [DestinationFlowConfig]
destinationFlowConfigList = [DestinationFlowConfig]
a} :: UpdateFlow) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of tasks that Amazon AppFlow performs while transferring the data
-- in the flow run.
updateFlow_tasks :: Lens.Lens' UpdateFlow [Task]
updateFlow_tasks :: Lens' UpdateFlow [Task]
updateFlow_tasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlow' {[Task]
tasks :: [Task]
$sel:tasks:UpdateFlow' :: UpdateFlow -> [Task]
tasks} -> [Task]
tasks) (\s :: UpdateFlow
s@UpdateFlow' {} [Task]
a -> UpdateFlow
s {$sel:tasks:UpdateFlow' :: [Task]
tasks = [Task]
a} :: UpdateFlow) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateFlow where
  type AWSResponse UpdateFlow = UpdateFlowResponse
  request :: (Service -> Service) -> UpdateFlow -> Request UpdateFlow
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 UpdateFlow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFlow)))
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 FlowStatus -> Int -> UpdateFlowResponse
UpdateFlowResponse'
            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
"flowStatus")
            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 UpdateFlow where
  hashWithSalt :: Int -> UpdateFlow -> Int
hashWithSalt Int
_salt UpdateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
metadataCatalogConfig :: Maybe MetadataCatalogConfig
description :: Maybe Text
$sel:tasks:UpdateFlow' :: UpdateFlow -> [Task]
$sel:destinationFlowConfigList:UpdateFlow' :: UpdateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:UpdateFlow' :: UpdateFlow -> SourceFlowConfig
$sel:triggerConfig:UpdateFlow' :: UpdateFlow -> TriggerConfig
$sel:flowName:UpdateFlow' :: UpdateFlow -> Text
$sel:metadataCatalogConfig:UpdateFlow' :: UpdateFlow -> Maybe MetadataCatalogConfig
$sel:description:UpdateFlow' :: UpdateFlow -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetadataCatalogConfig
metadataCatalogConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TriggerConfig
triggerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SourceFlowConfig
sourceFlowConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [DestinationFlowConfig]
destinationFlowConfigList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Task]
tasks

instance Prelude.NFData UpdateFlow where
  rnf :: UpdateFlow -> ()
rnf UpdateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
metadataCatalogConfig :: Maybe MetadataCatalogConfig
description :: Maybe Text
$sel:tasks:UpdateFlow' :: UpdateFlow -> [Task]
$sel:destinationFlowConfigList:UpdateFlow' :: UpdateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:UpdateFlow' :: UpdateFlow -> SourceFlowConfig
$sel:triggerConfig:UpdateFlow' :: UpdateFlow -> TriggerConfig
$sel:flowName:UpdateFlow' :: UpdateFlow -> Text
$sel:metadataCatalogConfig:UpdateFlow' :: UpdateFlow -> Maybe MetadataCatalogConfig
$sel:description:UpdateFlow' :: UpdateFlow -> Maybe Text
..} =
    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 MetadataCatalogConfig
metadataCatalogConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TriggerConfig
triggerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SourceFlowConfig
sourceFlowConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [DestinationFlowConfig]
destinationFlowConfigList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Task]
tasks

instance Data.ToHeaders UpdateFlow where
  toHeaders :: UpdateFlow -> 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.ToJSON UpdateFlow where
  toJSON :: UpdateFlow -> Value
toJSON UpdateFlow' {[Task]
[DestinationFlowConfig]
Maybe Text
Maybe MetadataCatalogConfig
Text
TriggerConfig
SourceFlowConfig
tasks :: [Task]
destinationFlowConfigList :: [DestinationFlowConfig]
sourceFlowConfig :: SourceFlowConfig
triggerConfig :: TriggerConfig
flowName :: Text
metadataCatalogConfig :: Maybe MetadataCatalogConfig
description :: Maybe Text
$sel:tasks:UpdateFlow' :: UpdateFlow -> [Task]
$sel:destinationFlowConfigList:UpdateFlow' :: UpdateFlow -> [DestinationFlowConfig]
$sel:sourceFlowConfig:UpdateFlow' :: UpdateFlow -> SourceFlowConfig
$sel:triggerConfig:UpdateFlow' :: UpdateFlow -> TriggerConfig
$sel:flowName:UpdateFlow' :: UpdateFlow -> Text
$sel:metadataCatalogConfig:UpdateFlow' :: UpdateFlow -> Maybe MetadataCatalogConfig
$sel:description:UpdateFlow' :: UpdateFlow -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"metadataCatalogConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MetadataCatalogConfig
metadataCatalogConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"flowName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
flowName),
            forall a. a -> Maybe a
Prelude.Just (Key
"triggerConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TriggerConfig
triggerConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sourceFlowConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SourceFlowConfig
sourceFlowConfig),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"destinationFlowConfigList"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [DestinationFlowConfig]
destinationFlowConfigList
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"tasks" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Task]
tasks)
          ]
      )

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

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

-- | /See:/ 'newUpdateFlowResponse' smart constructor.
data UpdateFlowResponse = UpdateFlowResponse'
  { -- | Indicates the current status of the flow.
    UpdateFlowResponse -> Maybe FlowStatus
flowStatus :: Prelude.Maybe FlowStatus,
    -- | The response's http status code.
    UpdateFlowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFlowResponse -> UpdateFlowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlowResponse -> UpdateFlowResponse -> Bool
$c/= :: UpdateFlowResponse -> UpdateFlowResponse -> Bool
== :: UpdateFlowResponse -> UpdateFlowResponse -> Bool
$c== :: UpdateFlowResponse -> UpdateFlowResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFlowResponse]
ReadPrec UpdateFlowResponse
Int -> ReadS UpdateFlowResponse
ReadS [UpdateFlowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlowResponse]
$creadListPrec :: ReadPrec [UpdateFlowResponse]
readPrec :: ReadPrec UpdateFlowResponse
$creadPrec :: ReadPrec UpdateFlowResponse
readList :: ReadS [UpdateFlowResponse]
$creadList :: ReadS [UpdateFlowResponse]
readsPrec :: Int -> ReadS UpdateFlowResponse
$creadsPrec :: Int -> ReadS UpdateFlowResponse
Prelude.Read, Int -> UpdateFlowResponse -> ShowS
[UpdateFlowResponse] -> ShowS
UpdateFlowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlowResponse] -> ShowS
$cshowList :: [UpdateFlowResponse] -> ShowS
show :: UpdateFlowResponse -> String
$cshow :: UpdateFlowResponse -> String
showsPrec :: Int -> UpdateFlowResponse -> ShowS
$cshowsPrec :: Int -> UpdateFlowResponse -> ShowS
Prelude.Show, forall x. Rep UpdateFlowResponse x -> UpdateFlowResponse
forall x. UpdateFlowResponse -> Rep UpdateFlowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFlowResponse x -> UpdateFlowResponse
$cfrom :: forall x. UpdateFlowResponse -> Rep UpdateFlowResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlowResponse' 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:
--
-- 'flowStatus', 'updateFlowResponse_flowStatus' - Indicates the current status of the flow.
--
-- 'httpStatus', 'updateFlowResponse_httpStatus' - The response's http status code.
newUpdateFlowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFlowResponse
newUpdateFlowResponse :: Int -> UpdateFlowResponse
newUpdateFlowResponse Int
pHttpStatus_ =
  UpdateFlowResponse'
    { $sel:flowStatus:UpdateFlowResponse' :: Maybe FlowStatus
flowStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFlowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates the current status of the flow.
updateFlowResponse_flowStatus :: Lens.Lens' UpdateFlowResponse (Prelude.Maybe FlowStatus)
updateFlowResponse_flowStatus :: Lens' UpdateFlowResponse (Maybe FlowStatus)
updateFlowResponse_flowStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowResponse' {Maybe FlowStatus
flowStatus :: Maybe FlowStatus
$sel:flowStatus:UpdateFlowResponse' :: UpdateFlowResponse -> Maybe FlowStatus
flowStatus} -> Maybe FlowStatus
flowStatus) (\s :: UpdateFlowResponse
s@UpdateFlowResponse' {} Maybe FlowStatus
a -> UpdateFlowResponse
s {$sel:flowStatus:UpdateFlowResponse' :: Maybe FlowStatus
flowStatus = Maybe FlowStatus
a} :: UpdateFlowResponse)

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

instance Prelude.NFData UpdateFlowResponse where
  rnf :: UpdateFlowResponse -> ()
rnf UpdateFlowResponse' {Int
Maybe FlowStatus
httpStatus :: Int
flowStatus :: Maybe FlowStatus
$sel:httpStatus:UpdateFlowResponse' :: UpdateFlowResponse -> Int
$sel:flowStatus:UpdateFlowResponse' :: UpdateFlowResponse -> Maybe FlowStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FlowStatus
flowStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus