{-# 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.Pipes.UpdatePipe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update an existing pipe. When you call @UpdatePipe@, only the fields
-- that are included in the request are changed, the rest are unchanged.
-- The exception to this is if you modify any Amazon Web Services-service
-- specific fields in the @SourceParameters@, @EnrichmentParameters@, or
-- @TargetParameters@ objects. The fields in these objects are updated
-- atomically as one and override existing values. This is by design and
-- means that if you don\'t specify an optional field in one of these
-- Parameters objects, that field will be set to its system-default value
-- after the update.
--
-- >  <p>For more information about pipes, see <a href="https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-pipes.html"> Amazon EventBridge Pipes</a> in the Amazon EventBridge User Guide.</p>
module Amazonka.Pipes.UpdatePipe
  ( -- * Creating a Request
    UpdatePipe (..),
    newUpdatePipe,

    -- * Request Lenses
    updatePipe_description,
    updatePipe_desiredState,
    updatePipe_enrichment,
    updatePipe_enrichmentParameters,
    updatePipe_sourceParameters,
    updatePipe_target,
    updatePipe_targetParameters,
    updatePipe_name,
    updatePipe_roleArn,

    -- * Destructuring the Response
    UpdatePipeResponse (..),
    newUpdatePipeResponse,

    -- * Response Lenses
    updatePipeResponse_arn,
    updatePipeResponse_creationTime,
    updatePipeResponse_currentState,
    updatePipeResponse_desiredState,
    updatePipeResponse_lastModifiedTime,
    updatePipeResponse_name,
    updatePipeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdatePipe' smart constructor.
data UpdatePipe = UpdatePipe'
  { -- | A description of the pipe.
    UpdatePipe -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The state the pipe should be in.
    UpdatePipe -> Maybe RequestedPipeState
desiredState :: Prelude.Maybe RequestedPipeState,
    -- | The ARN of the enrichment resource.
    UpdatePipe -> Maybe Text
enrichment :: Prelude.Maybe Prelude.Text,
    -- | The parameters required to set up enrichment on your pipe.
    UpdatePipe -> Maybe PipeEnrichmentParameters
enrichmentParameters :: Prelude.Maybe PipeEnrichmentParameters,
    -- | The parameters required to set up a source for your pipe.
    UpdatePipe -> Maybe UpdatePipeSourceParameters
sourceParameters :: Prelude.Maybe UpdatePipeSourceParameters,
    -- | The ARN of the target resource.
    UpdatePipe -> Maybe Text
target :: Prelude.Maybe Prelude.Text,
    -- | The parameters required to set up a target for your pipe.
    UpdatePipe -> Maybe PipeTargetParameters
targetParameters :: Prelude.Maybe PipeTargetParameters,
    -- | The name of the pipe.
    UpdatePipe -> Text
name :: Prelude.Text,
    -- | The ARN of the role that allows the pipe to send data to the target.
    UpdatePipe -> Text
roleArn :: Prelude.Text
  }
  deriving (UpdatePipe -> UpdatePipe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePipe -> UpdatePipe -> Bool
$c/= :: UpdatePipe -> UpdatePipe -> Bool
== :: UpdatePipe -> UpdatePipe -> Bool
$c== :: UpdatePipe -> UpdatePipe -> Bool
Prelude.Eq, Int -> UpdatePipe -> ShowS
[UpdatePipe] -> ShowS
UpdatePipe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePipe] -> ShowS
$cshowList :: [UpdatePipe] -> ShowS
show :: UpdatePipe -> String
$cshow :: UpdatePipe -> String
showsPrec :: Int -> UpdatePipe -> ShowS
$cshowsPrec :: Int -> UpdatePipe -> ShowS
Prelude.Show, forall x. Rep UpdatePipe x -> UpdatePipe
forall x. UpdatePipe -> Rep UpdatePipe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePipe x -> UpdatePipe
$cfrom :: forall x. UpdatePipe -> Rep UpdatePipe x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePipe' 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', 'updatePipe_description' - A description of the pipe.
--
-- 'desiredState', 'updatePipe_desiredState' - The state the pipe should be in.
--
-- 'enrichment', 'updatePipe_enrichment' - The ARN of the enrichment resource.
--
-- 'enrichmentParameters', 'updatePipe_enrichmentParameters' - The parameters required to set up enrichment on your pipe.
--
-- 'sourceParameters', 'updatePipe_sourceParameters' - The parameters required to set up a source for your pipe.
--
-- 'target', 'updatePipe_target' - The ARN of the target resource.
--
-- 'targetParameters', 'updatePipe_targetParameters' - The parameters required to set up a target for your pipe.
--
-- 'name', 'updatePipe_name' - The name of the pipe.
--
-- 'roleArn', 'updatePipe_roleArn' - The ARN of the role that allows the pipe to send data to the target.
newUpdatePipe ::
  -- | 'name'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  UpdatePipe
newUpdatePipe :: Text -> Text -> UpdatePipe
newUpdatePipe Text
pName_ Text
pRoleArn_ =
  UpdatePipe'
    { $sel:description:UpdatePipe' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredState:UpdatePipe' :: Maybe RequestedPipeState
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:enrichment:UpdatePipe' :: Maybe Text
enrichment = forall a. Maybe a
Prelude.Nothing,
      $sel:enrichmentParameters:UpdatePipe' :: Maybe PipeEnrichmentParameters
enrichmentParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceParameters:UpdatePipe' :: Maybe UpdatePipeSourceParameters
sourceParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:target:UpdatePipe' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing,
      $sel:targetParameters:UpdatePipe' :: Maybe PipeTargetParameters
targetParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdatePipe' :: Text
name = Text
pName_,
      $sel:roleArn:UpdatePipe' :: Text
roleArn = Text
pRoleArn_
    }

-- | A description of the pipe.
updatePipe_description :: Lens.Lens' UpdatePipe (Prelude.Maybe Prelude.Text)
updatePipe_description :: Lens' UpdatePipe (Maybe Text)
updatePipe_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:UpdatePipe' :: UpdatePipe -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe (Sensitive Text)
a -> UpdatePipe
s {$sel:description:UpdatePipe' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: UpdatePipe) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | The state the pipe should be in.
updatePipe_desiredState :: Lens.Lens' UpdatePipe (Prelude.Maybe RequestedPipeState)
updatePipe_desiredState :: Lens' UpdatePipe (Maybe RequestedPipeState)
updatePipe_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe RequestedPipeState
desiredState :: Maybe RequestedPipeState
$sel:desiredState:UpdatePipe' :: UpdatePipe -> Maybe RequestedPipeState
desiredState} -> Maybe RequestedPipeState
desiredState) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe RequestedPipeState
a -> UpdatePipe
s {$sel:desiredState:UpdatePipe' :: Maybe RequestedPipeState
desiredState = Maybe RequestedPipeState
a} :: UpdatePipe)

