{-|
Module      : AWS.Lambda.Events.S3
Description : Data types for working with S3 events.
Copyright   : (c) Nike, Inc., 2019
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : stable
-}

{-# LANGUAGE DuplicateRecordFields #-}

module AWS.Lambda.Events.S3 (
  PrincipalIdentity(..),
  Records(..),
  RequestParameters(..),
  ResponseElements(..),
  S3Bucket(..),
  S3Config(..),
  S3Event(..),
  S3Object(..)
) where

import Data.Aeson       (FromJSON (..), Value (Object), withObject, (.:), (.:?))
import Data.Aeson.Types (typeMismatch)
import Data.Text        (Text)
import Data.Time.Clock  (UTCTime)
import GHC.Generics     (Generic)

newtype Records = Records {
  Records -> [S3Event]
records :: [S3Event]
} deriving (Int -> Records -> ShowS
[Records] -> ShowS
Records -> String
(Int -> Records -> ShowS)
-> (Records -> String) -> ([Records] -> ShowS) -> Show Records
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Records] -> ShowS
$cshowList :: [Records] -> ShowS
show :: Records -> String
$cshow :: Records -> String
showsPrec :: Int -> Records -> ShowS
$cshowsPrec :: Int -> Records -> ShowS
Show, Records -> Records -> Bool
(Records -> Records -> Bool)
-> (Records -> Records -> Bool) -> Eq Records
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Records -> Records -> Bool
$c/= :: Records -> Records -> Bool
== :: Records -> Records -> Bool
$c== :: Records -> Records -> Bool
Eq)

instance FromJSON Records where
  parseJSON :: Value -> Parser Records
parseJSON = String -> (Object -> Parser Records) -> Value -> Parser Records
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Records" ((Object -> Parser Records) -> Value -> Parser Records)
-> (Object -> Parser Records) -> Value -> Parser Records
forall a b. (a -> b) -> a -> b
$ \Object
v -> [S3Event] -> Records
Records ([S3Event] -> Records) -> Parser [S3Event] -> Parser Records
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [S3Event]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Records"

data PrincipalIdentity = PrincipalIdentity {
  PrincipalIdentity -> Text
principalId :: Text
} deriving (Int -> PrincipalIdentity -> ShowS
[PrincipalIdentity] -> ShowS
PrincipalIdentity -> String
(Int -> PrincipalIdentity -> ShowS)
-> (PrincipalIdentity -> String)
-> ([PrincipalIdentity] -> ShowS)
-> Show PrincipalIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrincipalIdentity] -> ShowS
$cshowList :: [PrincipalIdentity] -> ShowS
show :: PrincipalIdentity -> String
$cshow :: PrincipalIdentity -> String
showsPrec :: Int -> PrincipalIdentity -> ShowS
$cshowsPrec :: Int -> PrincipalIdentity -> ShowS
Show, PrincipalIdentity -> PrincipalIdentity -> Bool
(PrincipalIdentity -> PrincipalIdentity -> Bool)
-> (PrincipalIdentity -> PrincipalIdentity -> Bool)
-> Eq PrincipalIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrincipalIdentity -> PrincipalIdentity -> Bool
$c/= :: PrincipalIdentity -> PrincipalIdentity -> Bool
== :: PrincipalIdentity -> PrincipalIdentity -> Bool
$c== :: PrincipalIdentity -> PrincipalIdentity -> Bool
Eq, (forall x. PrincipalIdentity -> Rep PrincipalIdentity x)
-> (forall x. Rep PrincipalIdentity x -> PrincipalIdentity)
-> Generic PrincipalIdentity
forall x. Rep PrincipalIdentity x -> PrincipalIdentity
forall x. PrincipalIdentity -> Rep PrincipalIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrincipalIdentity x -> PrincipalIdentity
$cfrom :: forall x. PrincipalIdentity -> Rep PrincipalIdentity x
Generic)

instance FromJSON PrincipalIdentity

data S3Bucket = S3Bucket {
  S3Bucket -> Text
arn           :: Text,
  S3Bucket -> Text
name          :: Text,
  S3Bucket -> PrincipalIdentity
ownerIdentity :: PrincipalIdentity
} deriving (Int -> S3Bucket -> ShowS
[S3Bucket] -> ShowS
S3Bucket -> String
(Int -> S3Bucket -> ShowS)
-> (S3Bucket -> String) -> ([S3Bucket] -> ShowS) -> Show S3Bucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Bucket] -> ShowS
$cshowList :: [S3Bucket] -> ShowS
show :: S3Bucket -> String
$cshow :: S3Bucket -> String
showsPrec :: Int -> S3Bucket -> ShowS
$cshowsPrec :: Int -> S3Bucket -> ShowS
Show, S3Bucket -> S3Bucket -> Bool
(S3Bucket -> S3Bucket -> Bool)
-> (S3Bucket -> S3Bucket -> Bool) -> Eq S3Bucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Bucket -> S3Bucket -> Bool
$c/= :: S3Bucket -> S3Bucket -> Bool
== :: S3Bucket -> S3Bucket -> Bool
$c== :: S3Bucket -> S3Bucket -> Bool
Eq, (forall x. S3Bucket -> Rep S3Bucket x)
-> (forall x. Rep S3Bucket x -> S3Bucket) -> Generic S3Bucket
forall x. Rep S3Bucket x -> S3Bucket
forall x. S3Bucket -> Rep S3Bucket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3Bucket x -> S3Bucket
$cfrom :: forall x. S3Bucket -> Rep S3Bucket x
Generic)

