diff options
Diffstat (limited to 'src/Erebos/Object')
| -rw-r--r-- | src/Erebos/Object/Deferred.hs | 29 |
1 files changed, 24 insertions, 5 deletions
diff --git a/src/Erebos/Object/Deferred.hs b/src/Erebos/Object/Deferred.hs index 1faa85b..396428d 100644 --- a/src/Erebos/Object/Deferred.hs +++ b/src/Erebos/Object/Deferred.hs @@ -1,5 +1,6 @@ module Erebos.Object.Deferred ( Deferred, + DeferredSize(..), DeferredResult(..), deferredRef, @@ -11,6 +12,8 @@ module Erebos.Object.Deferred ( import Control.Concurrent.MVar import Control.Monad.IO.Class +import Data.Word + import Erebos.Identity import Erebos.Network import Erebos.Object @@ -19,10 +22,15 @@ import Erebos.Storable data Deferred a = Deferred { deferredRef_ :: RefDigest + , deferredSize :: DeferredSize , deferredServer :: Server , deferredPeers :: [ RefDigest ] } +data DeferredSize + = DeferredExactSize Word64 + | DeferredMaximumSize Word64 + data DeferredResult a = DeferredLoaded (Stored a) | DeferredInvalid @@ -42,15 +50,26 @@ deferredLoad Deferred {..} = liftIO $ do liftIO (findPeer deferredServer matchPeer) >>= \case Just peer -> do - requestDataFromPeer peer deferredRef_ $ liftIO . \case - DataRequestFulfilled ref -> putMVar mvar $ DeferredLoaded $ wrappedLoad ref + 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 - DataRequestInvalid -> putMVar mvar DeferredInvalid + DataRequestBrokenBound -> putMVar mvar DeferredInvalid + Nothing -> putMVar mvar DeferredFailed return mvar -deferLoadWithServer :: Storable a => RefDigest -> Server -> [ RefDigest ] -> IO (Deferred a) -deferLoadWithServer deferredRef_ deferredServer deferredPeers = return Deferred {..} +deferLoadWithServer :: Storable a => RefDigest -> DeferredSize -> Server -> [ RefDigest ] -> IO (Deferred a) +deferLoadWithServer deferredRef_ deferredSize deferredServer deferredPeers = return Deferred {..} identityDigests :: Foldable f => Identity f -> [ RefDigest ] |