{-# 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.Rekognition.UpdateStreamProcessor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows you to update a stream processor. You can change some settings
-- and regions of interest and delete certain parameters.
module Amazonka.Rekognition.UpdateStreamProcessor
  ( -- * Creating a Request
    UpdateStreamProcessor (..),
    newUpdateStreamProcessor,

    -- * Request Lenses
    updateStreamProcessor_dataSharingPreferenceForUpdate,
    updateStreamProcessor_parametersToDelete,
    updateStreamProcessor_regionsOfInterestForUpdate,
    updateStreamProcessor_settingsForUpdate,
    updateStreamProcessor_name,

    -- * Destructuring the Response
    UpdateStreamProcessorResponse (..),
    newUpdateStreamProcessorResponse,

    -- * Response Lenses
    updateStreamProcessorResponse_httpStatus,
  )
where

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 Amazonka.Rekognition.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateStreamProcessor' smart constructor.
data UpdateStreamProcessor = UpdateStreamProcessor'
  { -- | Shows whether you are sharing data with Rekognition to improve model
    -- performance. You can choose this option at the account level or on a
    -- per-stream basis. Note that if you opt out at the account level this
    -- setting is ignored on individual streams.
    UpdateStreamProcessor -> Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate :: Prelude.Maybe StreamProcessorDataSharingPreference,
    -- | A list of parameters you want to delete from the stream processor.
    UpdateStreamProcessor -> Maybe [StreamProcessorParameterToDelete]
parametersToDelete :: Prelude.Maybe [StreamProcessorParameterToDelete],
    -- | Specifies locations in the frames where Amazon Rekognition checks for
    -- objects or people. This is an optional parameter for label detection
    -- stream processors.
    UpdateStreamProcessor -> Maybe [RegionOfInterest]
regionsOfInterestForUpdate :: Prelude.Maybe [RegionOfInterest],
    -- | The stream processor settings that you want to update. Label detection
    -- settings can be updated to detect different labels with a different
    -- minimum confidence.
    UpdateStreamProcessor -> Maybe StreamProcessorSettingsForUpdate
settingsForUpdate :: Prelude.Maybe StreamProcessorSettingsForUpdate,
    -- | Name of the stream processor that you want to update.
    UpdateStreamProcessor -> Text
name :: Prelude.Text
  }
  deriving (UpdateStreamProcessor -> UpdateStreamProcessor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStreamProcessor -> UpdateStreamProcessor -> Bool
$c/= :: UpdateStreamProcessor -> UpdateStreamProcessor -> Bool
== :: UpdateStreamProcessor -> UpdateStreamProcessor -> Bool
$c== :: UpdateStreamProcessor -> UpdateStreamProcessor -> Bool
Prelude.Eq, ReadPrec [UpdateStreamProcessor]
ReadPrec UpdateStreamProcessor
Int -> ReadS UpdateStreamProcessor
ReadS [UpdateStreamProcessor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStreamProcessor]
$creadListPrec :: ReadPrec [UpdateStreamProcessor]
readPrec :: ReadPrec UpdateStreamProcessor
$creadPrec :: ReadPrec UpdateStreamProcessor
readList :: ReadS [UpdateStreamProcessor]
$creadList :: ReadS [UpdateStreamProcessor]
readsPrec :: Int -> ReadS UpdateStreamProcessor
$creadsPrec :: Int -> ReadS UpdateStreamProcessor
Prelude.Read, Int -> UpdateStreamProcessor -> ShowS
[UpdateStreamProcessor] -> ShowS
UpdateStreamProcessor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStreamProcessor] -> ShowS
$cshowList :: [UpdateStreamProcessor] -> ShowS
show :: UpdateStreamProcessor -> String
$cshow :: UpdateStreamProcessor -> String
showsPrec :: Int -> UpdateStreamProcessor -> ShowS
$cshowsPrec :: Int -> UpdateStreamProcessor -> ShowS
Prelude.Show, forall x. Rep UpdateStreamProcessor x -> UpdateStreamProcessor
forall x. UpdateStreamProcessor -> Rep UpdateStreamProcessor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateStreamProcessor x -> UpdateStreamProcessor
$cfrom :: forall x. UpdateStreamProcessor -> Rep UpdateStreamProcessor x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStreamProcessor' 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:
--
-- 'dataSharingPreferenceForUpdate', 'updateStreamProcessor_dataSharingPreferenceForUpdate' - Shows whether you are sharing data with Rekognition to improve model
-- performance. You can choose this option at the account level or on a
-- per-stream basis. Note that if you opt out at the account level this
-- setting is ignored on individual streams.
--
-- 'parametersToDelete', 'updateStreamProcessor_parametersToDelete' - A list of parameters you want to delete from the stream processor.
--
-- 'regionsOfInterestForUpdate', 'updateStreamProcessor_regionsOfInterestForUpdate' - Specifies locations in the frames where Amazon Rekognition checks for
-- objects or people. This is an optional parameter for label detection
-- stream processors.
--
-- 'settingsForUpdate', 'updateStreamProcessor_settingsForUpdate' - The stream processor settings that you want to update. Label detection
-- settings can be updated to detect different labels with a different
-- minimum confidence.
--
-- 'name', 'updateStreamProcessor_name' - Name of the stream processor that you want to update.
newUpdateStreamProcessor ::
  -- | 'name'
  Prelude.Text ->
  UpdateStreamProcessor
newUpdateStreamProcessor :: Text -> UpdateStreamProcessor
newUpdateStreamProcessor Text
pName_ =
  UpdateStreamProcessor'
    { $sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:parametersToDelete:UpdateStreamProcessor' :: Maybe [StreamProcessorParameterToDelete]
parametersToDelete = forall a. Maybe a
Prelude.Nothing,
      $sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: Maybe [RegionOfInterest]
regionsOfInterestForUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:settingsForUpdate:UpdateStreamProcessor' :: Maybe StreamProcessorSettingsForUpdate
settingsForUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateStreamProcessor' :: Text
name = Text
pName_
    }

-- | Shows whether you are sharing data with Rekognition to improve model
-- performance. You can choose this option at the account level or on a
-- per-stream basis. Note that if you opt out at the account level this
-- setting is ignored on individual streams.
updateStreamProcessor_dataSharingPreferenceForUpdate :: Lens.Lens' UpdateStreamProcessor (Prelude.Maybe StreamProcessorDataSharingPreference)
updateStreamProcessor_dataSharingPreferenceForUpdate :: Lens'
  UpdateStreamProcessor (Maybe StreamProcessorDataSharingPreference)
updateStreamProcessor_dataSharingPreferenceForUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStreamProcessor' {Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate :: Maybe StreamProcessorDataSharingPreference
$sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate} -> Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate) (\s :: UpdateStreamProcessor
s@UpdateStreamProcessor' {} Maybe StreamProcessorDataSharingPreference
a -> UpdateStreamProcessor
s {$sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate = Maybe StreamProcessorDataSharingPreference
a} :: UpdateStreamProcessor)

