{-# 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.CloudWatchEvents.PutEvents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends custom events to Amazon EventBridge so that they can be matched to
-- rules.
--
-- PutEvents will only process nested JSON up to 1100 levels deep.
module Amazonka.CloudWatchEvents.PutEvents
  ( -- * Creating a Request
    PutEvents (..),
    newPutEvents,

    -- * Request Lenses
    putEvents_endpointId,
    putEvents_entries,

    -- * Destructuring the Response
    PutEventsResponse (..),
    newPutEventsResponse,

    -- * Response Lenses
    putEventsResponse_entries,
    putEventsResponse_failedEntryCount,
    putEventsResponse_httpStatus,
  )
where

import Amazonka.CloudWatchEvents.Types
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

-- | /See:/ 'newPutEvents' smart constructor.
data PutEvents = PutEvents'
  { -- | The URL subdomain of the endpoint. For example, if the URL for Endpoint
    -- is abcde.veo.endpoints.event.amazonaws.com, then the EndpointId is
    -- @abcde.veo@.
    --
    -- When using Java, you must include @auth-crt@ on the class path.
    PutEvents -> Maybe Text
endpointId :: Prelude.Maybe Prelude.Text,
    -- | The entry that defines an event in your system. You can specify several
    -- parameters for the entry such as the source and type of the event,
    -- resources associated with the event, and so on.
    PutEvents -> NonEmpty PutEventsRequestEntry
entries :: Prelude.NonEmpty PutEventsRequestEntry
  }
  deriving (PutEvents -> PutEvents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEvents -> PutEvents -> Bool
$c/= :: PutEvents -> PutEvents -> Bool
== :: PutEvents -> PutEvents -> Bool
$c== :: PutEvents -> PutEvents -> Bool
Prelude.Eq, ReadPrec [PutEvents]
ReadPrec PutEvents
Int -> ReadS PutEvents
ReadS [PutEvents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEvents]
$creadListPrec :: ReadPrec [PutEvents]
readPrec :: ReadPrec PutEvents
$creadPrec :: ReadPrec PutEvents
readList :: ReadS [PutEvents]
$creadList :: ReadS [PutEvents]
readsPrec :: Int -> ReadS PutEvents
$creadsPrec :: Int -> ReadS PutEvents
Prelude.Read, Int -> PutEvents -> ShowS
[PutEvents] -> ShowS
PutEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEvents] -> ShowS
$cshowList :: [PutEvents] -> ShowS
show :: PutEvents -> String
$cshow :: PutEvents -> String
showsPrec :: Int -> PutEvents -> ShowS
$cshowsPrec :: Int -> PutEvents -> ShowS
Prelude.Show, forall x. Rep PutEvents x -> PutEvents
forall x. PutEvents -> Rep PutEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEvents x -> PutEvents
$cfrom :: forall x. PutEvents -> Rep PutEvents x
Prelude.Generic)

-- |
-- Create a value of 'PutEvents' 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:
--
-- 'endpointId', 'putEvents_endpointId' - The URL subdomain of the endpoint. For example, if the URL for Endpoint
-- is abcde.veo.endpoints.event.amazonaws.com, then the EndpointId is
-- @abcde.veo@.
--
-- When using Java, you must include @auth-crt@ on the class path.
--
-- 'entries', 'putEvents_entries' - The entry that defines an event in your system. You can specify several
-- parameters for the entry such as the source and type of the event,
-- resources associated with the event, and so on.
newPutEvents ::
  -- | 'entries'
  Prelude.NonEmpty PutEventsRequestEntry ->
  PutEvents
newPutEvents :: NonEmpty PutEventsRequestEntry -> PutEvents
newPutEvents NonEmpty PutEventsRequestEntry
pEntries_ =
  PutEvents'
    { $sel:endpointId:PutEvents' :: Maybe Text
endpointId = forall a. Maybe a
Prelude.Nothing,
      $sel:entries:PutEvents' :: NonEmpty PutEventsRequestEntry
entries = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PutEventsRequestEntry
pEntries_
    }

-- | The URL subdomain of the endpoint. For example, if the URL for Endpoint
-- is abcde.veo.endpoints.event.amazonaws.com, then the EndpointId is
-- @abcde.veo@.
--
-- When using Java, you must include @auth-crt@ on the class path.
putEvents_endpointId :: Lens.Lens' PutEvents (Prelude.Maybe Prelude.Text)
putEvents_endpointId :: Lens' PutEvents (Maybe Text)
putEvents_endpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvents' {Maybe Text
endpointId :: Maybe Text
$sel:endpointId:PutEvents' :: PutEvents -> Maybe Text
endpointId} -> Maybe Text
endpointId) (\s :: PutEvents
s@PutEvents' {} Maybe Text
a -> PutEvents
s {$sel:endpointId:PutEvents' :: Maybe Text
endpointId = Maybe Text
a} :: PutEvents)

