Test: explicit list of services for start-serverrelease-0.1

8 files changed, 88 insertions, 46 deletions

diff --git a/main/Test.hs b/main/Test.hs
index 1b156ae..4314852 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Test (
     runTestTool,
 ) where
@@ -448,21 +450,30 @@ cmdStartServer :: Command
 cmdStartServer = do
     out <- asks tiOutput
 
+    let parseParams = \case
+            (name : value : rest)
+                | name == "services" -> T.splitOn "," value
+                | otherwise -> parseParams rest
+            _ -> []
+    serviceNames <- parseParams <$> asks tiParams
+
     h <- getOrLoadHead
     rsPeers <- liftIO $ newMVar (1, [])
-    rsServer <- liftIO $ startServer defaultServerOptions h (B.hPutStr stderr . (`BC.snoc` '\n') . BC.pack)
-        [ someServiceAttr $ pairingAttributes (Proxy @AttachService) out rsPeers "attach"
-        , someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
-        , someServiceAttr $ directMessageAttributes out
-        , someService @SyncService Proxy
-        , someService @ChatroomService Proxy
-        , someServiceAttr $ (defaultServiceAttributes Proxy)
+    services <- forM serviceNames $ \case
+        "attach" -> return $ someServiceAttr $ pairingAttributes (Proxy @AttachService) out rsPeers "attach"
+        "chatroom" -> return $ someService @ChatroomService Proxy
+        "contact" -> return $ someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
+        "dm" -> return $ someServiceAttr $ directMessageAttributes out
+        "sync" -> return $ someService @SyncService Proxy
+        "test" -> return $ someServiceAttr $ (defaultServiceAttributes Proxy)
             { testMessageReceived = \obj otype len sref -> do
                 liftIO $ do
                     void $ store (headStorage h) obj
                     outLine out $ unwords ["test-message-received", otype, len, sref]
             }
-        ]
+        sname -> throwError $ "unknown service `" <> T.unpack sname <> "'"
+
+    rsServer <- liftIO $ startServer defaultServerOptions h (B.hPutStr stderr . (`BC.snoc` '\n') . BC.pack) services
 
     rsPeerThread <- liftIO $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange rsServer
diff --git a/test/attach.test b/test/attach.test
index 33a1483..afbdd0e 100644
--- a/test/attach.test
+++ b/test/attach.test
@@ -1,12 +1,14 @@
 test:
+	let services = "attach,sync"
+
 	spawn as p1
 	spawn as p2
 	send "create-identity Device1 Owner" to p1
 	send "create-identity Device2" to p2
 	send "watch-local-identity" to p1
 	send "watch-local-identity" to p2
-	send "start-server" to p1
-	send "start-server" to p2
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/local-identity Device1 Owner/
 		/peer 1 addr ${p2.node.ip} 29665/
diff --git a/test/chatroom.test b/test/chatroom.test
index 4dda21e..862087d 100644
--- a/test/chatroom.test
+++ b/test/chatroom.test
@@ -1,4 +1,6 @@
 test ChatroomSetup:
+	let services = "chatroom"
+
 	# Local chatrooms
 
 	spawn as p1
