1 files changed, 67 insertions, 35 deletions

diff --git a/src/Erebos/Object/Deferred.hs b/src/Erebos/Object/Deferred.hs
index 396428d..31ff0f9 100644
--- a/src/Erebos/Object/Deferred.hs
+++ b/src/Erebos/Object/Deferred.hs
@@ -5,6 +5,8 @@ module Erebos.Object.Deferred (
 
     deferredRef,
     deferredLoad,
+    deferredWait,
+    deferredCheck,
 
     deferLoadWithServer,
 ) where
@@ -20,56 +22,86 @@ import Erebos.Object
 import Erebos.Storable
 
 
+-- | Deffered value, which can be loaded on request. Holds a reference (digest)
+-- to an object and information about suitable network peers, from which the
+-- data can be requested.
 data Deferred a = Deferred
     { deferredRef_ :: RefDigest
     , deferredSize :: DeferredSize
     , deferredServer :: Server
     , deferredPeers :: [ RefDigest ]
+    , deferredStatus :: MVar (Maybe (MVar (DeferredResult a)))
     }
 
+-- | Size constraint for the deferred object.
 data DeferredSize
-    = DeferredExactSize Word64
-    | DeferredMaximumSize Word64
+    = DeferredExactSize Word64 -- ^ Component size of the referred data must be exactly the given value.
+    | DeferredMaximumSize Word64 -- ^ Component size of the referred data must not exceed the given value.
 
+-- | Result of the deferred load request.
 data DeferredResult a
-    = DeferredLoaded (Stored a)
-    | DeferredInvalid
-    | DeferredFailed
+    = DeferredLoaded (Stored a) -- ^ Deferred object was sucessfully loaded.
+    | DeferredInvalid -- ^ Deferred object was (partially) loaded, but failed to meet the size constraint or was an invalid object.
+    | DeferredFailed -- ^ Failure to load the object, e.g. no suitable peer was found.
 
+-- | Get the digest of the deferred object.
 deferredRef :: Deferred a -> RefDigest
 deferredRef = deferredRef_
 
-deferredLoad :: MonadIO m => Storable a => Deferred a -> m (MVar (DeferredResult a))
+-- | Request the deferred object to be loaded. Does nothing if that was already
+-- requested before. The result can be received using `deferredWait` or
+-- `deferredCheck` functions.
+deferredLoad :: (Storable a, MonadIO m) => Deferred a -> m ()
 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
-            let bound = case deferredSize of
-                    DeferredExactSize s -> s
-                    DeferredMaximumSize s -> s
-
-                checkSize ref = case deferredSize of
-                    DeferredExactSize s -> componentSize ref == s
-                    DeferredMaximumSize s -> componentSize ref <= s
-
-            requestDataFromPeer peer deferredRef_ bound $ liftIO . \case
-                DataRequestFulfilled ref
-                    | checkSize ref -> putMVar mvar $ DeferredLoaded $ wrappedLoad ref
-                    | otherwise -> putMVar mvar DeferredInvalid
-                DataRequestRejected -> putMVar mvar DeferredFailed
-                DataRequestBrokenBound -> putMVar mvar DeferredInvalid
-
-        Nothing -> putMVar mvar DeferredFailed
-    return mvar
-
-deferLoadWithServer :: Storable a => RefDigest -> DeferredSize -> Server -> [ RefDigest ] -> IO (Deferred a)
-deferLoadWithServer deferredRef_ deferredSize deferredServer deferredPeers = return Deferred {..}
+    modifyMVar_ deferredStatus $ \case
+        Nothing -> 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
+                    let bound = case deferredSize of
+                            DeferredExactSize s -> s
+                            DeferredMaximumSize s -> s
+
+                        checkSize ref = case deferredSize of
+                            DeferredExactSize s -> componentSize ref == s
+                            DeferredMaximumSize s -> componentSize ref <= s
+
+                    requestDataFromPeer peer deferredRef_ bound $ liftIO . \case
+                        DataRequestFulfilled ref
+                            | checkSize ref -> putMVar mvar $ DeferredLoaded $ wrappedLoad ref
+                            | otherwise -> putMVar mvar DeferredInvalid
+                        DataRequestRejected -> putMVar mvar DeferredFailed
+                        DataRequestBrokenBound -> putMVar mvar DeferredInvalid
+
+                Nothing -> putMVar mvar DeferredFailed
+            return $ Just mvar
+        cur@Just {} -> return cur
+
+-- | Wait for a `Deferred` value to be loaded and return the result. Requests
+-- the value to be loaded if that was not already done.
+deferredWait :: (Storable a, MonadIO m) => Deferred a -> m (DeferredResult a)
+deferredWait d@Deferred {..} = liftIO $ readMVar deferredStatus >>= \case
+    Nothing -> deferredLoad d >> deferredWait d
+    Just mvar -> readMVar mvar
+
+-- | Check if a `Deferred` value has already been loaded and return it in
+-- `Just` if so, otherwise return `Nothing`. Requests the value to be loaded if
+-- that was not already done.
+deferredCheck :: (Storable a, MonadIO m) => Deferred a -> m (Maybe (DeferredResult a))
+deferredCheck d@Deferred {..} = liftIO $ readMVar deferredStatus >>= \case
+    Nothing -> deferredLoad d >> deferredCheck d
+    Just mvar -> tryReadMVar mvar
+
+deferLoadWithServer :: (Storable a, MonadIO m) => RefDigest -> DeferredSize -> Server -> [ RefDigest ] -> m (Deferred a)
+deferLoadWithServer deferredRef_ deferredSize deferredServer deferredPeers = do
+    deferredStatus <- liftIO $ newMVar Nothing
+    return Deferred {..}
 
 
 identityDigests :: Foldable f => Identity f -> [ RefDigest ]