-- | The entry that defines an event in your system. You can specify several
-- parameters for the entry such as the source and type of the event,
-- resources associated with the event, and so on.
putEvents_entries :: Lens.Lens' PutEvents (Prelude.NonEmpty PutEventsRequestEntry)
putEvents_entries :: Lens' PutEvents (NonEmpty PutEventsRequestEntry)
putEvents_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEvents' {NonEmpty PutEventsRequestEntry
entries :: NonEmpty PutEventsRequestEntry
$sel:entries:PutEvents' :: PutEvents -> NonEmpty PutEventsRequestEntry
entries} -> NonEmpty PutEventsRequestEntry
entries) (\s :: PutEvents
s@PutEvents' {} NonEmpty PutEventsRequestEntry
a -> PutEvents
s {$sel:entries:PutEvents' :: NonEmpty PutEventsRequestEntry
entries = NonEmpty PutEventsRequestEntry
a} :: PutEvents) 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 PutEvents where
  type AWSResponse PutEvents = PutEventsResponse
  request :: (Service -> Service) -> PutEvents -> Request PutEvents
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 PutEvents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutEvents)))
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 [PutEventsResultEntry]
-> Maybe Int -> Int -> PutEventsResponse
PutEventsResponse'
            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
"Entries" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"FailedEntryCount")
            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 PutEvents where
  hashWithSalt :: Int -> PutEvents -> Int
hashWithSalt Int
_salt PutEvents' {Maybe Text
NonEmpty PutEventsRequestEntry
entries :: NonEmpty PutEventsRequestEntry
endpointId :: Maybe Text
$sel:entries:PutEvents' :: PutEvents -> NonEmpty PutEventsRequestEntry
$sel:endpointId:PutEvents' :: PutEvents -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpointId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PutEventsRequestEntry
entries

instance Prelude.NFData PutEvents where
  rnf :: PutEvents -> ()
rnf PutEvents' {Maybe Text
NonEmpty PutEventsRequestEntry
entries :: NonEmpty PutEventsRequestEntry
endpointId :: Maybe Text
$sel:entries:PutEvents' :: PutEvents -> NonEmpty PutEventsRequestEntry
$sel:endpointId:PutEvents' :: PutEvents -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PutEventsRequestEntry
entries

instance Data.ToHeaders PutEvents where
  toHeaders :: PutEvents -> 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
"AWSEvents.PutEvents" :: 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 PutEvents where
  toJSON :: PutEvents -> Value
toJSON PutEvents' {Maybe Text
NonEmpty PutEventsRequestEntry
entries :: NonEmpty PutEventsRequestEntry
endpointId :: Maybe Text
$sel:entries:PutEvents' :: PutEvents -> NonEmpty PutEventsRequestEntry
$sel:endpointId:PutEvents' :: PutEvents -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EndpointId" 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
endpointId,
            forall a. a -> Maybe a
Prelude.Just (Key
"Entries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty PutEventsRequestEntry
entries)
          ]
      )

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

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

