{-# 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.FraudDetector.SendEvent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stores events in Amazon Fraud Detector without generating fraud
-- predictions for those events. For example, you can use @SendEvent@ to
-- upload a historical dataset, which you can then later use to train a
-- model.
module Amazonka.FraudDetector.SendEvent
  ( -- * Creating a Request
    SendEvent (..),
    newSendEvent,

    -- * Request Lenses
    sendEvent_assignedLabel,
    sendEvent_labelTimestamp,
    sendEvent_eventId,
    sendEvent_eventTypeName,
    sendEvent_eventTimestamp,
    sendEvent_eventVariables,
    sendEvent_entities,

    -- * Destructuring the Response
    SendEventResponse (..),
    newSendEventResponse,

    -- * Response Lenses
    sendEventResponse_httpStatus,
  )
where

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

-- | /See:/ 'newSendEvent' smart constructor.
data SendEvent = SendEvent'
  { -- | The label to associate with the event. Required if specifying
    -- @labelTimestamp@.
    SendEvent -> Maybe Text
assignedLabel :: Prelude.Maybe Prelude.Text,
    -- | The timestamp associated with the label. Required if specifying
    -- @assignedLabel@.
    SendEvent -> Maybe Text
labelTimestamp :: Prelude.Maybe Prelude.Text,
    -- | The event ID to upload.
    SendEvent -> Text
eventId :: Prelude.Text,
    -- | The event type name of the event.
    SendEvent -> Text
eventTypeName :: Prelude.Text,
    -- | The timestamp that defines when the event under evaluation occurred. The
    -- timestamp must be specified using ISO 8601 standard in UTC.
    SendEvent -> Text
eventTimestamp :: Prelude.Text,
    -- | Names of the event type\'s variables you defined in Amazon Fraud
    -- Detector to represent data elements and their corresponding values for
    -- the event you are sending for evaluation.
    SendEvent -> HashMap Text (Sensitive Text)
eventVariables :: Prelude.HashMap Prelude.Text (Data.Sensitive Prelude.Text),
    -- | An array of entities.
    SendEvent -> [Sensitive Entity]
entities :: [Data.Sensitive Entity]
  }
  deriving (SendEvent -> SendEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendEvent -> SendEvent -> Bool
$c/= :: SendEvent -> SendEvent -> Bool
== :: SendEvent -> SendEvent -> Bool
$c== :: SendEvent -> SendEvent -> Bool
Prelude.Eq, Int -> SendEvent -> ShowS
[SendEvent] -> ShowS
SendEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendEvent] -> ShowS
$cshowList :: [SendEvent] -> ShowS
show :: SendEvent -> String
$cshow :: SendEvent -> String
showsPrec :: Int -> SendEvent -> ShowS
$cshowsPrec :: Int -> SendEvent -> ShowS
Prelude.Show, forall x. Rep SendEvent x -> SendEvent
forall x. SendEvent -> Rep SendEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendEvent x -> SendEvent
$cfrom :: forall x. SendEvent -> Rep SendEvent x
Prelude.Generic)

-- |
-- Create a value of 'SendEvent' 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:
--
-- 'assignedLabel', 'sendEvent_assignedLabel' - The label to associate with the event. Required if specifying
-- @labelTimestamp@.
--
-- 'labelTimestamp', 'sendEvent_labelTimestamp' - The timestamp associated with the label. Required if specifying
-- @assignedLabel@.
--
-- 'eventId', 'sendEvent_eventId' - The event ID to upload.
--
-- 'eventTypeName', 'sendEvent_eventTypeName' - The event type name of the event.
--
-- 'eventTimestamp', 'sendEvent_eventTimestamp' - The timestamp that defines when the event under evaluation occurred. The
-- timestamp must be specified using ISO 8601 standard in UTC.
--
-- 'eventVariables', 'sendEvent_eventVariables' - Names of the event type\'s variables you defined in Amazon Fraud
-- Detector to represent data elements and their corresponding values for
-- the event you are sending for evaluation.
--
-- 'entities', 'sendEvent_entities' - An array of entities.
newSendEvent ::
  -- | 'eventId'
  Prelude.Text ->
  -- | 'eventTypeName'
  Prelude.Text ->
  -- | 'eventTimestamp'
  Prelude.Text ->
  SendEvent
newSendEvent :: Text -> Text -> Text -> SendEvent
newSendEvent
  Text
pEventId_
  Text
pEventTypeName_
  Text
