serverless-haskell 0.11.3 → 0.12.0

raw patch · 8 files changed

+160/−146 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• serverless-haskell.cabal +2/−2
• src/AWSLambda/Events.hs +27/−86
• src/AWSLambda/Events/Records.hs +19/−3
• src/AWSLambda/Events/S3Event.hs +33/−6
• src/AWSLambda/Events/SNSEvent.hs +26/−13
• src/AWSLambda/Events/SQSEvent.hs +24/−11
• src/AWSLambda/Handler.hs +28/−24

@@ -1,6 +1,6 @@ # Serverless Haskell -[![Build status](https://img.shields.io/travis/seek-oss/serverless-haskell.svg)](https://travis-ci.org/seek-oss/serverless-haskell)+![Build status](https://github.com/seek-oss/serverless-haskell/workflows/Build/badge.svg) [![Hackage](https://img.shields.io/hackage/v/serverless-haskell.svg)](https://hackage.haskell.org/package/serverless-haskell) [![Stackage LTS](https://www.stackage.org/package/serverless-haskell/badge/lts)](https://www.stackage.org/lts/package/serverless-haskell) [![Hackage dependencies](https://img.shields.io/hackage-deps/v/serverless-haskell.svg)](https://packdeps.haskellers.com/feed?needle=serverless-haskell)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b59f07c12f9fd7b00b5fe4ab4e1842ce35b15ae050d1c4166bc645916b13f94e+-- hash: f3d35ad6736c054bc1bebffa93ddf0f4d556eca6a0743b1a17f9dc2e7d898c4d  name:           serverless-haskell-version:        0.11.3+version:        0.12.0 synopsis:       Deploying Haskell code onto AWS Lambda using Serverless description:    Utilities to help process the events from AWS Lambda when deployed with the serverless-haskell plugin. category:       AWS, Cloud, Network

@@ -1,96 +1,37 @@-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} -module AWSLambda.Events where+module AWSLambda.Events+  ( module AWSLambda.Events.APIGateway+  , module AWSLambda.Events.KinesisEvent+  , module AWSLambda.Events.MessageAttribute+  , module AWSLambda.Events.Records+  , module AWSLambda.Events.S3Event+  , module AWSLambda.Events.SNSEvent+  , module AWSLambda.Events.SQSEvent+  , snsInSqsMain+  , s3InSnsInSqsMain+  ) where -import           Control.Applicative           ((<|>))-import           Control.Lens.TH-import           Data.Aeson                    (FromJSON (..), Value)-import           Network.AWS.Data.Text         (FromText)+import           Control.Exception.Safe (MonadCatch)+import           Control.Monad.IO.Class+import           Data.Aeson (FromJSON(..)) +import           AWSLambda.Events.APIGateway import           AWSLambda.Events.KinesisEvent+import           AWSLambda.Events.MessageAttribute+import           AWSLambda.Events.Records import           AWSLambda.Events.S3Event import           AWSLambda.Events.SNSEvent import           AWSLambda.Events.SQSEvent --- | Not yet implemented-data DynamoDBEvent---- | Not yet implemented-data SESEvent---- | Not yet implemented-data CognitoEvent---- | Not yet implemented-data CloudFormationEvent---- | Not yet implemented-data CloudWatchLogsEvent---- | Not yet implemented-data CloudWatchEventsEvent---- | Not yet implemented-data CodeCommitEvent---- | Not yet implemented-data ConfigEvent---- | Not yet implemented-data AlexaEvent---- | Not yet implemented-data LexEvent---- | Not yet implemented-data APIGatewayEvent---- | Not yet implemented-data IoTButtonEvent---- | Not yet implemented-data CloudFrontEvent---- | Not yet implemented-data FirehoseEvent---- | Not yet implemented-data InvokeEvent---- | Sum type for all possible Lambda events.--- Parameterised on the type of SNS Events to be handled.--- See @SNSEvent@ for details.-data LambdaEvent message-  = S3 !S3Event-  | DynamoDB !DynamoDBEvent-  | KinesisStream !KinesisEvent-  | SNS !(SNSEvent message)-  | SQS !(SQSEvent message)-  | SES !SESEvent-  | Cognito !CognitoEvent-  | CloudFormation !CloudFormationEvent-  | CloudWatchLogs !CloudWatchLogsEvent-  | CloudWatchEvents !CloudWatchEventsEvent-  | CodeCommit !CodeCommitEvent-  | Config !ConfigEvent-  | Alexa !AlexaEvent-  | Lex !LexEvent-  | APIGateway !APIGatewayEvent-  | IoTButton !IoTButtonEvent-  | CloudFront !CloudFrontEvent-  | Firehose !FirehoseEvent-  | Invoke !InvokeEvent-  | Custom !Value---- | Attempt to parse the various event types.--- Any valid JSON that can't be parsed as a specific--- event type will result in a 'Custom' value.-instance FromText message =>-         FromJSON (LambdaEvent message) where-  parseJSON v =-    try S3 v <|> try KinesisStream v <|> try SNS v <|> try SQS v <|> pure (Custom v)-    where-      try f = fmap f . parseJSON+-- | A specialised version of the 'lambdaMain' entry-point+-- for handling individual SNS messages embedded in SQS messages+snsInSqsMain :: (FromJSON a, MonadCatch m, MonadIO m) => (a -> m ()) -> m ()+snsInSqsMain = sqsMain . traverseSns -$(makePrisms ''LambdaEvent)+-- | A specialised version of the 'lambdaMain' entry-point+-- for handling individual S3 event notifications embedded in+-- SNS messages embedded in SQS messages+s3InSnsInSqsMain :: (MonadCatch m, MonadIO m) => (S3EventNotification -> m ()) -> m ()+s3InSnsInSqsMain = snsInSqsMain . traverseRecords

