From 9e6d2603fe654f908cede454ba89bd2f2f23dadf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 21 Jun 2026 21:07:01 +0200
Subject: Cache last direct message thread for each peer

---
 src/Erebos/DirectMessage.hs | 35 +++++++++++++++++++++--------------
 1 file changed, 21 insertions(+), 14 deletions(-)

(limited to 'src/Erebos')

diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index 84a1ee6..e97672d 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -27,6 +27,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 
 import Data.List
+import Data.Maybe
 import Data.Ord
 import Data.Proxy
 import Data.Set (Set)
@@ -91,6 +92,10 @@ defaultDirectMessageAttributes = DirectMessageAttributes
     { dmOwnerMismatch = svcPrint "Owner mismatch"
     }
 
+data DirectMessagePeerState = DirectMessagePeerState
+    { dmpsLastThread :: Maybe DirectMessageThread
+    }
+
 data DirectMessageGlobalState = DirectMessageGlobalState
     { dmgsLastState :: Maybe [ Stored MessageState ]
     }
@@ -101,6 +106,11 @@ instance Service DirectMessage where
     type ServiceAttributes DirectMessage = DirectMessageAttributes
     defaultServiceAttributes _ = defaultDirectMessageAttributes
 
+    type ServiceState DirectMessage = DirectMessagePeerState
+    emptyServiceState _ = DirectMessagePeerState
+        { dmpsLastThread = Nothing
+        }
+
     type ServiceGlobalState DirectMessage = DirectMessageGlobalState
     emptyServiceGlobalState _ = DirectMessageGlobalState
         { dmgsLastState = Nothing
@@ -290,28 +300,25 @@ syncDirectMessageToPeer :: DirectMessageThreads -> ServiceHandler DirectMessage
 syncDirectMessageToPeer (DirectMessageThreads mss _) = do
     pid <- finalOwner <$> asks svcPeerIdentity
     peer <- asks svcPeer
-    let thread = messageThreadFor (dmEmptyThread pid) mss
+    pthread <- fromMaybe (dmEmptyThread pid) . dmpsLastThread <$> svcGet
+    let thread = messageThreadFor pthread mss
     mapM_ (sendToPeerStored peer) $ msgHead thread
-    updateLocalState_ $ \ls -> do
-        let powner = finalOwner pid
-        flip updateSharedState_ ls $ \unchanged@(DirectMessageThreads prev _) -> do
-            let ready = concat $ propertyValue $ findMsgProperty powner msReady prev
-                sent = concat $ propertyValue $ findMsgProperty powner msSent prev
-                sent' = filterAncestors (ready ++ sent)
-
-            if sent' /= sent
-              then do
+    when (msgHead thread /= msgSent thread) $ do
+        updateLocalState_ $ \ls -> do
+            let powner = finalOwner pid
+            flip updateSharedState_ ls $ \_ -> do
                 next <- mstore MessageState
-                    { msPrev = prev
+                    { msPrev = mss
                     , msPeer = powner
                     , msReady = []
-                    , msSent = sent'
+                    , msSent = msgHead thread
                     , msReceived = []
                     , msSeen = []
                     }
                 return $ DirectMessageThreads [ next ] (dmThreadView [ next ])
-              else do
-                return unchanged
+    svcModify $ \s -> s
+        { dmpsLastThread = Just thread
+        }
 
 findMissingPeers :: Server -> DirectMessageThreads -> ExceptT ErebosError IO ()
 findMissingPeers server (DirectMessageThreads states threads) = do
-- 
cgit v1.2.3