Terminate ICE thread when server is stoppedrelease-0.1

Changelog: Improved handling of ICE connections

6 files changed, 39 insertions, 2 deletions

diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index d203866..d098f98 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -384,6 +384,12 @@ instance Service DiscoveryService where
                 Just ref -> sendToPeer peer $ DiscoverySearch ref
                 Nothing -> return ()
 
+#ifdef ENABLE_ICE_SUPPORT
+    serviceStopServer _ _ _ pstates = do
+        forM_ pstates $ \( _, DiscoveryPeerState {..} ) -> do
+            mapM_ iceStopThread dpsIceConfig
+#endif
+
 
 identityDigests :: Foldable f => Identity f -> [ RefDigest ]
 identityDigests pid = map (refDigest . storedRef) $ idDataF =<< unfoldOwners pid
diff --git a/src/Erebos/ICE.chs b/src/Erebos/ICE.chs
index 6f61451..cc2fdcc 100644
--- a/src/Erebos/ICE.chs
+++ b/src/Erebos/ICE.chs
@@ -8,6 +8,7 @@ module Erebos.ICE (
     IceRemoteInfo,
 
     iceCreateConfig,
+    iceStopThread,
     iceCreateSession,
     iceDestroy,
     iceRemoteInfo,
@@ -138,6 +139,12 @@ iceCreateConfig stun turn =
           then return Nothing
           else Just . IceConfig <$> newForeignPtr ice_cfg_free cfg
 
+foreign import ccall unsafe "pjproject.h ice_cfg_stop_thread"
+    ice_cfg_stop_thread :: Ptr PjIceStransCfg -> IO ()
+
+iceStopThread :: IceConfig -> IO ()
+iceStopThread (IceConfig fcfg) = withForeignPtr fcfg ice_cfg_stop_thread
+
 {#pointer *pj_ice_strans as ^ #}
 
 iceCreateSession :: IceConfig -> IceSessionRole -> (IceSession -> IO ()) -> IO IceSession
diff --git a/src/Erebos/ICE/pjproject.c b/src/Erebos/ICE/pjproject.c
index 54da58d..e9446fe 100644
--- a/src/Erebos/ICE/pjproject.c
+++ b/src/Erebos/ICE/pjproject.c
@@ -216,6 +216,13 @@ void ice_cfg_free( struct erebos_ice_cfg * ecfg )
 	free( ecfg );
 }
 
+void ice_cfg_stop_thread( struct erebos_ice_cfg * ecfg )
+{
+	if( ! ecfg )
+		return;
+	ecfg->exit = true;
+}
+
 pj_ice_strans * ice_create( const struct erebos_ice_cfg * ecfg, pj_ice_sess_role role,
 		HsStablePtr sptr, HsStablePtr cb )
 {
diff --git a/src/Erebos/ICE/pjproject.h b/src/Erebos/ICE/pjproject.h
index 1d20891..c31e227 100644
--- a/src/Erebos/ICE/pjproject.h
+++ b/src/Erebos/ICE/pjproject.h
@@ -6,6 +6,7 @@
 struct erebos_ice_cfg * ice_cfg_create( const char * stun_server, uint16_t stun_port,
 		const char * turn_server, uint16_t turn_port );
 void ice_cfg_free( struct erebos_ice_cfg * cfg );
+void ice_cfg_stop_thread( struct erebos_ice_cfg * cfg );
 
 pj_ice_strans * ice_create( const struct erebos_ice_cfg *, pj_ice_sess_role role,
 		HsStablePtr sptr, HsStablePtr cb );
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 32d06f2..ed68ed4 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -392,8 +392,21 @@ startServer serverOptions serverOrigHead logd' serverServices = do
     return server
 
 stopServer :: Server -> IO ()
-stopServer Server {..} = do
-    mapM_ killThread =<< takeMVar serverThreads
+stopServer server@Server {..} = do
+    withMVar serverPeers $ \peers -> do
+        ( global, peerStates ) <- atomically $ (,)
+            <$> takeTMVar serverServiceStates
+            <*> (forM (M.elems peers) $ \p@Peer {..} -> ( p, ) <$> takeTMVar peerServiceState)
+
+        forM_ global $ \(SomeServiceGlobalState (proxy :: Proxy s) gs) -> do
+            ps <- forM peerStates $ \( peer, states ) ->
+                return $ ( peer, ) $ case M.lookup (serviceID proxy) states of
+                    Just (SomeServiceState (_ :: Proxy ps) pstate)
+                        | Just (Refl :: s :~: ps) <- eqT
+                        -> pstate
+                    _ -> emptyServiceState proxy
+            serviceStopServer proxy server gs ps
+        mapM_ killThread =<< takeMVar serverThreads
 
 dataResponseWorker :: Server -> IO ()
 dataResponseWorker server = forever $ do
diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs
index d1943e1..9cf71e7 100644
--- a/src/Erebos/Service.hs
+++ b/src/Erebos/Service.hs
@@ -71,6 +71,9 @@ class (
     serviceStorageWatchers :: proxy s -> [SomeStorageWatcher s]
     serviceStorageWatchers _ = []
 
+    serviceStopServer :: proxy s -> Server -> ServiceGlobalState s -> [ ( Peer, ServiceState s ) ] -> IO ()
+    serviceStopServer _ _ _ _ = return ()
+
 
 data SomeService = forall s. Service s => SomeService (Proxy s) (ServiceAttributes s)