{-# 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.GetResourceEventConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the event configuration for a particular resource identifier.
module Amazonka.IoTWireless.GetResourceEventConfiguration
  ( -- * Creating a Request
    GetResourceEventConfiguration (..),
    newGetResourceEventConfiguration,

    -- * Request Lenses
    getResourceEventConfiguration_partnerType,
    getResourceEventConfiguration_identifier,
    getResourceEventConfiguration_identifierType,

    -- * Destructuring the Response
    GetResourceEventConfigurationResponse (..),
    newGetResourceEventConfigurationResponse,

    -- * Response Lenses
    getResourceEventConfigurationResponse_connectionStatus,
    getResourceEventConfigurationResponse_deviceRegistrationState,
    getResourceEventConfigurationResponse_join,
    getResourceEventConfigurationResponse_messageDeliveryStatus,
    getResourceEventConfigurationResponse_proximity,
    getResourceEventConfigurationResponse_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:/ 'newGetResourceEventConfiguration' smart constructor.
data GetResourceEventConfiguration = GetResourceEventConfiguration'
  { -- | Partner type of the resource if the identifier type is
    -- @PartnerAccountId@.
    GetResourceEventConfiguration -> Maybe EventNotificationPartnerType
partnerType :: Prelude.Maybe EventNotificationPartnerType,
    -- | Resource identifier to opt in for event messaging.
    GetResourceEventConfiguration -> Text
identifier :: Prelude.Text,
    -- | Identifier type of the particular resource identifier for event
    -- configuration.
    GetResourceEventConfiguration -> IdentifierType
identifierType :: IdentifierType
  }
  deriving (GetResourceEventConfiguration
-> GetResourceEventConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResourceEventConfiguration
-> GetResourceEventConfiguration -> Bool
$c/= :: GetResourceEventConfiguration
-> GetResourceEventConfiguration -> Bool
== :: GetResourceEventConfiguration
-> GetResourceEventConfiguration -> Bool
$c== :: GetResourceEventConfiguration
-> GetResourceEventConfiguration -> Bool
Prelude.Eq, ReadPrec [GetResourceEventConfiguration]
ReadPrec GetResourceEventConfiguration
Int -> ReadS GetResourceEventConfiguration
ReadS [GetResourceEventConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResourceEventConfiguration]
$creadListPrec :: ReadPrec [GetResourceEventConfiguration]
readPrec :: ReadPrec GetResourceEventConfiguration
$creadPrec :: ReadPrec GetResourceEventConfiguration
readList :: ReadS [GetResourceEventConfiguration]
$creadList :: ReadS [GetResourceEventConfiguration]
readsPrec :: Int -> ReadS GetResourceEventConfiguration
$creadsPrec :: Int -> ReadS GetResourceEventConfiguration
Prelude.Read, Int -> GetResourceEventConfiguration -> ShowS
[GetResourceEventConfiguration] -> ShowS
GetResourceEventConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResourceEventConfiguration] -> ShowS
$cshowList :: [GetResourceEventConfiguration] -> ShowS
show :: GetResourceEventConfiguration -> String
$cshow :: GetResourceEventConfiguration -> String
showsPrec :: Int -> GetResourceEventConfiguration -> ShowS
$cshowsPrec :: Int -> GetResourceEventConfiguration -> ShowS
Prelude.Show, forall x.
Rep GetResourceEventConfiguration x
-> GetResourceEventConfiguration
forall x.
GetResourceEventConfiguration
-> Rep GetResourceEventConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetResourceEventConfiguration x
-> GetResourceEventConfiguration
$cfrom :: forall x.
GetResourceEventConfiguration
-> Rep GetResourceEventConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetResourceEventConfiguration' 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:
--
-- 'partnerType', 'getResourceEventConfiguration_partnerType' - Partner type of the resource if the identifier type is
-- @PartnerAccountId@.
--
-- 'identifier', 'getResourceEventConfiguration_identifier' - Resource identifier to opt in for event messaging.
--
-- 'identifierType', 'getResourceEventConfiguration_identifierType' - Identifier type of the particular resource identifier for event
-- configuration.
newGetResourceEventConfiguration ::
  -- | 'identifier'
  Prelude.Text ->
  -- | 'identifierType'
  IdentifierType ->
  GetResourceEventConfiguration
newGetResourceEventConfiguration :: Text -> IdentifierType -> GetResourceEventConfiguration
newGetResourceEventConfiguration
  Text
pIdentifier_
  IdentifierType
pIdentifierType_ =
    GetResourceEventConfiguration'
      { $sel:partnerType:GetResourceEventConfiguration' :: Maybe EventNotificationPartnerType
partnerType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:identifier:GetResourceEventConfiguration' :: Text
identifier = Text
pIdentifier_,
        $sel:identifierType:GetResourceEventConfiguration' :: IdentifierType
identifierType = IdentifierType
pIdentifierType_
      }

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

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

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

instance
  Core.AWSRequest
    GetResourceEventConfiguration
  where
  type
    AWSResponse GetResourceEventConfiguration =
      GetResourceEventConfigurationResponse
  request :: (Service -> Service)
-> GetResourceEventConfiguration
-> Request GetResourceEventConfiguration
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetResourceEventConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetResourceEventConfiguration)))
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 ConnectionStatusEventConfiguration
-> Maybe DeviceRegistrationStateEventConfiguration
-> Maybe JoinEventConfiguration
-> Maybe MessageDeliveryStatusEventConfiguration
-> Maybe ProximityEventConfiguration
-> Int
-> GetResourceEventConfigurationResponse
GetResourceEventConfigurationResponse'
            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
"ConnectionStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DeviceRegistrationState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Join")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MessageDeliveryStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Proximity")
            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
    GetResourceEventConfiguration
  where
  hashWithSalt :: Int -> GetResourceEventConfiguration -> Int
hashWithSalt Int
_salt GetResourceEventConfiguration' {Maybe EventNotificationPartnerType
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
partnerType :: Maybe EventNotificationPartnerType
$sel:identifierType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> IdentifierType
$sel:identifier:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Text
$sel:partnerType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Maybe EventNotificationPartnerType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventNotificationPartnerType
partnerType
      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 GetResourceEventConfiguration where
  rnf :: GetResourceEventConfiguration -> ()
rnf GetResourceEventConfiguration' {Maybe EventNotificationPartnerType
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
partnerType :: Maybe EventNotificationPartnerType
$sel:identifierType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> IdentifierType
$sel:identifier:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Text
$sel:partnerType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Maybe EventNotificationPartnerType
..} =
    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 Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IdentifierType
identifierType

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

instance Data.ToPath GetResourceEventConfiguration where
  toPath :: GetResourceEventConfiguration -> ByteString
toPath GetResourceEventConfiguration' {Maybe EventNotificationPartnerType
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
partnerType :: Maybe EventNotificationPartnerType
$sel:identifierType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> IdentifierType
$sel:identifier:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Text
$sel:partnerType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Maybe EventNotificationPartnerType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/event-configurations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
identifier]

instance Data.ToQuery GetResourceEventConfiguration where
  toQuery :: GetResourceEventConfiguration -> QueryString
toQuery GetResourceEventConfiguration' {Maybe EventNotificationPartnerType
Text
IdentifierType
identifierType :: IdentifierType
identifier :: Text
partnerType :: Maybe EventNotificationPartnerType
$sel:identifierType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> IdentifierType
$sel:identifier:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Text
$sel:partnerType:GetResourceEventConfiguration' :: GetResourceEventConfiguration -> Maybe EventNotificationPartnerType
..} =
    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:/ 'newGetResourceEventConfigurationResponse' smart constructor.
