Deferred object loading

1 files changed, 13 insertions, 0 deletions

diff --git a/main/Test/Service.hs b/main/Test/Service.hs
index c0be07d..156b62c 100644
--- a/main/Test/Service.hs
+++ b/main/Test/Service.hs
@@ -9,9 +9,12 @@ import Control.Monad
 import Control.Monad.Reader
 
 import Data.ByteString.Lazy.Char8 qualified as BL
+import Data.Word
 
+import Erebos.Identity
 import Erebos.Network
 import Erebos.Object
+import Erebos.Object.Deferred
 import Erebos.Service
 import Erebos.Service.Stream
 import Erebos.Storable
@@ -21,6 +24,7 @@ data TestMessage = TestMessage (Stored Object)
 data TestMessageAttributes = TestMessageAttributes
     { testMessageReceived :: Object -> String -> String -> String -> ServiceHandler TestMessage ()
     , testStreamsReceived :: [ StreamReader ] -> ServiceHandler TestMessage ()
+    , testOnDemandReceived :: Word64 -> Deferred Object -> ServiceHandler TestMessage ()
     }
 
 instance Storable TestMessage where
@@ -34,6 +38,7 @@ instance Service TestMessage where
     defaultServiceAttributes _ = TestMessageAttributes
         { testMessageReceived = \_ _ _ _ -> return ()
         , testStreamsReceived = \_ -> return ()
+        , testOnDemandReceived = \_ _ -> return ()
         }
 
     serviceHandler smsg = do
@@ -50,6 +55,14 @@ instance Service TestMessage where
             cb <- asks $ testStreamsReceived . svcAttributes
             cb streams
 
+        case obj of
+            OnDemand size dgst -> do
+                cb <- asks $ testOnDemandReceived . svcAttributes
+                server <- asks svcServer
+                pid <- asks svcPeerIdentity
+                cb size =<< liftIO (deferLoadWithServer dgst server [ refDigest $ storedRef $ idData pid ])
+            _ -> return ()
+
 
 openTestStreams :: Int -> ServiceHandler TestMessage [ StreamWriter ]
 openTestStreams count = do