{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}

{-|
Module      : AWS.Lambda.Events.EventBridge
Description : Data types for consuming EventBridge events.
License     : BSD3
Stability   : stable

Data types for Lambda functions which subscribe to AWS EventBridge
events.

-}

module AWS.Lambda.Events.EventBridge (
  EventBridgeEvent,
  EventBridgeEvent'(..)
) where

import Control.Monad  (unless)
import Data.Aeson
import Data.Text      (Text)
import Data.Time      (UTCTime)
import GHC.Generics   (Generic)
import Prelude        hiding (id)

-- | Convenience alias for events of unknown type. Most of the time
-- you will want to define or use a data type @Foo@ representing the
-- @detail@ payload, and write an @instance FromJSON Foo@ to get
-- @instance FromJSON ('EventBridgeEvent'' Foo)@. See the
-- @AWS.Lambda.Events.EventBridge.Detail.*@ modules for data types
-- which you can use.
type EventBridgeEvent = EventBridgeEvent' Value

-- | Represents an event from Amazon EventBridge.
--
-- See the <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-events.html AWS documentation>
-- for information about events, and a sample payload.
data EventBridgeEvent' a = EventBridgeEvent {
  -- | By default, this is set to 0 (zero) in all events.
  forall a. EventBridgeEvent' a -> Text
version :: Text,

  -- | A Version 4 UUID that's generated for every event. You can use
  -- id to trace events as they move through rules to targets.
  forall a. EventBridgeEvent' a -> Text
id :: Text,

  -- | Identifies, in combination with the source field, the fields
  -- and values that appear in the detail field.
  --
  -- Events that are delivered by CloudTrail have AWS API Call via
  -- CloudTrail as the value for detail-type.
  --
  -- __NOTE:__ This is called @detail-type@ in the AWS payload.
  forall a. EventBridgeEvent' a -> Text
detailType :: Text,

  -- | Identifies the service that generated the event. All events
  -- that come from AWS services begin with "aws." Customer-generated
  -- events can have any value here, as long as it doesn't begin with
  -- "aws." We recommend the use of Java package-name style reverse
  -- domain-name strings.
  --
  -- To find the correct value for source for an AWS service, see The
  -- condition keys table, select a service from the list, and look
  -- for the service prefix. For example, the source value for Amazon
  -- CloudFront is aws.cloudfront.
  forall a. EventBridgeEvent' a -> Text
source :: Text,

  -- | The 12-digit number identifying an AWS account.
  forall a. EventBridgeEvent' a -> Text
account :: Text,

  -- | The event timestamp, which can be specified by the service
  -- originating the event. If the event spans a time interval, the
  -- service can report the start time, so this value might be before
  -- the time the event is received.
  forall a. EventBridgeEvent' a -> UTCTime
time :: UTCTime,

  -- | Identifies the AWS Region where the event originated.
  forall a. EventBridgeEvent' a -> Text
region :: Text,

  -- | A JSON array that contains ARNs that identify resources that
  -- are involved in the event. The service generating the event
  -- determines whether to include these ARNs. For example, Amazon EC2
  -- instance state-changes include Amazon EC2 instance ARNs, Auto
  -- Scaling events include ARNs for both instances and Auto Scaling
  -- groups, but API calls with AWS CloudTrail do not include resource
  -- ARNs.
  forall a. EventBridgeEvent' a -> [Text]
resources :: [Text],

  -- | A JSON object that contains information about the event. The
  -- service generating the event determines the content of this
  -- field. The detail content can be as simple as two fields. AWS API
  -- call events have detail objects with approximately 50 fields
  -- nested several levels deep.
  forall a. EventBridgeEvent' a -> a
detail :: a
} deriving (EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
forall a.
Eq a =>
EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
$c/= :: forall a.
Eq a =>
EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
== :: EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
$c== :: forall a.
Eq a =>
EventBridgeEvent' a -> EventBridgeEvent' a -> Bool
Eq, Int -> EventBridgeEvent' a -> ShowS
forall a. Show a => Int -> EventBridgeEvent' a -> ShowS
forall a. Show a => [EventBridgeEvent' a] -> ShowS
forall a. Show a => EventBridgeEvent' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventBridgeEvent' a] -> ShowS
$cshowList :: forall a. Show a => [EventBridgeEvent' a] -> ShowS
show :: EventBridgeEvent' a -> String
$cshow :: forall a. Show a => EventBridgeEvent' a -> String
showsPrec :: Int -> EventBridgeEvent' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EventBridgeEvent' a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EventBridgeEvent' a) x -> EventBridgeEvent' a
forall a x. EventBridgeEvent' a -> Rep (EventBridgeEvent' a) x
$cto :: forall a x. Rep (EventBridgeEvent' a) x -> EventBridgeEvent' a
$cfrom :: forall a x. EventBridgeEvent' a -> Rep (EventBridgeEvent' a) x
Generic, forall a b. a -> EventBridgeEvent' b -> EventBridgeEvent' a
forall a b. (a -> b) -> EventBridgeEvent' a -> EventBridgeEvent' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EventBridgeEvent' b -> EventBridgeEvent' a
$c<$ :: forall a b. a -> EventBridgeEvent' b -> EventBridgeEvent' a
fmap :: forall a b. (a -> b) -> EventBridgeEvent' a -> EventBridgeEvent' b
$cfmap :: forall a b. (a -> b) -> EventBridgeEvent' a -> EventBridgeEvent' b
Functor, forall a. Eq a => a -> EventBridgeEvent' a -> Bool
forall a. Num a => EventBridgeEvent' a -> a
forall a. Ord a => EventBridgeEvent' a -> a
forall m. Monoid m => EventBridgeEvent' m -> m
forall a. EventBridgeEvent' a -> Bool
forall a. EventBridgeEvent' a -> Int
forall a. EventBridgeEvent' a -> [a]
forall a. (a -> a -> a) -> EventBridgeEvent' a -> a
forall m a. Monoid m => (a -> m) -> EventBridgeEvent' a -> m
forall b a. (b -> a -> b) -> b -> EventBridgeEvent' a -> b
forall a b. (a -> b -> b) -> b -> EventBridgeEvent' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => EventBridgeEvent' a -> a
$cproduct :: forall a. Num a => EventBridgeEvent' a -> a
sum :: forall a. Num a => EventBridgeEvent' a -> a
$csum :: forall a. Num a => EventBridgeEvent' a -> a
minimum :: forall a. Ord a => EventBridgeEvent' a -> a
$cminimum :: forall a. Ord a => EventBridgeEvent' a -> a
maximum :: forall a. Ord a => EventBridgeEvent' a -> a
$cmaximum :: forall a. Ord a => EventBridgeEvent' a -> a
elem :: forall a. Eq a => a -> EventBridgeEvent' a -> Bool
$celem :: forall a. Eq a => a -> EventBridgeEvent' a -> Bool
length :: forall a. EventBridgeEvent' a -> Int
$clength :: forall a. EventBridgeEvent' a -> Int
null :: forall a. EventBridgeEvent' a -> Bool
$cnull :: forall a. EventBridgeEvent' a -> Bool
toList :: forall a. EventBridgeEvent' a -> [a]
$ctoList :: forall a. EventBridgeEvent' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> EventBridgeEvent' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EventBridgeEvent' a -> a
foldr1 :: forall a. (a -> a -> a) -> EventBridgeEvent' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> EventBridgeEvent' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> EventBridgeEvent' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EventBridgeEvent' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> EventBridgeEvent' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EventBridgeEvent' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> EventBridgeEvent' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EventBridgeEvent' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> EventBridgeEvent' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> EventBridgeEvent' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> EventBridgeEvent' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EventBridgeEvent' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> EventBridgeEvent' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EventBridgeEvent' a -> m
fold :: forall m. Monoid m => EventBridgeEvent' m -> m
$cfold :: forall m. Monoid m => EventBridgeEvent' m -> m
Foldable, Functor EventBridgeEvent'
Foldable EventBridgeEvent'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
EventBridgeEvent' (m a) -> m (EventBridgeEvent' a)
forall (f :: * -> *) a.
Applicative f =>
EventBridgeEvent' (f a) -> f (EventBridgeEvent' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EventBridgeEvent' a -> m (EventBridgeEvent' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EventBridgeEvent' a -> f (EventBridgeEvent' b)
sequence :: forall (m :: * -> *) a.
Monad m =>
EventBridgeEvent' (m a) -> m (EventBridgeEvent' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EventBridgeEvent' (m a) -> m (EventBridgeEvent' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EventBridgeEvent' a -> m (EventBridgeEvent' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EventBridgeEvent' a -> m (EventBridgeEvent' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
EventBridgeEvent' (f a) -> f (EventBridgeEvent' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EventBridgeEvent' (f a) -> f (EventBridgeEvent' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EventBridgeEvent' a -> f (EventBridgeEvent' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EventBridgeEvent' a -> f (EventBridgeEvent' b)
Traversable)

