From 9d2671dc19bdc46d1f0fc976813cb9d63e34c71e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Fri, 23 Feb 2024 22:21:51 +0100 Subject: Test message service for sending arbitrary data --- main/Test.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'main/Test.hs') 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 -- cgit v1.2.3