diff options
Diffstat (limited to 'src/Erebos/Chatroom.hs')
-rw-r--r-- | src/Erebos/Chatroom.hs | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs index 3a2628d..673c59f 100644 --- a/src/Erebos/Chatroom.hs +++ b/src/Erebos/Chatroom.hs @@ -10,6 +10,7 @@ module Erebos.Chatroom ( listChatrooms, findChatroomByRoomData, findChatroomByStateData, + chatroomSetSubscribe, getMessagesSinceState, ChatroomSetChange(..), @@ -27,6 +28,7 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class +import Data.Bool import Data.IORef import Data.List import Data.Maybe @@ -178,6 +180,7 @@ chatroomMessageByStateData lookupData msg = void $ findAndUpdateChatroomState $ mergeSorted . (:[]) <$> mstore ChatroomStateData { rsdPrev = roomStateData cstate , rsdRoom = [] + , rsdSubscribe = Just True , rsdMessages = [ mdata ] } @@ -185,6 +188,7 @@ chatroomMessageByStateData lookupData msg = void $ findAndUpdateChatroomState $ data ChatroomStateData = ChatroomStateData { rsdPrev :: [Stored ChatroomStateData] , rsdRoom :: [Stored (Signed ChatroomData)] + , rsdSubscribe :: Maybe Bool , rsdMessages :: [Stored (Signed ChatMessageData)] } @@ -192,6 +196,7 @@ data ChatroomState = ChatroomState { roomStateData :: [Stored ChatroomStateData] , roomStateRoom :: Maybe Chatroom , roomStateMessageData :: [Stored (Signed ChatMessageData)] + , roomStateSubscribe :: Bool , roomStateMessages :: [ChatMessage] } @@ -199,11 +204,13 @@ instance Storable ChatroomStateData where store' ChatroomStateData {..} = storeRec $ do forM_ rsdPrev $ storeRef "PREV" forM_ rsdRoom $ storeRef "room" + forM_ rsdSubscribe $ storeInt "subscribe" . bool @Int 0 1 forM_ rsdMessages $ storeRef "msg" load' = loadRec $ do rsdPrev <- loadRefs "PREV" rsdRoom <- loadRefs "room" + rsdSubscribe <- fmap ((/=) @Int 0) <$> loadMbInt "subscribe" rsdMessages <- loadRefs "msg" return ChatroomStateData {..} @@ -216,6 +223,7 @@ instance Mergeable ChatroomState where roomStateMessageData = filterAncestors $ concat $ flip findProperty roomStateData $ \case ChatroomStateData {..} | null rsdMessages -> Nothing | otherwise -> Just rsdMessages + roomStateSubscribe = fromMaybe False $ findPropertyFirst rsdSubscribe roomStateData roomStateMessages = threadToList $ concatMap (rsdMessages . fromStored) roomStateData in ChatroomState {..} @@ -232,6 +240,7 @@ createChatroom rdName rdDescription = do cstate <- mergeSorted . (:[]) <$> mstore ChatroomStateData { rsdPrev = [] , rsdRoom = [ rdata ] + , rsdSubscribe = Just True , rsdMessages = [] } @@ -278,6 +287,7 @@ updateChatroomByStateData lookupData newName newDesc = findAndUpdateChatroomStat mergeSorted . (:[]) <$> mstore ChatroomStateData { rsdPrev = roomStateData cstate , rsdRoom = [ rdata ] + , rsdSubscribe = Just True , rsdMessages = [] } @@ -298,6 +308,19 @@ findChatroomByRoomData cdata = findChatroom $ findChatroomByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe ChatroomState) findChatroomByStateData cdata = findChatroom $ any (cdata `precedesOrEquals`) . roomStateData +chatroomSetSubscribe + :: (MonadStorage m, MonadHead LocalState m, MonadError String m) + => Stored ChatroomStateData -> Bool -> m () +chatroomSetSubscribe lookupData subscribe = void $ findAndUpdateChatroomState $ \cstate -> do + guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate + Just $ do + mergeSorted . (:[]) <$> mstore ChatroomStateData + { rsdPrev = roomStateData cstate + , rsdRoom = [] + , rsdSubscribe = Just subscribe + , rsdMessages = [] + } + getMessagesSinceState :: ChatroomState -> ChatroomState -> [ChatMessage] getMessagesSinceState cur old = takeWhile notOld (roomStateMessages cur) where @@ -394,7 +417,7 @@ instance Service ChatroomService where upd set (roomInfo :: Stored (Signed ChatroomData)) = do let currentRoots = storedRoots roomInfo isCurrentRoom = any ((`intersectsSorted` currentRoots) . storedRoots) . - concatMap (rsdRoom . fromStored) . roomStateData + maybe [] roomData . roomStateRoom let prev = concatMap roomStateData $ filter isCurrentRoom rooms prevRoom = concatMap (rsdRoom . fromStored) prev @@ -406,6 +429,7 @@ instance Service ChatroomService where sdata <- mstore ChatroomStateData { rsdPrev = prev , rsdRoom = room + , rsdSubscribe = Nothing , rsdMessages = [] } storeSetAddComponent sdata set |