agent: test migrating to/from service subscriptions (WIP, fails)

Author: epoberezkin

tests/AgentTests/FunctionalAPITests.hs

@@ -479,7 +479,8 @@ functionalAPITests ps = do
       withSmpServer ps testTwoUsers
   describe "Client service certificates" $ do
     it "should connect, subscribe and reconnect as a service" $ testClientServiceConnection ps
-    it "should re-subscribe when service ID changed" $ testClientServiceIDChange ps
+    fit "should re-subscribe when service ID changed" $ testClientServiceIDChange ps
+    fit "migrate connections to and from service" $ testMigrateConnectionsToService ps
   describe "Connection switch" $ do
     describe "should switch delivery to the new queue" $
       testServerMatrix2 ps testSwitchConnection
@@ -3743,7 +3744,7 @@ testClientServiceIDChange ps@(_, ASType qs _) = do
       liftIO $ getInAnyOrder service
         [ \case ("", "", AEvt SAENone (SERVICE_UP _ (SMP.ServiceSubResult (Just (SMP.SSErrorQueueCount 1 0)) (SMP.ServiceSub _ 0 _)))) -> True; _ -> False,
           \case ("", "", AEvt SAENone (SERVICE_ALL _)) -> True; _ -> False,
-          \case ("", "", AEvt SAENone (UP _ _)) -> True; _ -> False
+          \case ("", "", AEvt SAENone (UP _ [_])) -> True; _ -> False
         ]
       subscribeAllConnections user False Nothing
       ("", "", UP _ [_]) <- nGet user
@@ -3759,6 +3760,36 @@ testClientServiceIDChange ps@(_, ASType qs _) = do
       ("", "", UP _ [_]) <- nGet user
       exchangeGreetingsMsgId 6 notService uId user sId
 
+testMigrateConnectionsToService :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testMigrateConnectionsToService ps =
+  withSmpServerStoreLogOn ps testPort $ \_ -> do
+    ((sId1, uId1), (sId2, uId2)) <-
+      withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers) $ \notService user ->
+        runRight $ (,) <$> makeConnection notService user <*> makeConnection notService user
+    ((sId3, uId3), (sId4, uId4)) <-
+      withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> runRight $ do
+        subscribeAllConnections service False Nothing
+        ("", "", UP _ [_, _]) <- nGet service
+        subscribeAllConnections user False Nothing
+        ("", "", UP _ [_, _]) <- nGet user
+        exchangeGreetings service uId1 user sId1
+        exchangeGreetings service uId2 user sId2
+        (,) <$> makeConnection service user <*> makeConnection service user
+    withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> runRight $ do
+      subscribeAllConnections service False Nothing
+      r <- nGet service
+      liftIO $ print r
+      liftIO $ getInAnyOrder service
+        [ \case ("", "", AEvt SAENone (SERVICE_UP _ (SMP.ServiceSubResult Nothing (SMP.ServiceSub _ 4 _)))) -> True; _ -> False,
+          \case ("", "", AEvt SAENone (SERVICE_ALL _)) -> True; _ -> False
+        ]
+      subscribeAllConnections user False Nothing
+      ("", "", UP _ [_, _, _, _]) <- nGet user
+      exchangeGreetings service uId1 user sId1
+      exchangeGreetings service uId2 user sId2
+      exchangeGreetings service uId3 user sId3
+      exchangeGreetings service uId4 user sId4
+
 getSMPAgentClient' :: Int -> AgentConfig -> InitialAgentServers -> String -> IO AgentClient
 getSMPAgentClient' clientId cfg' initServers dbPath = do
   Right st <- liftIO $ createStore dbPath