@@ -1,14 +1,30 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}  module AWSLambda.Events.Records where +import           Control.Exception.Safe (MonadCatch) import           Control.Lens.TH (makeLenses)-import           Data.Aeson      (FromJSON (..), withObject, (.:))+import           Control.Monad.IO.Class+import           Data.Aeson (FromJSON(..), withObject, (.:))+import           Data.Foldable (traverse_) -newtype RecordsEvent a = RecordsEvent { _reRecords :: [a] } deriving (Eq, Show)+import           AWSLambda.Handler (lambdaMain) +newtype RecordsEvent a = RecordsEvent { _reRecords :: [a] } deriving (Eq, Show, Functor, Foldable)+ instance FromJSON a => FromJSON (RecordsEvent a) where   parseJSON = withObject "RecordsEvent" $ \o -> RecordsEvent <$> o .: "Records"  $(makeLenses ''RecordsEvent)++-- | Traverse all the records in a Lambda event+traverseRecords :: Applicative m => (a -> m ()) -> RecordsEvent a -> m ()+traverseRecords = traverse_++-- | A specialised version of the 'lambdaMain' entry-point+-- for handling individual records in a Lambda event+recordsMain :: (FromJSON a, MonadCatch m, MonadIO m) => (a -> m ()) -> m ()+recordsMain = lambdaMain . traverseRecords

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE LambdaCase        #-}  {-| Module: AWSLambda.Events.S3Event@@ -17,7 +18,7 @@ import           Data.Aeson.TH            (deriveFromJSON) import           Data.Text                (Text) import           Data.Time.Clock          (UTCTime)-import qualified Network.AWS.S3           as S3+import           Network.AWS.S3           (BucketName, ETag, Event(..), ObjectKey, ObjectVersionId) import qualified Network.AWS.Types        as AWS  import           AWSLambda.Events.Records@@ -32,7 +33,7 @@  data S3BucketEntity = S3BucketEntity   { _sbeArn           :: !Text-  , _sbeName          :: !S3.BucketName+  , _sbeName          :: !BucketName   , _sbeOwnerIdentity :: !UserIdentityEntity   } deriving (Eq, Show) @@ -40,11 +41,11 @@ $(makeLenses ''S3BucketEntity)  data S3ObjectEntity = S3ObjectEntity-  { _soeETag      :: !(Maybe S3.ETag)-  , _soeKey       :: !S3.ObjectKey+  { _soeETag      :: !(Maybe ETag)+  , _soeKey       :: !ObjectKey   , _soeSize      :: !(Maybe Integer)   , _soeSequencer :: !Text-  , _soeVersionId :: !(Maybe S3.ObjectVersionId)+  , _soeVersionId :: !(Maybe ObjectVersionId)   } deriving (Eq, Show)  $(deriveFromJSON (aesonDrop 4 camelCase) ''S3ObjectEntity)@@ -81,7 +82,7 @@  data S3EventNotification = S3EventNotification   { _senAwsRegion         :: !AWS.Region-  , _senEventName         :: !S3.Event+  , _senEventName         :: !Event   , _senEventSource       :: !Text   , _senEventTime         :: !UTCTime   , _senEventVersion      :: !Text@@ -107,3 +108,29 @@ $(makeLenses ''S3EventNotification)  type S3Event = RecordsEvent S3EventNotification++-- | Is the event an object creation event+isCreateEvent :: S3EventNotification -> Bool+isCreateEvent e = case _senEventName e of+  S3ObjectCreated -> True+  S3ObjectCreatedCompleteMultipartUpload -> True+  S3ObjectCreatedCopy -> True+  S3ObjectCreatedPost -> True+  S3ObjectCreatedPut -> True+  S3ObjectRemoved -> False+  S3ObjectRemovedDelete -> False+  S3ObjectRemovedDeleteMarkerCreated -> False+  S3ReducedRedundancyLostObject -> False++-- | Is the event an object removal event+isRemoveEvent :: S3EventNotification -> Bool+isRemoveEvent e = case _senEventName e of+  S3ObjectCreated -> False+  S3ObjectCreatedCompleteMultipartUpload -> False+  S3ObjectCreatedCopy -> False+  S3ObjectCreatedPost -> False+  S3ObjectCreatedPut -> False+  S3ObjectRemoved -> True+  S3ObjectRemovedDelete -> True+  S3ObjectRemovedDeleteMarkerCreated -> True+  S3ReducedRedundancyLostObject -> False

