From d1c5f97bd70cf68cd1c20565f9ec3a413e51c2ca Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Wed, 28 Oct 2020 14:24:52 -0400
Subject: [PATCH] king: cancel http servers immediately on shutdown.

---
 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs       | 6 +++---
 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 2 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs  | 6 ++----
 3 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs
index ee6d616eb4..256728a449 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs
@@ -344,9 +344,9 @@ eyre env who plan isFake stderr = (initialEvents, runHttpServer)
   kill :: HasLogFunc e => Serv -> RIO e ()
   kill Serv{..} = do
     atomically (leaveMultiEyre multi who)
-    atomically (saKil sLop)
-    atomically (saKil sIns)
-    for_ sSec (\sec -> atomically (saKil sec))
+    io (saKil sLop)
+    io (saKil sIns)
+    io $ for_ sSec (\sec -> (saKil sec))
     io (removePortsFile sPortsFile)
 
   restart :: Drv -> HttpServerConf -> RIO e Serv
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs
index 73a0c5c559..2c60a9c781 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs
@@ -45,7 +45,7 @@ data MultiEyreApi = MultiEyreApi
   , meaPlan :: TVar (Map Ship OnMultiReq)
   , meaCanc :: TVar (Map Ship OnMultiKil)
   , meaTlsC :: TVar (Map Ship (TlsConfig, Credential))
-  , meaKill :: STM ()
+  , meaKill :: IO ()
   }
 
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs
index 0fdab349b6..ad4f0eea9d 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs
@@ -54,7 +54,7 @@ import qualified Urbit.Vere.Eyre.Wai         as E
 -- Internal Types --------------------------------------------------------------
 
 data ServApi = ServApi
-  { saKil :: STM ()
+  { saKil :: IO ()
   , saPor :: STM W.Port
   }
 
@@ -332,14 +332,12 @@ getFirstTlsConfig (MTC var) = do
 realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi
 realServ vLive conf@ServConf {..} = do
   logInfo (displayShow ("EYRE", "SERV", "Running Real Server"))
-  kil <- newEmptyTMVarIO
   por <- newEmptyTMVarIO
 
   tid <- async (runServ por)
-  _   <- async (atomically (takeTMVar kil) >> cancel tid)
 
   pure $ ServApi
-    { saKil = void (tryPutTMVar kil ())
+    { saKil = cancel tid
     , saPor = readTMVar por
     }
  where