From 38b65166a920530da8d019986fe368ee7e50a3d8 Mon Sep 17 00:00:00 2001
From: Lucy Cifferello <lvcifferello@gmail.com>
Date: Wed, 19 Aug 2020 11:21:32 -0600
Subject: [PATCH] fix port

---
 config/settings.yml |  2 +-
 src/Application.hs  | 25 ++++++++++++-------------
 src/Settings.hs     |  5 ++++-
 3 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/config/settings.yml b/config/settings.yml
index e3cd492..7865304 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -32,7 +32,7 @@ app-compatibility-path: "_env:APP_COMPATIBILITY_CONFIG:/etc/start9/registry/comp
 resources-path: "_env:RESOURCES_PATH:/var/www/html/resources"
 ssl-path: "_env:SSL_PATH:/var/ssl"
 registry-hostname: "_env:REGISTRY_HOSTNAME:registry.start9labs.com"
-enable-tor: "false"
+tor-port: "_env:TOR_PORT:447"
 
 database:
   database: "_env:PG_DATABASE:start9_registry"
diff --git a/src/Application.hs b/src/Application.hs
index 310262f..2a0ec90 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -34,7 +34,7 @@ import           Database.Persist.Postgresql           (createPostgresqlPool, pg
 import           Language.Haskell.TH.Syntax            (qLocation)
 import           Network.Wai
 import           Network.Wai.Handler.Warp              (Settings, defaultSettings, defaultShouldDisplayException,
-                                                        getPort, setHost, setOnException, setPort, run)
+                                                        getPort, setHost, setOnException, setPort, runSettings)
 import           Network.Wai.Handler.WarpTLS
 import           Network.Wai.Middleware.AcceptOverride
 import           Network.Wai.Middleware.Autohead
@@ -145,9 +145,9 @@ makeAuthWare _ app req res = next
         next = app req res
 
 -- | Warp settings for the given foundation value.
-warpSettings :: RegistryCtx -> Settings
-warpSettings foundation =
-      setPort (fromIntegral . appPort $ appSettings foundation)
+warpSettings :: AppPort -> RegistryCtx -> Settings
+warpSettings port foundation =
+      setPort (fromIntegral port)
     $ setHost (appHost $ appSettings foundation)
     $ setOnException (\_req e ->
         when (defaultShouldDisplayException e) $ messageLoggerSource
@@ -181,7 +181,7 @@ startApp :: RegistryCtx -> IO ()
 startApp foundation = do
     -- set up ssl certificates
     putStrLn @Text "Setting up SSL"
-    _ <- setupSsl $ appSettings foundation
+    -- _ <- setupSsl $ appSettings foundation
     putStrLn @Text "SSL Setup Complete"
 
     -- certbot renew loop
@@ -204,11 +204,11 @@ startWeb foundation = do
         startWeb' app = do
             let AppSettings{..} = appSettings foundation
             putStrLn @Text $ "Launching Web Server on port " <> show appPort
-            torAction <- async $ run (fromIntegral appPort) app
+            torAction <- async $ runSettings (warpSettings torPort foundation) app
             action <- async $ runTLS (tlsSettings sslCertLocation sslKeyLocation)
-                            (warpSettings foundation)
+                            (warpSettings appPort foundation)
                             app
-            let actions = (,) action torAction
+            let actions = (action, torAction)
 
             setWebProcessThreadId (join (***) asyncThreadId actions) foundation
             void $ both waitCatch actions
@@ -232,17 +232,16 @@ shutdownAll threadIds = do
 shutdownWeb :: RegistryCtx -> IO ()
 shutdownWeb RegistryCtx{..} = do
     threadIds <-  takeMVar appWebServerThreadId
-    _ <- both killThread threadIds
-    pure ()
+    void $ both killThread threadIds
 
 --------------------------------------------------------------
 -- Functions for DevelMain.hs (a way to run the RegistryCtx from GHCi)
 --------------------------------------------------------------
 
-getApplicationRepl :: IO (Int, RegistryCtx, Application)
-getApplicationRepl = do
+getApplicationRepl :: AppPort -> IO (Int, RegistryCtx, Application)
+getApplicationRepl port = do
     foundation <- getAppSettings >>= makeFoundation
-    wsettings <- getDevSettings $ warpSettings foundation
+    wsettings <- getDevSettings $ warpSettings port foundation
     app1 <- makeApplication foundation
     return (getPort wsettings, foundation,  app1)
 
diff --git a/src/Settings.hs b/src/Settings.hs
index d37148f..c01da97 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -31,11 +31,12 @@ import           Data.Yaml.Config
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.
+type AppPort = Word16
 data AppSettings = AppSettings
     { appDatabaseConf           :: PostgresConf
     , appHost                   :: HostPreference
     -- ^ Host/interface the server should bind to.
-    , appPort                   :: Word16
+    , appPort                   :: AppPort
     -- ^ Port to listen on
     , appIpFromHeader           :: Bool
     -- ^ Get the IP address from the header when logging. Useful when sitting
@@ -53,6 +54,7 @@ data AppSettings = AppSettings
     , sslKeyLocation            :: FilePath
     , sslCsrLocation            :: FilePath
     , sslCertLocation           :: FilePath
+    , torPort                   :: AppPort
     }
 
 instance FromJSON AppSettings where
@@ -67,6 +69,7 @@ instance FromJSON AppSettings where
         resourcesDir              <- o .: "resources-path"
         sslPath                   <- o .: "ssl-path"
         registryHostname          <- o .: "registry-hostname"
+        torPort                   <- o .: "tor-port"
 
         let sslKeyLocation  = sslPath </> "key.pem"
         let sslCsrLocation  = sslPath </> "certificate.csr"