-- | /See:/ 'newPutEventsResponse' smart constructor.
data PutEventsResponse = PutEventsResponse'
  { -- | The successfully and unsuccessfully ingested events results. If the
    -- ingestion was successful, the entry has the event ID in it. Otherwise,
    -- you can use the error code and error message to identify the problem
    -- with the entry.
    PutEventsResponse -> Maybe [PutEventsResultEntry]
entries :: Prelude.Maybe [PutEventsResultEntry],
    -- | The number of failed entries.
    PutEventsResponse -> Maybe Int
failedEntryCount :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    PutEventsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutEventsResponse -> PutEventsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutEventsResponse -> PutEventsResponse -> Bool
$c/= :: PutEventsResponse -> PutEventsResponse -> Bool
== :: PutEventsResponse -> PutEventsResponse -> Bool
$c== :: PutEventsResponse -> PutEventsResponse -> Bool
Prelude.Eq, ReadPrec [PutEventsResponse]
ReadPrec PutEventsResponse
Int -> ReadS PutEventsResponse
ReadS [PutEventsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutEventsResponse]
$creadListPrec :: ReadPrec [PutEventsResponse]
readPrec :: ReadPrec PutEventsResponse
$creadPrec :: ReadPrec PutEventsResponse
readList :: ReadS [PutEventsResponse]
$creadList :: ReadS [PutEventsResponse]
readsPrec :: Int -> ReadS PutEventsResponse
$creadsPrec :: Int -> ReadS PutEventsResponse
Prelude.Read, Int -> PutEventsResponse -> ShowS
[PutEventsResponse] -> ShowS
PutEventsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutEventsResponse] -> ShowS
$cshowList :: [PutEventsResponse] -> ShowS
show :: PutEventsResponse -> String
$cshow :: PutEventsResponse -> String
showsPrec :: Int -> PutEventsResponse -> ShowS
$cshowsPrec :: Int -> PutEventsResponse -> ShowS
Prelude.Show, forall x. Rep PutEventsResponse x -> PutEventsResponse
forall x. PutEventsResponse -> Rep PutEventsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutEventsResponse x -> PutEventsResponse
$cfrom :: forall x. PutEventsResponse -> Rep PutEventsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutEventsResponse' 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:
--
-- 'entries', 'putEventsResponse_entries' - The successfully and unsuccessfully ingested events results. If the
-- ingestion was successful, the entry has the event ID in it. Otherwise,
-- you can use the error code and error message to identify the problem
-- with the entry.
--
-- 'failedEntryCount', 'putEventsResponse_failedEntryCount' - The number of failed entries.
--
-- 'httpStatus', 'putEventsResponse_httpStatus' - The response's http status code.
newPutEventsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutEventsResponse
newPutEventsResponse :: Int -> PutEventsResponse
newPutEventsResponse Int
pHttpStatus_ =
  PutEventsResponse'
    { $sel:entries:PutEventsResponse' :: Maybe [PutEventsResultEntry]
entries = forall a. Maybe a
Prelude.Nothing,
      $sel:failedEntryCount:PutEventsResponse' :: Maybe Int
failedEntryCount = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutEventsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The successfully and unsuccessfully ingested events results. If the
-- ingestion was successful, the entry has the event ID in it. Otherwise,
-- you can use the error code and error message to identify the problem
-- with the entry.
putEventsResponse_entries :: Lens.Lens' PutEventsResponse (Prelude.Maybe [PutEventsResultEntry])
putEventsResponse_entries :: Lens' PutEventsResponse (Maybe [PutEventsResultEntry])
putEventsResponse_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsResponse' {Maybe [PutEventsResultEntry]
entries :: Maybe [PutEventsResultEntry]
$sel:entries:PutEventsResponse' :: PutEventsResponse -> Maybe [PutEventsResultEntry]
entries} -> Maybe [PutEventsResultEntry]
entries) (\s :: PutEventsResponse
s@PutEventsResponse' {} Maybe [PutEventsResultEntry]
a -> PutEventsResponse
s {$sel:entries:PutEventsResponse' :: Maybe [PutEventsResultEntry]
entries = Maybe [PutEventsResultEntry]
a} :: PutEventsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The number of failed entries.
putEventsResponse_failedEntryCount :: Lens.Lens' PutEventsResponse (Prelude.Maybe Prelude.Int)
putEventsResponse_failedEntryCount :: Lens' PutEventsResponse (Maybe Int)
putEventsResponse_failedEntryCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutEventsResponse' {Maybe Int
failedEntryCount :: Maybe Int
$sel:failedEntryCount:PutEventsResponse' :: PutEventsResponse -> Maybe Int
failedEntryCount} -> Maybe Int
failedEntryCount) (\s :: PutEventsResponse
s@PutEventsResponse' {} Maybe Int
a -> PutEventsResponse
s {$sel:failedEntryCount:PutEventsResponse' :: Maybe Int
failedEntryCount = Maybe Int
a} :: PutEventsResponse)

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

instance Prelude.NFData PutEventsResponse where
  rnf :: PutEventsResponse -> ()
rnf PutEventsResponse' {Int
Maybe Int
Maybe [PutEventsResultEntry]
httpStatus :: Int
failedEntryCount :: Maybe Int
entries :: Maybe [PutEventsResultEntry]
$sel:httpStatus:PutEventsResponse' :: PutEventsResponse -> Int
$sel:failedEntryCount:PutEventsResponse' :: PutEventsResponse -> Maybe Int
$sel:entries:PutEventsResponse' :: PutEventsResponse -> Maybe [PutEventsResultEntry]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PutEventsResultEntry]
entries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
failedEntryCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus