From a9697ffdf3690c7db68a256c0a0b68941d0937b8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 7 Jun 2026 11:42:13 +0200
Subject: Test: log direct message history changes with removals

---
 main/Test.hs | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

(limited to 'main')

diff --git a/main/Test.hs b/main/Test.hs
index ad4cb0b..1755031 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -95,19 +95,21 @@ initTestState = TestState
 data TestInput = TestInput
     { tiOutput :: Output
     , tiStorage :: Storage
-    , tiParams :: [Text]
+    , tiParams :: [ Text ]
+    , tiDmLogChange :: MVar Bool
     }
 
 
 runTestTool :: Storage -> IO ()
 runTestTool st = do
     out <- newMVar ()
+    changeVar <- newMVar False
     let testLoop = getLineMb >>= \case
             Just line -> do
                 case T.words line of
                     (cname:params)
                         | Just (CommandM cmd) <- lookup cname commands -> do
-                            runReaderT cmd $ TestInput out st params
+                            runReaderT cmd $ TestInput out st params changeVar
                         | otherwise -> fail $ "Unknown command '" ++ T.unpack cname ++ "'"
                     [] -> return ()
                 testLoop
@@ -247,9 +249,15 @@ inviteAttributes out = (defaultServiceAttributes Proxy)
         afterCommit $ outLine out $ "invite-reply " <> showInviteToken token <> " invalid"
     }
 
-dmThreadWatcher :: ComposedIdentity -> Output -> DirectMessageThread -> DirectMessageThread -> IO ()
-dmThreadWatcher self out prev cur = do
-    forM_ (reverse $ dmThreadToListSinceUnread prev cur) $ \( msg, new ) -> do
+dmThreadWatcher :: MVar Bool -> ComposedIdentity -> Output -> DirectMessageThread -> DirectMessageThread -> IO ()
+dmThreadWatcher changeVar self out prev cur = do
+    change <- readMVar changeVar
+    let ( removed, added )
+            | change = dmThreadToListChange prev cur
+            | otherwise = ( 0, dmThreadToListSinceUnread prev cur )
+    when (removed > 0) $ do
+        outLine out $ unwords [ "dm-removed", show removed ]
+    forM_ (reverse added) $ \( msg, new ) -> do
         outLine out $ unwords
             [ if sameIdentity self (msgFrom msg)
                  then "dm-sent"
@@ -326,6 +334,7 @@ commands =
     , ( "contact-reject", cmdContactReject )
     , ( "contact-list", cmdContactList )
     , ( "contact-set-name", cmdContactSetName )
+    , ( "dm-log-change", cmdDmLogChange )
     , ( "dm-send-peer", cmdDmSendPeer )
     , ( "dm-send-contact", cmdDmSendContact )
     , ( "dm-send-identity", cmdDmSendIdentity )
@@ -544,7 +553,8 @@ cmdHeadUnwatch = do
 initTestHead :: Head LocalState -> Command
 initTestHead h = do
     let self = finalOwner $ headLocalIdentity h
-    _ <- liftIO . watchDirectMessageThreads h . dmThreadWatcher self =<< asks tiOutput
+    changeVar <- asks tiDmLogChange
+    _ <- liftIO . watchDirectMessageThreads h . dmThreadWatcher changeVar self =<< asks tiOutput
     modify $ \s -> s { tsHead = Just h }
 
 loadTestHead :: CommandM (Head LocalState)
@@ -935,6 +945,12 @@ cmdContactSetName = do
     updateLocalState_ $ updateSharedState_ $ contactSetName contact name
     cmdOut "contact-set-name-done"
 
+cmdDmLogChange :: Command
+cmdDmLogChange = do
+    var <- asks tiDmLogChange
+    liftIO $ modifyMVar_ var $ return . const True
+    cmdOut "dm-log-change-done"
+
 cmdDmSendPeer :: Command
 cmdDmSendPeer = do
     [spidx, msg] <- asks tiParams
-- 
cgit v1.2.3