-- | The ARN of the enrichment resource.
updatePipe_enrichment :: Lens.Lens' UpdatePipe (Prelude.Maybe Prelude.Text)
updatePipe_enrichment :: Lens' UpdatePipe (Maybe Text)
updatePipe_enrichment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe Text
enrichment :: Maybe Text
$sel:enrichment:UpdatePipe' :: UpdatePipe -> Maybe Text
enrichment} -> Maybe Text
enrichment) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe Text
a -> UpdatePipe
s {$sel:enrichment:UpdatePipe' :: Maybe Text
enrichment = Maybe Text
a} :: UpdatePipe)

-- | The parameters required to set up enrichment on your pipe.
updatePipe_enrichmentParameters :: Lens.Lens' UpdatePipe (Prelude.Maybe PipeEnrichmentParameters)
updatePipe_enrichmentParameters :: Lens' UpdatePipe (Maybe PipeEnrichmentParameters)
updatePipe_enrichmentParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe PipeEnrichmentParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
$sel:enrichmentParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeEnrichmentParameters
enrichmentParameters} -> Maybe PipeEnrichmentParameters
enrichmentParameters) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe PipeEnrichmentParameters
a -> UpdatePipe
s {$sel:enrichmentParameters:UpdatePipe' :: Maybe PipeEnrichmentParameters
enrichmentParameters = Maybe PipeEnrichmentParameters
a} :: UpdatePipe)

