summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--erebos.cabal1
-rw-r--r--main/Test.hs16
-rw-r--r--main/Test/Service.hs36
-rw-r--r--test/network.test (renamed from test/discovery.test)29
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