-- | A list of parameters you want to delete from the stream processor.
updateStreamProcessor_parametersToDelete :: Lens.Lens' UpdateStreamProcessor (Prelude.Maybe [StreamProcessorParameterToDelete])
updateStreamProcessor_parametersToDelete :: Lens'
  UpdateStreamProcessor (Maybe [StreamProcessorParameterToDelete])
updateStreamProcessor_parametersToDelete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStreamProcessor' {Maybe [StreamProcessorParameterToDelete]
parametersToDelete :: Maybe [StreamProcessorParameterToDelete]
$sel:parametersToDelete:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [StreamProcessorParameterToDelete]
parametersToDelete} -> Maybe [StreamProcessorParameterToDelete]
parametersToDelete) (\s :: UpdateStreamProcessor
s@UpdateStreamProcessor' {} Maybe [StreamProcessorParameterToDelete]
a -> UpdateStreamProcessor
s {$sel:parametersToDelete:UpdateStreamProcessor' :: Maybe [StreamProcessorParameterToDelete]
parametersToDelete = Maybe [StreamProcessorParameterToDelete]
a} :: UpdateStreamProcessor) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies locations in the frames where Amazon Rekognition checks for
-- objects or people. This is an optional parameter for label detection
-- stream processors.
updateStreamProcessor_regionsOfInterestForUpdate :: Lens.Lens' UpdateStreamProcessor (Prelude.Maybe [RegionOfInterest])
updateStreamProcessor_regionsOfInterestForUpdate :: Lens' UpdateStreamProcessor (Maybe [RegionOfInterest])
updateStreamProcessor_regionsOfInterestForUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStreamProcessor' {Maybe [RegionOfInterest]
regionsOfInterestForUpdate :: Maybe [RegionOfInterest]
$sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [RegionOfInterest]
regionsOfInterestForUpdate} -> Maybe [RegionOfInterest]
regionsOfInterestForUpdate) (\s :: UpdateStreamProcessor
s@UpdateStreamProcessor' {} Maybe [RegionOfInterest]
a -> UpdateStreamProcessor
s {$sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: Maybe [RegionOfInterest]
regionsOfInterestForUpdate = Maybe [RegionOfInterest]
a} :: UpdateStreamProcessor) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The stream processor settings that you want to update. Label detection
-- settings can be updated to detect different labels with a different
-- minimum confidence.
updateStreamProcessor_settingsForUpdate :: Lens.Lens' UpdateStreamProcessor (Prelude.Maybe StreamProcessorSettingsForUpdate)
updateStreamProcessor_settingsForUpdate :: Lens'
  UpdateStreamProcessor (Maybe StreamProcessorSettingsForUpdate)
