Fix sqs message attribute

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

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

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

src/AWS/Lambda/Events/SQS.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE ApplicativeDo   #-}
+{-# LANGUAGE RecordWildCards #-}
+
 {-|
 Module      : AWS.Lambda.Events.SQS
 Description : Data types for working with SQS events.
@@ -10,17 +13,25 @@ Stability   : stable
 module AWS.Lambda.Events.SQS (
   Records (..),
   Attributes (..),
+  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.Text              (Text)
+import qualified Data.Text.Encoding     as TE
+import           GHC.Generics           (Generic)
 
+-- | Represents an event from AWS SQS.
+--
+-- See the <https://docs.aws.amazon.com/lambda/latest/dg/with-sqs.html AWS documentation>
+-- 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,27 +40,53 @@ 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 value as it appears in Lambda SQS event payloads.
+--
+-- See the <https://docs.aws.amazon.com/lambda/latest/dg/with-sqs.html#example-standard-queue-message-event AWS Lambda SQS event payload example>
+-- for the JSON shape used under @messageAttributes@.
+data MessageAttributeValue = MessageAttributeValue {
+  stringValue      :: Maybe Text,
+  binaryValue      :: Maybe ByteString,
+  stringListValues :: [Text],
+  binaryListValues :: [ByteString],
+  dataType         :: Text
+} deriving (Show, Eq, Generic)
+
+instance FromJSON MessageAttributeValue where
+  parseJSON = withObject "MessageAttributeValue" $ \v -> do
+    stringValue <- v .:? "stringValue"
+    binaryValue <- fmap decodeBase64Text <$> v .:? "binaryValue"
+    stringListValues <- maybe [] id <$> v .:? "stringListValues"
+    binaryListValues <- maybe [] (map decodeBase64Text) <$> v .:? "binaryListValues"
+    dataType <- v .: "dataType"
+    pure MessageAttributeValue {..}
 
 data SQSEvent = SQSEvent {
   messageId         :: Text,
   receiptHandle     :: Text,
   body              :: Text,
   attributes        :: Attributes,
-  messageAttributes :: Map Text Text,
+  messageAttributes :: Map Text MessageAttributeValue,
   md5OfBody         :: Text,
   eventSource       :: Text,
   eventSourceARN    :: Text,
   awsRegion         :: Text
 } deriving (Show, Eq, Generic)
 
 instance FromJSON SQSEvent
+
+decodeBase64Text :: Text -> ByteString
+decodeBase64Text = B64.decodeLenient . TE.encodeUtf8

test/AWS/Lambda/Events/SQS/Spec.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module AWS.Lambda.Events.SQS.Spec where
+
+import           AWS.Lambda.Events.SQS
+import           Data.Aeson            (eitherDecode)
+import qualified Data.Map              as M
+import           Data.ByteString.Lazy  (ByteString)
+import           Test.Hspec            (Spec, shouldBe, specify)
+import           Text.RawString.QQ     (r)
+
+spec :: Spec
+spec =
+  specify "read sample payload" $
+    eitherDecode samplePayload `shouldBe` Right expectedRecords
+
+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": [],
+          "binaryListValues": [],
+          "dataType": "String"
+        },
+        "attribute2": {
+          "binaryValue": "dmFsdWUy",
+          "stringListValues": [],
+          "binaryListValues": [],
+          "dataType": "Binary"
+        }
+      },
+      "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"
+                , MessageAttributeValue
+                    { stringValue = Just "value1"
+                    , binaryValue = Nothing
+                    , stringListValues = []
+                    , binaryListValues = []
+                    , dataType = "String"
+                    }
+                )
+              , ( "attribute2"
+                , MessageAttributeValue
+                    { stringValue = Nothing
+                    , binaryValue = Just "value2"
+                    , stringListValues = []
+                    , binaryListValues = []
+                    , dataType = "Binary"
+                    }
+                )
+              ]
+          , md5OfBody = "9a0364b9e99bb480dd25e1f0284c8555"
+          , eventSource = "aws:sqs"
+          , eventSourceARN = "arn:aws:sqs:us-east-1:123456789012:queue1"
+          , awsRegion = "us-east-1"
+          }
+      ]
+  }

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 =