-- | The parameters required to set up a source for your pipe.
updatePipe_sourceParameters :: Lens.Lens' UpdatePipe (Prelude.Maybe UpdatePipeSourceParameters)
updatePipe_sourceParameters :: Lens' UpdatePipe (Maybe UpdatePipeSourceParameters)
updatePipe_sourceParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe UpdatePipeSourceParameters
sourceParameters :: Maybe UpdatePipeSourceParameters
$sel:sourceParameters:UpdatePipe' :: UpdatePipe -> Maybe UpdatePipeSourceParameters
sourceParameters} -> Maybe UpdatePipeSourceParameters
sourceParameters) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe UpdatePipeSourceParameters
a -> UpdatePipe
s {$sel:sourceParameters:UpdatePipe' :: Maybe UpdatePipeSourceParameters
sourceParameters = Maybe UpdatePipeSourceParameters
a} :: UpdatePipe)

-- | The ARN of the target resource.
updatePipe_target :: Lens.Lens' UpdatePipe (Prelude.Maybe Prelude.Text)
updatePipe_target :: Lens' UpdatePipe (Maybe Text)
updatePipe_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe Text
target :: Maybe Text
$sel:target:UpdatePipe' :: UpdatePipe -> Maybe Text
target} -> Maybe Text
target) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe Text
a -> UpdatePipe
s {$sel:target:UpdatePipe' :: Maybe Text
target = Maybe Text
a} :: UpdatePipe)

-- | The parameters required to set up a target for your pipe.
updatePipe_targetParameters :: Lens.Lens' UpdatePipe (Prelude.Maybe PipeTargetParameters)
updatePipe_targetParameters :: Lens' UpdatePipe (Maybe PipeTargetParameters)
updatePipe_targetParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Maybe PipeTargetParameters
targetParameters :: Maybe PipeTargetParameters
$sel:targetParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeTargetParameters
targetParameters} -> Maybe PipeTargetParameters
targetParameters) (\s :: UpdatePipe
s@UpdatePipe' {} Maybe PipeTargetParameters
a -> UpdatePipe
s {$sel:targetParameters:UpdatePipe' :: Maybe PipeTargetParameters
targetParameters = Maybe PipeTargetParameters
a} :: UpdatePipe)

-- | The name of the pipe.
updatePipe_name :: Lens.Lens' UpdatePipe Prelude.Text
updatePipe_name :: Lens' UpdatePipe Text
updatePipe_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Text
name :: Text
$sel:name:UpdatePipe' :: UpdatePipe -> Text
name} -> Text
name) (\s :: UpdatePipe
s@UpdatePipe' {} Text
a -> UpdatePipe
s {$sel:name:UpdatePipe' :: Text
name = Text
a} :: UpdatePipe)

-- | The ARN of the role that allows the pipe to send data to the target.
updatePipe_roleArn :: Lens.Lens' UpdatePipe Prelude.Text
updatePipe_roleArn :: Lens' UpdatePipe Text
updatePipe_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipe' {Text
roleArn :: Text
$sel:roleArn:UpdatePipe' :: UpdatePipe -> Text
roleArn} -> Text
roleArn) (\s :: UpdatePipe
s@UpdatePipe' {} Text
a -> UpdatePipe
s {$sel:roleArn:UpdatePipe' :: Text
roleArn = Text
a} :: UpdatePipe)

instance Core.AWSRequest UpdatePipe where
  type AWSResponse UpdatePipe = UpdatePipeResponse
  request :: (Service -> Service) -> UpdatePipe -> Request UpdatePipe
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdatePipe
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePipe)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe PipeState
-> Maybe RequestedPipeState
-> Maybe POSIX
-> Maybe Text
-> Int
-> UpdatePipeResponse
UpdatePipeResponse'
            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
"Arn")
            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
"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
"CurrentState")
            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
"DesiredState")
            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
"LastModifiedTime")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdatePipe where
  hashWithSalt :: Int -> UpdatePipe -> Int
