{-# 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.SecurityLake.UpdateSubscriber
-- 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 subscription for the given Amazon Security Lake
-- account ID. You can update a subscriber by changing the sources that the
-- subscriber consumes data from.
module Amazonka.SecurityLake.UpdateSubscriber
  ( -- * Creating a Request
    UpdateSubscriber (..),
    newUpdateSubscriber,

    -- * Request Lenses
    updateSubscriber_externalId,
    updateSubscriber_subscriberDescription,
    updateSubscriber_subscriberName,
    updateSubscriber_id,
    updateSubscriber_sourceTypes,

    -- * Destructuring the Response
    UpdateSubscriberResponse (..),
    newUpdateSubscriberResponse,

    -- * Response Lenses
    updateSubscriberResponse_subscriber,
    updateSubscriberResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SecurityLake.Types

-- | /See:/ 'newUpdateSubscriber' smart constructor.
data UpdateSubscriber = UpdateSubscriber'
  { -- | The external ID of the Security Lake account.
    UpdateSubscriber -> Maybe Text
externalId :: Prelude.Maybe Prelude.Text,
    -- | The description of the Security Lake account subscriber.
    UpdateSubscriber -> Maybe Text
subscriberDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the Security Lake account subscriber.
    UpdateSubscriber -> Maybe Text
subscriberName :: Prelude.Maybe Prelude.Text,
    -- | A value created by Security Lake that uniquely identifies your
    -- subscription.
    UpdateSubscriber -> Text
id :: Prelude.Text,
    -- | The supported Amazon Web Services from which logs and events are
    -- collected. For the list of supported Amazon Web Services, see the
    -- <https://docs.aws.amazon.com/security-lake/latest/userguide/internal-sources.html Amazon Security Lake User Guide>.
    UpdateSubscriber -> [SourceType]
sourceTypes :: [SourceType]
  }
  deriving (UpdateSubscriber -> UpdateSubscriber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSubscriber -> UpdateSubscriber -> Bool
$c/= :: UpdateSubscriber -> UpdateSubscriber -> Bool
== :: UpdateSubscriber -> UpdateSubscriber -> Bool
$c== :: UpdateSubscriber -> UpdateSubscriber -> Bool
Prelude.Eq, ReadPrec [UpdateSubscriber]
ReadPrec UpdateSubscriber
Int -> ReadS UpdateSubscriber
ReadS [UpdateSubscriber]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSubscriber]
$creadListPrec :: ReadPrec [UpdateSubscriber]
readPrec :: ReadPrec UpdateSubscriber
$creadPrec :: ReadPrec UpdateSubscriber
readList :: ReadS [UpdateSubscriber]
$creadList :: ReadS [UpdateSubscriber]
readsPrec :: Int -> ReadS UpdateSubscriber
$creadsPrec :: Int -> ReadS UpdateSubscriber
Prelude.Read, Int -> UpdateSubscriber -> ShowS
[UpdateSubscriber] -> ShowS
UpdateSubscriber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSubscriber] -> ShowS
$cshowList :: [UpdateSubscriber] -> ShowS
show :: UpdateSubscriber -> String
$cshow :: UpdateSubscriber -> String
showsPrec :: Int -> UpdateSubscriber -> ShowS
$cshowsPrec :: Int -> UpdateSubscriber -> ShowS
Prelude.Show, forall x. Rep UpdateSubscriber x -> UpdateSubscriber
forall x. UpdateSubscriber -> Rep UpdateSubscriber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSubscriber x -> UpdateSubscriber
$cfrom :: forall x. UpdateSubscriber -> Rep UpdateSubscriber x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSubscriber' 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:
--
-- 'externalId', 'updateSubscriber_externalId' - The external ID of the Security Lake account.
--
-- 'subscriberDescription', 'updateSubscriber_subscriberDescription' - The description of the Security Lake account subscriber.
--
-- 'subscriberName', 'updateSubscriber_subscriberName' - The name of the Security Lake account subscriber.
--
-- 'id', 'updateSubscriber_id' - A value created by Security Lake that uniquely identifies your
-- subscription.
--
-- 'sourceTypes', 'updateSubscriber_sourceTypes' - The supported Amazon Web Services from which logs and events are
-- collected. For the list of supported Amazon Web Services, see the
-- <https://docs.aws.amazon.com/security-lake/latest/userguide/internal-sources.html Amazon Security Lake User Guide>.
newUpdateSubscriber ::
  -- | 'id'
  Prelude.Text ->
  UpdateSubscriber
newUpdateSubscriber :: Text -> UpdateSubscriber
newUpdateSubscriber Text
pId_ =
  UpdateSubscriber'
    { $sel:externalId:UpdateSubscriber' :: Maybe Text
externalId = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriberDescription:UpdateSubscriber' :: Maybe Text
subscriberDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriberName:UpdateSubscriber' :: Maybe Text
subscriberName = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateSubscriber' :: Text
id = Text
pId_,
      $sel:sourceTypes:UpdateSubscriber' :: [SourceType]
sourceTypes = forall a. Monoid a => a
Prelude.mempty
    }

-- | The external ID of the Security Lake account.
updateSubscriber_externalId :: Lens.Lens' UpdateSubscriber (Prelude.Maybe Prelude.Text)
updateSubscriber_externalId :: Lens' UpdateSubscriber (Maybe Text)
updateSubscriber_externalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriber' {Maybe Text
externalId :: Maybe Text
$sel:externalId:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
externalId} -> Maybe Text
externalId) (\s :: UpdateSubscriber
s@UpdateSubscriber' {} Maybe Text
a -> UpdateSubscriber
s {$sel:externalId:UpdateSubscriber' :: Maybe Text
externalId = Maybe Text
a} :: UpdateSubscriber)

