From 88a7bb50033baab3c2d0eed7e4be868e8966300a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 17 Nov 2023 20:28:44 +0100
Subject: Split to library and executable parts

---
 src/Erebos/Sync.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 src/Erebos/Sync.hs

(limited to 'src/Erebos/Sync.hs')

diff --git a/src/Erebos/Sync.hs b/src/Erebos/Sync.hs
new file mode 100644
index 0000000..04b5f11
--- /dev/null
+++ b/src/Erebos/Sync.hs
@@ -0,0 +1,46 @@
+module Erebos.Sync (
+    SyncService(..),
+) where
+
+import Control.Monad
+import Control.Monad.Reader
+
+import Data.List
+
+import Erebos.Identity
+import Erebos.Service
+import Erebos.State
+import Erebos.Storage
+import Erebos.Storage.Merge
+
+data SyncService = SyncPacket (Stored SharedState)
+
+instance Service SyncService where
+    serviceID _ = mkServiceID "a4f538d0-4e50-4082-8e10-7e3ec2af175d"
+
+    serviceHandler packet = do
+        let SyncPacket added = fromStored packet
+        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 mstore (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 =<< (mstore . SyncPacket) sh
-- 
cgit v1.2.3