From 66bfcd8ad4ef16dcd0e287004dc08f8948589bce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 25 Jan 2026 10:22:04 +0100 Subject: Deferred object loading --- main/Test/Service.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'main/Test/Service.hs') 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 -- cgit v1.2.3