From c27b3c23ecdd53acdbfece747b9bbdb39bf4dae9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 27 Aug 2023 18:33:16 +0200 Subject: Replace storedStorage usage with MonadHead --- src/Message.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'src/Message.hs') diff --git a/src/Message.hs b/src/Message.hs index 41a88b0..ac67f07 100644 --- a/src/Message.hs +++ b/src/Message.hs @@ -73,8 +73,8 @@ instance Service DirectMessage where let msg = fromStored smsg powner <- asks $ finalOwner . svcPeerIdentity erb <- svcGetLocal - let st = storedStorage erb - DirectMessageThreads prev _ = lookupSharedValue $ lsShared $ fromStored erb + st <- getStorage + let DirectMessageThreads prev _ = lookupSharedValue $ lsShared $ fromStored erb sent = findMsgProperty powner msSent prev received = findMsgProperty powner msReceived prev received' = filterAncestors $ smsg : received @@ -153,21 +153,20 @@ findMsgProperty pid sel mss = concat $ flip findProperty mss $ \x -> do sendDirectMessage :: (Foldable f, Applicative f, MonadHead LocalState m, MonadError String m) => Identity f -> Text -> m (Stored DirectMessage) sendDirectMessage pid text = updateLocalHead $ \ls -> do - let st = storedStorage ls - self = localIdentity $ fromStored ls + let self = localIdentity $ fromStored ls powner = finalOwner pid - flip updateSharedState ls $ \(DirectMessageThreads prev _) -> liftIO $ do + flip updateSharedState ls $ \(DirectMessageThreads prev _) -> do let sent = findMsgProperty powner msSent prev received = findMsgProperty powner msReceived prev - time <- getZonedTime - smsg <- wrappedStore st DirectMessage + time <- liftIO getZonedTime + smsg <- mstore DirectMessage { msgFrom = toComposedIdentity $ finalOwner self , msgPrev = filterAncestors $ sent ++ received , msgTime = time , msgText = text } - next <- wrappedStore st $ MessageState + next <- mstore MessageState { msPrev = prev , msPeer = powner , msSent = [smsg] -- cgit v1.2.3