{-# 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.IoTAnalytics.UpdatePipeline
-- 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 the settings of a pipeline. You must specify both a @channel@
-- and a @datastore@ activity and, optionally, as many as 23 additional
-- activities in the @pipelineActivities@ array.
module Amazonka.IoTAnalytics.UpdatePipeline
  ( -- * Creating a Request
    UpdatePipeline (..),
    newUpdatePipeline,

    -- * Request Lenses
    updatePipeline_pipelineName,
    updatePipeline_pipelineActivities,

    -- * Destructuring the Response
    UpdatePipelineResponse (..),
    newUpdatePipelineResponse,
  )
where

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

-- | /See:/ 'newUpdatePipeline' smart constructor.
data UpdatePipeline = UpdatePipeline'
  { -- | The name of the pipeline to update.
    UpdatePipeline -> Text
pipelineName :: Prelude.Text,
    -- | A list of @PipelineActivity@ objects. Activities perform transformations
    -- on your messages, such as removing, renaming or adding message
    -- attributes; filtering messages based on attribute values; invoking your
    -- Lambda functions on messages for advanced processing; or performing
    -- mathematical transformations to normalize device data.
    --
    -- The list can be 2-25 @PipelineActivity@ objects and must contain both a
    -- @channel@ and a @datastore@ activity. Each entry in the list must
    -- contain only one activity. For example:
    --
    -- @pipelineActivities = [ { \"channel\": { ... } }, { \"lambda\": { ... } }, ... ]@
    UpdatePipeline -> NonEmpty PipelineActivity
pipelineActivities :: Prelude.NonEmpty PipelineActivity
  }
  deriving (UpdatePipeline -> UpdatePipeline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePipeline -> UpdatePipeline -> Bool
$c/= :: UpdatePipeline -> UpdatePipeline -> Bool
== :: UpdatePipeline -> UpdatePipeline -> Bool
$c== :: UpdatePipeline -> UpdatePipeline -> Bool
Prelude.Eq, ReadPrec [UpdatePipeline]
ReadPrec UpdatePipeline
Int -> ReadS UpdatePipeline
ReadS [UpdatePipeline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePipeline]
$creadListPrec :: ReadPrec [UpdatePipeline]
readPrec :: ReadPrec UpdatePipeline
$creadPrec :: ReadPrec UpdatePipeline
readList :: ReadS [UpdatePipeline]
$creadList :: ReadS [UpdatePipeline]
readsPrec :: Int -> ReadS UpdatePipeline
$creadsPrec :: Int -> ReadS UpdatePipeline
Prelude.Read, Int -> UpdatePipeline -> ShowS
[UpdatePipeline] -> ShowS
UpdatePipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePipeline] -> ShowS
$cshowList :: [UpdatePipeline] -> ShowS
show :: UpdatePipeline -> String
$cshow :: UpdatePipeline -> String
showsPrec :: Int -> UpdatePipeline -> ShowS
$cshowsPrec :: Int -> UpdatePipeline -> ShowS
Prelude.Show, forall x. Rep UpdatePipeline x -> UpdatePipeline
forall x. UpdatePipeline -> Rep UpdatePipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePipeline x -> UpdatePipeline
$cfrom :: forall x. UpdatePipeline -> Rep UpdatePipeline x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePipeline' 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:
--
-- 'pipelineName', 'updatePipeline_pipelineName' - The name of the pipeline to update.
--
-- 'pipelineActivities', 'updatePipeline_pipelineActivities' - A list of @PipelineActivity@ objects. Activities perform transformations
-- on your messages, such as removing, renaming or adding message
-- attributes; filtering messages based on attribute values; invoking your
-- Lambda functions on messages for advanced processing; or performing
-- mathematical transformations to normalize device data.
--
-- The list can be 2-25 @PipelineActivity@ objects and must contain both a
-- @channel@ and a @datastore@ activity. Each entry in the list must
-- contain only one activity. For example:
--
-- @pipelineActivities = [ { \"channel\": { ... } }, { \"lambda\": { ... } }, ... ]@
newUpdatePipeline ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'pipelineActivities'
  Prelude.NonEmpty PipelineActivity ->
  UpdatePipeline
newUpdatePipeline :: Text -> NonEmpty PipelineActivity -> UpdatePipeline
newUpdatePipeline Text
pPipelineName_ NonEmpty PipelineActivity
pPipelineActivities_ =
  UpdatePipeline'
    { $sel:pipelineName:UpdatePipeline' :: Text
pipelineName = Text
pPipelineName_,
      $sel:pipelineActivities:UpdatePipeline' :: NonEmpty PipelineActivity
pipelineActivities =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PipelineActivity
pPipelineActivities_
    }

-- | The name of the pipeline to update.
updatePipeline_pipelineName :: Lens.Lens' UpdatePipeline Prelude.Text
updatePipeline_pipelineName :: Lens' UpdatePipeline Text
updatePipeline_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeline' {Text
pipelineName :: Text
$sel:pipelineName:UpdatePipeline' :: UpdatePipeline -> Text
pipelineName} -> Text
pipelineName) (\s :: UpdatePipeline
s@UpdatePipeline' {} Text
a -> UpdatePipeline
s {$sel:pipelineName:UpdatePipeline' :: Text
pipelineName = Text
a} :: UpdatePipeline)

-- | A list of @PipelineActivity@ objects. Activities perform transformations
-- on your messages, such as removing, renaming or adding message
-- attributes; filtering messages based on attribute values; invoking your
-- Lambda functions on messages for advanced processing; or performing
-- mathematical transformations to normalize device data.
--
-- The list can be 2-25 @PipelineActivity@ objects and must contain both a
-- @channel@ and a @datastore@ activity. Each entry in the list must
-- contain only one activity. For example:
--
-- @pipelineActivities = [ { \"channel\": { ... } }, { \"lambda\": { ... } }, ... ]@
updatePipeline_pipelineActivities :: Lens.Lens' UpdatePipeline (Prelude.NonEmpty PipelineActivity)
updatePipeline_pipelineActivities :: Lens' UpdatePipeline (NonEmpty PipelineActivity)
updatePipeline_pipelineActivities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePipeline' {NonEmpty PipelineActivity
pipelineActivities :: NonEmpty PipelineActivity
$sel:pipelineActivities:UpdatePipeline' :: UpdatePipeline -> NonEmpty PipelineActivity
pipelineActivities} -> NonEmpty PipelineActivity
pipelineActivities) (\s :: UpdatePipeline
s@UpdatePipeline' {} NonEmpty PipelineActivity
a -> UpdatePipeline
s {$sel:pipelineActivities:UpdatePipeline' :: NonEmpty PipelineActivity
pipelineActivities = NonEmpty PipelineActivity
a} :: UpdatePipeline) 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 UpdatePipeline where
  type
    AWSResponse UpdatePipeline =
      UpdatePipelineResponse
  request :: (Service -> Service) -> UpdatePipeline -> Request UpdatePipeline
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 UpdatePipeline
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePipeline)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdatePipelineResponse
UpdatePipelineResponse'

instance Prelude.Hashable UpdatePipeline where
  hashWithSalt :: Int -> UpdatePipeline -> Int
hashWithSalt Int
_salt UpdatePipeline' {NonEmpty PipelineActivity
Text
pipelineActivities :: NonEmpty PipelineActivity
pipelineName :: Text
$sel:pipelineActivities:UpdatePipeline' :: UpdatePipeline -> NonEmpty PipelineActivity
$sel:pipelineName:UpdatePipeline' :: UpdatePipeline -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PipelineActivity
pipelineActivities

instance Prelude.NFData UpdatePipeline where
  rnf :: UpdatePipeline -> ()
rnf UpdatePipeline' {NonEmpty PipelineActivity
Text
pipelineActivities :: NonEmpty PipelineActivity
pipelineName :: Text
$sel:pipelineActivities:UpdatePipeline' :: UpdatePipeline -> NonEmpty PipelineActivity
$sel:pipelineName:UpdatePipeline' :: UpdatePipeline -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PipelineActivity
pipelineActivities

instance Data.ToHeaders UpdatePipeline where
  toHeaders :: UpdatePipeline -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToPath UpdatePipeline where
  toPath :: UpdatePipeline -> ByteString
toPath UpdatePipeline' {NonEmpty PipelineActivity
Text
pipelineActivities :: NonEmpty PipelineActivity
pipelineName :: Text
$sel:pipelineActivities:UpdatePipeline' :: UpdatePipeline -> NonEmpty PipelineActivity
$sel:pipelineName:UpdatePipeline' :: UpdatePipeline -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/pipelines/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
pipelineName]

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

-- | /See:/ 'newUpdatePipelineResponse' smart constructor.
data UpdatePipelineResponse = UpdatePipelineResponse'
  {
  }
  deriving (UpdatePipelineResponse -> UpdatePipelineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePipelineResponse -> UpdatePipelineResponse -> Bool
$c/= :: UpdatePipelineResponse -> UpdatePipelineResponse -> Bool
== :: UpdatePipelineResponse -> UpdatePipelineResponse -> Bool
$c== :: UpdatePipelineResponse -> UpdatePipelineResponse -> Bool
Prelude.Eq, ReadPrec [UpdatePipelineResponse]
ReadPrec UpdatePipelineResponse
Int -> ReadS UpdatePipelineResponse
ReadS [UpdatePipelineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePipelineResponse]
$creadListPrec :: ReadPrec [UpdatePipelineResponse]
readPrec :: ReadPrec UpdatePipelineResponse
$creadPrec :: ReadPrec UpdatePipelineResponse
readList :: ReadS [UpdatePipelineResponse]
$creadList :: ReadS [UpdatePipelineResponse]
readsPrec :: Int -> ReadS UpdatePipelineResponse
$creadsPrec :: Int -> ReadS UpdatePipelineResponse
Prelude.Read, Int -> UpdatePipelineResponse -> ShowS
[UpdatePipelineResponse] -> ShowS
UpdatePipelineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePipelineResponse] -> ShowS
$cshowList :: [UpdatePipelineResponse] -> ShowS
show :: UpdatePipelineResponse -> String
$cshow :: UpdatePipelineResponse -> String
showsPrec :: Int -> UpdatePipelineResponse -> ShowS
$cshowsPrec :: Int -> UpdatePipelineResponse -> ShowS
Prelude.Show, forall x. Rep UpdatePipelineResponse x -> UpdatePipelineResponse
forall x. UpdatePipelineResponse -> Rep UpdatePipelineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePipelineResponse x -> UpdatePipelineResponse
$cfrom :: forall x. UpdatePipelineResponse -> Rep UpdatePipelineResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePipelineResponse' 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.
newUpdatePipelineResponse ::
  UpdatePipelineResponse
newUpdatePipelineResponse :: UpdatePipelineResponse
newUpdatePipelineResponse = UpdatePipelineResponse
UpdatePipelineResponse'

instance Prelude.NFData UpdatePipelineResponse where
  rnf :: UpdatePipelineResponse -> ()
rnf UpdatePipelineResponse
_ = ()