From 943cd6e754453f70deae6ad89c6045b42c59e9c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 6 Apr 2024 19:07:27 +0200
Subject: Chatroom service

---
 main/Test.hs | 33 ++++++++++++++++++++++++---------
 1 file changed, 24 insertions(+), 9 deletions(-)

(limited to 'main/Test.hs')

diff --git a/main/Test.hs b/main/Test.hs
index 182d941..b32872a 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -267,6 +267,7 @@ commands = map (T.pack *** id)
     , ("dm-list-contact", cmdDmListContact)
     , ("chatroom-create", cmdChatroomCreate)
     , ("chatroom-list-local", cmdChatroomListLocal)
+    , ("chatroom-watch-local", cmdChatroomWatchLocal)
     ]
 
 cmdStore :: Command
@@ -346,6 +347,7 @@ cmdStartServer = do
         , someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
         , someServiceAttr $ directMessageAttributes out
         , someService @SyncService Proxy
+        , someService @ChatroomService Proxy
         , someServiceAttr $ (defaultServiceAttributes Proxy)
             { testMessageReceived = \otype len sref ->
                 liftIO $ outLine out $ unwords ["test-message-received", otype, len, sref]
@@ -577,14 +579,27 @@ cmdChatroomCreate = do
 cmdChatroomListLocal :: Command
 cmdChatroomListLocal = do
     [] <- asks tiParams
-    h <- getHead
-    let rooms = fromSetBy (comparing $ roomName <=< roomStateRoom) . lookupSharedValue . lsShared . headObject $ h
+    rooms <- listChatrooms
     forM_ rooms $ \room -> do
-        r:_ <- return $ filterAncestors $ concatMap storedRoots $ toComponents room
-        cmdOut $ concat
-            [ "chatroom-list-item "
-            , show $ refDigest $ storedRef r
-            , " "
-            , maybe "<unnamed>" T.unpack $ roomName =<< roomStateRoom room
-            ]
+        cmdOut $ unwords $ "chatroom-list-item" : chatroomInfo room
     cmdOut "chatroom-list-done"
+
+cmdChatroomWatchLocal :: Command
+cmdChatroomWatchLocal = do
+    [] <- asks tiParams
+    h <- getHead
+    out <- asks tiOutput
+    void $ watchChatrooms h $ \_ -> \case
+        Nothing -> return ()
+        Just diff -> forM_ diff $ \case
+            AddedChatroom room -> outLine out $ unwords $ "chatroom-watched-added" : chatroomInfo room
+            RemovedChatroom room -> outLine out $ unwords $ "chatroom-watched-removed" : chatroomInfo room
+            UpdatedChatroom oldroom room -> outLine out $ unwords $ "chatroom-watched-updated" : chatroomInfo room ++
+                map (show . refDigest . storedRef) (roomStateData oldroom) ++
+                map (show . refDigest . storedRef) (roomStateData room)
+
+chatroomInfo :: ChatroomState -> [String]
+chatroomInfo room =
+    [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room
+    , maybe "<unnamed>" T.unpack $ roomName =<< roomStateRoom room
+    ]
-- 
cgit v1.2.3