Test message service for sending arbitrary data

4 files changed, 81 insertions, 1 deletions

diff --git a/erebos.cabal b/erebos.cabal
index 1692c3f..c616e11 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -156,6 +156,7 @@ executable erebos
     other-modules:
         Paths_erebos
         Test
+        Test.Service
         Version
         Version.Git
     autogen-modules:
diff --git a/main/Test.hs b/main/Test.hs
index 8a205ea..991cf85 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -43,6 +43,8 @@ import Erebos.Storage.Internal (unsafeStoreRawBytes)
 import Erebos.Storage.Merge
 import Erebos.Sync
 
+import Test.Service
+
 
 data TestState = TestState
     { tsHead :: Maybe (Head LocalState)
@@ -243,6 +245,7 @@ commands = map (T.pack *** id)
     , ("start-server", cmdStartServer)
     , ("stop-server", cmdStopServer)
     , ("peer-add", cmdPeerAdd)
+    , ("test-message-send", cmdTestMessageSend)
     , ("shared-state-get", cmdSharedStateGet)
     , ("shared-state-wait", cmdSharedStateWait)
     , ("watch-local-identity", cmdWatchLocalIdentity)
@@ -340,6 +343,10 @@ cmdStartServer = do
         , someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
         , someServiceAttr $ directMessageAttributes out
         , someService @SyncService Proxy
+        , someServiceAttr $ (defaultServiceAttributes Proxy)
+            { testMessageReceived = \otype len sref ->
+                liftIO $ outLine out $ unwords ["test-message-received", otype, len, sref]
+            }
         ]
 
     rsPeerThread <- liftIO $ forkIO $ void $ forever $ do
@@ -378,6 +385,15 @@ cmdPeerAdd = do
     addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just host) (Just port)
     void $ liftIO $ serverPeer rsServer (addrAddress addr)
 
+cmdTestMessageSend :: Command
+cmdTestMessageSend = do
+    [spidx, tref] <- asks tiParams
+    st <- asks tiStorage
+    Just ref <- liftIO $ readRef st (encodeUtf8 tref)
+    peer <- getPeer spidx
+    sendToPeer peer $ TestMessage $ wrappedLoad ref
+    cmdOut "test-message-send done"
+
 cmdSharedStateGet :: Command
 cmdSharedStateGet = do
     h <- getHead
diff --git a/main/Test/Service.hs b/main/Test/Service.hs
new file mode 100644
index 0000000..1018e0d
--- /dev/null
+++ b/main/Test/Service.hs
@@ -0,0 +1,36 @@
+module Test.Service (
+    TestMessage(..),
+    TestMessageAttributes(..),
+) where
+
+import Control.Monad.Reader
+
+import Data.ByteString.Lazy.Char8 qualified as BL
+
+import Erebos.Network
+import Erebos.Service
+import Erebos.Storage
+
+data TestMessage = TestMessage (Stored Object)
+
+data TestMessageAttributes = TestMessageAttributes
+    { testMessageReceived :: String -> String -> String -> ServiceHandler TestMessage ()
+    }
+
+instance Storable TestMessage where
+    store' (TestMessage msg) = store' msg
+    load' = TestMessage <$> load'
+
+instance Service TestMessage where
+    serviceID _ = mkServiceID "cb46b92c-9203-4694-8370-8742d8ac9dc8"
+
+    type ServiceAttributes TestMessage = TestMessageAttributes
+    defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ -> return ())
+
+    serviceHandler smsg = do
+        let TestMessage sobj = fromStored smsg
+        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject $ fromStored sobj of
+            [otype, len] -> do
+                cb <- asks $ testMessageReceived . svcAttributes
+                cb otype len (show $ refDigest $ storedRef sobj)
+            _ -> return ()
diff --git a/test/discovery.test b/test/network.test
index 2aaaf24..0b9fecb 100644
--- a/test/discovery.test
+++ b/test/network.test
@@ -1,4 +1,4 @@
-test:
+test Discovery:
 	spawn as p1
 	spawn as p2
 	send "create-identity Device1 Owner" to p1
@@ -117,3 +117,30 @@ test:
 		/peer $peer6_4 id Device4/
 		/peer ([0-9]+) addr ${p5.node.ip} 29665/ capture peer6_5
 		/peer $peer6_5 id Device5/
+
+
+test LargeData:
+	spawn as p1
+	spawn as p2
+	send "create-identity Device1" to p1
+	send "create-identity Device2" to p2
+	send "start-server" to p1
+	send "start-server" to p2
+	expect from p1:
+		/peer 1 addr ${p2.node.ip} 29665/
+		/peer 1 id Device2/
+	expect from p2:
+		/peer 1 addr ${p1.node.ip} 29665/
+		/peer 1 id Device1/
+
+	for i in [0..1]:
+		with p1:
+			send "store blob"
+			for j in [1 .. i * 10]:
+				send "123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789"
+			send ""
+			expect /store-done (blake2#[0-9a-f]*)/ capture ref
+
+			send "test-message-send 1 $ref"
+			expect /test-message-send done/
+			expect /test-message-received blob ${i*1000} $ref/ from p2