2 files changed, 63 insertions, 5 deletions
diff --git a/main/Test/Service.hs b/main/Test/Service.hs
index 1018e0d..c952c86 100644
--- a/main/Test/Service.hs
+++ b/main/Test/Service.hs
@@ -1,20 +1,30 @@
 module Test.Service (
     TestMessage(..),
     TestMessageAttributes(..),
+
+    openTestStreams,
 ) where
 
+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.Storage
+import Erebos.Service.Stream
+import Erebos.Storable
 
 data TestMessage = TestMessage (Stored Object)
 
 data TestMessageAttributes = TestMessageAttributes
-    { testMessageReceived :: String -> String -> String -> ServiceHandler TestMessage ()
+    { testMessageReceived :: Object -> String -> String -> String -> ServiceHandler TestMessage ()
+    , testStreamsReceived :: [ StreamReader ] -> ServiceHandler TestMessage ()
+    , testOnDemandReceived :: Word64 -> Deferred Object -> ServiceHandler TestMessage ()
     }
 
 instance Storable TestMessage where
@@ -25,12 +35,36 @@ instance Service TestMessage where
     serviceID _ = mkServiceID "cb46b92c-9203-4694-8370-8742d8ac9dc8"
 
     type ServiceAttributes TestMessage = TestMessageAttributes
-    defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ -> return ())
+    defaultServiceAttributes _ = TestMessageAttributes
+        { testMessageReceived = \_ _ _ _ -> return ()
+        , testStreamsReceived = \_ -> return ()
+        , testOnDemandReceived = \_ _ -> return ()
+        }
 
     serviceHandler smsg = do
         let TestMessage sobj = fromStored smsg
-        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject $ fromStored sobj of
+            obj = fromStored sobj
+        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject obj of
             [otype, len] -> do
                 cb <- asks $ testMessageReceived . svcAttributes
-                cb otype len (show $ refDigest $ storedRef sobj)
+                cb obj otype len (show $ refDigest $ storedRef sobj)
+            _ -> return ()
+
+        streams <- receivedStreams
+        when (not $ null streams) $ do
+            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 (DeferredExactSize size) server [ refDigest $ storedRef $ idData pid ])
             _ -> return ()
+
+
+openTestStreams :: Int -> ServiceHandler TestMessage [ StreamWriter ]
+openTestStreams count = do
+    replyPacket . TestMessage =<< mstore (Rec [])
+    replicateM count openStream
diff --git a/main/Test/State.hs b/main/Test/State.hs
new file mode 100644
index 0000000..3ef1558
--- /dev/null
+++ b/main/Test/State.hs
@@ -0,0 +1,24 @@
+module Test.State (
+    CustomSharedState(..),
+) where
+
+import Data.Proxy
+
+import GHC.TypeLits
+
+import Erebos.Object
+import Erebos.State
+import Erebos.Storage.Merge
+
+
+data CustomSharedState (tid :: Symbol) = CustomSharedState
+    { customStateComponents :: StoredTips Object
+    }
+
+instance Mergeable (CustomSharedState tid) where
+    type Component (CustomSharedState tid) = Object
+    toComponents = customStateComponents
+    mergeSorted = CustomSharedState
+
+instance KnownSymbol tid => SharedType (CustomSharedState tid) where
+    sharedTypeID _ = mkSharedTypeID (symbolVal @tid Proxy)