instance FromJSON S3Bucket

data S3Config = S3Config {
  S3Config -> S3Bucket
bucket          :: S3Bucket,
  S3Config -> Text
configurationId :: Text,
  S3Config -> S3Object
object          :: S3Object,
  S3Config -> Text
s3SchemaVersion :: Text
} deriving (Int -> S3Config -> ShowS
[S3Config] -> ShowS
S3Config -> String
(Int -> S3Config -> ShowS)
-> (S3Config -> String) -> ([S3Config] -> ShowS) -> Show S3Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Config] -> ShowS
$cshowList :: [S3Config] -> ShowS
show :: S3Config -> String
$cshow :: S3Config -> String
showsPrec :: Int -> S3Config -> ShowS
$cshowsPrec :: Int -> S3Config -> ShowS
Show, S3Config -> S3Config -> Bool
(S3Config -> S3Config -> Bool)
-> (S3Config -> S3Config -> Bool) -> Eq S3Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Config -> S3Config -> Bool
$c/= :: S3Config -> S3Config -> Bool
== :: S3Config -> S3Config -> Bool
$c== :: S3Config -> S3Config -> Bool
Eq, (forall x. S3Config -> Rep S3Config x)
-> (forall x. Rep S3Config x -> S3Config) -> Generic S3Config
forall x. Rep S3Config x -> S3Config
forall x. S3Config -> Rep S3Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3Config x -> S3Config
$cfrom :: forall x. S3Config -> Rep S3Config x
Generic)

instance FromJSON S3Config

data ResponseElements = ResponseElements {
  ResponseElements -> Text
amazonId        :: Text,
  ResponseElements -> Text
amazonRequestId :: Text
} deriving (Int -> ResponseElements -> ShowS
[ResponseElements] -> ShowS
ResponseElements -> String
(Int -> ResponseElements -> ShowS)
-> (ResponseElements -> String)
-> ([ResponseElements] -> ShowS)
-> Show ResponseElements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseElements] -> ShowS
$cshowList :: [ResponseElements] -> ShowS
show :: ResponseElements -> String
$cshow :: ResponseElements -> String
showsPrec :: Int -> ResponseElements -> ShowS
$cshowsPrec :: Int -> ResponseElements -> ShowS
Show, ResponseElements -> ResponseElements -> Bool
(ResponseElements -> ResponseElements -> Bool)
-> (ResponseElements -> ResponseElements -> Bool)
-> Eq ResponseElements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseElements -> ResponseElements -> Bool
$c/= :: ResponseElements -> ResponseElements -> Bool
== :: ResponseElements -> ResponseElements -> Bool
$c== :: ResponseElements -> ResponseElements -> Bool
Eq)

instance FromJSON ResponseElements where
  parseJSON :: Value -> Parser ResponseElements
parseJSON = String
-> (Object -> Parser ResponseElements)
-> Value
-> Parser ResponseElements
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject  String
"ResponseElements" ((Object -> Parser ResponseElements)
 -> Value -> Parser ResponseElements)
-> (Object -> Parser ResponseElements)
-> Value
-> Parser ResponseElements
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> ResponseElements
ResponseElements (Text -> Text -> ResponseElements)
-> Parser Text -> Parser (Text -> ResponseElements)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"x-amz-id-2" Parser (Text -> ResponseElements)
-> Parser Text -> Parser ResponseElements
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"x-amz-request-id"

data RequestParameters = RequestParameters {
  RequestParameters -> Text
sourceIPAddress :: Text
} deriving (Int -> RequestParameters -> ShowS
[RequestParameters] -> ShowS
RequestParameters -> String
(Int -> RequestParameters -> ShowS)
-> (RequestParameters -> String)
-> ([RequestParameters] -> ShowS)
-> Show RequestParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestParameters] -> ShowS
$cshowList :: [RequestParameters] -> ShowS
show :: RequestParameters -> String
$cshow :: RequestParameters -> String
showsPrec :: Int -> RequestParameters -> ShowS
$cshowsPrec :: Int -> RequestParameters -> ShowS
Show, RequestParameters -> RequestParameters -> Bool
(RequestParameters -> RequestParameters -> Bool)
-> (RequestParameters -> RequestParameters -> Bool)
-> Eq RequestParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestParameters -> RequestParameters -> Bool
$c/= :: RequestParameters -> RequestParameters -> Bool
== :: RequestParameters -> RequestParameters -> Bool
$c== :: RequestParameters -> RequestParameters -> Bool
Eq, (forall x. RequestParameters -> Rep RequestParameters x)
-> (forall x. Rep RequestParameters x -> RequestParameters)
-> Generic RequestParameters
forall x. Rep RequestParameters x -> RequestParameters
forall x. RequestParameters -> Rep RequestParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestParameters x -> RequestParameters
$cfrom :: forall x. RequestParameters -> Rep RequestParameters x
Generic)

