diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2024-04-06 19:07:27 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-04-17 20:59:41 +0200 |
| commit | 943cd6e754453f70deae6ad89c6045b42c59e9c9 (patch) | |
| tree | f7ff52bfbfacacc6af7e2793c3d60651a10c71dc /main | |
| parent | d684bc2b012e23e3cc0dfa1195a74abac661b926 (diff) | |
Chatroom service
Diffstat (limited to 'main')
| -rw-r--r-- | main/Test.hs | 33 |
1 files changed, 24 insertions, 9 deletions
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 + ] |