-- | The description of the Security Lake account subscriber.
updateSubscriber_subscriberDescription :: Lens.Lens' UpdateSubscriber (Prelude.Maybe Prelude.Text)
updateSubscriber_subscriberDescription :: Lens' UpdateSubscriber (Maybe Text)
updateSubscriber_subscriberDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriber' {Maybe Text
subscriberDescription :: Maybe Text
$sel:subscriberDescription:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
subscriberDescription} -> Maybe Text
subscriberDescription) (\s :: UpdateSubscriber
s@UpdateSubscriber' {} Maybe Text
a -> UpdateSubscriber
s {$sel:subscriberDescription:UpdateSubscriber' :: Maybe Text
subscriberDescription = Maybe Text
a} :: UpdateSubscriber)

-- | The name of the Security Lake account subscriber.
updateSubscriber_subscriberName :: Lens.Lens' UpdateSubscriber (Prelude.Maybe Prelude.Text)
updateSubscriber_subscriberName :: Lens' UpdateSubscriber (Maybe Text)
updateSubscriber_subscriberName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriber' {Maybe Text
subscriberName :: Maybe Text
$sel:subscriberName:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
subscriberName} -> Maybe Text
subscriberName) (\s :: UpdateSubscriber
s@UpdateSubscriber' {} Maybe Text
a -> UpdateSubscriber
s {$sel:subscriberName:UpdateSubscriber' :: Maybe Text
subscriberName = Maybe Text
a} :: UpdateSubscriber)

-- | A value created by Security Lake that uniquely identifies your
-- subscription.
updateSubscriber_id :: Lens.Lens' UpdateSubscriber Prelude.Text
updateSubscriber_id :: Lens' UpdateSubscriber Text
updateSubscriber_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriber' {Text
id :: Text
$sel:id:UpdateSubscriber' :: UpdateSubscriber -> Text
id} -> Text
id) (\s :: UpdateSubscriber
s@UpdateSubscriber' {} Text
a -> UpdateSubscriber
s {$sel:id:UpdateSubscriber' :: Text
id = Text
a} :: UpdateSubscriber)

-- | The supported Amazon Web Services from which logs and events are
-- collected. For the list of supported Amazon Web Services, see the
-- <https://docs.aws.amazon.com/security-lake/latest/userguide/internal-sources.html Amazon Security Lake User Guide>.
updateSubscriber_sourceTypes :: Lens.Lens' UpdateSubscriber [SourceType]
updateSubscriber_sourceTypes :: Lens' UpdateSubscriber [SourceType]
updateSubscriber_sourceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriber' {[SourceType]
sourceTypes :: [SourceType]
$sel:sourceTypes:UpdateSubscriber' :: UpdateSubscriber -> [SourceType]
sourceTypes} -> [SourceType]
sourceTypes) (\s :: UpdateSubscriber
s@UpdateSubscriber' {} [SourceType]
a -> UpdateSubscriber
s {$sel:sourceTypes:UpdateSubscriber' :: [SourceType]
sourceTypes = [SourceType]
a} :: UpdateSubscriber) 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 UpdateSubscriber where
  type
    AWSResponse UpdateSubscriber =
      UpdateSubscriberResponse
  request :: (Service -> Service)
-> UpdateSubscriber -> Request UpdateSubscriber
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 UpdateSubscriber
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateSubscriber)))
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 SubscriberResource -> Int -> UpdateSubscriberResponse
UpdateSubscriberResponse'
            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