hashWithSalt Int
_salt UpdatePipe' {Maybe Text
Maybe (Sensitive Text)
Maybe PipeEnrichmentParameters
Maybe RequestedPipeState
Maybe PipeTargetParameters
Maybe UpdatePipeSourceParameters
Text
roleArn :: Text
name :: Text
targetParameters :: Maybe PipeTargetParameters
target :: Maybe Text
sourceParameters :: Maybe UpdatePipeSourceParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
enrichment :: Maybe Text
desiredState :: Maybe RequestedPipeState
description :: Maybe (Sensitive Text)
$sel:roleArn:UpdatePipe' :: UpdatePipe -> Text
$sel:name:UpdatePipe' :: UpdatePipe -> Text
$sel:targetParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeTargetParameters
$sel:target:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:sourceParameters:UpdatePipe' :: UpdatePipe -> Maybe UpdatePipeSourceParameters
$sel:enrichmentParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeEnrichmentParameters
$sel:enrichment:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:desiredState:UpdatePipe' :: UpdatePipe -> Maybe RequestedPipeState
$sel:description:UpdatePipe' :: UpdatePipe -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestedPipeState
desiredState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
enrichment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PipeEnrichmentParameters
enrichmentParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdatePipeSourceParameters
sourceParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
target
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PipeTargetParameters
targetParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData UpdatePipe where
  rnf :: UpdatePipe -> ()
rnf UpdatePipe' {Maybe Text
Maybe (Sensitive Text)
Maybe PipeEnrichmentParameters
Maybe RequestedPipeState
Maybe PipeTargetParameters
Maybe UpdatePipeSourceParameters
Text
roleArn :: Text
name :: Text
targetParameters :: Maybe PipeTargetParameters
target :: Maybe Text
sourceParameters :: Maybe UpdatePipeSourceParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
enrichment :: Maybe Text
desiredState :: Maybe RequestedPipeState
description :: Maybe (Sensitive Text)
$sel:roleArn:UpdatePipe' :: UpdatePipe -> Text
$sel:name:UpdatePipe' :: UpdatePipe -> Text
$sel:targetParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeTargetParameters
$sel:target:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:sourceParameters:UpdatePipe' :: UpdatePipe -> Maybe UpdatePipeSourceParameters
$sel:enrichmentParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeEnrichmentParameters
$sel:enrichment:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:desiredState:UpdatePipe' :: UpdatePipe -> Maybe RequestedPipeState
$sel:description:UpdatePipe' :: UpdatePipe -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestedPipeState
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
enrichment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeEnrichmentParameters
enrichmentParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdatePipeSourceParameters
sourceParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeTargetParameters
targetParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders UpdatePipe where
  toHeaders :: UpdatePipe -> 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 UpdatePipe where
  toJSON :: UpdatePipe -> Value
