{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

{-|
Module: AWSLambda.Events.S3Event
Description: Types for S3 Lambda events

Based on https://github.com/aws/aws-lambda-dotnet/tree/master/Libraries/src/Amazon.Lambda.S3Events
-}
module AWSLambda.Events.S3Event where

import           Control.Lens.TH
import           Control.Monad            (guard)
import           Data.Aeson               (FromJSON (..), withObject, (.:))
import           Data.Aeson.Casing        (aesonDrop, camelCase)
import           Data.Aeson.TH            (deriveFromJSON)
import           Data.Text                (Text)
import           Data.Time.Clock          (UTCTime)
import qualified Network.AWS.S3           as S3
import qualified Network.AWS.Types        as AWS

import           AWSLambda.Events.Records
import           AWSLambda.Orphans        ()

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

$(deriveFromJSON (aesonDrop 4 camelCase) ''UserIdentityEntity)
$(makeLenses ''UserIdentityEntity)

data S3BucketEntity = S3BucketEntity
  { S3BucketEntity -> Text
_sbeArn           :: !Text
  , S3BucketEntity -> BucketName
_sbeName          :: !S3.BucketName
  , S3BucketEntity -> UserIdentityEntity
_sbeOwnerIdentity :: !UserIdentityEntity
  } deriving (S3BucketEntity -> S3BucketEntity -> Bool
(S3BucketEntity -> S3BucketEntity -> Bool)
-> (S3BucketEntity -> S3BucketEntity -> Bool) -> Eq S3BucketEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3BucketEntity -> S3BucketEntity -> Bool
$c/= :: S3BucketEntity -> S3BucketEntity -> Bool
== :: S3BucketEntity -> S3BucketEntity -> Bool
$c== :: S3BucketEntity -> S3BucketEntity -> Bool
Eq, Int -> S3BucketEntity -> ShowS
[S3BucketEntity] -> ShowS
S3BucketEntity -> String
(Int -> S3BucketEntity -> ShowS)
-> (S3BucketEntity -> String)
-> ([S3BucketEntity] -> ShowS)
-> Show S3BucketEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3BucketEntity] -> ShowS
$cshowList :: [S3BucketEntity] -> ShowS
show :: S3BucketEntity -> String
$cshow :: S3BucketEntity -> String
showsPrec :: Int -> S3BucketEntity -> ShowS
$cshowsPrec :: Int -> S3BucketEntity -> ShowS
Show)

$(deriveFromJSON (aesonDrop 4 camelCase) ''S3BucketEntity)
$(makeLenses ''S3BucketEntity)

data S3ObjectEntity = S3ObjectEntity
  { S3ObjectEntity -> Maybe ETag
_soeETag      :: !(Maybe S3.ETag)
  , S3ObjectEntity -> ObjectKey
_soeKey       :: !S3.ObjectKey
  , S3ObjectEntity -> Maybe Integer
_soeSize      :: !(Maybe Integer)
  , S3ObjectEntity -> Text
_soeSequencer :: !Text
  , S3ObjectEntity -> Maybe Text
_soeVersionId :: !(Maybe Text)
  } deriving (S3ObjectEntity -> S3ObjectEntity -> Bool
(S3ObjectEntity -> S3ObjectEntity -> Bool)
-> (S3ObjectEntity -> S3ObjectEntity -> Bool) -> Eq S3ObjectEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3ObjectEntity -> S3ObjectEntity -> Bool
$c/= :: S3ObjectEntity -> S3ObjectEntity -> Bool
== :: S3ObjectEntity -> S3ObjectEntity -> Bool
$c== :: S3ObjectEntity -> S3ObjectEntity -> Bool
Eq, Int -> S3ObjectEntity -> ShowS
[S3ObjectEntity] -> ShowS
S3ObjectEntity -> String
(Int -> S3ObjectEntity -> ShowS)
-> (S3ObjectEntity -> String)
-> ([S3ObjectEntity] -> ShowS)
-> Show S3ObjectEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3ObjectEntity] -> ShowS
$cshowList :: [S3ObjectEntity] -> ShowS
show :: S3ObjectEntity -> String
$cshow :: S3ObjectEntity -> String
showsPrec :: Int -> S3ObjectEntity -> ShowS
$cshowsPrec :: Int -> S3ObjectEntity -> ShowS
Show)

$(deriveFromJSON (aesonDrop 4 camelCase) ''S3ObjectEntity)
$(makeLenses ''S3ObjectEntity)

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

$(deriveFromJSON (aesonDrop 4 camelCase) ''RequestParametersEntity)
$(makeLenses ''RequestParametersEntity)

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

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

