merge master

build.sh

@@ -1,4 +1,4 @@
 #!/usr/bin/env bash
 
-exec -- stack build --fast --flag uniworx:-library-only --flag uniworx:dev
+exec -- stack build --fast --flag uniworx:-library-only --flag uniworx:dev $@
 echo Build task completed.

src/Application.hs

@@ -160,11 +160,8 @@ makeFoundation appSettings'@AppSettings{..} = do
           (error "secretBoxKey forced in tempFoundation")
           (error "widgetMemcached forced in tempFoundation")
           (error "JSONWebKeySet forced in tempFoundation")
-        logFunc loc src lvl str = do
-          f <- messageLoggerSource tempFoundation <$> readTVarIO (snd appLogger)
-          f loc src lvl str
 
-    flip runLoggingT logFunc $ do
+    runAppLoggingT tempFoundation $ do
       $logInfoS "InstanceID" $ UUID.toText appInstanceID
       -- logDebugS "Configuration" $ tshow appSettings'
 
@@ -204,6 +201,13 @@ makeFoundation appSettings'@AppSettings{..} = do
       $logDebugS "setup" "Done"
       return foundation
 
+runAppLoggingT :: UniWorX -> LoggingT m a -> m a
+runAppLoggingT app@(appLogger -> (_, loggerTVar)) = flip runLoggingT logFunc
+  where
+    logFunc loc src lvl str = do
+      f <- messageLoggerSource app <$> readTVarIO loggerTVar
+      f loc src lvl str
+
 clusterSetting :: forall key m p.
                   ( MonadIO m
                   , ClusterSetting key
@@ -306,7 +310,10 @@ makeLogWare app = do
 -- | Warp settings for the given foundation value.
 warpSettings :: UniWorX -> Settings
 warpSettings foundation = defaultSettings
-    & setBeforeMainLoop (void Systemd.notifyReady)
+    & setBeforeMainLoop (runAppLoggingT foundation $ do
+                            $logInfoS "setup" "Ready"
+                            void $ liftIO Systemd.notifyReady
+                        )
     & setHost (foundation ^. _appHost)
     & setPort (foundation ^. _appPort)
     & setOnException (\_req e ->
@@ -352,11 +359,7 @@ appMain = runResourceT $ do
     -- Generate the foundation from the settings
     foundation <- makeFoundation settings
 
-    let logFunc loc src lvl str = do
-          f <- messageLoggerSource foundation <$> readTVarIO (snd $ foundation ^. _appLogger)
-          f loc src lvl str
-
-    flip runLoggingT logFunc $ do
+    runAppLoggingT foundation $ do
       -- Generate a WAI Application from the foundation
       app <- makeApplication foundation
 
@@ -365,7 +368,7 @@ appMain = runResourceT $ do
       sockets <- case activatedSockets of
         Just socks@(_ : _) -> do
           $logInfoS "bind" [st|Ignoring configuration and listening on #{tshow (fmap snd socks)}|]
-          return $ fmap fst socks
+          return $ fst <$> socks
         _other -> do
           let
             host = foundation ^. _appHost
@@ -374,7 +377,10 @@ appMain = runResourceT $ do
           liftIO $ pure <$> bindPortTCP port host
 
       let runWarp socket = runSettingsSocket (warpSettings foundation) socket app
-      liftIO $ void . waitAnyCancel =<< mapM (async . runWarp) sockets
+      case sockets of
+        []  -> $logErrorS "bind" "No sockets to listen on"
+        [s] -> liftIO $ runWarp s
+        ss  -> liftIO $ void . waitAnyCancel =<< mapM (async . runWarp) ss
 
 
 --------------------------------------------------------------