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/Object/Deferred.hs | 57 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 src/Erebos/Object/Deferred.hs

(limited to 'src/Erebos/Object')

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