"subscriber")
            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 UpdateSubscriber where
  hashWithSalt :: Int -> UpdateSubscriber -> Int
hashWithSalt Int
_salt UpdateSubscriber' {[SourceType]
Maybe Text
Text
sourceTypes :: [SourceType]
id :: Text
subscriberName :: Maybe Text
subscriberDescription :: Maybe Text
externalId :: Maybe Text
$sel:sourceTypes:UpdateSubscriber' :: UpdateSubscriber -> [SourceType]
$sel:id:UpdateSubscriber' :: UpdateSubscriber -> Text
$sel:subscriberName:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:subscriberDescription:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:externalId:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
externalId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subscriberDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subscriberName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [SourceType]
sourceTypes

instance Prelude.NFData UpdateSubscriber where
  rnf :: UpdateSubscriber -> ()
rnf UpdateSubscriber' {[SourceType]
Maybe Text
Text
sourceTypes :: [SourceType]
id :: Text
subscriberName :: Maybe Text
subscriberDescription :: Maybe Text
externalId :: Maybe Text
$sel:sourceTypes:UpdateSubscriber' :: UpdateSubscriber -> [SourceType]
$sel:id:UpdateSubscriber' :: UpdateSubscriber -> Text
$sel:subscriberName:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:subscriberDescription:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:externalId:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
externalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subscriberDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subscriberName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SourceType]
sourceTypes

instance Data.ToHeaders UpdateSubscriber where
  toHeaders :: UpdateSubscriber -> 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 UpdateSubscriber where
  toJSON :: UpdateSubscriber -> Value
toJSON UpdateSubscriber' {[SourceType]
Maybe Text
Text
sourceTypes :: [SourceType]
id :: Text
subscriberName :: Maybe Text
subscriberDescription :: Maybe Text
externalId :: Maybe Text
$sel:sourceTypes:UpdateSubscriber' :: UpdateSubscriber -> [SourceType]
$sel:id:UpdateSubscriber' :: UpdateSubscriber -> Text
$sel:subscriberName:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:subscriberDescription:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:externalId:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"externalId" 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
externalId,
            (Key
"subscriberDescription" 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
subscriberDescription,
            (Key
"subscriberName" 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
subscriberName,
            forall a. a -> Maybe a
Prelude.Just (Key
"sourceTypes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [SourceType]
sourceTypes)
          ]
      )

instance Data.ToPath UpdateSubscriber where
  toPath :: UpdateSubscriber -> ByteString
toPath UpdateSubscriber' {[SourceType]
Maybe Text
Text
sourceTypes :: [SourceType]
id :: Text
subscriberName :: Maybe Text
subscriberDescription :: Maybe Text
externalId :: Maybe Text
$sel:sourceTypes:UpdateSubscriber' :: UpdateSubscriber -> [SourceType]
$sel:id:UpdateSubscriber' :: UpdateSubscriber -> Text
$sel:subscriberName:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:subscriberDescription:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
$sel:externalId:UpdateSubscriber' :: UpdateSubscriber -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/v1/subscribers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

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

-- |
-- Create a value of 'UpdateSubscriberResponse' 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:
--
-- 'subscriber', 'updateSubscriberResponse_subscriber' - The account of the subscriber.
--
-- 'httpStatus', 'updateSubscriberResponse_httpStatus' - The response's http status code.
newUpdateSubscriberResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSubscriberResponse
newUpdateSubscriberResponse :: Int -> UpdateSubscriberResponse
newUpdateSubscriberResponse Int
pHttpStatus_ =
  UpdateSubscriberResponse'
    { $sel:subscriber:UpdateSubscriberResponse' :: Maybe SubscriberResource
subscriber =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSubscriberResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The account of the subscriber.
updateSubscriberResponse_subscriber :: Lens.Lens' UpdateSubscriberResponse (Prelude.Maybe SubscriberResource)
updateSubscriberResponse_subscriber :: Lens' UpdateSubscriberResponse (Maybe SubscriberResource)
updateSubscriberResponse_subscriber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubscriberResponse' {Maybe SubscriberResource
subscriber :: Maybe SubscriberResource
$sel:subscriber:UpdateSubscriberResponse' :: UpdateSubscriberResponse -> Maybe SubscriberResource
subscriber} -> Maybe SubscriberResource
subscriber) (\s :: UpdateSubscriberResponse
s@UpdateSubscriberResponse' {} Maybe SubscriberResource
a -> UpdateSubscriberResponse
s {$sel:subscriber:UpdateSubscriberResponse' :: Maybe SubscriberResource
subscriber = Maybe SubscriberResource
a} :: UpdateSubscriberResponse)

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

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