pEventTimestamp_ =
    SendEvent'
      { $sel:assignedLabel:SendEvent' :: Maybe Text
assignedLabel = forall a. Maybe a
Prelude.Nothing,
        $sel:labelTimestamp:SendEvent' :: Maybe Text
labelTimestamp = forall a. Maybe a
Prelude.Nothing,
        $sel:eventId:SendEvent' :: Text
eventId = Text
pEventId_,
        $sel:eventTypeName:SendEvent' :: Text
eventTypeName = Text
pEventTypeName_,
        $sel:eventTimestamp:SendEvent' :: Text
eventTimestamp = Text
pEventTimestamp_,
        $sel:eventVariables:SendEvent' :: HashMap Text (Sensitive Text)
eventVariables = forall a. Monoid a => a
Prelude.mempty,
        $sel:entities:SendEvent' :: [Sensitive Entity]
entities = forall a. Monoid a => a
Prelude.mempty
      }

-- | The label to associate with the event. Required if specifying
-- @labelTimestamp@.
sendEvent_assignedLabel :: Lens.Lens' SendEvent (Prelude.Maybe Prelude.Text)
sendEvent_assignedLabel :: Lens' SendEvent (Maybe Text)
sendEvent_assignedLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Maybe Text
assignedLabel :: Maybe Text
$sel:assignedLabel:SendEvent' :: SendEvent -> Maybe Text
assignedLabel} -> Maybe Text
assignedLabel) (\s :: SendEvent
s@SendEvent' {} Maybe Text
a -> SendEvent
s {$sel:assignedLabel:SendEvent' :: Maybe Text
assignedLabel = Maybe Text
a} :: SendEvent)

-- | The timestamp associated with the label. Required if specifying
-- @assignedLabel@.
sendEvent_labelTimestamp :: Lens.Lens' SendEvent (Prelude.Maybe Prelude.Text)
sendEvent_labelTimestamp :: Lens' SendEvent (Maybe Text)
sendEvent_labelTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Maybe Text
labelTimestamp :: Maybe Text
$sel:labelTimestamp:SendEvent' :: SendEvent -> Maybe Text
labelTimestamp} -> Maybe Text
labelTimestamp) (\s :: SendEvent
s@SendEvent' {} Maybe Text
a -> SendEvent
s {$sel:labelTimestamp:SendEvent' :: Maybe Text
labelTimestamp = Maybe Text
a} :: SendEvent)

-- | The event ID to upload.
sendEvent_eventId :: Lens.Lens' SendEvent Prelude.Text
sendEvent_eventId :: Lens' SendEvent Text
sendEvent_eventId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
eventId :: Text
$sel:eventId:SendEvent' :: SendEvent -> Text
eventId} -> Text
eventId) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:eventId:SendEvent' :: Text
eventId = Text
a} :: SendEvent)

-- | The event type name of the event.
sendEvent_eventTypeName :: Lens.Lens' SendEvent Prelude.Text
sendEvent_eventTypeName :: Lens' SendEvent Text
sendEvent_eventTypeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
eventTypeName :: Text
$sel:eventTypeName:SendEvent' :: SendEvent -> Text
eventTypeName} -> Text
eventTypeName) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:eventTypeName:SendEvent' :: Text
eventTypeName = Text
a} :: SendEvent)

-- | The timestamp that defines when the event under evaluation occurred. The
-- timestamp must be specified using ISO 8601 standard in UTC.
sendEvent_eventTimestamp :: Lens.Lens' SendEvent Prelude.Text
sendEvent_eventTimestamp :: Lens' SendEvent Text
sendEvent_eventTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
eventTimestamp :: Text
$sel:eventTimestamp:SendEvent' :: SendEvent -> Text
eventTimestamp} -> Text
eventTimestamp) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:eventTimestamp:SendEvent' :: Text
eventTimestamp = Text
a} :: SendEvent)

-- | Names of the event type\'s variables you defined in Amazon Fraud
-- Detector to represent data elements and their corresponding values for
-- the event you are sending for evaluation.
sendEvent_eventVariables :: Lens.Lens' SendEvent (Prelude.HashMap Prelude.Text Prelude.Text)
sendEvent_eventVariables :: Lens' SendEvent (HashMap Text Text)
sendEvent_eventVariables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {HashMap Text (Sensitive Text)
eventVariables :: HashMap Text (Sensitive Text)
$sel:eventVariables:SendEvent' :: SendEvent -> HashMap Text (Sensitive Text)
eventVariables} -> HashMap Text (Sensitive Text)
eventVariables) (\s :: SendEvent
s@SendEvent' {} HashMap Text (Sensitive Text)
a -> SendEvent
s {$sel:eventVariables:SendEvent' :: HashMap Text (Sensitive Text)
eventVariables = HashMap Text (Sensitive Text)
a} :: SendEvent) 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

