From d29db859aa4f786071b59fe3f8f2d0d32c595205 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 29 Nov 2024 15:17:45 +0100
Subject: [PATCH] Log uncaught IO exceptions in cargohold (#4352)

* Log uncaught IO exceptions in cargohold

* Add CHANGELOG entry
---
 changelog.d/5-internal/cargohold-errors |  1 +
 services/cargohold/src/CargoHold/App.hs | 14 +++++++++++---
 2 files changed, 12 insertions(+), 3 deletions(-)
 create mode 100644 changelog.d/5-internal/cargohold-errors

diff --git a/changelog.d/5-internal/cargohold-errors b/changelog.d/5-internal/cargohold-errors
new file mode 100644
index 00000000000..89d23cfb392
--- /dev/null
+++ b/changelog.d/5-internal/cargohold-errors
@@ -0,0 +1 @@
+Log uncaught IO exceptions in cargohold
diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs
index 5acb66a57ed..ef292fdaef7 100644
--- a/services/cargohold/src/CargoHold/App.hs
+++ b/services/cargohold/src/CargoHold/App.hs
@@ -53,8 +53,8 @@ import Bilge.RPC (HasRequestId (..))
 import qualified CargoHold.AWS as AWS
 import CargoHold.Options (AWSOpts, Opts, S3Compatibility (..), brig)
 import qualified CargoHold.Options as Opt
-import Control.Error (ExceptT, exceptT)
-import Control.Exception (throw)
+import Control.Error (ExceptT, runExceptT)
+import Control.Exception (catch, throwIO)
 import Control.Lens (lensField, lensRules, makeLensesWith, non, (.~), (?~), (^.))
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import Data.Id
@@ -241,4 +241,12 @@ executeBrigInteral action = do
 type Handler = ExceptT Error App
 
 runHandler :: Env -> Handler a -> IO a
-runHandler e h = runAppT e (exceptT throw pure h)
+runHandler env h =
+  catch
+    (runAppT env (runExceptT h) >>= either throwIO pure)
+    $ \(e :: SomeException) -> do
+      Log.err env.appLogger $
+        Log.msg ("IO Exception occurred" :: ByteString)
+          . Log.field "message" (displayException e)
+          . Log.field "request" (unRequestId env.requestId)
+      throwIO e