fork process

src/Application.hs

@@ -59,6 +59,8 @@ import           Settings
 import           System.Posix.Process
 import           System.Time.Extra
 import           Model
+import           Control.Lens
+import           Control.Arrow ((***))
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -202,16 +204,14 @@ startWeb foundation = do
         startWeb' app = do
             let AppSettings{..} = appSettings foundation
             putStrLn @Text $ "Launching Web Server on port " <> show appPort
-            putStrLn @Text $ "Tor enabled: " <> show enableTor
-            action <- async $ if enableTor 
-                                then run (fromIntegral appPort) app
-                                else runTLS
-                                    (tlsSettings sslCertLocation sslKeyLocation)
-                                    (warpSettings foundation)
-                                    app
+            torAction <- async $ run (fromIntegral appPort) app
+            action <- async $ runTLS (tlsSettings sslCertLocation sslKeyLocation)
+                            (warpSettings foundation)
+                            app
+            let actions = (,) action torAction
 
-            setWebProcessThreadId (asyncThreadId action) foundation
-            void $ waitCatch action
+            setWebProcessThreadId (join (***) asyncThreadId actions) foundation
+            void $ both waitCatch actions
             shouldRestart <- takeMVar (appShouldRestartWeb foundation)
             when shouldRestart $ do
                 putMVar (appShouldRestartWeb foundation) False
@@ -231,8 +231,9 @@ shutdownAll threadIds = do
 -- Careful, you should always spawn this within forkIO so as to avoid accidentally killing the running process
 shutdownWeb :: RegistryCtx -> IO ()
 shutdownWeb RegistryCtx{..} = do
-    threadId <-  takeMVar appWebServerThreadId
-    killThread threadId
+    threadIds <-  takeMVar appWebServerThreadId
+    _ <- both killThread threadIds
+    pure ()
 
 --------------------------------------------------------------
 -- Functions for DevelMain.hs (a way to run the RegistryCtx from GHCi)

src/Foundation.hs

@@ -29,13 +29,13 @@ import           Yesod.Persist.Core
 data RegistryCtx = RegistryCtx
     { appSettings          :: AppSettings
     , appLogger            :: Logger
-    , appWebServerThreadId :: MVar ThreadId
+    , appWebServerThreadId :: MVar (ThreadId, ThreadId)
     , appShouldRestartWeb  :: MVar Bool
     , appCompatibilityMap  :: HM.HashMap AppVersion AppVersion
     , appConnPool          :: ConnectionPool
     }
 
-setWebProcessThreadId :: ThreadId -> RegistryCtx -> IO ()
+setWebProcessThreadId :: (ThreadId, ThreadId) -> RegistryCtx -> IO ()
 setWebProcessThreadId tid a = putMVar (appWebServerThreadId a) $ tid
 
 -- This is where we define all of the routes in our application. For a full

src/Settings.hs

@@ -53,7 +53,6 @@ data AppSettings = AppSettings
     , sslKeyLocation            :: FilePath
     , sslCsrLocation            :: FilePath
     , sslCertLocation           :: FilePath
-    , enableTor                 :: Bool
     }
 
 instance FromJSON AppSettings where
@@ -68,7 +67,6 @@ instance FromJSON AppSettings where
         resourcesDir              <- o .: "resources-path"
         sslPath                   <- o .: "ssl-path"
         registryHostname          <- o .: "registry-hostname"
-        enableTor                 <- o .: "enable-tor"
 
         let sslKeyLocation  = sslPath </> "key.pem"
         let sslCsrLocation  = sslPath </> "certificate.csr"