diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-11-17 20:28:44 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-11-18 20:03:24 +0100 |
commit | 88a7bb50033baab3c2d0eed7e4be868e8966300a (patch) | |
tree | 861631a1e5e7434b92a8f19ef8f7b783790e1d1f /src/Sync.hs | |
parent | 5b908c86320ee73f2722c85f8a47fa03ec093c6c (diff) |
Split to library and executable parts
Diffstat (limited to 'src/Sync.hs')
-rw-r--r-- | src/Sync.hs | 46 |
1 files changed, 0 insertions, 46 deletions
diff --git a/src/Sync.hs b/src/Sync.hs deleted file mode 100644 index dd801b5..0000000 --- a/src/Sync.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Sync ( - SyncService(..), -) where - -import Control.Monad -import Control.Monad.Reader - -import Data.List - -import Identity -import Service -import State -import Storage -import 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 |