diff --git a/changelog.d/5-internal/WPB-28709 b/changelog.d/5-internal/WPB-28709 new file mode 100644 index 0000000000..5d6b3dc8eb --- /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. diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs index c4265369a4..70428536c3 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs @@ -25,15 +25,18 @@ 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 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 +90,14 @@ import Wire.TeamSubsystem (TeamSubsystem) import Wire.UserClientIndexStore (UserClientIndexStore) import Wire.UserGroupStore (UserGroupStore) +renderConversationSubsystemError :: ConversationSubsystemError -> Text +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, Member (Error ConversationSubsystemError) r, @@ -152,9 +163,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 b862e488b0..e5ff6133bc 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, onException) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as TinyLog import System.Logger qualified as Log @@ -123,25 +123,46 @@ 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 () + releaseCommitLock gid epoch + `onException` (logCommitLockFailure "release" lConvOrSubId 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 () + ) + `onException` 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 ->