data S3Entity = S3Entity
  { S3Entity -> S3BucketEntity
_seBucket          :: !S3BucketEntity
  , S3Entity -> Text
_seConfigurationId :: !Text
  , S3Entity -> S3ObjectEntity
_seObject          :: !S3ObjectEntity
  , S3Entity -> Text
_seS3SchemaVersion :: !Text
  } deriving (S3Entity -> S3Entity -> Bool
(S3Entity -> S3Entity -> Bool)
-> (S3Entity -> S3Entity -> Bool) -> Eq S3Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Entity -> S3Entity -> Bool
$c/= :: S3Entity -> S3Entity -> Bool
== :: S3Entity -> S3Entity -> Bool
$c== :: S3Entity -> S3Entity -> Bool
Eq, Int -> S3Entity -> ShowS
[S3Entity] -> ShowS
S3Entity -> String
(Int -> S3Entity -> ShowS)
-> (S3Entity -> String) -> ([S3Entity] -> ShowS) -> Show S3Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Entity] -> ShowS
$cshowList :: [S3Entity] -> ShowS
show :: S3Entity -> String
$cshow :: S3Entity -> String
showsPrec :: Int -> S3Entity -> ShowS
$cshowsPrec :: Int -> S3Entity -> ShowS
Show)

$(deriveFromJSON (aesonDrop 3 camelCase) ''S3Entity)
$(makeLenses ''S3Entity)

data S3EventNotification = S3EventNotification
  { S3EventNotification -> Region
_senAwsRegion         :: !AWS.Region
  , S3EventNotification -> Event
_senEventName         :: !S3.Event
  , S3EventNotification -> Text
_senEventSource       :: !Text
  , S3EventNotification -> UTCTime
_senEventTime         :: !UTCTime
  , S3EventNotification -> Text
_senEventVersion      :: !Text
  , S3EventNotification -> RequestParametersEntity
_senRequestParameters :: !RequestParametersEntity
  , S3EventNotification -> ResponseElementsEntity
_senResponseElements  :: !ResponseElementsEntity
  , S3EventNotification -> S3Entity
_senS3                :: !S3Entity
  , S3EventNotification -> UserIdentityEntity
_senUserIdentity      :: !UserIdentityEntity
  } deriving (S3EventNotification -> S3EventNotification -> Bool
(S3EventNotification -> S3EventNotification -> Bool)
-> (S3EventNotification -> S3EventNotification -> Bool)
-> Eq S3EventNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3EventNotification -> S3EventNotification -> Bool
$c/= :: S3EventNotification -> S3EventNotification -> Bool
== :: S3EventNotification -> S3EventNotification -> Bool
$c== :: S3EventNotification -> S3EventNotification -> Bool
Eq, Int -> S3EventNotification -> ShowS
[S3EventNotification] -> ShowS
S3EventNotification -> String
(Int -> S3EventNotification -> ShowS)
-> (S3EventNotification -> String)
-> ([S3EventNotification] -> ShowS)
-> Show S3EventNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3EventNotification] -> ShowS
$cshowList :: [S3EventNotification] -> ShowS
show :: S3EventNotification -> String
$cshow :: S3EventNotification -> String
showsPrec :: Int -> S3EventNotification -> ShowS
$cshowsPrec :: Int -> S3EventNotification -> ShowS
Show)

instance FromJSON S3EventNotification where
  parseJSON :: Value -> Parser S3EventNotification
parseJSON = String
-> (Object -> Parser S3EventNotification)
-> Value
-> Parser S3EventNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"S3EventNotification" ((Object -> Parser S3EventNotification)
 -> Value -> Parser S3EventNotification)
-> (Object -> Parser S3EventNotification)
-> Value
-> Parser S3EventNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
_senEventSource <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"eventSource"
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text
_senEventSource Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"aws:s3"
    Region
_senAwsRegion <- Object
o Object -> Text -> Parser Region
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"awsRegion"
    Event
_senEventName <- Object
o Object -> Text -> Parser Event
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"eventName"
    UTCTime
_senEventTime <- Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"eventTime"
    Text
_senEventVersion <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"eventVersion"
    RequestParametersEntity
_senRequestParameters <- Object
o Object -> Text -> Parser RequestParametersEntity
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"requestParameters"
    ResponseElementsEntity
_senResponseElements <- Object
o Object -> Text -> Parser ResponseElementsEntity
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"responseElements"
    S3Entity
_senS3 <- Object
o Object -> Text -> Parser S3Entity
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s3"
    UserIdentityEntity
_senUserIdentity <- Object
o Object -> Text -> Parser UserIdentityEntity
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"userIdentity"
    S3EventNotification -> Parser S3EventNotification
forall (m :: * -> *) a. Monad m => a -> m a
return S3EventNotification :: Region
-> Event
-> Text
-> UTCTime
-> Text
-> RequestParametersEntity
-> ResponseElementsEntity
-> S3Entity
-> UserIdentityEntity
-> S3EventNotification
S3EventNotification {Text
UTCTime
Region
Event
UserIdentityEntity
RequestParametersEntity
ResponseElementsEntity
S3Entity
_senUserIdentity :: UserIdentityEntity
_senS3 :: S3Entity
_senResponseElements :: ResponseElementsEntity
_senRequestParameters :: RequestParametersEntity
_senEventVersion :: Text
_senEventTime :: UTCTime
_senEventName :: Event
_senAwsRegion :: Region
_senEventSource :: Text
_senUserIdentity :: UserIdentityEntity
_senS3 :: S3Entity
_senResponseElements :: ResponseElementsEntity
_senRequestParameters :: RequestParametersEntity
_senEventVersion :: Text
_senEventTime :: UTCTime
_senEventSource :: Text
_senEventName :: Event
_senAwsRegion :: Region
..}
$(makeLenses ''S3EventNotification)

type S3Event = RecordsEvent S3EventNotification