instance FromJSON RequestParameters

-- | Event data sent by S3 when triggering a Lambda.
data S3Event = S3Event {
  S3Event -> Text
awsRegion         :: Text,
  S3Event -> Text
eventName         :: Text,
  S3Event -> Text
eventSource       :: Text,
  S3Event -> UTCTime
eventTime         :: UTCTime,
  S3Event -> Text
eventVersion      :: Text,
  S3Event -> RequestParameters
requestParameters :: RequestParameters,
  S3Event -> ResponseElements
responseElements  :: ResponseElements,
  S3Event -> S3Config
s3                :: S3Config,
  S3Event -> PrincipalIdentity
userIdentity      :: PrincipalIdentity
} deriving (Int -> S3Event -> ShowS
[S3Event] -> ShowS
S3Event -> String
(Int -> S3Event -> ShowS)
-> (S3Event -> String) -> ([S3Event] -> ShowS) -> Show S3Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Event] -> ShowS
$cshowList :: [S3Event] -> ShowS
show :: S3Event -> String
$cshow :: S3Event -> String
showsPrec :: Int -> S3Event -> ShowS
$cshowsPrec :: Int -> S3Event -> ShowS
Show, S3Event -> S3Event -> Bool
(S3Event -> S3Event -> Bool)
-> (S3Event -> S3Event -> Bool) -> Eq S3Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Event -> S3Event -> Bool
$c/= :: S3Event -> S3Event -> Bool
== :: S3Event -> S3Event -> Bool
$c== :: S3Event -> S3Event -> Bool
Eq, (forall x. S3Event -> Rep S3Event x)
-> (forall x. Rep S3Event x -> S3Event) -> Generic S3Event
forall x. Rep S3Event x -> S3Event
forall x. S3Event -> Rep S3Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3Event x -> S3Event
$cfrom :: forall x. S3Event -> Rep S3Event x
Generic)

instance FromJSON S3Event

-- | S3 object representations based on event type received.
--
-- Currently only Put/Delete events can trigger Lambdas
data S3Object =
  PutObject {
    S3Object -> Text
eTag      :: Text,
    S3Object -> Text
sequencer :: Text,
    S3Object -> Text
key       :: Text,
    S3Object -> Int
size      :: Int
  } | DeleteObject {
    sequencer :: Text,
    key       :: Text
  } deriving (Int -> S3Object -> ShowS
[S3Object] -> ShowS
S3Object -> String
(Int -> S3Object -> ShowS)
-> (S3Object -> String) -> ([S3Object] -> ShowS) -> Show S3Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Object] -> ShowS
$cshowList :: [S3Object] -> ShowS
show :: S3Object -> String
$cshow :: S3Object -> String
showsPrec :: Int -> S3Object -> ShowS
$cshowsPrec :: Int -> S3Object -> ShowS
Show, S3Object -> S3Object -> Bool
(S3Object -> S3Object -> Bool)
-> (S3Object -> S3Object -> Bool) -> Eq S3Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Object -> S3Object -> Bool
$c/= :: S3Object -> S3Object -> Bool
== :: S3Object -> S3Object -> Bool
$c== :: S3Object -> S3Object -> Bool
Eq, (forall x. S3Object -> Rep S3Object x)
-> (forall x. Rep S3Object x -> S3Object) -> Generic S3Object
forall x. Rep S3Object x -> S3Object
forall x. S3Object -> Rep S3Object x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3Object x -> S3Object
$cfrom :: forall x. S3Object -> Rep S3Object x
Generic)

instance FromJSON S3Object where
  parseJSON :: Value -> Parser S3Object
parseJSON (Object Object
o) = do
    Maybe Text
maybeEtag  <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"eTag"
    Maybe Int
maybeSize  <- Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"size"
    Text
key'       <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"key"
    Text
sequencer' <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"sequencer"

    S3Object -> Parser S3Object
forall (m :: * -> *) a. Monad m => a -> m a
return (S3Object -> Parser S3Object) -> S3Object -> Parser S3Object
forall a b. (a -> b) -> a -> b
$ case (Maybe Text
maybeEtag, Maybe Int
maybeSize) of
      (Just Text
etag', Just Int
size') -> Text -> Text -> Text -> Int -> S3Object
PutObject Text
etag' Text
sequencer' Text
key' Int
size'
      (Maybe Text, Maybe Int)
_                        -> Text -> Text -> S3Object
DeleteObject Text
sequencer' Text
key'

  parseJSON Value
invalid    = String -> Value -> Parser S3Object
forall a. String -> Value -> Parser a
typeMismatch String
"S3Object" Value
invalid