Watch direct messages using local state diffs

Changelog: API: Replaced `watchReceivedDirectMessages` with `watchDirectMessageThreads`

1 files changed, 12 insertions, 9 deletions

diff --git a/main/Test.hs b/main/Test.hs
index fd6258d..323b240 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -232,14 +232,16 @@ discoveryAttributes = (defaultServiceAttributes Proxy)
     { discoveryProvideTunnel = \_ _ -> False
     }
 
-dmReceivedWatcher :: Output -> Stored DirectMessage -> IO ()
-dmReceivedWatcher out smsg = do
-    let msg = fromStored smsg
-    outLine out $ unwords
-        [ "dm-received"
-        , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg
-        , "text", T.unpack $ msgText msg
-        ]
+dmThreadWatcher :: ComposedIdentity -> Output -> DirectMessageThread -> DirectMessageThread -> IO ()
+dmThreadWatcher self out prev cur = do
+    forM_ (reverse $ dmThreadToListSince prev cur) $ \msg -> do
+        outLine out $ unwords
+            [ if sameIdentity self (msgFrom msg)
+                 then "dm-sent"
+                 else "dm-received"
+            , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg
+            , "text", T.unpack $ msgText msg
+            ]
 
 
 newtype CommandM a = CommandM (ReaderT TestInput (StateT TestState (ExceptT ErebosError IO)) a)
@@ -456,7 +458,8 @@ cmdHeadUnwatch = do
 
 initTestHead :: Head LocalState -> Command
 initTestHead h = do
-    _ <- liftIO . watchReceivedDirectMessages h . dmReceivedWatcher =<< asks tiOutput
+    let self = finalOwner $ headLocalIdentity h
+    _ <- liftIO . watchDirectMessageThreads h . dmThreadWatcher self =<< asks tiOutput
     modify $ \s -> s { tsHead = Just h }
 
 loadTestHead :: CommandM (Head LocalState)