@@ -30,7 +32,7 @@ test ChatroomSetup:
 	for p in [ p1, p2, p3 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	for p in [ p2, p3 ]:
 		with p:
@@ -97,6 +99,8 @@ test ChatroomSetup:
 
 
 test ChatroomMessages:
+	let services = "chatroom"
+
 	spawn as p1
 	spawn as p2
 
@@ -106,7 +110,7 @@ test ChatroomMessages:
 	for p in [ p1, p2 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-create first_room" to p1
 	expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
@@ -159,7 +163,7 @@ test ChatroomMessages:
 	spawn as p3
 	send "create-identity Device3 Owner3" to p3
 	send "chatroom-watch-local" to p3
-	send "start-server" to p3
+	send "start-server services $services" to p3
 	expect /chatroom-watched-added ([a-z0-9#]+) first_room sub false/  from p3 capture room1_p3
 	expect /chatroom-watched-added ([a-z0-9#]+) second_room sub false/ from p3 capture room2_p3
 	expect /chatroom-watched-added ([a-z0-9#]+) third_room sub false/  from p3 capture room3_p3
@@ -242,6 +246,8 @@ test ChatroomMessages:
 
 
 test ChatroomSubscribedBeforeStart:
+	let services = "chatroom"
+
 	spawn as p1
 	spawn as p2
 
@@ -251,7 +257,7 @@ test ChatroomSubscribedBeforeStart:
 	for p in [ p1, p2 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-create first_room" to p1
 	expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
@@ -271,7 +277,7 @@ test ChatroomSubscribedBeforeStart:
 			expect /stop-server-done/
 	for p in [p1, p2]:
 		with p:
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-message-send $room1_p1 message1" to p1
 	expect /chatroom-message-new $room1_p1 room first_room from Owner1 text message1/ from p1
@@ -283,6 +289,8 @@ test ChatroomSubscribedBeforeStart:
 
 
 test ParallelThreads:
+	let services = "chatroom"
+
 	spawn as p1
 	spawn as p2
 
@@ -292,7 +300,7 @@ test ParallelThreads:
 	for p in [ p1, p2 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-create first_room" to p1
 	expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
@@ -330,7 +338,7 @@ test ParallelThreads:
 
 	for p in [p1, p2]:
 		with p:
-			send "start-server"
+			send "start-server services $services"
 
 	with p1:
 		expect /chatroom-message-new $room1_p1 room first_room from Owner. text message(..)/ capture msg
@@ -347,6 +355,8 @@ test ParallelThreads:
 
 
 test ChatroomMembers:
+	let services = "chatroom"
+
 	spawn as p1
 	spawn as p2
 	spawn as p3
@@ -358,7 +368,7 @@ test ChatroomMembers:
 	for p in [ p1, p2, p3 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-create first_room" to p1
 	expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
@@ -432,6 +442,8 @@ test ChatroomMembers:
 
 
 test ChatroomIdentity:
+	let services = "chatroom"
+
 	spawn as p1
 	spawn as p2
 
@@ -441,7 +453,7 @@ test ChatroomIdentity:
 	for p in [ p1, p2 ]:
 		with p:
 			send "chatroom-watch-local"
-			send "start-server"
+			send "start-server services $services"
 
 	send "chatroom-create first_room" to p1
 	expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
diff --git a/test/contact.test b/test/contact.test
index 438aa1f..978f8a6 100644
--- a/test/contact.test
+++ b/test/contact.test
@@ -1,4 +1,6 @@
 test Contact:
+	let services = "attach,contact,sync"
+	
 	spawn as p1
 	spawn as p2
 	spawn as p3
@@ -9,10 +11,10 @@ test Contact:
 	send "create-identity Device3 Owner3" to p3
 	send "create-identity Device4"        to p4
 
-	send "start-server" to p1
-	send "start-server" to p2
-	send "start-server" to p3
-	send "start-server" to p4
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
+	send "start-server services $services" to p3
+	send "start-server services $services" to p4
 
 	expect from p1:
 		/peer ([0-9]+) addr ${p2.node.ip} 29665/ capture peer1_2
diff --git a/test/message.test b/test/message.test
index 307f11a..c0e251b 100644
--- a/test/message.test
+++ b/test/message.test
@@ -1,10 +1,12 @@
 test DirectMessage:
+	let services = "contact,dm"
+
 	spawn as p1
 	spawn as p2
 	send "create-identity Device1 Owner1" to p1
 	send "create-identity Device2 Owner2" to p2
-	send "start-server" to p1
-	send "start-server" to p2
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 
 	expect from p1:
 		/peer ([0-9]+) addr ${p2.node.ip} 29665/ capture peer1_2
@@ -96,7 +98,7 @@ test DirectMessage:
 			expect /stop-server-done/
 	for p in [p1, p2]:
 		with p:
-			send "start-server"
+			send "start-server services $services"
 
 	with p1:
 		send "contact-list"
@@ -126,10 +128,10 @@ test DirectMessage:
 	for p in [p1, p2]:
 		with p:
 			expect /stop-server-done/
-	send "start-server" to p2
+	send "start-server services $services" to p2
 
 	send "dm-send-contact $c1_2 while_offline" to p1
-	send "start-server" to p1
+	send "start-server services $services" to p1
 
 	expect /dm-received from Owner1 text while_offline/ from p2
 
@@ -139,11 +141,11 @@ test DirectMessage:
 	for p in [p1, p2]:
 		with p:
 			expect /stop-server-done/
-	send "start-server" to p1
+	send "start-server services $services" to p1
 
 	send "dm-send-contact $c1_2 while_peer_offline" to p1
 	# TODO: sync from p1 on peer p2 discovery not ensured without addition wait
 	#wait
-	send "start-server" to p2
+	send "start-server services $services" to p2
 
 	expect /dm-received from Owner1 text while_peer_offline/ from p2
diff --git a/test/network.test b/test/network.test
index 40190f4..52fcbee 100644
--- a/test/network.test
+++ b/test/network.test
@@ -120,12 +120,14 @@ test Discovery:
 
 
 test LargeData:
+	let services = "test"
+
 	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
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/peer 1 addr ${p2.node.ip} 29665/
 		/peer 1 id Device2/
@@ -149,12 +151,14 @@ test LargeData:
 
 
 test ManyStreams:
+	let services = "test"
+
 	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
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/peer 1 addr ${p2.node.ip} 29665/
 		/peer 1 id Device2/
@@ -179,12 +183,14 @@ test ManyStreams:
 
 
 test MultipleServiceRefs:
+	let services = "test"
+
 	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
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/peer 1 addr ${p2.node.ip} 29665/
 		/peer 1 id Device2/
@@ -235,16 +241,18 @@ test MultipleServiceRefs:
 
 
 test Reconnection:
+	let services = "test"
+
 	spawn as p1
 	with p1:
 		send "create-identity Device1"
-		send "start-server"
+		send "start-server services $services"
 
 	node n
 	local:
 		spawn as p2 on n
 		send "create-identity Device2" to p2
-		send "start-server" to p2
+		send "start-server services $services" to p2
 
 		expect from p1:
 			/peer 1 addr ${p2.node.ip} 29665/
@@ -272,7 +280,7 @@ test Reconnection:
 	# Restart process on node 'n'
 	local:
 		spawn as p2 on n
-		send "start-server" to p2
+		send "start-server services $services" to p2
 		send "peer-add ${p1.node.ip}" to p2
 
 		expect from p2:
@@ -383,6 +391,7 @@ test Reconnection:
 
 
 test SendUnknownObjectType:
+	let services = "test"
 	let refpat = /blake2#[0-9a-f]*/
 
 	spawn as p1
@@ -390,10 +399,10 @@ test SendUnknownObjectType:
 
 	with p1:
 		send "create-identity Device1"
-		send "start-server"
+		send "start-server services $services"
 	with p2:
 		send "create-identity Device2"
-		send "start-server"
+		send "start-server services $services"
 
 	expect from p1:
 		/peer 1 addr ${p2.node.ip} 29665/
diff --git a/test/storage.test b/test/storage.test
index db9e0a1..a5cca7f 100644
--- a/test/storage.test
+++ b/test/storage.test
@@ -381,14 +381,16 @@ test StorageWatcher:
 
 
 test SharedStateWatcher:
+	let services = "attach,sync"
+
 	spawn as p1
 	spawn as p2
 	send "create-identity Device1 Owner" to p1
 	send "create-identity Device2" to p2
 	send "watch-local-identity" to p1
 	send "watch-local-identity" to p2
-	send "start-server" to p1
-	send "start-server" to p2
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/local-identity Device1 Owner/
 		/peer 1 addr ${p2.node.ip} 29665/
diff --git a/test/sync.test b/test/sync.test
index ea9595d..d465b11 100644
--- a/test/sync.test
+++ b/test/sync.test
@@ -1,4 +1,6 @@
 test:
+	let services = "attach,sync"
+
 	spawn as p1
 	spawn as p2
 	send "create-identity Device1 Owner" to p1
@@ -7,8 +9,8 @@ test:
 	send "watch-local-identity" to p2
 	send "watch-shared-identity" to p1
 	send "watch-shared-identity" to p2
-	send "start-server" to p1
-	send "start-server" to p2
+	send "start-server services $services" to p1
+	send "start-server services $services" to p2
 	expect from p1:
 		/local-identity Device1 Owner/
 		/shared-identity Owner/
@@ -57,7 +59,7 @@ test:
 		send "create-identity Device3"
 		send "watch-local-identity"
 		send "watch-shared-identity"
-		send "start-server"
+		send "start-server services $services"
 
 		send "peer-add ${p1.node.ip}"