{-# 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.IoTWireless.UpdateResourceEventConfiguration
-- 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 the event configuration for a particular resource identifier.
module Amazonka.IoTWireless.UpdateResourceEventConfiguration
  ( -- * Creating a Request
    UpdateResourceEventConfiguration (..),
    newUpdateResourceEventConfiguration,

    -- * Request Lenses
    updateResourceEventConfiguration_connectionStatus,
    updateResourceEventConfiguration_deviceRegistrationState,
    updateResourceEventConfiguration_join,
    updateResourceEventConfiguration_messageDeliveryStatus,
    updateResourceEventConfiguration_partnerType,
    updateResourceEventConfiguration_proximity,
    updateResourceEventConfiguration_identifier,
    updateResourceEventConfiguration_identifierType,

    -- * Destructuring the Response
    UpdateResourceEventConfigurationResponse (..),
    newUpdateResourceEventConfigurationResponse,

    -- * Response Lenses
    updateResourceEventConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateResourceEventConfiguration' smart constructor.
data UpdateResourceEventConfiguration = UpdateResourceEventConfiguration'
  { -- | Event configuration for the connection status event.
    UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
connectionStatus :: Prelude.Maybe ConnectionStatusEventConfiguration,
    -- | Event configuration for the device registration state event.
    UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState :: Prelude.Maybe DeviceRegistrationStateEventConfiguration,
    -- | Event configuration for the join event.
    UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
join :: Prelude.Maybe JoinEventConfiguration,
    -- | Event configuration for the message delivery status event.
    UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus :: Prelude.Maybe MessageDeliveryStatusEventConfiguration,
    -- | Partner type of the resource if the identifier type is
    -- @PartnerAccountId@
    UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
partnerType :: Prelude.Maybe EventNotificationPartnerType,
    -- | Event configuration for the proximity event.
    UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
proximity :: Prelude.Maybe ProximityEventConfiguration,
    -- | Resource identifier to opt in for event messaging.
    UpdateResourceEventConfiguration -> Text
identifier :: Prelude.Text,
    -- | Identifier type of the particular resource identifier for event
    -- configuration.
    UpdateResourceEventConfiguration -> IdentifierType
identifierType :: IdentifierType
  }
  deriving (UpdateResourceEventConfiguration
-> UpdateResourceEventConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateResourceEventConfiguration
-> UpdateResourceEventConfiguration -> Bool
$c/= :: UpdateResourceEventConfiguration
-> UpdateResourceEventConfiguration -> Bool
== :: UpdateResourceEventConfiguration
-> UpdateResourceEventConfiguration -> Bool
$c== :: UpdateResourceEventConfiguration
-> UpdateResourceEventConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateResourceEventConfiguration]
ReadPrec UpdateResourceEventConfiguration
Int -> ReadS UpdateResourceEventConfiguration
ReadS [UpdateResourceEventConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateResourceEventConfiguration]
$creadListPrec :: ReadPrec [UpdateResourceEventConfiguration]
readPrec :: ReadPrec UpdateResourceEventConfiguration
$creadPrec :: ReadPrec UpdateResourceEventConfiguration
readList :: ReadS [UpdateResourceEventConfiguration]
$creadList :: ReadS [UpdateResourceEventConfiguration]
readsPrec :: Int -> ReadS UpdateResourceEventConfiguration
$creadsPrec :: Int -> ReadS UpdateResourceEventConfiguration
Prelude.Read, Int -> UpdateResourceEventConfiguration -> ShowS
[UpdateResourceEventConfiguration] -> ShowS
UpdateResourceEventConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateResourceEventConfiguration] -> ShowS
$cshowList :: [UpdateResourceEventConfiguration] -> ShowS
show :: UpdateResourceEventConfiguration -> String
$cshow :: UpdateResourceEventConfiguration -> String
showsPrec :: Int -> UpdateResourceEventConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateResourceEventConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateResourceEventConfiguration x
-> UpdateResourceEventConfiguration
forall x.
UpdateResourceEventConfiguration
-> Rep UpdateResourceEventConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateResourceEventConfiguration x
-> UpdateResourceEventConfiguration
$cfrom :: forall x.
UpdateResourceEventConfiguration
-> Rep UpdateResourceEventConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateResourceEventConfiguration' 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:
--
-- 'connectionStatus', 'updateResourceEventConfiguration_connectionStatus' - Event configuration for the connection status event.
--
-- 'deviceRegistrationState', 'updateResourceEventConfiguration_deviceRegistrationState' - Event configuration for the device registration state event.
--
-- 'join', 'updateResourceEventConfiguration_join' - Event configuration for the join event.
--
-- 'messageDeliveryStatus', 'updateResourceEventConfiguration_messageDeliveryStatus' - Event configuration for the message delivery status event.
--
-- 'partnerType', 'updateResourceEventConfiguration_partnerType' - Partner type of the resource if the identifier type is
-- @PartnerAccountId@
--
-- 'proximity', 'updateResourceEventConfiguration_proximity' - Event configuration for the proximity event.
--
-- 'identifier', 'updateResourceEventConfiguration_identifier' - Resource identifier to opt in for event messaging.
--
-- 'identifierType', 'updateResourceEventConfiguration_identifierType' - Identifier type of the particular resource identifier for event
-- configuration.
newUpdateResourceEventConfiguration ::
  -- | 'identifier'
  Prelude.Text ->
  -- | 'identifierType'
  IdentifierType ->
  UpdateResourceEventConfiguration
newUpdateResourceEventConfiguration :: Text -> IdentifierType -> UpdateResourceEventConfiguration
newUpdateResourceEventConfiguration
  Text
pIdentifier_
  IdentifierType
pIdentifierType_ =
    UpdateResourceEventConfiguration'
      { $sel:connectionStatus:UpdateResourceEventConfiguration' :: Maybe ConnectionStatusEventConfiguration
connectionStatus =
          forall a. Maybe a
Prelude.Nothing,
        $sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState = forall a. Maybe a
Prelude.Nothing,
        $sel:join:UpdateResourceEventConfiguration' :: Maybe JoinEventConfiguration
join = forall a. Maybe a
Prelude.Nothing,
        $sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:partnerType:UpdateResourceEventConfiguration' :: Maybe EventNotificationPartnerType
partnerType = forall a. Maybe a
Prelude.Nothing,
        $sel:proximity:UpdateResourceEventConfiguration' :: Maybe ProximityEventConfiguration
proximity = forall a. Maybe a
Prelude.Nothing,
        $sel:identifier:UpdateResourceEventConfiguration' :: Text
identifier = Text
pIdentifier_,
        $sel:identifierType:UpdateResourceEventConfiguration' :: IdentifierType
identifierType = IdentifierType
pIdentifierType_
      }

-- | Event configuration for the connection status event.
updateResourceEventConfiguration_connectionStatus :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe ConnectionStatusEventConfiguration)
updateResourceEventConfiguration_connectionStatus :: Lens'
  UpdateResourceEventConfiguration
  (Maybe ConnectionStatusEventConfiguration)
updateResourceEventConfiguration_connectionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe ConnectionStatusEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
connectionStatus} -> Maybe ConnectionStatusEventConfiguration
connectionStatus) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe ConnectionStatusEventConfiguration
a -> UpdateResourceEventConfiguration
s {$sel:connectionStatus:UpdateResourceEventConfiguration' :: Maybe ConnectionStatusEventConfiguration
connectionStatus = Maybe ConnectionStatusEventConfiguration
a} :: UpdateResourceEventConfiguration)

-- | Event configuration for the device registration state event.
updateResourceEventConfiguration_deviceRegistrationState :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe DeviceRegistrationStateEventConfiguration)
updateResourceEventConfiguration_deviceRegistrationState :: Lens'
  UpdateResourceEventConfiguration
  (Maybe DeviceRegistrationStateEventConfiguration)
updateResourceEventConfiguration_deviceRegistrationState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState} -> Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe DeviceRegistrationStateEventConfiguration
a -> UpdateResourceEventConfiguration
s {$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState = Maybe DeviceRegistrationStateEventConfiguration
a} :: UpdateResourceEventConfiguration)

-- | Event configuration for the join event.
updateResourceEventConfiguration_join :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe JoinEventConfiguration)
updateResourceEventConfiguration_join :: Lens'
  UpdateResourceEventConfiguration (Maybe JoinEventConfiguration)