@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}  {-| Module: AWSLambda.Events.SNSEvent@@ -11,23 +11,26 @@ -} module AWSLambda.Events.SNSEvent where -import           Control.Applicative      ((<|>))+import           Control.Applicative ((<|>))+import           Control.Exception.Safe (MonadCatch) import           Control.Lens-import           Data.Aeson               (FromJSON (..), genericParseJSON,-                                           withObject, (.:), (.:?), (.!=))-import           Data.Aeson.Casing        (aesonDrop, pascalCase)+import           Control.Monad.IO.Class+import           Data.Aeson+                  (FromJSON(..), genericParseJSON, withObject, (.!=), (.:), (.:?))+import           Data.Aeson.Casing (aesonDrop, pascalCase) import           Data.Aeson.Embedded import           Data.Aeson.TextValue-import           Data.ByteString          (ByteString)-import           Data.HashMap.Strict      (HashMap)-import           Data.Text                (Text)-import           Data.Time.Clock          (UTCTime)-import           GHC.Generics             (Generic)+import           Data.ByteString (ByteString)+import           Data.HashMap.Strict (HashMap)+import           Data.Text (Text)+import           Data.Time.Clock (UTCTime)+import           GHC.Generics (Generic) import           Network.AWS.Data.Base64-import           Network.AWS.Data.Text    (FromText)+import           Network.AWS.Data.Text (FromText)  import           AWSLambda.Events.MessageAttribute import           AWSLambda.Events.Records+import           AWSLambda.Handler (lambdaMain)  data SNSMessage message = SNSMessage   { _smMessage           :: !(TextValue message )@@ -100,3 +103,13 @@  binary :: Traversal' (SNSEvent Base64) ByteString binary = messages . _Base64++-- | Traverse all the messages in an SNS event+traverseSns :: (FromJSON a, Applicative m) => (a -> m ()) -> SNSEvent (Embedded a) -> m ()+traverseSns act = traverseRecords $ \record ->+    act $ record ^. srSns . smMessage . unTextValue . unEmbed++-- | A specialed version of the 'lambdaMain' entry-point+-- for handling individual SNS messages+snsMain :: (FromJSON a, MonadCatch m, MonadIO m) => (a -> m ()) -> m ()+snsMain = lambdaMain . traverseSns

@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}  {-| Module: AWSLambda.Events.SQSEvent@@ -9,21 +9,24 @@ -} module AWSLambda.Events.SQSEvent where +import           Control.Exception.Safe (MonadCatch) import           Control.Lens-import           Data.Aeson               (FromJSON (..), genericParseJSON)-import           Data.Aeson.Casing        (aesonPrefix, camelCase)+import           Control.Monad.IO.Class+import           Data.Aeson (FromJSON(..), genericParseJSON)+import           Data.Aeson.Casing (aesonPrefix, camelCase) import           Data.Aeson.Embedded import           Data.Aeson.TextValue-import           Data.ByteString          (ByteString)-import           Data.HashMap.Strict      (HashMap)-import           Data.Text                (Text)-import           GHC.Generics             (Generic)+import           Data.ByteString (ByteString)+import           Data.HashMap.Strict (HashMap)+import           Data.Text (Text)+import           GHC.Generics (Generic) import           Network.AWS.Data.Base64-import           Network.AWS.Data.Text    (FromText)-import qualified Network.AWS.Types        as AWS+import           Network.AWS.Data.Text (FromText)+import qualified Network.AWS.Types as AWS  import           AWSLambda.Events.MessageAttribute import           AWSLambda.Events.Records+import           AWSLambda.Handler (lambdaMain)  data SQSMessage body = SQSMessage   { _sqsmMessageId         :: !Text@@ -54,3 +57,13 @@  sqsBinary :: Traversal' (SQSEvent Base64) ByteString sqsBinary = sqsMessages . _Base64++-- | Traverse all the messages in an SQS event+traverseSqs :: (FromJSON a, Applicative m) => (a -> m ()) -> SQSEvent (Embedded a) -> m ()+traverseSqs act = traverseRecords $ \record ->+    act $ record ^. sqsmBody . unTextValue . unEmbed++-- | A specialised version of the 'lambdaMain' entry-point+-- for handling individual SQS messages+sqsMain :: (FromJSON a, MonadCatch m, MonadIO m) => (a -> m ()) -> m ()+sqsMain = lambdaMain . traverseSqs

@@ -9,15 +9,17 @@ -} module AWSLambda.Handler   ( lambdaMain+  , lambdaMainRaw   ) where -import Control.Exception.Safe (SomeException(..), displayException, tryAny)-import Control.Monad (forever, void)+import           Control.Exception.Safe (MonadCatch, SomeException(..), displayException, tryAny)+import           Control.Monad (forever, void)+import           Control.Monad.IO.Class -import Data.Aeson ((.=))+import           Data.Aeson ((.=)) import qualified Data.Aeson as Aeson -import Data.Typeable (typeOf)+import           Data.Typeable (typeOf)  import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8@@ -26,13 +28,13 @@ import qualified Data.Text.Encoding as Text import qualified Data.Text.IO as Text -import GHC.IO.Handle (BufferMode(..), hSetBuffering)+import           GHC.IO.Handle (BufferMode(..), hSetBuffering) -import Network.HTTP.Client-import Network.HTTP.Types (HeaderName)+import           Network.HTTP.Client+import           Network.HTTP.Types (HeaderName) -import System.Environment (lookupEnv)-import System.IO (stdout)+import           System.Environment (lookupEnv)+import           System.IO (stdout)  -- | Process incoming events from @serverless-haskell@ using a provided -- function.@@ -84,38 +86,40 @@ -- the command line, and the result of the execution is printed, also as JSON, -- to the standard output. lambdaMain ::-     (Aeson.FromJSON event, Aeson.ToJSON res)-  => (event -> IO res) -- ^ Function to process the event-  -> IO ()+     (Aeson.FromJSON event, Aeson.ToJSON res, MonadCatch m, MonadIO m)+  => (event -> m res) -- ^ Function to process the event+  -> m () lambdaMain act =-  runMain $ \input -> do+  lambdaMainRaw $ \input -> do     case Aeson.eitherDecode input of       Left err -> error err       Right event -> do         result <- act event         pure $ Aeson.encode result --- Process the incoming requests (using the AWS Lambda runtime interface or from the standard input).+-- | Process the incoming requests (using the AWS Lambda runtime interface or from the standard input). -- Also set line buffering on standard output for AWS Lambda so the logs are output in a timely manner.-runMain :: (LBS.ByteString -> IO LBS.ByteString) -> IO ()-runMain act = do-  lambdaApiAddress <- lookupEnv lambdaApiAddressEnv+-- This function provides a lower level interface than 'lambdaMain' for users who don't want to use+-- Aeson for encoding and decoding JSON.+lambdaMainRaw :: (MonadCatch m, MonadIO m) => (LBS.ByteString -> m LBS.ByteString) -> m ()+lambdaMainRaw act = do+  lambdaApiAddress <- liftIO $ lookupEnv lambdaApiAddressEnv   case lambdaApiAddress of     Just address -> do-      hSetBuffering stdout LineBuffering-      manager <- newManager defaultManagerSettings+      liftIO $ hSetBuffering stdout LineBuffering+      manager <- liftIO $ newManager defaultManagerSettings       forever $ do-        invocation <- httpLbs (invocationRequest address) manager+        invocation <- liftIO $ httpLbs (invocationRequest address) manager         let input = responseBody invocation         let requestId = responseRequestId invocation         resultOrError <- tryAny $ act input         case resultOrError of-          Right result -> void $ httpNoBody (resultRequest address requestId result) manager-          Left exception -> void $ httpNoBody (errorRequest address requestId exception) manager+          Right result   -> liftIO $ void $ httpNoBody (resultRequest address requestId result) manager+          Left exception -> liftIO $ void $ httpNoBody (errorRequest address requestId exception) manager     Nothing -> do-      input <- LBS.fromStrict <$> ByteString.getLine+      input <- liftIO $ LBS.fromStrict <$> ByteString.getLine       result <- act input-      Text.putStrLn $ Text.decodeUtf8 $ LBS.toStrict result+      liftIO $ Text.putStrLn $ Text.decodeUtf8 $ LBS.toStrict result  lambdaApiAddressEnv :: String lambdaApiAddressEnv = "AWS_LAMBDA_RUNTIME_API"