updateStreamProcessor_settingsForUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStreamProcessor' {Maybe StreamProcessorSettingsForUpdate
settingsForUpdate :: Maybe StreamProcessorSettingsForUpdate
$sel:settingsForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorSettingsForUpdate
settingsForUpdate} -> Maybe StreamProcessorSettingsForUpdate
settingsForUpdate) (\s :: UpdateStreamProcessor
s@UpdateStreamProcessor' {} Maybe StreamProcessorSettingsForUpdate
a -> UpdateStreamProcessor
s {$sel:settingsForUpdate:UpdateStreamProcessor' :: Maybe StreamProcessorSettingsForUpdate
settingsForUpdate = Maybe StreamProcessorSettingsForUpdate
a} :: UpdateStreamProcessor)

-- | Name of the stream processor that you want to update.
updateStreamProcessor_name :: Lens.Lens' UpdateStreamProcessor Prelude.Text
updateStreamProcessor_name :: Lens' UpdateStreamProcessor Text
updateStreamProcessor_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStreamProcessor' {Text
name :: Text
$sel:name:UpdateStreamProcessor' :: UpdateStreamProcessor -> Text
name} -> Text
name) (\s :: UpdateStreamProcessor
s@UpdateStreamProcessor' {} Text
a -> UpdateStreamProcessor
s {$sel:name:UpdateStreamProcessor' :: Text
name = Text
a} :: UpdateStreamProcessor)

instance Core.AWSRequest UpdateStreamProcessor where
  type
    AWSResponse UpdateStreamProcessor =
      UpdateStreamProcessorResponse
  request :: (Service -> Service)
-> UpdateStreamProcessor -> Request UpdateStreamProcessor
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 UpdateStreamProcessor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateStreamProcessor)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateStreamProcessorResponse
UpdateStreamProcessorResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateStreamProcessor where
  hashWithSalt :: Int -> UpdateStreamProcessor -> Int