updateResourceEventConfiguration_join = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe JoinEventConfiguration
join :: Maybe JoinEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
join} -> Maybe JoinEventConfiguration
join) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe JoinEventConfiguration
a -> UpdateResourceEventConfiguration
s {$sel:join:UpdateResourceEventConfiguration' :: Maybe JoinEventConfiguration
join = Maybe JoinEventConfiguration
a} :: UpdateResourceEventConfiguration)

-- | Event configuration for the message delivery status event.
updateResourceEventConfiguration_messageDeliveryStatus :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe MessageDeliveryStatusEventConfiguration)
updateResourceEventConfiguration_messageDeliveryStatus :: Lens'
  UpdateResourceEventConfiguration
  (Maybe MessageDeliveryStatusEventConfiguration)
updateResourceEventConfiguration_messageDeliveryStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus} -> Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe MessageDeliveryStatusEventConfiguration
a -> UpdateResourceEventConfiguration
s {$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus = Maybe MessageDeliveryStatusEventConfiguration
a} :: UpdateResourceEventConfiguration)

-- | Partner type of the resource if the identifier type is
-- @PartnerAccountId@
updateResourceEventConfiguration_partnerType :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe EventNotificationPartnerType)
updateResourceEventConfiguration_partnerType :: Lens'
  UpdateResourceEventConfiguration
  (Maybe EventNotificationPartnerType)
updateResourceEventConfiguration_partnerType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
partnerType :: Maybe EventNotificationPartnerType
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
partnerType} -> Maybe EventNotificationPartnerType
partnerType) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe EventNotificationPartnerType
a -> UpdateResourceEventConfiguration
s {$sel:partnerType:UpdateResourceEventConfiguration' :: Maybe EventNotificationPartnerType
partnerType = Maybe EventNotificationPartnerType
a} :: UpdateResourceEventConfiguration)

-- | Event configuration for the proximity event.
updateResourceEventConfiguration_proximity :: Lens.Lens' UpdateResourceEventConfiguration (Prelude.Maybe ProximityEventConfiguration)
updateResourceEventConfiguration_proximity :: Lens'
  UpdateResourceEventConfiguration
  (Maybe ProximityEventConfiguration)
updateResourceEventConfiguration_proximity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Maybe ProximityEventConfiguration
proximity :: Maybe ProximityEventConfiguration
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
proximity} -> Maybe ProximityEventConfiguration
proximity) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Maybe ProximityEventConfiguration
a -> UpdateResourceEventConfiguration
s {$sel:proximity:UpdateResourceEventConfiguration' :: Maybe ProximityEventConfiguration
proximity = Maybe ProximityEventConfiguration
a} :: UpdateResourceEventConfiguration)

-- | Resource identifier to opt in for event messaging.
updateResourceEventConfiguration_identifier :: Lens.Lens' UpdateResourceEventConfiguration Prelude.Text
updateResourceEventConfiguration_identifier :: Lens' UpdateResourceEventConfiguration Text
updateResourceEventConfiguration_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {Text
identifier :: Text
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
identifier} -> Text
identifier) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} Text
a -> UpdateResourceEventConfiguration
s {$sel:identifier:UpdateResourceEventConfiguration' :: Text
identifier = Text
a} :: UpdateResourceEventConfiguration)

