From 15f7d82c37cb1b0e12a1eade91e0db2e132d4c60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 26 Jun 2024 22:40:20 +0200 Subject: Subscribe flag in chatroom state --- main/Test.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) (limited to 'main/Test.hs') diff --git a/main/Test.hs b/main/Test.hs index cdc337e..a957f4b 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -12,6 +12,7 @@ import Control.Monad.State import Crypto.Random +import Data.Bool import Data.ByteString qualified as B import Data.ByteString.Char8 qualified as BC import Data.ByteString.Lazy qualified as BL @@ -271,6 +272,8 @@ commands = map (T.pack *** id) , ("chatroom-list-local", cmdChatroomListLocal) , ("chatroom-watch-local", cmdChatroomWatchLocal) , ("chatroom-set-name", cmdChatroomSetName) + , ("chatroom-subscribe", cmdChatroomSubscribe) + , ("chatroom-unsubscribe", cmdChatroomUnsubscribe) , ("chatroom-message-send", cmdChatroomMessageSend) ] @@ -655,7 +658,7 @@ cmdChatroomWatchLocal = do AddedChatroom room -> outLine out $ unwords $ "chatroom-watched-added" : chatroomInfo room RemovedChatroom room -> outLine out $ unwords $ "chatroom-watched-removed" : chatroomInfo room UpdatedChatroom oldroom room -> do - when (any (not . null . rsdRoom . fromStored) (roomStateData room)) $ do + when (any ((\rsd -> not (null (rsdRoom rsd)) || not (null (rsdSubscribe rsd))) . fromStored) (roomStateData room)) $ do outLine out $ unwords $ concat [ [ "chatroom-watched-updated" ], chatroomInfo room , [ "old" ], map (show . refDigest . storedRef) (roomStateData oldroom) @@ -674,8 +677,21 @@ chatroomInfo :: ChatroomState -> [String] chatroomInfo room = [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room , maybe "" T.unpack $ roomName =<< roomStateRoom room + , "sub " <> bool "false" "true" (roomStateSubscribe room) ] +cmdChatroomSubscribe :: Command +cmdChatroomSubscribe = do + [ cid ] <- asks tiParams + to <- getChatroomStateData cid + void $ chatroomSetSubscribe to True + +cmdChatroomUnsubscribe :: Command +cmdChatroomUnsubscribe = do + [ cid ] <- asks tiParams + to <- getChatroomStateData cid + void $ chatroomSetSubscribe to False + cmdChatroomMessageSend :: Command cmdChatroomMessageSend = do [cid, msg] <- asks tiParams -- cgit v1.2.3