instance FromJSON a => FromJSON (EventBridgeEvent' a) where
  parseJSON :: Value -> Parser (EventBridgeEvent' a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"EventBridgeEvent" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
version <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
version forall a. Eq a => a -> a -> Bool
== Text
"0") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"version != 0"
    Text
id <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Text
detailType <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail-type"
    Text
source <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    Text
account <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account"
    UTCTime
time <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
    Text
region <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"region"
    [Text]
resources <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resources"
    a
detail <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"detail"

    pure EventBridgeEvent
      { Text
version :: Text
$sel:version:EventBridgeEvent :: Text
version
      , Text
id :: Text
$sel:id:EventBridgeEvent :: Text
id
      , Text
detailType :: Text
$sel:detailType:EventBridgeEvent :: Text
detailType
      , Text
source :: Text
$sel:source:EventBridgeEvent :: Text
source
      , Text
account :: Text
$sel:account:EventBridgeEvent :: Text
account
      , UTCTime
time :: UTCTime
$sel:time:EventBridgeEvent :: UTCTime
time
      , Text
region :: Text
$sel:region:EventBridgeEvent :: Text
region
      , [Text]
resources :: [Text]
$sel:resources:EventBridgeEvent :: [Text]
resources
      , a
detail :: a
$sel:detail:EventBridgeEvent :: a
detail
      }

instance ToJSON a => ToJSON (EventBridgeEvent' a) where
  toJSON :: EventBridgeEvent' a -> Value
toJSON EventBridgeEvent' a
event = [Pair] -> Value
object
    [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
version EventBridgeEvent' a
event
    , Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
id EventBridgeEvent' a
event
    , Key
"detail-type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
detailType EventBridgeEvent' a
event
    , Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
source EventBridgeEvent' a
event
    , Key
"account" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
account EventBridgeEvent' a
event
    , Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> UTCTime
time EventBridgeEvent' a
event
    , Key
"region" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
region EventBridgeEvent' a
event
    , Key
"resources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> [Text]
resources EventBridgeEvent' a
event
    , Key
"detail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> a
detail EventBridgeEvent' a
event
    ]

  toEncoding :: EventBridgeEvent' a -> Encoding
toEncoding EventBridgeEvent' a
event = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
version EventBridgeEvent' a
event
    , Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
id EventBridgeEvent' a
event
    , Key
"detail-type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
detailType EventBridgeEvent' a
event
    , Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
source EventBridgeEvent' a
event
    , Key
"account" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
account EventBridgeEvent' a
event
    , Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> UTCTime
time EventBridgeEvent' a
event
    , Key
"region" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> Text
region EventBridgeEvent' a
event
    , Key
"resources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> [Text]
resources EventBridgeEvent' a
event
    , Key
"detail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. EventBridgeEvent' a -> a
detail EventBridgeEvent' a
event
    ]