diff --git a/CHANGELOG.md b/CHANGELOG.md index 64deef6..65c88c0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog][chg] and this project adheres to [Haskell's Package Versioning Policy][pvp] +## Unreleased + - Add `messageGroupId` to SQS Attributes. + - Fix the type of `messageAttributes` in `SQSEvent`. + ## `1.1` - 2023-12-18 - `fallibleRuntime` and `fallibleRuntimeWithContext` report errors to AWS diff --git a/hal.cabal b/hal.cabal index 915640a..2979637 100644 --- a/hal.cabal +++ b/hal.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack -- --- hash: 68071e7a76bb7ee4441cd578bc9de2a1c3ffb2622ab059ce676d816922ed3d4b +-- hash: a8f1e61978a7c0772b00f7d79b8d54b83646f1aac9da8e964f32057442567c95 name: hal version: 1.1 @@ -116,6 +116,7 @@ test-suite hal-test AWS.Lambda.Events.EventBridge.Spec AWS.Lambda.Events.Kafka.Gen AWS.Lambda.Events.Kafka.Spec + AWS.Lambda.Events.SQS.Spec Gen.Header Paths_hal hs-source-dirs: @@ -149,7 +150,7 @@ test-suite hal-test , case-insensitive , containers , hal - , hedgehog >=1.0.3 && <1.5 + , hedgehog >=1.0.3 && <1.8 , hspec , hspec-hedgehog , http-client diff --git a/package.yaml b/package.yaml index 99bb281..ca385a9 100644 --- a/package.yaml +++ b/package.yaml @@ -101,7 +101,7 @@ tests: - bytestring - case-insensitive - containers - - hedgehog >= 1.0.3 && < 1.5 + - hedgehog >= 1.0.3 && < 1.8 - hspec - hspec-hedgehog - http-client diff --git a/src/AWS/Lambda/Events/SQS.hs b/src/AWS/Lambda/Events/SQS.hs index 7f3fd65..c17cb80 100644 --- a/src/AWS/Lambda/Events/SQS.hs +++ b/src/AWS/Lambda/Events/SQS.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + {-| Module : AWS.Lambda.Events.SQS Description : Data types for working with SQS events. @@ -10,17 +14,29 @@ Stability : stable module AWS.Lambda.Events.SQS ( Records (..), Attributes (..), + MessageAttribute (..), + MessageAttributeValue (..), SQSEvent (..) ) where -import Data.Aeson (FromJSON (..), withObject, (.:)) -import Data.Map (Map) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON (..), withObject, (.:), (.:?)) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as B64 +import Data.Map (Map) +import Data.Scientific (Scientific) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as TE +import GHC.Generics (Generic) +import Text.Read (readMaybe) +-- | Represents an event from AWS SQS. +-- +-- See the +-- for a sample payload. newtype Records = Records { records :: [SQSEvent] -} deriving (Show, Eq) +} deriving (Show, Eq, Generic) instance FromJSON Records where parseJSON = withObject "Records" $ \v -> Records <$> v .: "Records" @@ -29,23 +45,55 @@ data Attributes = Attributes { approximateReceiveCount :: Text, sentTimestamp :: Text, senderId :: Text, - approximateFirstReceiveTimestamp :: Text -} deriving (Show, Eq) + approximateFirstReceiveTimestamp :: Text, + messageGroupId :: Maybe Text +} deriving (Show, Eq, Generic) instance FromJSON Attributes where - parseJSON = withObject "Attributes" $ \v -> - Attributes - <$> v .: "ApproximateReceiveCount" - <*> v .: "SentTimestamp" - <*> v .: "SenderId" - <*> v .: "ApproximateFirstReceiveTimestamp" + parseJSON = withObject "Attributes" $ \v -> do + approximateReceiveCount <- v .: "ApproximateReceiveCount" + sentTimestamp <- v .: "SentTimestamp" + senderId <- v .: "SenderId" + approximateFirstReceiveTimestamp <- v .: "ApproximateFirstReceiveTimestamp" + messageGroupId <- v .:? "MessageGroupId" + pure Attributes {..} + +-- | An SQS message attribute as it appears in Lambda SQS event payloads. +-- +-- See the +-- for the JSON shape used under @messageAttributes@. +data MessageAttribute = MessageAttribute { + customTypeLabel :: Maybe Text, + value :: MessageAttributeValue +} deriving (Show, Eq, Generic) + +instance FromJSON MessageAttribute where + parseJSON = withObject "MessageAttribute" $ \v -> do + dataType <- v .: "dataType" + let (baseType, customTypeLabel) = splitDataType dataType + + value <- case baseType of + "Binary" -> Binary . decodeBase64Text <$> v .: "binaryValue" + "Number" -> Number <$> (v .: "stringValue" >>= parseNumber) + "String" -> String <$> v .: "stringValue" + _ -> fail $ "Unexpected message attribute dataType: " <> show dataType + + pure MessageAttribute { customTypeLabel, value } + where + parseNumber = maybe (fail "can't parse stringValue into Scientific") pure . readMaybe + +data MessageAttributeValue + = Binary ByteString + | Number Scientific + | String Text + deriving (Show, Eq, Generic) data SQSEvent = SQSEvent { messageId :: Text, receiptHandle :: Text, body :: Text, attributes :: Attributes, - messageAttributes :: Map Text Text, + messageAttributes :: Map Text MessageAttribute, md5OfBody :: Text, eventSource :: Text, eventSourceARN :: Text, @@ -53,3 +101,13 @@ data SQSEvent = SQSEvent { } deriving (Show, Eq, Generic) instance FromJSON SQSEvent + +decodeBase64Text :: Text -> ByteString +decodeBase64Text = B64.decodeLenient . TE.encodeUtf8 + +splitDataType :: Text -> (Text, Maybe Text) +splitDataType dataType = + case Text.breakOn "." dataType of + (baseType, "") -> (baseType, Nothing) + (baseType, customTypeLabel) -> + (baseType, Just $ Text.drop 1 customTypeLabel) diff --git a/test/AWS/Lambda/Events/SQS/Spec.hs b/test/AWS/Lambda/Events/SQS/Spec.hs new file mode 100644 index 0000000..8bc5b7b --- /dev/null +++ b/test/AWS/Lambda/Events/SQS/Spec.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE QuasiQuotes #-} + +module AWS.Lambda.Events.SQS.Spec where + +import AWS.Lambda.Events.SQS +import Data.Aeson (eitherDecode) +import Data.Either (isLeft) +import qualified Data.Map as M +import Data.ByteString.Lazy (ByteString) +import Test.Hspec (Spec, shouldBe, shouldSatisfy, specify) +import Text.RawString.QQ (r) + +spec :: Spec +spec = do + specify "read sample payload" $ + eitherDecode samplePayload `shouldBe` Right expectedRecords + + specify "fail on invalid number message attributes" $ + (eitherDecode invalidNumberPayload :: Either String Records) `shouldSatisfy` isLeft + +samplePayload :: ByteString +samplePayload = [r| +{ + "Records": [ + { + "messageId": "11111111-2222-3333-4444-555555555555", + "receiptHandle": "AQEBwJnKyrHigUMZj6rYigCgxlaS3SLy0a...", + "body": "Hello from SQS!", + "attributes": { + "ApproximateReceiveCount": "1", + "SentTimestamp": "1523232000000", + "SenderId": "123456789012", + "ApproximateFirstReceiveTimestamp": "1523232000001", + "MessageGroupId": "group-1" + }, + "messageAttributes": { + "attribute1": { + "stringValue": "value1", + "stringListValues": ["ignored-string-list-value"], + "binaryListValues": ["aWdub3JlZC1iaW5hcnktbGlzdC12YWx1ZQ=="], + "dataType": "String" + }, + "attribute2": { + "stringValue": "ignored-string-value", + "binaryValue": "dmFsdWUy", + "stringListValues": [], + "binaryListValues": [], + "dataType": "Binary" + }, + "attribute3": { + "stringValue": "123.45", + "stringListValues": [], + "binaryListValues": [], + "dataType": "Number" + }, + "attribute4": { + "stringValue": "value4", + "binaryValue": "aWdub3JlZC1iaW5hcnktdmFsdWU=", + "stringListValues": ["ignored-extra-string"], + "binaryListValues": ["aWdub3JlZC1leHRyYS1iaW5hcnk="], + "dataType": "String.foo" + } + }, + "md5OfBody": "9a0364b9e99bb480dd25e1f0284c8555", + "eventSource": "aws:sqs", + "eventSourceARN": "arn:aws:sqs:us-east-1:123456789012:queue1", + "awsRegion": "us-east-1" + } + ] +} +|] + +expectedRecords :: Records +expectedRecords = Records + { records = + [ SQSEvent + { messageId = "11111111-2222-3333-4444-555555555555" + , receiptHandle = "AQEBwJnKyrHigUMZj6rYigCgxlaS3SLy0a..." + , body = "Hello from SQS!" + , attributes = Attributes + { approximateReceiveCount = "1" + , sentTimestamp = "1523232000000" + , senderId = "123456789012" + , approximateFirstReceiveTimestamp = "1523232000001" + , messageGroupId = Just "group-1" + } + , messageAttributes = M.fromList + [ ( "attribute1" + , MessageAttribute + { customTypeLabel = Nothing + , value = String "value1" + } + ) + , ( "attribute2" + , MessageAttribute + { customTypeLabel = Nothing + , value = Binary "value2" + } + ) + , ( "attribute3" + , MessageAttribute + { customTypeLabel = Nothing + , value = Number 123.45 + } + ) + , ( "attribute4" + , MessageAttribute + { customTypeLabel = Just "foo" + , value = String "value4" + } + ) + ] + , md5OfBody = "9a0364b9e99bb480dd25e1f0284c8555" + , eventSource = "aws:sqs" + , eventSourceARN = "arn:aws:sqs:us-east-1:123456789012:queue1" + , awsRegion = "us-east-1" + } + ] + } + +invalidNumberPayload :: ByteString +invalidNumberPayload = [r| +{ + "Records": [ + { + "messageId": "11111111-2222-3333-4444-555555555555", + "receiptHandle": "AQEBwJnKyrHigUMZj6rYigCgxlaS3SLy0a...", + "body": "Hello from SQS!", + "attributes": { + "ApproximateReceiveCount": "1", + "SentTimestamp": "1523232000000", + "SenderId": "123456789012", + "ApproximateFirstReceiveTimestamp": "1523232000001" + }, + "messageAttributes": { + "attribute1": { + "stringValue": "not-a-number", + "dataType": "Number" + } + }, + "md5OfBody": "9a0364b9e99bb480dd25e1f0284c8555", + "eventSource": "aws:sqs", + "eventSourceARN": "arn:aws:sqs:us-east-1:123456789012:queue1", + "awsRegion": "us-east-1" + } + ] +} +|] diff --git a/test/Spec.hs b/test/Spec.hs index bf8ba6f..bee42ba 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -9,6 +9,7 @@ import qualified AWS.Lambda.Events.ApiGateway.ProxyResponse.Spec as ProxyRespons import qualified AWS.Lambda.Events.EventBridge.Spec as EventBridge import qualified AWS.Lambda.Events.Kafka.Spec as Kafka +import qualified AWS.Lambda.Events.SQS.Spec as SQS import AWS.Lambda.Internal (StaticContext (..)) import AWS.Lambda.RuntimeClient.Internal (eventResponseToNextData) import Data.Aeson (Value (Null)) @@ -37,6 +38,7 @@ main = describe "ProxyResponse" ProxyResponse.spec describe "EventBridge" EventBridge.spec describe "Kafka" Kafka.spec + describe "SQS" SQS.spec describe "Event Response Data" $ do let staticContext =