From 66bfcd8ad4ef16dcd0e287004dc08f8948589bce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 25 Jan 2026 10:22:04 +0100
Subject: Deferred object loading

---
 src/Erebos/Network.hs         | 14 +++++++++++
 src/Erebos/Object/Deferred.hs | 57 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+)
 create mode 100644 src/Erebos/Object/Deferred.hs

(limited to 'src')

diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index b5cfa6b..3a6f259 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -26,6 +26,7 @@ module Erebos.Network (
     sendToPeerWith,
     runPeerService,
     modifyServiceGlobalState,
+    requestDataFromPeer, DataRequestResult(..),
 
     discoveryPort,
 ) where
@@ -1063,6 +1064,19 @@ modifyServiceGlobalState server proxy f = do
             throwErebosError $ UnhandledService svc
 
 
+data DataRequestResult
+    = DataRequestFulfilled Ref
+    | DataRequestRejected
+    | DataRequestInvalid
+
+requestDataFromPeer :: MonadIO m => Peer -> RefDigest -> (DataRequestResult -> ExceptT ErebosError IO ()) -> m ()
+requestDataFromPeer peer@Peer {..} dgst callback = do
+    liftIO $ atomically $ do
+        wref <- WaitingRef peerStorage_ (partialRefFromDigest peerInStorage dgst) (callback . DataRequestFulfilled) <$> newTVar (Left [])
+        putTMVar peerWaitingRefs . (wref :) =<< takeTMVar peerWaitingRefs
+        writeTQueue (serverDataResponse peerServer_) ( peer, Nothing )
+
+
 foreign import ccall unsafe "Network/ifaddrs.h erebos_join_multicast" cJoinMulticast :: CInt -> Ptr CSize -> IO (Ptr Word32)
 foreign import ccall unsafe "Network/ifaddrs.h erebos_local_addresses" cLocalAddresses :: Ptr CSize -> IO (Ptr InetAddress)
 foreign import ccall unsafe "Network/ifaddrs.h erebos_broadcast_addresses" cBroadcastAddresses :: IO (Ptr Word32)
diff --git a/src/Erebos/Object/Deferred.hs b/src/Erebos/Object/Deferred.hs
new file mode 100644
index 0000000..1faa85b
--- /dev/null
+++ b/src/Erebos/Object/Deferred.hs
@@ -0,0 +1,57 @@
+module Erebos.Object.Deferred (
+    Deferred,
+    DeferredResult(..),
+
+    deferredRef,
+    deferredLoad,
+
+    deferLoadWithServer,
+) where
+
+import Control.Concurrent.MVar
+import Control.Monad.IO.Class
+
+import Erebos.Identity
+import Erebos.Network
+import Erebos.Object
+import Erebos.Storable
+
+
+data Deferred a = Deferred
+    { deferredRef_ :: RefDigest
+    , deferredServer :: Server
+    , deferredPeers :: [ RefDigest ]
+    }
+
+data DeferredResult a
+    = DeferredLoaded (Stored a)
+    | DeferredInvalid
+    | DeferredFailed
+
+deferredRef :: Deferred a -> RefDigest
+deferredRef = deferredRef_
+
+deferredLoad :: MonadIO m => Storable a => Deferred a -> m (MVar (DeferredResult a))
+deferredLoad Deferred {..} = liftIO $ do
+    mvar <- newEmptyMVar
+    let matchPeer peer =
+            getPeerIdentity peer >>= \case
+                PeerIdentityFull pid -> do
+                    return $ any (`elem` identityDigests pid) deferredPeers
+                _ -> return False
+
+    liftIO (findPeer deferredServer matchPeer) >>= \case
+        Just peer -> do
+            requestDataFromPeer peer deferredRef_ $ liftIO . \case
+                DataRequestFulfilled ref -> putMVar mvar $ DeferredLoaded $ wrappedLoad ref
+                DataRequestRejected -> putMVar mvar DeferredFailed
+                DataRequestInvalid -> putMVar mvar DeferredInvalid
+        Nothing -> putMVar mvar DeferredFailed
+    return mvar
+
+deferLoadWithServer :: Storable a => RefDigest -> Server -> [ RefDigest ] -> IO (Deferred a)
+deferLoadWithServer deferredRef_ deferredServer deferredPeers = return Deferred {..}
+
+
+identityDigests :: Foldable f => Identity f -> [ RefDigest ]
+identityDigests pid = map (refDigest . storedRef) $ idDataF =<< unfoldOwners pid
-- 
cgit v1.2.3