hashWithSalt Int
_salt UpdateStreamProcessor' {Maybe [RegionOfInterest]
Maybe [StreamProcessorParameterToDelete]
Maybe StreamProcessorDataSharingPreference
Maybe StreamProcessorSettingsForUpdate
Text
name :: Text
settingsForUpdate :: Maybe StreamProcessorSettingsForUpdate
regionsOfInterestForUpdate :: Maybe [RegionOfInterest]
parametersToDelete :: Maybe [StreamProcessorParameterToDelete]
dataSharingPreferenceForUpdate :: Maybe StreamProcessorDataSharingPreference
$sel:name:UpdateStreamProcessor' :: UpdateStreamProcessor -> Text
$sel:settingsForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorSettingsForUpdate
$sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [RegionOfInterest]
$sel:parametersToDelete:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [StreamProcessorParameterToDelete]
$sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorDataSharingPreference
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [StreamProcessorParameterToDelete]
parametersToDelete
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RegionOfInterest]
regionsOfInterestForUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamProcessorSettingsForUpdate
settingsForUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateStreamProcessor where
  rnf :: UpdateStreamProcessor -> ()
rnf UpdateStreamProcessor' {Maybe [RegionOfInterest]
Maybe [StreamProcessorParameterToDelete]
Maybe StreamProcessorDataSharingPreference
Maybe StreamProcessorSettingsForUpdate
Text
name :: Text
settingsForUpdate :: Maybe StreamProcessorSettingsForUpdate
regionsOfInterestForUpdate :: Maybe [RegionOfInterest]
parametersToDelete :: Maybe [StreamProcessorParameterToDelete]
dataSharingPreferenceForUpdate :: Maybe StreamProcessorDataSharingPreference
$sel:name:UpdateStreamProcessor' :: UpdateStreamProcessor -> Text
$sel:settingsForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorSettingsForUpdate
$sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [RegionOfInterest]
$sel:parametersToDelete:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [StreamProcessorParameterToDelete]
$sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorDataSharingPreference
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [StreamProcessorParameterToDelete]
parametersToDelete
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RegionOfInterest]
regionsOfInterestForUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorSettingsForUpdate
settingsForUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON UpdateStreamProcessor where
  toJSON :: UpdateStreamProcessor -> Value
toJSON UpdateStreamProcessor' {Maybe [RegionOfInterest]
Maybe [StreamProcessorParameterToDelete]
Maybe StreamProcessorDataSharingPreference
Maybe StreamProcessorSettingsForUpdate
Text
name :: Text
settingsForUpdate :: Maybe StreamProcessorSettingsForUpdate
regionsOfInterestForUpdate :: Maybe [RegionOfInterest]
parametersToDelete :: Maybe [StreamProcessorParameterToDelete]
dataSharingPreferenceForUpdate :: Maybe StreamProcessorDataSharingPreference
$sel:name:UpdateStreamProcessor' :: UpdateStreamProcessor -> Text
$sel:settingsForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorSettingsForUpdate
$sel:regionsOfInterestForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [RegionOfInterest]
$sel:parametersToDelete:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe [StreamProcessorParameterToDelete]
$sel:dataSharingPreferenceForUpdate:UpdateStreamProcessor' :: UpdateStreamProcessor -> Maybe StreamProcessorDataSharingPreference
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataSharingPreferenceForUpdate" 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 StreamProcessorDataSharingPreference
dataSharingPreferenceForUpdate,
            (Key
"ParametersToDelete" 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 [StreamProcessorParameterToDelete]
parametersToDelete,
            (Key
"RegionsOfInterestForUpdate" 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 [RegionOfInterest]
regionsOfInterestForUpdate,
            (Key
"SettingsForUpdate" 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 StreamProcessorSettingsForUpdate
settingsForUpdate,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateStreamProcessorResponse' 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:
--
-- 'httpStatus', 'updateStreamProcessorResponse_httpStatus' - The response's http status code.
newUpdateStreamProcessorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateStreamProcessorResponse
newUpdateStreamProcessorResponse :: Int -> UpdateStreamProcessorResponse
newUpdateStreamProcessorResponse Int
pHttpStatus_ =
  UpdateStreamProcessorResponse'
    { $sel:httpStatus:UpdateStreamProcessorResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateStreamProcessorResponse where
  rnf :: UpdateStreamProcessorResponse -> ()
rnf UpdateStreamProcessorResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateStreamProcessorResponse' :: UpdateStreamProcessorResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus