From 84c74b69c9f9e44dde21d58f5ae77755c40a29db Mon Sep 17 00:00:00 2001
From: Diogo Castro <dc@diogocastro.com>
Date: Wed, 6 Sep 2023 18:25:13 +0100
Subject: [PATCH] [#107] Correctly parse `channel_join` events

Problem: The parser fails to parse events of type `message` and subtype
`channel_join`, and the logs are flooded with errors.

This seems to happen because the parser expects every event of type
`message` to have a `blocks` field, and that's not always true.

Solution: Make the `blocks` field optional.
---
 src/TzBot/ProcessEvents/Common.hs | 8 +++++---
 src/TzBot/Slack/API.hs            | 4 ++--
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/src/TzBot/ProcessEvents/Common.hs b/src/TzBot/ProcessEvents/Common.hs
index e270d4f..5f26379 100644
--- a/src/TzBot/ProcessEvents/Common.hs
+++ b/src/TzBot/ProcessEvents/Common.hs
@@ -85,8 +85,10 @@ getTextPiecesFromMessage
   -> m [Text]
 getTextPiecesFromMessage message = do
   let throwAwayTooShort = filter (\x -> T.compareLength x 2 == GT)
-  throwAwayTooShort <$> case unUnknown $ msgBlocks message of
-    Left unknownBlocksValue -> do
+  throwAwayTooShort <$> case unUnknown <$> msgBlocks message of
+    Nothing ->
+      pure $ ignoreCodeBlocksManually $ mText message
+    Just (Left unknownBlocksValue) -> do
       logWarn [int||
         Failed to parse message blocks, \
         trying to ignore code blocks manually
@@ -96,7 +98,7 @@ getTextPiecesFromMessage message = do
         #{encodePrettyToTextBuilder unknownBlocksValue}
         |]
       pure $ ignoreCodeBlocksManually $ mText message
-    Right blocks -> do
+    Just (Right blocks) -> do
       let (pieces, exErrs) = extractPieces blocks
       let (l1Errs, l2Errs) = splitExtractErrors exErrs
       when (not $ null l1Errs) $
diff --git a/src/TzBot/Slack/API.hs b/src/TzBot/Slack/API.hs
index c0200a6..c23f2bb 100644
--- a/src/TzBot/Slack/API.hs
+++ b/src/TzBot/Slack/API.hs
@@ -225,7 +225,7 @@ data Message = Message
   , mThreadId :: Maybe ThreadId
   , mEdited :: Bool
   , mSubType :: Maybe Text
-  , msgBlocks :: WithUnknown [MessageBlock]
+  , msgBlocks :: Maybe (WithUnknown [MessageBlock])
   } deriving stock (Eq, Show, Generic)
 
 instance FromJSON Message where
@@ -241,7 +241,7 @@ parseMessage o = do
   mSubType <- o .:? "subtype"
   mEdited <- fmap (isJust @Text) . runMaybeT $
     MaybeT (o .:? "edited") >>= MaybeT . (.:? "ts")
-  msgBlocks <- o .: "blocks"
+  msgBlocks <- o .:? "blocks"
   pure Message {..}
 
 -- | See: https://api.slack.com/types/user