Merge pull request #3823 from urbit/kh-eyre-shutdown

king: cancel http servers immediately on shutdown.

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

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 ()
   }
 
 

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