-- | An array of entities.
sendEvent_entities :: Lens.Lens' SendEvent [Entity]
sendEvent_entities :: Lens' SendEvent [Entity]
sendEvent_entities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {[Sensitive Entity]
entities :: [Sensitive Entity]
$sel:entities:SendEvent' :: SendEvent -> [Sensitive Entity]
entities} -> [Sensitive Entity]
entities) (\s :: SendEvent
s@SendEvent' {} [Sensitive Entity]
a -> SendEvent
s {$sel:entities:SendEvent' :: [Sensitive Entity]
entities = [Sensitive Entity]
a} :: SendEvent) 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 SendEvent where
  type AWSResponse SendEvent = SendEventResponse
  request :: (Service -> Service) -> SendEvent -> Request SendEvent
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 SendEvent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendEvent)))
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 -> SendEventResponse
SendEventResponse'
            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 SendEvent where
  hashWithSalt :: Int -> SendEvent -> Int
hashWithSalt Int
_salt SendEvent' {[Sensitive Entity]
Maybe Text
Text
HashMap Text (Sensitive Text)
entities :: [Sensitive Entity]
eventVariables :: HashMap Text (Sensitive Text)
eventTimestamp :: Text
eventTypeName :: Text
eventId :: Text
labelTimestamp :: Maybe Text
assignedLabel :: Maybe Text
$sel:entities:SendEvent' :: SendEvent -> [Sensitive Entity]
$sel:eventVariables:SendEvent' :: SendEvent -> HashMap Text (Sensitive Text)
$sel:eventTimestamp:SendEvent' :: SendEvent -> Text
$sel:eventTypeName:SendEvent' :: SendEvent -> Text
$sel:eventId:SendEvent' :: SendEvent -> Text
$sel:labelTimestamp:SendEvent' :: SendEvent -> Maybe Text
$sel:assignedLabel:SendEvent' :: SendEvent -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
assignedLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
labelTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventTypeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text (Sensitive Text)
eventVariables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Sensitive Entity]
entities

instance Prelude.NFData SendEvent where
  rnf :: SendEvent -> ()
rnf SendEvent' {[Sensitive Entity]
Maybe Text
Text
HashMap Text (Sensitive Text)
entities :: [Sensitive Entity]
eventVariables :: HashMap Text (Sensitive Text)
eventTimestamp :: Text
eventTypeName :: Text
eventId :: Text
labelTimestamp :: Maybe Text
assignedLabel :: Maybe Text
$sel:entities:SendEvent' :: SendEvent -> [Sensitive Entity]
$sel:eventVariables:SendEvent' :: SendEvent -> HashMap Text (Sensitive Text)
$sel:eventTimestamp:SendEvent' :: SendEvent -> Text
$sel:eventTypeName:SendEvent' :: SendEvent -> Text
$sel:eventId:SendEvent' :: SendEvent -> Text
$sel:labelTimestamp:SendEvent' :: SendEvent -> Maybe Text
$sel:assignedLabel:SendEvent' :: SendEvent -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
assignedLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventTypeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text (Sensitive Text)
eventVariables
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Sensitive Entity]
entities

instance Data.ToHeaders SendEvent where
  toHeaders :: SendEvent -> 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
"AWSHawksNestServiceFacade.SendEvent" ::
                          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 SendEvent where
  toJSON :: SendEvent -> Value
toJSON SendEvent' {[Sensitive Entity]
Maybe Text
Text
HashMap Text (Sensitive Text)
entities :: [Sensitive Entity]
eventVariables :: HashMap Text (Sensitive Text)
eventTimestamp :: Text
eventTypeName :: Text
eventId :: Text
labelTimestamp :: Maybe Text
assignedLabel :: Maybe Text
$sel:entities:SendEvent' :: SendEvent -> [Sensitive Entity]
$sel:eventVariables:SendEvent' :: SendEvent -> HashMap Text (Sensitive Text)
$sel:eventTimestamp:SendEvent' :: SendEvent -> Text
$sel:eventTypeName:SendEvent' :: SendEvent -> Text
$sel:eventId:SendEvent' :: SendEvent -> Text
$sel:labelTimestamp:SendEvent' :: SendEvent -> Maybe Text
$sel:assignedLabel:SendEvent' :: SendEvent -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"assignedLabel" 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
assignedLabel,
            (Key
"labelTimestamp" 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
labelTimestamp,
            forall a. a -> Maybe a
Prelude.Just (Key
"eventId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventId),
            forall a. a -> Maybe a
Prelude.Just (Key
"eventTypeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventTypeName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"eventTimestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventTimestamp),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"eventVariables" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text (Sensitive Text)
eventVariables),
            forall a. a -> Maybe a
Prelude.Just (Key
"entities" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Sensitive Entity]
entities)
          ]
      )

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

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

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

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

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

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