diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Erebos/Attach.hs | 2 | ||||
| -rw-r--r-- | src/Erebos/DirectMessage.hs | 7 | ||||
| -rw-r--r-- | src/Erebos/State.hs | 9 |
3 files changed, 8 insertions, 10 deletions
diff --git a/src/Erebos/Attach.hs b/src/Erebos/Attach.hs index fad6197..b7c642f 100644 --- a/src/Erebos/Attach.hs +++ b/src/Erebos/Attach.hs @@ -59,7 +59,7 @@ instance PairingResult AttachIdentity where liftIO $ mapM_ storeKey $ catMaybes [ keyFromData sec pub | sec <- keys, pub <- pkeys ] identity' <- mergeIdentity $ updateIdentity [ lsIdentity $ fromStored slocal ] identity - shared <- makeSharedStateUpdate st (Just owner) (lsShared $ fromStored slocal) + shared <- makeSharedStateUpdate (Just owner) (lsShared $ fromStored slocal) mstore (fromStored slocal) { lsIdentity = idExtData identity' , lsShared = [ shared ] diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs index 7807204..f518b57 100644 --- a/src/Erebos/DirectMessage.hs +++ b/src/Erebos/DirectMessage.hs @@ -81,7 +81,6 @@ instance Service DirectMessage where let msg = fromStored smsg powner <- asks $ finalOwner . svcPeerIdentity erb <- svcGetLocal - st <- getStorage let DirectMessageThreads prev _ = lookupSharedValue $ lsShared $ fromStored erb sent = findMsgProperty powner msSent prev received = findMsgProperty powner msReceived prev @@ -90,7 +89,7 @@ instance Service DirectMessage where filterAncestors sent == filterAncestors (smsg : sent) then do when (received' /= received) $ do - next <- wrappedStore st $ MessageState + next <- mstore MessageState { msPrev = prev , msPeer = powner , msReady = [] @@ -99,8 +98,8 @@ instance Service DirectMessage where , msSeen = [] } let threads = DirectMessageThreads [ next ] (dmThreadView [ next ]) - shared <- makeSharedStateUpdate st threads (lsShared $ fromStored erb) - svcSetLocal =<< wrappedStore st (fromStored erb) { lsShared = [ shared ] } + shared <- makeSharedStateUpdate threads (lsShared $ fromStored erb) + svcSetLocal =<< mstore (fromStored erb) { lsShared = [ shared ] } when (powner `sameIdentity` msgFrom msg) $ do replyStoredRef smsg diff --git a/src/Erebos/State.hs b/src/Erebos/State.hs index 68b8b89..06e5c54 100644 --- a/src/Erebos/State.hs +++ b/src/Erebos/State.hs @@ -160,12 +160,11 @@ updateSharedState :: forall a b m. (SharedType a, MonadHead LocalState m) => (a updateSharedState f = \ls -> do let shared = lsShared $ fromStored ls val = lookupSharedValue shared - st <- getStorage (val', x) <- f val (,x) <$> if toComponents val' == toComponents val then return ls - else do shared' <- makeSharedStateUpdate st val' shared - wrappedStore st (fromStored ls) { lsShared = [shared'] } + else do shared' <- makeSharedStateUpdate val' shared + mstore (fromStored ls) { lsShared = [shared'] } lookupSharedValue :: forall a. SharedType a => [Stored SharedState] -> a lookupSharedValue = mergeSorted . filterAncestors . map wrappedLoad . concatMap (ssValue . fromStored) . filterAncestors . helper @@ -173,8 +172,8 @@ lookupSharedValue = mergeSorted . filterAncestors . map wrappedLoad . concatMap | otherwise = helper $ ssPrev (fromStored x) ++ xs helper [] = [] -makeSharedStateUpdate :: forall a m. MonadIO m => SharedType a => Storage -> a -> [Stored SharedState] -> m (Stored SharedState) -makeSharedStateUpdate st val prev = liftIO $ wrappedStore st SharedState +makeSharedStateUpdate :: forall a m. (SharedType a, MonadStorage m) => a -> [ Stored SharedState ] -> m (Stored SharedState) +makeSharedStateUpdate val prev = mstore SharedState { ssPrev = prev , ssType = Just $ sharedTypeID @a Proxy , ssValue = storedRef <$> toComponents val |