-- | Identifier type of the particular resource identifier for event
-- configuration.
updateResourceEventConfiguration_identifierType :: Lens.Lens' UpdateResourceEventConfiguration IdentifierType
updateResourceEventConfiguration_identifierType :: Lens' UpdateResourceEventConfiguration IdentifierType
updateResourceEventConfiguration_identifierType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateResourceEventConfiguration' {IdentifierType
identifierType :: IdentifierType
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
identifierType} -> IdentifierType
identifierType) (\s :: UpdateResourceEventConfiguration
s@UpdateResourceEventConfiguration' {} IdentifierType
a -> UpdateResourceEventConfiguration
s {$sel:identifierType:UpdateResourceEventConfiguration' :: IdentifierType
identifierType = IdentifierType
a} :: UpdateResourceEventConfiguration)

instance
  Core.AWSRequest
    UpdateResourceEventConfiguration
  where
  type
    AWSResponse UpdateResourceEventConfiguration =
      UpdateResourceEventConfigurationResponse
  request :: (Service -> Service)
-> UpdateResourceEventConfiguration
-> Request UpdateResourceEventConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateResourceEventConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateResourceEventConfiguration)))
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 -> UpdateResourceEventConfigurationResponse
UpdateResourceEventConfigurationResponse'
            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
    UpdateResourceEventConfiguration
  where
  hashWithSalt :: Int -> UpdateResourceEventConfiguration -> Int
hashWithSalt
    Int
_salt
    UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
proximity :: Maybe ProximityEventConfiguration
partnerType :: Maybe EventNotificationPartnerType
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionStatusEventConfiguration
connectionStatus
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JoinEventConfiguration
join
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventNotificationPartnerType
partnerType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProximityEventConfiguration
proximity
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IdentifierType
identifierType

instance
  Prelude.NFData
    UpdateResourceEventConfiguration
  where
  rnf :: UpdateResourceEventConfiguration -> ()
rnf UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
proximity :: Maybe ProximityEventConfiguration
partnerType :: Maybe EventNotificationPartnerType
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionStatusEventConfiguration
connectionStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JoinEventConfiguration
join
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EventNotificationPartnerType
partnerType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProximityEventConfiguration
proximity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IdentifierType
identifierType

instance
  Data.ToHeaders
    UpdateResourceEventConfiguration
  where
  toHeaders :: UpdateResourceEventConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateResourceEventConfiguration where
  toJSON :: UpdateResourceEventConfiguration -> Value
toJSON UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
proximity :: Maybe ProximityEventConfiguration
partnerType :: Maybe EventNotificationPartnerType
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConnectionStatus" 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 ConnectionStatusEventConfiguration
connectionStatus,
            (Key
"DeviceRegistrationState" 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 DeviceRegistrationStateEventConfiguration
deviceRegistrationState,
            (Key
"Join" 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 JoinEventConfiguration
join,
            (Key
"MessageDeliveryStatus" 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 MessageDeliveryStatusEventConfiguration
messageDeliveryStatus,
            (Key
"Proximity" 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 ProximityEventConfiguration
proximity
          ]
      )

instance Data.ToPath UpdateResourceEventConfiguration where
  toPath :: UpdateResourceEventConfiguration -> ByteString
toPath UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
proximity :: Maybe ProximityEventConfiguration
partnerType :: Maybe EventNotificationPartnerType
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/event-configurations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
identifier]

instance
  Data.ToQuery
    UpdateResourceEventConfiguration
  where
  toQuery :: UpdateResourceEventConfiguration -> QueryString
toQuery UpdateResourceEventConfiguration' {Maybe EventNotificationPartnerType
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
proximity :: Maybe ProximityEventConfiguration
partnerType :: Maybe EventNotificationPartnerType
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:identifierType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> IdentifierType
$sel:identifier:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Text
$sel:proximity:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ProximityEventConfiguration
$sel:partnerType:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe EventNotificationPartnerType
$sel:messageDeliveryStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration -> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:UpdateResourceEventConfiguration' :: UpdateResourceEventConfiguration
-> Maybe ConnectionStatusEventConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"partnerType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe EventNotificationPartnerType
partnerType,
        ByteString
"identifierType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: IdentifierType
identifierType
      ]

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

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

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

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