diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-27 18:33:16 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-30 20:53:55 +0200 |
| commit | c27b3c23ecdd53acdbfece747b9bbdb39bf4dae9 (patch) | |
| tree | 52a4be70840e2691195ec54149f5ac14ec112606 /src/Message.hs | |
| parent | dfddb65ad1abf5ba4171be42d303850ebbc363ee (diff) | |
Replace storedStorage usage with MonadHead
Diffstat (limited to 'src/Message.hs')
| -rw-r--r-- | src/Message.hs | 15 |
1 files changed, 7 insertions, 8 deletions
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] |