From 95449bb4b93cf10468c47b27f20396d916c46778 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 13 Jul 2023 18:39:01 +0200
Subject: Send and receive direct messages through storage

---
 src/Test.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

(limited to 'src/Test.hs')

diff --git a/src/Test.hs b/src/Test.hs
index 678be18..c0b8aed 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -190,17 +190,18 @@ pairingAttributes _ out peers prefix = PairingAttributes
 
 directMessageAttributes :: Output -> DirectMessageAttributes
 directMessageAttributes out = DirectMessageAttributes
-    { dmReceived = \smsg -> do
-        let msg = fromStored smsg
-        afterCommit $ outLine out $ unwords
-            [ "dm-received"
-            , "from", maybe "<unnamed>" T.unpack $ idName $ msgFrom msg
-            , "text", T.unpack $ msgText msg
-            ]
-
-    , dmOwnerMismatch = afterCommit $ outLine out "dm-owner-mismatch"
+    { dmOwnerMismatch = afterCommit $ outLine out "dm-owner-mismatch"
     }
 
+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
+        ]
+
 
 newtype CommandM a = CommandM (ReaderT TestInput (StateT TestState (ExceptT String IO)) a)
     deriving (Functor, Applicative, Monad, MonadIO, MonadReader TestInput, MonadState TestState, MonadError String)
@@ -313,6 +314,7 @@ cmdCreateIdentity = do
             , lsShared = shared
             }
 
+    _ <- liftIO . watchReceivedMessages h . dmReceivedWatcher =<< asks tiOutput
     modify $ \s -> s { tsHead = Just h }
 
 cmdStartServer :: Command
-- 
cgit v1.2.3