From 03c1f809b23d5ab1613ce5633acc9706469587c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 2 Aug 2026 20:57:05 +0200 Subject: Make head caches available in service storage watchers --- src/Erebos/Network.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'src/Erebos/Network.hs') diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index c2a714e..dc24e93 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -75,6 +75,7 @@ import Erebos.Service import Erebos.State import Erebos.Storable.Internal import Erebos.Storage +import Erebos.Storage.Head import Erebos.Storage.Key import Erebos.Storage.Merge @@ -346,10 +347,21 @@ startServer serverOptions serverOrigHead logd' serverServices = do PeerIdentityFull _ -> writeTQueue serverIOActions $ do runPeerService peer $ act . sel =<< svcGetLocal _ -> return () + SomeStorageWatcherHC sel act -> do + watchHeadWith serverOrigHead (\h -> sel (headStoredObject h) (headCache h)) $ \_ -> do + withMVar serverPeers $ mapM_ $ \peer -> atomically $ do + readTVar (peerIdentityVar peer) >>= \case + PeerIdentityFull _ -> writeTQueue serverIOActions $ do + runPeerService peer $ act =<< (sel <$> getLocalHead <*> getLocalHeadCache @LocalState Proxy) + _ -> return () GlobalStorageWatcher sel act -> do watchHeadWith serverOrigHead (sel . headStoredObject) $ \x -> do atomically $ writeTQueue serverIOActions $ do act server x + GlobalStorageWatcherH sel act -> do + watchHeadWith serverOrigHead sel $ \x -> do + atomically $ writeTQueue serverIOActions $ do + act server x forkServerThread server "receiver" $ forever $ do (msg, saddr) <- S.recvFrom sock 4096 -- cgit v1.2.3