Use MonadStorage for makeSharedStateUpdate

Changelog: API: `State.makeSharedStateUpdate` uses `MonadStorage`

4 files changed, 11 insertions, 13 deletions

diff --git a/main/Test.hs b/main/Test.hs
index 9f52020..b59bd74 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -482,13 +482,13 @@ cmdCreateIdentity = do
     st <- asks tiStorage
     names <- asks tiParams
 
-    h <- liftIO $ do
-        Just identity <- if null names
+    h <- do
+        Just identity <- liftIO $ if null names
             then Just <$> createIdentity st Nothing Nothing
             else foldrM (\n o -> Just <$> createIdentity st (Just n) o) Nothing names
 
         shared <- case names of
-            _:_:_ -> (:[]) <$> makeSharedStateUpdate st (Just $ finalOwner identity) []
+            _:_:_ -> (: []) <$> makeSharedStateUpdate (Just $ finalOwner identity) []
             _ -> return []
 
         storeHead st $ LocalState
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