toJSON UpdatePipe' {Maybe Text
Maybe (Sensitive Text)
Maybe PipeEnrichmentParameters
Maybe RequestedPipeState
Maybe PipeTargetParameters
Maybe UpdatePipeSourceParameters
Text
roleArn :: Text
name :: Text
targetParameters :: Maybe PipeTargetParameters
target :: Maybe Text
sourceParameters :: Maybe UpdatePipeSourceParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
enrichment :: Maybe Text
desiredState :: Maybe RequestedPipeState
description :: Maybe (Sensitive Text)
$sel:roleArn:UpdatePipe' :: UpdatePipe -> Text
$sel:name:UpdatePipe' :: UpdatePipe -> Text
$sel:targetParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeTargetParameters
$sel:target:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:sourceParameters:UpdatePipe' :: UpdatePipe -> Maybe UpdatePipeSourceParameters
$sel:enrichmentParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeEnrichmentParameters
$sel:enrichment:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:desiredState:UpdatePipe' :: UpdatePipe -> Maybe RequestedPipeState
$sel:description:UpdatePipe' :: UpdatePipe -> Maybe (Sensitive 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 (Sensitive Text)
description,
            (Key
"DesiredState" 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 RequestedPipeState
desiredState,
            (Key
"Enrichment" 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
enrichment,
            (Key
"EnrichmentParameters" 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 PipeEnrichmentParameters
enrichmentParameters,
            (Key
"SourceParameters" 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 UpdatePipeSourceParameters
sourceParameters,
            (Key
"Target" 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
target,
            (Key
"TargetParameters" 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 PipeTargetParameters
targetParameters,
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

instance Data.ToPath UpdatePipe where
  toPath :: UpdatePipe -> ByteString
toPath UpdatePipe' {Maybe Text
Maybe (Sensitive Text)
Maybe PipeEnrichmentParameters
Maybe RequestedPipeState
Maybe PipeTargetParameters
Maybe UpdatePipeSourceParameters
Text
roleArn :: Text
name :: Text
targetParameters :: Maybe PipeTargetParameters
target :: Maybe Text
sourceParameters :: Maybe UpdatePipeSourceParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
enrichment :: Maybe Text
desiredState :: Maybe RequestedPipeState
description :: Maybe (Sensitive Text)
$sel:roleArn:UpdatePipe' :: UpdatePipe -> Text
$sel:name:UpdatePipe' :: UpdatePipe -> Text
$sel:targetParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeTargetParameters
$sel:target:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:sourceParameters:UpdatePipe' :: UpdatePipe -> Maybe UpdatePipeSourceParameters
$sel:enrichmentParameters:UpdatePipe' :: UpdatePipe -> Maybe PipeEnrichmentParameters
$sel:enrichment:UpdatePipe' :: UpdatePipe -> Maybe Text
$sel:desiredState:UpdatePipe' :: UpdatePipe -> Maybe RequestedPipeState
$sel:description:UpdatePipe' :: UpdatePipe -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/v1/pipes/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newUpdatePipeResponse' smart constructor.
data UpdatePipeResponse = UpdatePipeResponse'
  { -- | The ARN of the pipe.
    UpdatePipeResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time the pipe was created.
    UpdatePipeResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The state the pipe is in.
    UpdatePipeResponse -> Maybe PipeState
currentState :: Prelude.Maybe PipeState,
    -- | The state the pipe should be in.
    UpdatePipeResponse -> Maybe RequestedPipeState
desiredState :: Prelude.Maybe RequestedPipeState,
    -- | When the pipe was last updated, in
    -- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
    -- (YYYY-MM-DDThh:mm:ss.sTZD).
    UpdatePipeResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the pipe.
    UpdatePipeResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdatePipeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePipeResponse -> UpdatePipeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePipeResponse -> UpdatePipeResponse -> Bool
$c/= :: UpdatePipeResponse -> UpdatePipeResponse -> Bool
== :: UpdatePipeResponse -> UpdatePipeResponse -> Bool
$c== :: UpdatePipeResponse -> UpdatePipeResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePipeResponse]
ReadPrec UpdatePipeResponse
Int -> ReadS UpdatePipeResponse
ReadS [UpdatePipeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePipeResponse]
$creadListPrec :: ReadPrec [UpdatePipeResponse]
readPrec :: ReadPrec UpdatePipeResponse
$creadPrec :: ReadPrec UpdatePipeResponse
readList :: ReadS [UpdatePipeResponse]
$creadList :: ReadS [UpdatePipeResponse]
readsPrec :: Int -> ReadS UpdatePipeResponse
$creadsPrec :: Int -> ReadS UpdatePipeResponse
Prelude.Read, Int -> UpdatePipeResponse -> ShowS
[UpdatePipeResponse] -> ShowS
UpdatePipeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePipeResponse] -> ShowS
$cshowList :: [UpdatePipeResponse] -> ShowS
show :: UpdatePipeResponse -> String
$cshow :: UpdatePipeResponse -> String
showsPrec :: Int -> UpdatePipeResponse -> ShowS
$cshowsPrec :: Int -> UpdatePipeResponse -> ShowS
Prelude.Show, forall x. Rep UpdatePipeResponse x -> UpdatePipeResponse
forall x. UpdatePipeResponse -> Rep UpdatePipeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePipeResponse x -> UpdatePipeResponse
$cfrom :: forall x. UpdatePipeResponse -> Rep UpdatePipeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePipeResponse' 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:
--
-- 'arn', 'updatePipeResponse_arn' - The ARN of the pipe.
--
-- 'creationTime', 'updatePipeResponse_creationTime' - The time the pipe was created.
--
-- 'currentState', 'updatePipeResponse_currentState' - The state the pipe is in.
--
-- 'desiredState', 'updatePipeResponse_desiredState' - The state the pipe should be in.
--
-- 'lastModifiedTime', 'updatePipeResponse_lastModifiedTime' - When the pipe was last updated, in
-- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
-- (YYYY-MM-DDThh:mm:ss.sTZD).
--
-- 'name', 'updatePipeResponse_name' - The name of the pipe.
--
-- 'httpStatus', 'updatePipeResponse_httpStatus' - The response's http status code.
newUpdatePipeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePipeResponse
newUpdatePipeResponse :: Int -> UpdatePipeResponse
newUpdatePipeResponse Int
pHttpStatus_ =
  UpdatePipeResponse'
    { $sel:arn:UpdatePipeResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:UpdatePipeResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:currentState:UpdatePipeResponse' :: Maybe PipeState
currentState = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredState:UpdatePipeResponse' :: Maybe RequestedPipeState
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:UpdatePipeResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdatePipeResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePipeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the pipe.
updatePipeResponse_arn :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe Prelude.Text)
updatePipeResponse_arn :: Lens' UpdatePipeResponse (Maybe Text)
updatePipeResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe Text
a -> UpdatePipeResponse
s {$sel:arn:UpdatePipeResponse' :: Maybe Text
arn = Maybe Text
a} :: UpdatePipeResponse)

-- | The time the pipe was created.
updatePipeResponse_creationTime :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe Prelude.UTCTime)
updatePipeResponse_creationTime :: Lens' UpdatePipeResponse (Maybe UTCTime)
updatePipeResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe POSIX
a -> UpdatePipeResponse
s {$sel:creationTime:UpdatePipeResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: UpdatePipeResponse) 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 state the pipe is in.
updatePipeResponse_currentState :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe PipeState)
updatePipeResponse_currentState :: Lens' UpdatePipeResponse (Maybe PipeState)
updatePipeResponse_currentState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe PipeState
currentState :: Maybe PipeState
$sel:currentState:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe PipeState
currentState} -> Maybe PipeState
currentState) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe PipeState
a -> UpdatePipeResponse
s {$sel:currentState:UpdatePipeResponse' :: Maybe PipeState
currentState = Maybe PipeState
a} :: UpdatePipeResponse)

