Test: log direct message history changes with removalsHEADmaster

2 files changed, 39 insertions, 14 deletions

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
diff --git a/test/message.et b/test/message.et
index 3609da5..f160cd8 100644
--- a/test/message.et
+++ b/test/message.et
@@ -324,8 +324,10 @@ test DirectMessageSeen:
 	send "identity-info $p2id" to p2
 	expect /identity-info ref $p2id base ($refpat) owner ($refpat).*/ from p2 capture p2base, p2owner
 
-	send "start-server services $services" to p1
-	send "start-server services $services" to p2
+	for p in [ p1, p2 ]:
+		send "start-server services $services" to p
+		send "dm-log-change" to p
+		expect /dm-log-change-done/ from p
 
 	expect from p1:
 		/peer ([0-9]+) addr ${p2.node.ip} 29665/ capture peer1_2
@@ -335,22 +337,29 @@ test DirectMessageSeen:
 		/peer ([0-9]+) addr ${p1.node.ip} 29665/ capture peer2_1
 		/peer $peer2_1 id Device1 Owner1/
 
-	for i in [ 1 .. 2 ]:
+	for i in [ 1 .. 3 ]:
 		send "dm-send-peer $peer1_2 msg_a_$i" to p1
 		expect /dm-sent from Owner1 new no text msg_a_$i/ from p1
 		expect /dm-received from Owner1 new yes text msg_a_$i/ from p2
 
-	for i in [ 1 .. 2 ]:
+	send "dm-send-peer $peer2_1 msg_b_1" to p2
+	expect /dm-removed 3/ from p2
+	for i in [ 1 .. 3 ]:
+		expect /dm-received from Owner1 new no text msg_a_$i/ from p2
+	expect /dm-sent from Owner2 new no text msg_b_1/ from p2
+	expect /dm-received from Owner2 new yes text msg_b_1/ from p1
+
+	for i in [ 2 .. 3 ]:
 		send "dm-send-peer $peer2_1 msg_b_$i" to p2
 		expect /dm-sent from Owner2 new no text msg_b_$i/ from p2
 		expect /dm-received from Owner2 new yes text msg_b_$i/ from p1
 
 	send "dm-list-identity $p2owner" to p1
 	send "dm-list-identity $p1owner" to p2
-	for i in [ 1 .. 2 ]:
+	for i in [ 1 .. 3 ]:
 		expect /dm-list-item from Owner1 new no text msg_a_$i/ from p1
 		expect /dm-list-item from Owner1 new no text msg_a_$i/ from p2
-	for i in [ 1 .. 2 ]:
+	for i in [ 1 .. 3 ]:
 		expect /dm-list-item from Owner2 new yes text msg_b_$i/ from p1
 		expect /dm-list-item from Owner2 new no text msg_b_$i/ from p2
 	for p in [ p1, p2 ]:
@@ -364,10 +373,10 @@ test DirectMessageSeen:
 
 	send "dm-list-identity $p2owner" to p1
 	send "dm-list-identity $p1owner" to p2
-	for i in [1..2]:
+	for i in [ 1 .. 3 ]:
 		expect /dm-list-item from Owner1 new no text msg_a_$i/ from p1
 		expect /dm-list-item from Owner1 new no text msg_a_$i/ from p2
-	for i in [1..2]:
+	for i in [ 1 .. 3 ]:
 		expect /dm-list-item from Owner2 new no text msg_b_$i/ from p1
 		expect /dm-list-item from Owner2 new no text msg_b_$i/ from p2
 	for p in [ p1, p2 ]: