SQSWatcher: Ignore failures in deleting recieved messages (#3783)

* SQSWatcher: Ignore failures in deleting recieved messages

Perhaps they started getting delivered multiple times. There is code in
ElasticMQ which only allows last delivery receipt to be used for deletion.

* SQSWatcher: Better formatting for printing

* SQSWatcher: Remove unused function to fetch messages

Author: akshaymankar

libs/types-common-aws/default.nix

@@ -14,7 +14,6 @@
 , lib
 , proto-lens
 , resourcet
-, safe
 , text
 , time
 , unliftio
@@ -33,7 +32,6 @@ mkDerivation {
     lens
     proto-lens
     resourcet
-    safe
     text
     time
     unliftio

libs/types-common-aws/src/Util/Test/SQS.hs

@@ -34,9 +34,9 @@ import Data.List (delete)
 import Data.ProtoLens
 import Data.Text.Encoding qualified as Text
 import Imports
-import Safe (headDef)
-import UnliftIO (Async, async, throwIO)
+import UnliftIO (Async, async)
 import UnliftIO.Async qualified as Async
+import UnliftIO.Exception
 import UnliftIO.Resource (MonadResource, ResourceT)
 import UnliftIO.Timeout (timeout)
 
@@ -142,27 +142,26 @@ receive n url =
       . set SQS.receiveMessage_maxNumberOfMessages (Just n)
       . set SQS.receiveMessage_visibilityTimeout (Just 1)
 
-fetchMessage :: (Message a, MonadReader AWS.Env m, MonadResource m) => Text -> String -> (String -> Maybe a -> IO ()) -> m ()
-fetchMessage url label callback = do
-  msgs <- fromMaybe [] . view SQS.receiveMessageResponse_messages <$> sendEnv (receive 1 url)
-  events <- mapM (parseDeleteMessage url) msgs
-  liftIO $ callback label (headDef Nothing events)
-
 deleteMessage :: (MonadReader AWS.Env m, MonadResource m) => Text -> SQS.Message -> m ()
 deleteMessage url m = do
   for_
     (m ^. SQS.message_receiptHandle)
     (void . sendEnv . SQS.newDeleteMessage url)
 
-parseDeleteMessage :: (Message a, MonadReader AWS.Env m, MonadResource m) => Text -> SQS.Message -> m (Maybe a)
+parseDeleteMessage :: (Message a, MonadReader AWS.Env m, MonadResource m, MonadUnliftIO m) => Text -> SQS.Message -> m (Maybe a)
 parseDeleteMessage url m = do
   let decodedMessage = decodeMessage <=< (B64.decode . Text.encodeUtf8)
   evt <- case decodedMessage <$> (m ^. SQS.message_body) of
     Just (Right e) -> pure (Just e)
     _ -> do
-      liftIO $ print ("Failed to parse SQS message or event" :: String)
+      liftIO $ putStrLn "Failed to parse SQS message or event"
       pure Nothing
   deleteMessage url m
+    `catch` \case
+      (fromException @SomeAsyncException -> Just asyncExc) ->
+        throwIO asyncExc
+      e ->
+        liftIO $ putStrLn $ "Failed to delete message, this error will be ignored. Message: " <> show m <> ", Exception: " <> displayException e
   pure evt
 
 sendEnv :: (MonadReader AWS.Env m, MonadResource m, AWS.AWSRequest a) => a -> m (AWS.AWSResponse a)

libs/types-common-aws/types-common-aws.cabal

@@ -86,7 +86,6 @@ library
     , lens               >=4.10
     , proto-lens
     , resourcet
-    , safe               >=0.3
     , text               >=0.11
     , time
     , unliftio