-- | The state the pipe should be in.
updatePipeResponse_desiredState :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe RequestedPipeState)
updatePipeResponse_desiredState :: Lens' UpdatePipeResponse (Maybe RequestedPipeState)
updatePipeResponse_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe RequestedPipeState
desiredState :: Maybe RequestedPipeState
$sel:desiredState:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe RequestedPipeState
desiredState} -> Maybe RequestedPipeState
desiredState) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe RequestedPipeState
a -> UpdatePipeResponse
s {$sel:desiredState:UpdatePipeResponse' :: Maybe RequestedPipeState
desiredState = Maybe RequestedPipeState
a} :: UpdatePipeResponse)

-- | When the pipe was last updated, in
-- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
-- (YYYY-MM-DDThh:mm:ss.sTZD).
updatePipeResponse_lastModifiedTime :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe Prelude.UTCTime)
updatePipeResponse_lastModifiedTime :: Lens' UpdatePipeResponse (Maybe UTCTime)
updatePipeResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe POSIX
a -> UpdatePipeResponse
s {$sel:lastModifiedTime:UpdatePipeResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: UpdatePipeResponse) 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 pipe.
updatePipeResponse_name :: Lens.Lens' UpdatePipeResponse (Prelude.Maybe Prelude.Text)
updatePipeResponse_name :: Lens' UpdatePipeResponse (Maybe Text)
updatePipeResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdatePipeResponse
s@UpdatePipeResponse' {} Maybe Text
a -> UpdatePipeResponse
s {$sel:name:UpdatePipeResponse' :: Maybe Text
name = Maybe Text
a} :: UpdatePipeResponse)

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

instance Prelude.NFData UpdatePipeResponse where
  rnf :: UpdatePipeResponse -> ()
rnf UpdatePipeResponse' {Int
Maybe Text
Maybe POSIX
Maybe PipeState
Maybe RequestedPipeState
httpStatus :: Int
name :: Maybe Text
lastModifiedTime :: Maybe POSIX
desiredState :: Maybe RequestedPipeState
currentState :: Maybe PipeState
creationTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:UpdatePipeResponse' :: UpdatePipeResponse -> Int
$sel:name:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe Text
$sel:lastModifiedTime:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe POSIX
$sel:desiredState:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe RequestedPipeState
$sel:currentState:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe PipeState
$sel:creationTime:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe POSIX
$sel:arn:UpdatePipeResponse' :: UpdatePipeResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 PipeState
currentState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestedPipeState
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      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 Int
httpStatus