From ba636680dc5fdd7d5db81248e4fa737d026f985f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 3 Jul 2023 20:21:04 +0200
Subject: Handle Sync service outside of Network module

---
 src/Sync.hs | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

(limited to 'src/Sync.hs')

diff --git a/src/Sync.hs b/src/Sync.hs
index afb45e6..b1c0ab0 100644
--- a/src/Sync.hs
+++ b/src/Sync.hs
@@ -3,9 +3,11 @@ module Sync (
 ) where
 
 import Control.Monad
+import Control.Monad.Reader
 
 import Data.List
 
+import Identity
 import Service
 import State
 import Storage
@@ -18,13 +20,27 @@ instance Service SyncService where
 
     serviceHandler packet = do
         let SyncPacket added = fromStored packet
-        ls <- svcGetLocal
-        let st = storedStorage ls
-            current = sort $ lsShared $ fromStored ls
-            updated = filterAncestors (added : current)
-        when (current /= updated) $ do
-            svcSetLocal =<< wrappedStore st (fromStored ls) { lsShared = updated }
+        pid <- asks svcPeerIdentity
+        self <- svcSelf
+        when (finalOwner pid `sameIdentity` finalOwner self) $ do
+            updateLocalHead_ $ \ls -> do
+                let current = sort $ lsShared $ fromStored ls
+                    updated = filterAncestors (added : current)
+                if current /= updated
+                   then wrappedStore (storedStorage ls) (fromStored ls) { lsShared = updated }
+                   else return ls
+
+    serviceNewPeer = notifyPeer . lsShared . fromStored =<< svcGetLocal
+    serviceStorageWatchers _ = (:[]) $ SomeStorageWatcher (lsShared . fromStored) notifyPeer
 
 instance Storable SyncService where
     store' (SyncPacket smsg) = store' smsg
     load' = SyncPacket <$> load'
+
+notifyPeer :: [Stored SharedState] -> ServiceHandler SyncService ()
+notifyPeer shared = do
+    pid <- asks svcPeerIdentity
+    self <- svcSelf
+    when (finalOwner pid `sameIdentity` finalOwner self) $ do
+        forM_ shared $ \sh ->
+            replyStoredRef =<< (wrappedStore (storedStorage sh) . SyncPacket) sh
-- 
cgit v1.2.3