diff --git a/build.sh b/build.sh index 962ccc1ee..9b4f5a2e2 100755 --- a/build.sh +++ b/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. diff --git a/src/Application.hs b/src/Application.hs index 97b671868..eff399e81 100644 --- a/src/Application.hs +++ b/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 --------------------------------------------------------------