From a81fd30b014aec5febfc7fd2bb8af0a3e1fd07a5 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 18 Sep 2026 08:53:49 +0200 Subject: [PATCH 1/4] Additional logging - unexpected exception during the protected commit operation; - unexpected exception during lock release; --- .../Wire/ConversationSubsystem/MLS/Util.hs | 53 +++++++++++++------ 1 file changed, 38 insertions(+), 15 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs index b862e488b09..0482f4c1a9e 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs @@ -28,7 +28,7 @@ import Data.Text qualified as T import Imports import Polysemy import Polysemy.Error -import Polysemy.Resource (Resource, bracket) +import Polysemy.Resource (Resource, bracket, bracketOnError) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as TinyLog import System.Logger qualified as Log @@ -123,25 +123,48 @@ withCommitLock lConvOrSubId gid epoch = Nothing throwS @'MLSStaleMessage ) - (const $ releaseCommitLock gid epoch) ( const $ do - actualEpoch <- - fromMaybe (Epoch 0) <$> case tUnqualified lConvOrSubId of - Conv cnv -> getConversationEpoch cnv - SubConv cnv sub -> getSubConversationEpoch cnv sub - unless (actualEpoch == epoch) $ do - logStaleCommitLock - "commit-lock-epoch-mismatch" - lConvOrSubId - gid - epoch - (Just actualEpoch) - throwS @'MLSStaleMessage - k () + bracketOnError + (releaseCommitLock gid epoch) + (const $ logCommitLockFailure "release" lConvOrSubId gid epoch) + ) + ( const $ + bracketOnError + ( do + actualEpoch <- + fromMaybe (Epoch 0) <$> case tUnqualified lConvOrSubId of + Conv cnv -> getConversationEpoch cnv + SubConv cnv sub -> getSubConversationEpoch cnv sub + unless (actualEpoch == epoch) $ do + logStaleCommitLock + "commit-lock-epoch-mismatch" + lConvOrSubId + gid + epoch + (Just actualEpoch) + throwS @'MLSStaleMessage + k () + ) + (const $ logCommitLockFailure "operation" lConvOrSubId gid epoch) ) where ttl = fromIntegral (600 :: Int) -- 10 minutes +logCommitLockFailure :: + (Member TinyLog r) => + ByteString -> + Local ConvOrSubConvId -> + GroupId -> + Epoch -> + Sem r () +logCommitLockFailure phase lConvOrSubId gid epoch = + TinyLog.warn $ + Log.msg ("MLS commit lock operation failed" :: ByteString) + . Log.field "phase" phase + . Log.field "groupId" ("0x" <> hex (unGroupId gid)) + . Log.field "epoch" (epochNumber epoch) + . Log.field "convOrSubConvId" (toByteString' (show (tUnqualified lConvOrSubId))) + logStaleCommitLock :: (Member TinyLog r) => ByteString -> From f0250a98930f6975f0f396eb293894fae1436a34 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 18 Sep 2026 09:49:17 +0200 Subject: [PATCH 2/4] log typed errors during commit operations --- .../Wire/ConversationSubsystem/Interpreter.hs | 16 ++++++-- .../Wire/ConversationSubsystem/MLS/Util.hs | 40 +++++++++---------- 2 files changed, 32 insertions(+), 24 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs index c4265369a46..1b80f86dc35 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs @@ -26,6 +26,7 @@ module Wire.ConversationSubsystem.Interpreter where import Data.Qualified +import Data.Text qualified as Text import Imports import Network.Wai.Utilities.JSONResponse (JSONResponse) import Polysemy @@ -33,7 +34,7 @@ import Polysemy.Async (Async) import Polysemy.Error import Polysemy.Input import Polysemy.Resource (Resource) -import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog (TinyLog, logErrors) import Wire.API.Conversation.Config import Wire.API.Error import Wire.API.Federation.Client (FederatorClient) @@ -87,6 +88,9 @@ import Wire.TeamSubsystem (TeamSubsystem) import Wire.UserClientIndexStore (UserClientIndexStore) import Wire.UserGroupStore (UserGroupStore) +renderConversationSubsystemError :: ConversationSubsystemError -> Text +renderConversationSubsystemError = Text.pack . show . (toResponse :: ConversationSubsystemError -> JSONResponse) + interpretConversationSubsystem :: ( Member MeetingNotifier r, Member (Error ConversationSubsystemError) r, @@ -152,9 +156,15 @@ interpretConversationSubsystem = interpret $ \case InternalGetLocalMember cid uid -> mapErrors $ ConvStore.getLocalMember cid uid PostMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle -> - mapErrors $ MLSMessage.postMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle + logErrors @_ @ConversationSubsystemError + renderConversationSubsystemError + "MLS commit bundle failed" + (mapErrors $ MLSMessage.postMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle) PostMLSCommitBundleFromLocalUser v lusr c conn bundle -> - mapErrors $ MLSMessage.postMLSCommitBundleFromLocalUser v lusr c conn bundle + logErrors @_ @ConversationSubsystemError + renderConversationSubsystemError + "MLS commit bundle failed" + (mapErrors $ MLSMessage.postMLSCommitBundleFromLocalUser v lusr c conn bundle) PostMLSMessage loc qusr c ctype qconvOrSub con oosCheck msg -> mapErrors $ MLSMessage.postMLSMessage loc qusr c ctype qconvOrSub con oosCheck msg PostMLSMessageFromLocalUser v lusr c conn smsg -> diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs index 0482f4c1a9e..e5ff6133bc9 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs @@ -28,7 +28,7 @@ import Data.Text qualified as T import Imports import Polysemy import Polysemy.Error -import Polysemy.Resource (Resource, bracket, bracketOnError) +import Polysemy.Resource (Resource, bracket, onException) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as TinyLog import System.Logger qualified as Log @@ -124,28 +124,26 @@ withCommitLock lConvOrSubId gid epoch = throwS @'MLSStaleMessage ) ( const $ do - bracketOnError - (releaseCommitLock gid epoch) - (const $ logCommitLockFailure "release" lConvOrSubId gid epoch) + releaseCommitLock gid epoch + `onException` (logCommitLockFailure "release" lConvOrSubId gid epoch) ) ( const $ - bracketOnError - ( do - actualEpoch <- - fromMaybe (Epoch 0) <$> case tUnqualified lConvOrSubId of - Conv cnv -> getConversationEpoch cnv - SubConv cnv sub -> getSubConversationEpoch cnv sub - unless (actualEpoch == epoch) $ do - logStaleCommitLock - "commit-lock-epoch-mismatch" - lConvOrSubId - gid - epoch - (Just actualEpoch) - throwS @'MLSStaleMessage - k () - ) - (const $ logCommitLockFailure "operation" lConvOrSubId gid epoch) + ( do + actualEpoch <- + fromMaybe (Epoch 0) <$> case tUnqualified lConvOrSubId of + Conv cnv -> getConversationEpoch cnv + SubConv cnv sub -> getSubConversationEpoch cnv sub + unless (actualEpoch == epoch) $ do + logStaleCommitLock + "commit-lock-epoch-mismatch" + lConvOrSubId + gid + epoch + (Just actualEpoch) + throwS @'MLSStaleMessage + k () + ) + `onException` logCommitLockFailure "operation" lConvOrSubId gid epoch ) where ttl = fromIntegral (600 :: Int) -- 10 minutes From 7a79918b6c17b28266e607801e1c9950c1007448 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 18 Sep 2026 09:51:27 +0200 Subject: [PATCH 3/4] changelog --- changelog.d/5-internal/WPB-28709 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/WPB-28709 diff --git a/changelog.d/5-internal/WPB-28709 b/changelog.d/5-internal/WPB-28709 new file mode 100644 index 00000000000..5d6b3dc8eb7 --- /dev/null +++ b/changelog.d/5-internal/WPB-28709 @@ -0,0 +1 @@ +Add diagnostic logging for failed MLS commit-bundle operations, including typed failures and exceptions during commit-lock handling. From f84c8a927a741055b1bbcb93753da54b03a02138 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 18 Sep 2026 11:45:17 +0200 Subject: [PATCH 4/4] render error safely --- .../src/Wire/ConversationSubsystem/Interpreter.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs index 1b80f86dc35..70428536c30 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs @@ -25,10 +25,12 @@ module Wire.ConversationSubsystem.Interpreter ) where +import Data.Aeson qualified as A +import Data.Aeson.Types qualified as AT import Data.Qualified import Data.Text qualified as Text import Imports -import Network.Wai.Utilities.JSONResponse (JSONResponse) +import Network.Wai.Utilities.JSONResponse (JSONResponse (..)) import Polysemy import Polysemy.Async (Async) import Polysemy.Error @@ -89,7 +91,12 @@ import Wire.UserClientIndexStore (UserClientIndexStore) import Wire.UserGroupStore (UserGroupStore) renderConversationSubsystemError :: ConversationSubsystemError -> Text -renderConversationSubsystemError = Text.pack . show . (toResponse :: ConversationSubsystemError -> JSONResponse) +renderConversationSubsystemError errorValue = + let response = toResponse errorValue + label = case response.value of + A.Object object -> fromMaybe "unknown" (AT.parseMaybe (A..: "label") object) + _ -> "unknown" + in "status=" <> Text.pack (show response.status) <> " label=" <> label interpretConversationSubsystem :: ( Member MeetingNotifier r,