1 files changed, 15 insertions, 2 deletions
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 9c96bab..b341974 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -419,8 +419,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