diff options
Diffstat (limited to 'main/Test.hs')
| -rw-r--r-- | main/Test.hs | 16 |
1 files changed, 16 insertions, 0 deletions
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 |