data GetResourceEventConfigurationResponse = GetResourceEventConfigurationResponse'
  { -- | Event configuration for the connection status event.
    GetResourceEventConfigurationResponse
-> Maybe ConnectionStatusEventConfiguration
connectionStatus :: Prelude.Maybe ConnectionStatusEventConfiguration,
    -- | Event configuration for the device registration state event.
    GetResourceEventConfigurationResponse
-> Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState :: Prelude.Maybe DeviceRegistrationStateEventConfiguration,
    -- | Event configuration for the join event.
    GetResourceEventConfigurationResponse
-> Maybe JoinEventConfiguration
join :: Prelude.Maybe JoinEventConfiguration,
    -- | Event configuration for the message delivery status event.
    GetResourceEventConfigurationResponse
-> Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus :: Prelude.Maybe MessageDeliveryStatusEventConfiguration,
    -- | Event configuration for the proximity event.
    GetResourceEventConfigurationResponse
-> Maybe ProximityEventConfiguration
proximity :: Prelude.Maybe ProximityEventConfiguration,
    -- | The response's http status code.
    GetResourceEventConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetResourceEventConfigurationResponse
-> GetResourceEventConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResourceEventConfigurationResponse
-> GetResourceEventConfigurationResponse -> Bool
$c/= :: GetResourceEventConfigurationResponse
-> GetResourceEventConfigurationResponse -> Bool
== :: GetResourceEventConfigurationResponse
-> GetResourceEventConfigurationResponse -> Bool
$c== :: GetResourceEventConfigurationResponse
-> GetResourceEventConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetResourceEventConfigurationResponse]
ReadPrec GetResourceEventConfigurationResponse
Int -> ReadS GetResourceEventConfigurationResponse
ReadS [GetResourceEventConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResourceEventConfigurationResponse]
$creadListPrec :: ReadPrec [GetResourceEventConfigurationResponse]
readPrec :: ReadPrec GetResourceEventConfigurationResponse
$creadPrec :: ReadPrec GetResourceEventConfigurationResponse
readList :: ReadS [GetResourceEventConfigurationResponse]
$creadList :: ReadS [GetResourceEventConfigurationResponse]
readsPrec :: Int -> ReadS GetResourceEventConfigurationResponse
$creadsPrec :: Int -> ReadS GetResourceEventConfigurationResponse
Prelude.Read, Int -> GetResourceEventConfigurationResponse -> ShowS
[GetResourceEventConfigurationResponse] -> ShowS
GetResourceEventConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResourceEventConfigurationResponse] -> ShowS
$cshowList :: [GetResourceEventConfigurationResponse] -> ShowS
show :: GetResourceEventConfigurationResponse -> String
$cshow :: GetResourceEventConfigurationResponse -> String
showsPrec :: Int -> GetResourceEventConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetResourceEventConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetResourceEventConfigurationResponse x
-> GetResourceEventConfigurationResponse
forall x.
GetResourceEventConfigurationResponse
-> Rep GetResourceEventConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetResourceEventConfigurationResponse x
-> GetResourceEventConfigurationResponse
$cfrom :: forall x.
GetResourceEventConfigurationResponse
-> Rep GetResourceEventConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetResourceEventConfigurationResponse' 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', 'getResourceEventConfigurationResponse_connectionStatus' - Event configuration for the connection status event.
--
-- 'deviceRegistrationState', 'getResourceEventConfigurationResponse_deviceRegistrationState' - Event configuration for the device registration state event.
--
-- 'join', 'getResourceEventConfigurationResponse_join' - Event configuration for the join event.
--
-- 'messageDeliveryStatus', 'getResourceEventConfigurationResponse_messageDeliveryStatus' - Event configuration for the message delivery status event.
--
-- 'proximity', 'getResourceEventConfigurationResponse_proximity' - Event configuration for the proximity event.
--
-- 'httpStatus', 'getResourceEventConfigurationResponse_httpStatus' - The response's http status code.
newGetResourceEventConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetResourceEventConfigurationResponse
newGetResourceEventConfigurationResponse :: Int -> GetResourceEventConfigurationResponse
newGetResourceEventConfigurationResponse Int
pHttpStatus_ =
  GetResourceEventConfigurationResponse'
    { $sel:connectionStatus:GetResourceEventConfigurationResponse' :: Maybe ConnectionStatusEventConfiguration
connectionStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deviceRegistrationState:GetResourceEventConfigurationResponse' :: Maybe DeviceRegistrationStateEventConfiguration
deviceRegistrationState =
        forall a. Maybe a
Prelude.Nothing,
      $sel:join:GetResourceEventConfigurationResponse' :: Maybe JoinEventConfiguration
join = forall a. Maybe a
Prelude.Nothing,
      $sel:messageDeliveryStatus:GetResourceEventConfigurationResponse' :: Maybe MessageDeliveryStatusEventConfiguration
messageDeliveryStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:proximity:GetResourceEventConfigurationResponse' :: Maybe ProximityEventConfiguration
proximity = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetResourceEventConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

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

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

instance
  Prelude.NFData
    GetResourceEventConfigurationResponse
  where
  rnf :: GetResourceEventConfigurationResponse -> ()
rnf GetResourceEventConfigurationResponse' {Int
Maybe ConnectionStatusEventConfiguration
Maybe JoinEventConfiguration
Maybe ProximityEventConfiguration
Maybe MessageDeliveryStatusEventConfiguration
Maybe DeviceRegistrationStateEventConfiguration
httpStatus :: Int
proximity :: Maybe ProximityEventConfiguration
messageDeliveryStatus :: Maybe MessageDeliveryStatusEventConfiguration
join :: Maybe JoinEventConfiguration
deviceRegistrationState :: Maybe DeviceRegistrationStateEventConfiguration
connectionStatus :: Maybe ConnectionStatusEventConfiguration
$sel:httpStatus:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse -> Int
$sel:proximity:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse
-> Maybe ProximityEventConfiguration
$sel:messageDeliveryStatus:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse
-> Maybe MessageDeliveryStatusEventConfiguration
$sel:join:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse
-> Maybe JoinEventConfiguration
$sel:deviceRegistrationState:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse
-> Maybe DeviceRegistrationStateEventConfiguration
$sel:connectionStatus:GetResourceEventConfigurationResponse' :: GetResourceEventConfigurationResponse
-> 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 ProximityEventConfiguration
proximity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus