diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,37 @@
+## 2.1
+
+Please reference `MigrationGuide-2.1.md` for in-depth documentation on breaking changes to be aware of, examples of said changes, and potential solutions/workarounds for them if you plan on upgrading to this version of `keter`.
+
++ Log naming and directory scheme has changed for both main keter logs and app logs.  
+  Old logs were named `dir/current.log` for the current log and `%Y%m%d_%H%M%S.log` 
+  (`time` package conventions) for rotated logs.  
+  Current logs have been brought up one level and named after their old directory:  
+  `logs/keter/current.log` -> `logs/keter.log`  
+  Rotated logs will now simply have `.1` `.2` ascending appended to the name of the base logs 
+  rather than be named after the date and time they were rotated at:  
+  `logs/keter/20230413_231415.log` -> `logs/keter.log.1`  
+  `logs/__builtin__/20230413_231415.log` -> `logs/__builtin__.log.1`  
+  `logs/app-foo/20230413_231415.log` -> `logs/app-foo.log.1`  
+  Please update anything that depended on the old log naming and directory conventions accordingly.
++ Added the `rotate-logs` option (default: true) in the keter config file.  
+  When true, the main keter (non-app!) logs will rotate like they have in previous versions.  
+  When false, the main keter logs will emit straight to stderr; this is useful e.g. if you're 
+  running keter via systemd, which captures stderr output for you.
++ Internal logging implementation has been switched over to `fast-logger` instead of the
+  old in-house logging solution.  
+  Please be aware that compared to the old logging solution, the usage of `fast-logger` does
+  not 100% guarantee consistent time ordering. If anything previously depended on tailing the last
+  line of a log and critically assumed that messages will be in order, it should now parse via 
+  timestamp instead.
++ The `LogMessage` ADT has been removed.
++ Replaced individual logging calls with TH splice -style calls where sensible to have access to source location info.
++ Updated log message format to make use of the additional info:  
+  `"$time|$module$:$line_num|$log_level> $msg"`
++ Added `Keter.Context`, exposing the new `KeterM` monad and related functions.  
+  This monad carries a mappable global config and logger around, eliminating the need to pass various configuration data and the logger to everything.
++ Refactored most `Keter.*` module functions to be actions in `KeterM`  
+  Please anticipate breaking changes for anything written against the exposed API.
+
 ## 2.0.1
 
 + Force usage of http-reverse-proxy versions above 0.6.0.1.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -8,7 +8,6 @@
 * Provides SSL support if requested.
 * Automatically launches applications, monitors processes, and relaunches any processes which die.
 * Provides graceful redeployment support, by launching a second copy of your application, performing a health check[1], and then switching reverse proxying to the new process.
-* Management of log files.
 
 Keter provides many more advanced features and extension points. It allows
 configuration of static hosts, redirect rules, management of PostgreSQL
@@ -152,6 +151,11 @@
 
     sudo mkdir -p /opt/keter/incoming
     sudo chown $USER /opt/keter/incoming
+
+Additionally, you may want to enable logging to stderr by disabling `rotate-logs` in `config/keter.yaml`, since systemd will automatically capture and manage stderr output for you:
+
+    rotate-logs: false
+
 ---    
 For versions of Ubuntu and derivatives less than 15.04, configure an Upstart job.
 
@@ -174,54 +178,13 @@
 
 
 ### NixOS 
-Add a nix file `keter.nix` that fetches this repository and imports
-the module file:
-```nix
-let
-  owner = "snoyberg";
-  repo = "keter";
-  rev = "be4e3132e988519dacd0f9b40a47e23d33865b76";
 
-  src = builtins.fetchTarball {
-    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz";
-    };
-in
-import "${src}/nix/module.nix"
-```
-Make sure to update rev to the latest commit!
-Now you can import this as an ordinary module
-in your `configuration.nix`:
-```nix
-imports = [
-  ./keter.nix
-];
-```
-
-Now you can configure keter in the same `configuration.nix`:
-```nix
-services.keter = {
-  enable = true;
-  keterPackage = pkgs.keter;
-  bundle = {
-    domain = "example.com";
-    secretScript = env.secretScript;
-    publicScript = env.publicScript;
-    package = myWebAppDerivation;
-    executable = "exe";
-  };
-};
-```
+Keter is integrated within nixos:
 
-secretScript is used to load environment varialbes, for example:
-```
-MY_AWS_KEY=$(cat /run/keys/AWS_ACCESS_KEY_ID)
-```
-Public script does the same but emits the loading to the logs.
-which isn't good for secrets.
+https://search.nixos.org/options?channel=22.11&show=services.keter.keterPackage&from=0&size=50&sort=relevance&type=packages&query=keter
 
-For the full option list available see `nix/module.nix`.
-This should load most webapps but PR's for improved support are welcome.
-Note that the default expects keter to be run behind nginx.
+There is an example that integrates yesod into keter with NixOS here:
+https://github.com/jappeace/yesod-keter-nix
     
 ## Bundles
 
diff --git a/keter.cabal b/keter.cabal
--- a/keter.cabal
+++ b/keter.cabal
@@ -1,6 +1,6 @@
 Cabal-version:       >=1.10
 Name:                keter
-Version:             2.0.1
+Version:             2.1.0
 Synopsis:            Web application deployment manager, focusing on Haskell web frameworks
 Description:
     Deployment system for web applications, originally intended for hosting Yesod
@@ -10,7 +10,6 @@
     * Provides SSL support if requested.
     * Automatically launches applications, monitors processes, and relaunches any processes which die.
     * Provides graceful redeployment support, by launching a second copy of your application, performing a health check, and then switching reverse proxying to the new process.
-    * Management of log files.
     .
     Keter provides many more advanced features and extension points. It allows configuration of static hosts, redirect rules, management of PostgreSQL databases, and more. It supports a simple bundle format for applications which allows for easy management of your web apps.
 
@@ -49,7 +48,7 @@
                      , template-haskell
                      , blaze-builder             >= 0.3           && < 0.5
                      , yaml                      >= 0.8.4         && < 0.12
-                     , unix-compat               >= 0.3           && < 0.6
+                     , unix-compat               >= 0.3           && < 0.7
                      , conduit                   >= 1.1
                      , conduit-extra             >= 1.1
                      , http-reverse-proxy        >= 0.6.0.1       && < 0.7
@@ -62,6 +61,9 @@
                      , attoparsec                >= 0.10
                      , http-client               >= 0.5.0
                      , http-conduit              >= 2.1
+                     , fast-logger               < 3.3
+                     , monad-logger              < 0.4
+                     , unliftio-core             < 0.3
                      , case-insensitive
                      , array
                      , mtl
@@ -95,6 +97,7 @@
                        Keter.AppManager
                        Keter.LabelMap
                        Keter.Cli
+                       Keter.Context
                        Keter.Main
                        Keter.PortPool
                        Keter.Proxy
@@ -102,7 +105,7 @@
                        Keter.Rewrite
                        Keter.Yaml.FilePath
                        Keter.TempTarball
-                       Keter.Conduit.LogFile
+                       Keter.Logger
                        Keter.Conduit.Process.Unix
   Other-Modules:
                        Keter.Aeson.KeyHelper
@@ -124,6 +127,8 @@
     type: exitcode-stdio-1.0
     build-depends:   base
                    , transformers
+                   , mtl
+                   , monad-logger
                    , conduit
                    , bytestring
                    , unix
diff --git a/src/Keter/App.hs b/src/Keter/App.hs
--- a/src/Keter/App.hs
+++ b/src/Keter/App.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 module Keter.App
     ( App
@@ -16,8 +18,10 @@
     ) where
 
 import Keter.Common
+import Keter.Context
 import           Data.Set                   (Set)
 import           Data.Text                  (Text)
+import           Data.ByteString            (ByteString)
 import           System.FilePath            (FilePath)
 import           Data.Map                   (Map)
 import           Keter.Rewrite (ReverseProxyConfig (..))
@@ -26,12 +30,17 @@
 import           Control.Arrow             ((***))
 import           Control.Concurrent        (forkIO, threadDelay)
 import           Control.Concurrent.STM
-import           Control.Exception         (IOException, bracketOnError,
+import           Control.Exception         (IOException, SomeException,
+                                            bracketOnError,
                                             throwIO, try, catch)
 import           Control.Monad             (void, when, liftM)
+import           Control.Monad.IO.Class    (liftIO)
+import           Control.Monad.IO.Unlift   (withRunInIO)
+import           Control.Monad.Logger      
+import           Control.Monad.Reader      (ask)
 import qualified Data.CaseInsensitive      as CI
-import           Keter.Conduit.LogFile      (RotatingLog)
-import qualified Keter.Conduit.LogFile      as LogFile
+import           Keter.Logger              (Logger)
+import qualified Keter.Logger              as Log
 import           Keter.Conduit.Process.Unix (MonitoredProcess, ProcessTracker,
                                             monitorProcess,
                                             terminateMonitoredProcess, printStatus)
@@ -49,7 +58,8 @@
 import           Keter.Yaml.FilePath
 import System.FilePath ((</>))
 import           System.Directory          (canonicalizePath, doesFileExist,
-                                            removeDirectoryRecursive)
+                                            removeDirectoryRecursive,
+                                            createDirectoryIfMissing)
 import           Keter.HostManager         hiding (start)
 import           Keter.PortPool            (PortPool, getPort, releasePort)
 import           Keter.Config
@@ -57,6 +67,7 @@
 import           Prelude                   hiding (FilePath)
 import           System.Environment        (getEnvironment)
 import           System.IO                 (hClose, IOMode(..))
+import qualified System.Log.FastLogger  as FL
 import           System.Posix.Files        (fileAccess)
 import           System.Posix.Types        (EpochTime, GroupID, UserID)
 import           System.Timeout            (timeout)
@@ -70,7 +81,7 @@
     , appHosts          :: !(TVar (Set Host))
     , appDir            :: !(TVar (Maybe FilePath))
     , appAsc            :: !AppStartConfig
-    , appRlog           :: !(TVar (Maybe RotatingLog))
+    , appLog           :: !(TVar (Maybe Logger))
     }
 instance Show App where
   show App {appId, ..} = "App{appId=" <> show appId <> "}"
@@ -99,13 +110,13 @@
     { rbaProcess :: MonitoredProcess
     }
 
-unpackBundle :: AppStartConfig
-             -> FilePath
+unpackBundle :: FilePath
              -> AppId
-             -> IO (FilePath, BundleConfig)
-unpackBundle AppStartConfig {..} bundle aid = do
-    ascLog $ UnpackingBundle bundle
-    unpackTempTar (fmap snd ascSetuid) ascTempFolder bundle folderName $ \dir -> do
+             -> KeterM AppStartConfig (FilePath, BundleConfig)
+unpackBundle bundle aid = do
+    AppStartConfig{..} <- ask
+    $logInfo $ pack $ "Unpacking bundle '" <> show bundle <> "'"
+    liftIO $ unpackTempTar (fmap snd ascSetuid) ascTempFolder bundle folderName $ \dir -> do
         -- Get the FilePath for the keter yaml configuration. Tests for
         -- keter.yml and defaults to keter.yaml.
         configFP <- do
@@ -133,36 +144,36 @@
     , ascHostManager    :: !HostManager
     , ascPortPool       :: !PortPool
     , ascPlugins        :: !Plugins
-    , ascLog            :: !(LogMessage -> IO ())
     , ascKeterConfig    :: !KeterConfig
     }
 
-withConfig :: AppStartConfig
-           -> AppId
+withConfig :: AppId
            -> AppInput
-           -> (Maybe FilePath -> BundleConfig -> Maybe EpochTime -> IO a)
-           -> IO a
-withConfig _asc _aid (AIData bconfig) f = f Nothing bconfig Nothing
-withConfig asc aid (AIBundle fp modtime) f = bracketOnError
-    (unpackBundle asc fp aid)
-    (\(newdir, _) -> removeDirectoryRecursive newdir)
-    $ \(newdir, bconfig) -> f (Just newdir) bconfig (Just modtime)
+           -> (Maybe FilePath -> BundleConfig -> Maybe EpochTime -> KeterM AppStartConfig a)
+           -> KeterM AppStartConfig a
+withConfig _aid (AIData bconfig) f = f Nothing bconfig Nothing
+withConfig aid (AIBundle fp modtime) f = do
+    withRunInIO $ \rio ->
+        bracketOnError (rio $ unpackBundle fp aid) (\(newdir, _) -> removeDirectoryRecursive newdir) $ \(newdir, bconfig) -> 
+            rio $ f (Just newdir) bconfig (Just modtime)
 
-withReservations :: AppStartConfig
-                 -> AppId
+withReservations :: AppId
                  -> BundleConfig
-                 -> ([WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a)
-                 -> IO a
-withReservations asc aid bconfig f = withActions asc bconfig $ \wacs backs actions -> bracketOnError
-    (reserveHosts (ascLog asc) (ascHostManager asc) aid $ Map.keysSet actions)
-    (forgetReservations (ascLog asc) (ascHostManager asc) aid)
-    (const $ f wacs backs actions)
+                 -> ([WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> KeterM AppStartConfig a)
+                 -> KeterM AppStartConfig a
+withReservations aid bconfig f = do
+    AppStartConfig{..} <- ask
+    withActions bconfig $ \wacs backs actions ->
+        withRunInIO $ \rio ->
+            bracketOnError
+              (rio $ withMappedConfig (const ascHostManager) $ reserveHosts aid $ Map.keysSet actions)
+              (\rsvs -> rio $ withMappedConfig (const ascHostManager)  $ forgetReservations aid rsvs)
+              (\_ -> rio $ f wacs backs actions)
 
-withActions :: AppStartConfig
-            -> BundleConfig
-            -> ([ WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> IO a)
-            -> IO a
-withActions asc bconfig f =
+withActions :: BundleConfig
+            -> ([ WebAppConfig Port] -> [BackgroundConfig] -> Map Host (ProxyAction, TLS.Credentials) -> KeterM AppStartConfig a)
+            -> KeterM AppStartConfig a
+withActions bconfig f =
     loop (V.toList $ bconfigStanzas bconfig) [] [] Map.empty
   where
     -- todo: add loading from relative location
@@ -172,20 +183,23 @@
     loadCert _ = return mempty
 
     loop [] wacs backs actions = f wacs backs actions
-    loop (Stanza (StanzaWebApp wac) rs:stanzas) wacs backs actions = bracketOnError
-        (getPort (ascLog asc) (ascPortPool asc) >>= either throwIO
-             (\p -> fmap (p,) <$> loadCert $ waconfigSsl wac)
-        )
-        (\(port, _)    -> releasePort (ascPortPool asc) port)
-        (\(port, cert) -> loop
-            stanzas
-            (wac { waconfigPort = port } : wacs)
-            backs
-            (Map.unions $ actions : map (\host -> Map.singleton host ((PAPort port (waconfigTimeout wac), rs), cert)) hosts))
+    loop (Stanza (StanzaWebApp wac) rs:stanzas) wacs backs actions = do
+      AppStartConfig{..} <- ask
+      withRunInIO $ \rio -> 
+        liftIO $ bracketOnError
+          (rio (getPort ascPortPool) >>= either throwIO
+               (\p -> fmap (p,) <$> loadCert $ waconfigSsl wac)
+          )
+          (\(port, _)    -> releasePort ascPortPool port)
+          (\(port, cert) -> rio $ loop
+              stanzas
+              (wac { waconfigPort = port } : wacs)
+              backs
+              (Map.unions $ actions : map (\host -> Map.singleton host ((PAPort port (waconfigTimeout wac), rs), cert)) hosts))
       where
         hosts = Set.toList $ Set.insert (waconfigApprootHost wac) (waconfigHosts wac)
     loop (Stanza (StanzaStaticFiles sfc) rs:stanzas) wacs backs actions0 = do
-        cert <- loadCert $ sfconfigSsl sfc
+        cert <- liftIO $ loadCert $ sfconfigSsl sfc
         loop stanzas wacs backs (actions cert)
       where
         actions cert = Map.unions
@@ -193,7 +207,7 @@
                 : map (\host -> Map.singleton host ((PAStatic sfc, rs), cert))
                   (Set.toList (sfconfigHosts sfc))
     loop (Stanza (StanzaRedirect red) rs:stanzas) wacs backs actions0 = do
-        cert <- loadCert $ redirconfigSsl red
+        cert <- liftIO $ loadCert $ redirconfigSsl red
         loop stanzas wacs backs (actions cert)
       where
         actions cert = Map.unions
@@ -201,40 +215,39 @@
                 : map (\host -> Map.singleton host ((PARedirect red, rs), cert))
                   (Set.toList (redirconfigHosts red))
     loop (Stanza (StanzaReverseProxy rev mid to) rs:stanzas) wacs backs actions0 = do
-        cert <- loadCert $ reversingUseSSL rev
+        cert <- liftIO $ loadCert $ reversingUseSSL rev
         loop stanzas wacs backs (actions cert)
       where
         actions cert = Map.insert (CI.mk $ reversingHost rev) ((PAReverseProxy rev mid to, rs), cert) actions0
     loop (Stanza (StanzaBackground back) _:stanzas) wacs backs actions =
         loop stanzas wacs (back:backs) actions
 
-withRotatingLog :: AppStartConfig
-                -> AppId
-                -> Maybe (TVar (Maybe RotatingLog))
-                -> ((TVar (Maybe RotatingLog)) -> RotatingLog -> IO a)
-                -> IO a
-withRotatingLog asc aid Nothing f = do
-    var <- newTVarIO Nothing
-    withRotatingLog asc aid (Just var) f
-withRotatingLog AppStartConfig {..} aid (Just var) f = do
-    mrlog <- readTVarIO var
-    case mrlog of
-        Nothing -> bracketOnError
-            (LogFile.openRotatingLog dir LogFile.defaultMaxTotal)
-            LogFile.close
-            (f var)
-        Just rlog ->  f var rlog
+-- | Gives the log file or log tag name for a given 'AppId'
+appLogName :: AppId -> String
+appLogName AIBuiltin = "__builtin__"
+appLogName (AINamed x) = "app-" <> unpack x
+
+withLogger :: AppId
+           -> Maybe (TVar (Maybe Logger))
+           -> ((TVar (Maybe Logger)) -> Logger -> KeterM AppStartConfig a)
+           -> KeterM AppStartConfig a
+withLogger aid Nothing f = do
+    var <- liftIO $ newTVarIO Nothing
+    withLogger aid (Just var) f
+withLogger aid (Just var) f = do
+    AppStartConfig{..} <- ask
+    mappLogger <- liftIO $ readTVarIO var
+    case mappLogger of
+        Nothing -> withRunInIO $ \rio -> 
+          bracketOnError (Log.createLoggerViaConfig ascKeterConfig (appLogName aid)) Log.loggerClose (rio . f var)
+        Just appLogger ->  f var appLogger
   where
-    dir = kconfigDir ascKeterConfig </> "log" </> name
-    name =
-        case aid of
-            AIBuiltin -> "__builtin__"
-            AINamed x -> unpack $ "app-" <> x
 
-withSanityChecks :: AppStartConfig -> BundleConfig -> IO a -> IO a
-withSanityChecks AppStartConfig {..} BundleConfig {..} f = do
-    V.mapM_ go bconfigStanzas
-    ascLog SanityChecksPassed
+withSanityChecks :: BundleConfig -> KeterM AppStartConfig a -> KeterM AppStartConfig a
+withSanityChecks BundleConfig{..} f = do
+    cfg@AppStartConfig{..} <- ask
+    liftIO $ V.mapM_ go bconfigStanzas
+    $logInfo "Sanity checks passed"
     f
   where
     go (Stanza (StanzaWebApp WebAppConfig {..}) _) = do
@@ -254,20 +267,21 @@
                     else throwIO $ FileNotExecutable fp
             else throwIO $ ExecutableNotFound fp
 
-start :: AppStartConfig
-      -> AppId
+start :: AppId
       -> AppInput
-      -> IO App
-start asc aid input =
-    withRotatingLog asc aid Nothing $ \trlog rlog ->
-    withConfig asc aid input $ \newdir bconfig mmodtime ->
-    withSanityChecks asc bconfig $
-    withReservations asc aid bconfig $ \webapps backs actions ->
-    withBackgroundApps asc aid bconfig newdir rlog backs $ \runningBacks ->
-    withWebApps asc aid bconfig newdir rlog webapps $ \runningWebapps -> do
-        mapM_ ensureAlive runningWebapps
-        activateApp (ascLog asc) (ascHostManager asc) aid actions
-        App
+      -> KeterM AppStartConfig App
+start aid input =
+    withLogger aid Nothing $ \tAppLogger appLogger ->
+    withConfig aid input $ \newdir bconfig mmodtime ->
+    withSanityChecks bconfig $
+    withReservations aid bconfig $ \webapps backs actions ->
+    withBackgroundApps aid bconfig newdir appLogger backs $ \runningBacks ->
+    withWebApps aid bconfig newdir appLogger webapps $ \runningWebapps -> do
+        asc@AppStartConfig{..} <- ask
+        liftIO $ mapM_ ensureAlive runningWebapps
+        withMappedConfig (const ascHostManager) $ activateApp aid actions
+        liftIO $ 
+          App
             <$> newTVarIO mmodtime
             <*> newTVarIO runningWebapps
             <*> newTVarIO runningBacks
@@ -275,7 +289,7 @@
             <*> newTVarIO (Map.keysSet actions)
             <*> newTVarIO newdir
             <*> return asc
-            <*> return trlog
+            <*> return tAppLogger
 
 bracketedMap :: (a -> (b -> IO c) -> IO c)
              -> ([b] -> IO c)
@@ -287,30 +301,35 @@
     loop front [] = inside $ front []
     loop front (c:cs) = with c $ \x -> loop (front . (x:)) cs
 
-withWebApps :: AppStartConfig
-            -> AppId
+withWebApps :: AppId
             -> BundleConfig
             -> Maybe FilePath
-            -> RotatingLog
+            -> Logger
             -> [WebAppConfig Port]
-            -> ([RunningWebApp] -> IO a)
-            -> IO a
-withWebApps asc aid bconfig mdir rlog configs0 f =
-    bracketedMap alloc f configs0
+            -> ([RunningWebApp] -> KeterM AppStartConfig a)
+            -> KeterM AppStartConfig a
+withWebApps aid bconfig mdir appLogger configs0 f =
+    withRunInIO $ \rio -> 
+      bracketedMap (\wac f -> rio $ alloc wac (liftIO <$> f)) (rio . f) configs0
   where
-    alloc = launchWebApp asc aid bconfig mdir rlog
+    alloc = launchWebApp aid bconfig mdir appLogger
 
-launchWebApp :: AppStartConfig
-             -> AppId
+-- | Format a log message for an app by tagging it with 'app-$name>' (only when it is being logged to stderr)
+formatAppLog :: AppId -> FL.LogType -> LogStr -> LogStr
+formatAppLog aid (FL.LogStderr _) msg = toLogStr (appLogName aid) <> "> " <> msg
+formatAppLog _ _ msg = msg
+
+launchWebApp :: AppId
              -> BundleConfig
              -> Maybe FilePath
-             -> RotatingLog
+             -> Logger
              -> WebAppConfig Port
-             -> (RunningWebApp -> IO a)
-             -> IO a
-launchWebApp AppStartConfig {..} aid BundleConfig {..} mdir rlog WebAppConfig {..} f = do
-    otherEnv <- pluginsGetEnv ascPlugins name bconfigPlugins
-    forwardedEnv <- getForwardedEnv waconfigForwardEnv
+             -> (RunningWebApp -> KeterM AppStartConfig a)
+             -> KeterM AppStartConfig a
+launchWebApp aid BundleConfig {..} mdir appLogger WebAppConfig {..} f = do
+    AppStartConfig{..} <- ask
+    otherEnv <- liftIO $ pluginsGetEnv ascPlugins name bconfigPlugins
+    forwardedEnv <- liftIO $ getForwardedEnv waconfigForwardEnv
     let httpPort  = kconfigExternalHttpPort  ascKeterConfig
         httpsPort = kconfigExternalHttpsPort ascKeterConfig
         (scheme, extport) =
@@ -327,20 +346,20 @@
             , Map.singleton "PORT" $ pack $ show waconfigPort
             , Map.singleton "APPROOT" $ scheme <> CI.original waconfigApprootHost <> pack extport
             ]
-    exec <- canonicalizePath waconfigExec
-    bracketOnError
-        (monitorProcess
-            (ascLog . OtherMessage . decodeUtf8With lenientDecode)
+    exec <- liftIO $ canonicalizePath waconfigExec
+    mainLogger <- askLoggerIO
+    withRunInIO $ \rio -> bracketOnError
+        (rio $ monitorProcess
             ascProcessTracker
             (encodeUtf8 . fst <$> ascSetuid)
             (encodeUtf8 $ pack exec)
             (maybe "/tmp" (encodeUtf8 . pack) mdir)
             (map encodeUtf8 $ V.toList waconfigArgs)
             (map (encodeUtf8 *** encodeUtf8) env)
-            (LogFile.addChunk rlog)
+            (Log.loggerLog appLogger . formatAppLog aid (Log.loggerType appLogger) . toLogStr)
             (const $ return True))
         terminateMonitoredProcess
-        $ \mp -> f RunningWebApp
+        $ \mp -> rio $ f RunningWebApp
             { rwaProcess = mp
             , rwaPort = waconfigPort
             , rwaEnsureAliveTimeOut = fromMaybe (90 * 1000 * 1000) waconfigEnsureAliveTimeout
@@ -351,11 +370,11 @@
             AIBuiltin -> "__builtin__"
             AINamed x -> x
 
-killWebApp :: (LogMessage -> IO ()) -> RunningWebApp -> IO ()
-killWebApp asclog RunningWebApp {..} = do
-    status <- printStatus rwaProcess
-    asclog $ KillingApp rwaPort status
-    terminateMonitoredProcess rwaProcess
+killWebApp :: RunningWebApp -> KeterM cfg ()
+killWebApp RunningWebApp {..} = do
+    status <- liftIO $ printStatus rwaProcess
+    $logInfo $ pack $ "Killing " <> unpack status <> " running on port: "  <> show rwaPort
+    liftIO $ terminateMonitoredProcess rwaProcess
 
 ensureAlive :: RunningWebApp -> IO ()
 ensureAlive RunningWebApp {..} = do
@@ -408,30 +427,29 @@
                   tryIO m = catch (liftM Right m) (return . Left)
 
 
-withBackgroundApps :: AppStartConfig
-                   -> AppId
+withBackgroundApps :: AppId
                    -> BundleConfig
                    -> Maybe FilePath
-                   -> RotatingLog
+                   -> Logger
                    -> [BackgroundConfig]
-                   -> ([RunningBackgroundApp] -> IO a)
-                   -> IO a
-withBackgroundApps asc aid bconfig mdir rlog configs f =
-    bracketedMap alloc f configs
+                   -> ([RunningBackgroundApp] -> KeterM AppStartConfig a)
+                   -> KeterM AppStartConfig a
+withBackgroundApps aid bconfig mdir appLogger configs f =
+    withRunInIO $ \rio -> bracketedMap (\cfg f -> rio $ alloc cfg (liftIO <$> f)) (rio . f) configs
   where
-    alloc = launchBackgroundApp asc aid bconfig mdir rlog
+    alloc = launchBackgroundApp aid bconfig mdir appLogger
 
-launchBackgroundApp :: AppStartConfig
-                    -> AppId
+launchBackgroundApp :: AppId
                     -> BundleConfig
                     -> Maybe FilePath
-                    -> RotatingLog
+                    -> Logger 
                     -> BackgroundConfig
                     -> (RunningBackgroundApp -> IO a)
-                    -> IO a
-launchBackgroundApp AppStartConfig {..} aid BundleConfig {..} mdir rlog BackgroundConfig {..} f = do
-    otherEnv <- pluginsGetEnv ascPlugins name bconfigPlugins
-    forwardedEnv <- getForwardedEnv bgconfigForwardEnv
+                    -> KeterM AppStartConfig a
+launchBackgroundApp aid BundleConfig {..} mdir appLogger BackgroundConfig {..} f = do
+    AppStartConfig{..} <- ask
+    otherEnv <- liftIO $ pluginsGetEnv ascPlugins name bconfigPlugins
+    forwardedEnv <- liftIO $ getForwardedEnv bgconfigForwardEnv
     let env = Map.toList $ Map.unions
             -- Order matters as in launchWebApp
             [ bgconfigEnvironment
@@ -439,7 +457,7 @@
             , Map.fromList otherEnv
             , kconfigEnvironment ascKeterConfig
             ]
-    exec <- canonicalizePath bgconfigExec
+    exec <- liftIO $ canonicalizePath bgconfigExec
 
     let delay = threadDelay $ fromIntegral $ bgconfigRestartDelaySeconds * 1000 * 1000
     shouldRestart <-
@@ -448,23 +466,22 @@
                 delay
                 return True
             LimitedRestarts maxCount -> do
-                icount <- newIORef 0
+                icount <- liftIO $ newIORef 0
                 return $ do
                     res <- atomicModifyIORef icount $ \count ->
                         (count + 1, count < maxCount)
                     when res delay
                     return res
-
-    bracketOnError
-        (monitorProcess
-            (ascLog . OtherMessage . decodeUtf8With lenientDecode)
+    mainLogger <- askLoggerIO
+    withRunInIO $ \rio -> bracketOnError
+        (rio $ monitorProcess
             ascProcessTracker
             (encodeUtf8 . fst <$> ascSetuid)
             (encodeUtf8 $ pack exec)
             (maybe "/tmp" (encodeUtf8 . pack) mdir)
             (map encodeUtf8 $ V.toList bgconfigArgs)
             (map (encodeUtf8 *** encodeUtf8) env)
-            (LogFile.addChunk rlog)
+            (Log.loggerLog appLogger . formatAppLog aid (Log.loggerType appLogger) . toLogStr)
             (const shouldRestart))
         terminateMonitoredProcess
         (f . RunningBackgroundApp)
@@ -489,7 +506,7 @@
       -> (Maybe BundleConfig)
       -> KIO () -- ^ action to perform to remove this App from list of actives
       -> KIO (App, KIO ())
-start tf muid processTracker portman plugins rlog appname bundle removeFromList = do
+start tf muid processTracker portman plugins appLogger appname bundle removeFromList = do
     Prelude.error "FIXME Keter.App.start"
     chan <- newChan
     return (App $ writeChan chan, rest chan)
@@ -599,74 +616,86 @@
         terminateOld = forkKIO $ do
     -}
 
-reload :: App -> AppInput -> IO ()
-reload App {..} input =
-    withRotatingLog appAsc appId (Just appRlog) $ \_ rlog ->
-    withConfig appAsc appId input $ \newdir bconfig mmodtime ->
-    withSanityChecks appAsc bconfig $
-    withReservations appAsc appId bconfig $ \webapps backs actions ->
-    withBackgroundApps appAsc appId bconfig newdir rlog backs $ \runningBacks ->
-    withWebApps appAsc appId bconfig newdir rlog webapps $ \runningWebapps -> do
-        mapM_ ensureAlive runningWebapps
-        readTVarIO appHosts >>= reactivateApp (ascLog appAsc) (ascHostManager appAsc) appId actions
-        (oldApps, oldBacks, oldDir, oldRlog) <- atomically $ do
-            oldApps <- readTVar appRunningWebApps
-            oldBacks <- readTVar appBackgroundApps
-            oldDir <- readTVar appDir
-            oldRlog <- readTVar appRlog
+reload :: AppInput -> KeterM App ()
+reload input = do
+    App{..} <- ask
+    withMappedConfig (const appAsc) $ 
+      withLogger appId (Just appLog) $ \_ appLogger ->
+      withConfig appId input $ \newdir bconfig mmodtime ->
+      withSanityChecks bconfig $
+      withReservations appId bconfig $ \webapps backs actions ->
+      withBackgroundApps appId bconfig newdir appLogger backs $ \runningBacks ->
+      withWebApps appId bconfig newdir appLogger webapps $ \runningWebapps -> do
+          liftIO $ mapM_ ensureAlive runningWebapps
+          liftIO (readTVarIO appHosts) >>= \hosts ->
+            withMappedConfig (const $ ascHostManager appAsc) $ 
+              reactivateApp appId actions hosts
+          (oldApps, oldBacks, oldDir, oldRlog) <- liftIO $ atomically $ do
+              oldApps <- readTVar appRunningWebApps
+              oldBacks <- readTVar appBackgroundApps
+              oldDir <- readTVar appDir
+              oldRlog <- readTVar appLog
 
-            writeTVar appModTime mmodtime
-            writeTVar appRunningWebApps runningWebapps
-            writeTVar appBackgroundApps runningBacks
-            writeTVar appHosts $ Map.keysSet actions
-            writeTVar appDir newdir
-            return (oldApps, oldBacks, oldDir, oldRlog)
-        void $ forkIO $ terminateHelper appAsc appId oldApps oldBacks oldDir oldRlog
+              writeTVar appModTime mmodtime
+              writeTVar appRunningWebApps runningWebapps
+              writeTVar appBackgroundApps runningBacks
+              writeTVar appHosts $ Map.keysSet actions
+              writeTVar appDir newdir
+              return (oldApps, oldBacks, oldDir, oldRlog)
+          void $ withRunInIO $ \rio -> 
+            forkIO $ rio $ terminateHelper appId oldApps oldBacks oldDir oldRlog
 
-terminate :: App -> IO ()
-terminate App {..} = do
-    (hosts, apps, backs, mdir, rlog) <- atomically $ do
+terminate :: KeterM App ()
+terminate = do
+    App{..} <- ask
+    let AppStartConfig {..} = appAsc
+    (hosts, apps, backs, mdir, appLogger) <- liftIO $ atomically $ do
         hosts <- readTVar appHosts
         apps <- readTVar appRunningWebApps
         backs <- readTVar appBackgroundApps
         mdir <- readTVar appDir
-        rlog <- readTVar appRlog
+        appLogger <- readTVar appLog
 
         writeTVar appModTime Nothing
         writeTVar appRunningWebApps []
         writeTVar appBackgroundApps []
         writeTVar appHosts Set.empty
         writeTVar appDir Nothing
-        writeTVar appRlog Nothing
+        writeTVar appLog Nothing
 
-        return (hosts, apps, backs, mdir, rlog)
+        return (hosts, apps, backs, mdir, appLogger)
 
-    deactivateApp ascLog ascHostManager appId hosts
-    void $ forkIO $ terminateHelper appAsc appId apps backs mdir rlog
-    maybe (return ()) LogFile.close rlog
-  where
-    AppStartConfig {..} = appAsc
+    withMappedConfig (const ascHostManager) $
+        deactivateApp appId hosts
 
-terminateHelper :: AppStartConfig
-                -> AppId
+    void $ withRunInIO $ \rio ->
+      forkIO $ rio $ withMappedConfig (const appAsc) $ 
+        terminateHelper appId apps backs mdir appLogger
+    liftIO $ maybe (return ()) Log.loggerClose appLogger
+
+terminateHelper :: AppId
                 -> [RunningWebApp]
                 -> [RunningBackgroundApp]
                 -> Maybe FilePath
-                -> Maybe RotatingLog
-                -> IO ()
-terminateHelper AppStartConfig {..} aid apps backs mdir rlog = do
-    threadDelay $ 20 * 1000 * 1000
-    ascLog $ TerminatingOldProcess aid
-    mapM_ (killWebApp ascLog) apps
-    mapM_ killBackgroundApp backs
-    threadDelay $ 60 * 1000 * 1000
+                -> Maybe Logger
+                -> KeterM AppStartConfig ()
+terminateHelper aid apps backs mdir appLogger = do
+    AppStartConfig{..} <- ask
+    liftIO $ threadDelay $ 20 * 1000 * 1000
+    $logInfo $ pack $ 
+        "Sending old process TERM signal: " 
+          ++ case aid of { AINamed t -> unpack t; AIBuiltin -> "builtin" }
+    mapM_ killWebApp apps
+    liftIO $ do 
+        mapM_ killBackgroundApp backs
+        threadDelay $ 60 * 1000 * 1000
     case mdir of
         Nothing -> return ()
         Just dir -> do
-            ascLog $ RemovingOldFolder dir
-            res <- try $ removeDirectoryRecursive dir
+            $logInfo $ pack $ "Removing unneeded folder: " ++ dir
+            res <- liftIO $ try @SomeException $ removeDirectoryRecursive dir
             case res of
-                Left e -> $logEx ascLog e
+                Left e -> $logError $ pack $ show e
                 Right () -> return ()
 
 -- | Get the modification time of the bundle file this app was launched from,
@@ -704,25 +733,25 @@
                         let time = either (P.const 0) id etime
                         return (Map.insert appname (app, time) appMap, return ())
                     Nothing -> do
-                        mlogger <- do
+                        mappLogger <- do
                             let dirout = kconfigDir </> "log" </> fromText ("app-" ++ appname)
                                 direrr = dirout </> "err"
-                            erlog <- liftIO $ LogFile.openRotatingLog
+                            eappLogger <- liftIO $ Log.openRotatingLog
                                 (F.encodeString dirout)
-                                LogFile.defaultMaxTotal
-                            case erlog of
+                                Log.defaultMaxTotal
+                            case eappLogger of
                                 Left e -> do
                                     $logEx e
                                     return Nothing
-                                Right rlog -> return (Just rlog)
-                        let logger = fromMaybe LogFile.dummy mlogger
+                                Right appLogger -> return (Just appLogger)
+                        let appLogger = fromMaybe Log.dummy mappLogger
                         (app, rest) <- App.start
                             tf
                             muid
                             processTracker
                             hostman
                             plugins
-                            logger
+                            appLogger
                             appname
                             bundle
                             (removeApp appname)
diff --git a/src/Keter/AppManager.hs b/src/Keter/AppManager.hs
--- a/src/Keter/AppManager.hs
+++ b/src/Keter/AppManager.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications   #-}
 -- | Used for management of applications.
 module Keter.AppManager
     ( -- * Types
@@ -18,6 +21,7 @@
     ) where
 
 import Keter.Common
+import Keter.Context
 import           Data.Set                   (Set)
 import           Data.Text                  (Text)
 import           System.FilePath            (FilePath)
@@ -29,6 +33,10 @@
 import           Control.Concurrent.STM
 import qualified Control.Exception          as E
 import           Control.Monad              (void)
+import           Control.Monad.IO.Class     (liftIO)
+import           Control.Monad.IO.Unlift    (withRunInIO)
+import           Control.Monad.Logger
+import           Control.Monad.Reader       (ask)
 import           Data.Foldable              (fold)
 import qualified Data.Map                   as Map
 import           Data.Maybe                 (catMaybes, mapMaybe)
@@ -49,7 +57,6 @@
     { apps           :: !(TVar (Map AppId (TVar AppState)))
     , appStartConfig :: !AppStartConfig
     , mutex          :: !(MVar ())
-    , log            :: !(LogMessage -> IO ())
     }
 
 data AppState = ASRunning App
@@ -81,14 +88,13 @@
 data Action = Reload AppInput | Terminate
  deriving Show
 
-initialize :: (LogMessage -> IO ())
-           -> AppStartConfig
-           -> IO AppManager
-initialize log' asc = AppManager
-    <$> newTVarIO Map.empty
-    <*> return asc
-    <*> newMVar ()
-    <*> return log'
+initialize :: KeterM AppStartConfig AppManager
+initialize = do
+  asc <- ask
+  liftIO $ AppManager
+      <$> newTVarIO Map.empty
+      <*> return asc
+      <*> newMVar ()
 
 -- | Reset which apps are running.
 --
@@ -97,16 +103,18 @@
 -- * Any app listed here that is currently running will be reloaded.
 --
 -- * Any app listed here that is not currently running will be started.
-reloadAppList :: AppManager
-              -> Map Appname (FilePath, EpochTime)
-              -> IO ()
-reloadAppList am@AppManager {..} newApps = withMVar mutex $ const $ do
-    actions <- atomically $ do
-        m <- readTVar apps
-        let currentApps = Set.fromList $ mapMaybe toAppName $ Map.keys m
-            allApps = Set.toList $ Map.keysSet newApps `Set.union` currentApps
-        fmap catMaybes $ mapM (getAction m) allApps
-    sequence_ actions
+reloadAppList :: Map Appname (FilePath, EpochTime)
+              -> KeterM AppManager ()
+reloadAppList newApps = do
+  am@AppManager{..} <- ask
+  withRunInIO $ \rio -> 
+    withMVar mutex $ const $ do
+      actions <- atomically $ do
+          m <- readTVar apps
+          let currentApps = Set.fromList $ mapMaybe toAppName $ Map.keys m
+              allApps = Set.toList $ Map.keysSet newApps `Set.union` currentApps
+          fmap catMaybes $ mapM (getAction m) allApps
+      sequence_ $ rio <$> actions
   where
     toAppName AIBuiltin   = Nothing
     toAppName (AINamed x) = Just x
@@ -141,8 +149,8 @@
             case Map.lookup appname newApps of
                 Nothing              -> E.assert False Nothing
                 Just (fp, timestamp) -> reload fp timestamp
-        terminate = Just $ performNoLock am (AINamed appname) Terminate
-        reload fp timestamp = Just $ performNoLock am (AINamed appname) (Reload $ AIBundle fp timestamp)
+        terminate = Just $ performNoLock (AINamed appname) Terminate
+        reload fp timestamp = Just $ performNoLock (AINamed appname) (Reload $ AIBundle fp timestamp)
         {-
         case (Map.lookup appname currentApps, Map.lookup appname newApps) of
             (Nothing, Nothing) -> E.assert False Nothing
@@ -171,37 +179,42 @@
     return $ Set.fromList $ mapMaybe toAppName $ Map.keys m
     -}
 
-perform :: AppManager -> AppId -> Action -> IO ()
-perform am appid action = withMVar (mutex am) $ const $ performNoLock am appid action
+perform :: AppId -> Action -> KeterM AppManager ()
+perform appid action = do
+    am <- ask
+    withRunInIO $ \rio -> 
+      withMVar (mutex am) $ const $ rio $  performNoLock appid action
 
-performNoLock :: AppManager -> AppId -> Action -> IO ()
-performNoLock am@AppManager {..} aid action = E.mask_ $ do
-    launchWorker' <- atomically $ do
-        m <- readTVar apps
-        case Map.lookup aid m of
-            Just tstate -> do
-                state <- readTVar tstate
-                case state of
-                    ASStarting _mcurrent _tmtimestamp tmnext -> do
-                        writeTVar tmnext $ Just action
-                        -- use the previous worker, so nothing to do
-                        return noWorker
-                    ASRunning runningApp -> do
-                        tmnext <- newTVar Nothing
-                        tmtimestamp <- newTVar $
-                            case action of
-                                Reload (AIBundle _fp timestamp) -> Just timestamp
-                                Reload (AIData _) -> Nothing
-                                Terminate -> Nothing
-                        writeTVar tstate $ ASStarting (Just runningApp) tmtimestamp tmnext
-                        return $ launchWorker am aid tstate tmnext (Just runningApp) action
-                    ASTerminated -> onNotRunning
-            Nothing -> onNotRunning
-    launchWorker'
+performNoLock :: AppId -> Action -> KeterM AppManager ()
+performNoLock aid action = do
+    am@AppManager{..} <- ask
+    withRunInIO $ \rio -> E.mask_ $ do
+        launchWorker' <- liftIO $ atomically $ do
+            m <- readTVar apps
+            case Map.lookup aid m of
+                Just tstate -> do
+                    state <- readTVar tstate
+                    case state of
+                        ASStarting _mcurrent _tmtimestamp tmnext -> do
+                            writeTVar tmnext $ Just action
+                            -- use the previous worker, so nothing to do
+                            return noWorker
+                        ASRunning runningApp -> do
+                            tmnext <- newTVar Nothing
+                            tmtimestamp <- newTVar $
+                                case action of
+                                    Reload (AIBundle _fp timestamp) -> Just timestamp
+                                    Reload (AIData _) -> Nothing
+                                    Terminate -> Nothing
+                            writeTVar tstate $ ASStarting (Just runningApp) tmtimestamp tmnext
+                            return $ launchWorker aid tstate tmnext (Just runningApp) action
+                        ASTerminated -> onNotRunning apps
+                Nothing -> onNotRunning apps
+        rio launchWorker'
   where
     noWorker = return ()
 
-    onNotRunning =
+    onNotRunning apps =
         case action of
             Reload input -> do
                 tmnext <- newTVar Nothing
@@ -211,22 +224,22 @@
                         AIData _               -> Nothing
                 tstate <- newTVar $ ASStarting Nothing tmtimestamp tmnext
                 modifyTVar apps $ Map.insert aid tstate
-                return $ launchWorker am aid tstate tmnext Nothing action
+                return $ launchWorker aid tstate tmnext Nothing action
             Terminate -> return noWorker
 
-launchWorker :: AppManager
-             -> AppId
+launchWorker :: AppId
              -> TVar AppState
              -> TVar (Maybe Action)
              -> Maybe App
              -> Action
-             -> IO ()
-launchWorker AppManager {..} appid tstate tmnext mcurrentApp0 action0 = void $ forkIO $ do
-    loop mcurrentApp0 action0
+             -> KeterM AppManager ()
+launchWorker appid tstate tmnext mcurrentApp0 action0 = 
+  loop mcurrentApp0 action0
   where
+    loop :: Maybe App -> Action -> KeterM AppManager ()
     loop mcurrentApp action = do
         mRunningApp <- processAction mcurrentApp action
-        mnext <- atomically $ do
+        mnext <- liftIO $ atomically $ do
             mnext <- readTVar tmnext
             writeTVar tmnext Nothing
             case mnext of
@@ -246,25 +259,37 @@
             Nothing   -> return ()
             Just next -> loop mRunningApp next
 
+    reloadMsg :: String -> String -> Text
+    reloadMsg app input =
+        pack $ "Reloading from: " <> app <> input
+    
+    errorStartingBundleMsg :: String -> String -> Text
+    errorStartingBundleMsg name e = 
+        pack $ "Error occured when launching bundle " <> name <> ": " <> e
+
+    processAction :: Maybe App -> Action -> KeterM AppManager (Maybe App)
     processAction Nothing Terminate = return Nothing
     processAction (Just app) Terminate = do
-        log $ Terminating $ show app
-        App.terminate app
+        $logInfo $ pack ("Terminating" <> show app)
+        withMappedConfig (const app) App.terminate
         return Nothing
     processAction Nothing (Reload input) = do
-        log $ ReloadFrom Nothing $ show input
-        eres <- E.try $ App.start appStartConfig appid input
+        $logInfo (reloadMsg "Nothing" (show input))
+        AppManager{..} <- ask
+        eres <- withRunInIO $ \rio -> E.try @SomeException $ 
+            rio $ withMappedConfig (const appStartConfig) $ App.start appid input
         case eres of
             Left e -> do
-                log $ ErrorStartingBundle name e
+                $logError (errorStartingBundleMsg (show name) (show e))
                 return Nothing
             Right app -> return $ Just app
     processAction (Just app) (Reload input) = do
-        log $ ReloadFrom (Just $ show app) (show input)
-        eres <- E.try $ App.reload app input
+        $logInfo (reloadMsg (show $ Just app) (show input))
+        eres <- withRunInIO $ \rio -> E.try @SomeException $ 
+            rio $ withMappedConfig (const app) $ App.reload input
         case eres of
             Left e -> do
-                log $ ErrorStartingBundle name e
+                $logError (errorStartingBundleMsg (show name) (show e))
                 -- reloading will /always/ result in a valid app, either the old one
                 -- will continue running or the new one will replace it.
                 return (Just app)
@@ -275,16 +300,15 @@
             AIBuiltin -> "<builtin>"
             AINamed x -> x
 
-addApp :: AppManager -> FilePath -> IO ()
-addApp appMan bundle = do
-    (input, action) <- getInputForBundle bundle
-    perform appMan input action
+addApp :: FilePath -> KeterM AppManager ()
+addApp bundle = do
+    (input, action) <- liftIO $ getInputForBundle bundle
+    perform input action
 
 getInputForBundle :: FilePath -> IO (AppId, Action)
 getInputForBundle bundle = do
     time <- modificationTime <$> getFileStatus bundle
     return (AINamed $ getAppname bundle, Reload $ AIBundle bundle time)
 
-terminateApp :: AppManager -> Appname -> IO ()
-terminateApp appMan appname = perform appMan (AINamed appname) Terminate
-
+terminateApp :: Appname -> KeterM AppManager ()
+terminateApp appname = perform (AINamed appname) Terminate
diff --git a/src/Keter/Cli.hs b/src/Keter/Cli.hs
--- a/src/Keter/Cli.hs
+++ b/src/Keter/Cli.hs
@@ -1,14 +1,22 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RecordWildCards #-}
 module Keter.Cli
     ( launchCli
     , CliStates(..)
     ) where
 
 import Keter.Common
+import Keter.Context
 import Keter.AppManager
 import Control.Concurrent (forkFinally)
 import qualified Control.Exception as E
 import Control.Monad (unless, forever, void, when)
+import Control.Monad.IO.Class    (MonadIO, liftIO)
+import Control.Monad.IO.Unlift   (withRunInIO)
+import Control.Monad.Trans.Class (MonadTrans, lift)
+import Control.Monad.Logger
+import Control.Monad.Reader      (ask)
 import qualified Data.ByteString as S
 import Network.Socket
 import Network.Socket.ByteString (recv, sendAll)
@@ -23,16 +31,19 @@
 
 data CliStates = MkCliStates
   { csAppManager :: !AppManager
-  , csLog        :: !(LogMessage -> IO ())
   , csPort       :: !Port
   }
 
-launchCli :: CliStates -> IO ()
-launchCli states = void $ forkIO $ withSocketsDo $ do
-    addr <- resolve $ show $ csPort states
-    E.bracket (open addr) close $ \x -> do
-                                    csLog states $ BindCli addr
-                                    loop states x
+launchCli :: KeterM CliStates ()
+launchCli = do
+  MkCliStates{..} <- ask
+  void $ withRunInIO $ \rio -> forkIO $ 
+    withSocketsDo $ do
+        addr <- resolve $ show csPort
+        E.bracket (open addr) close $ \x -> rio $ do
+            $logInfo $ T.pack $ "Bound cli to " <> show addr
+            loop x
+
 commandParser :: Parser Commands
 commandParser = hsubparser $
   fold [
@@ -65,31 +76,33 @@
     listen sock 10
     return sock
 
-loop :: CliStates -> Socket -> IO b
-loop states sock = forever $ do
-    (conn, peer) <- accept sock
-    csLog states $ ReceivedCliConnection peer
-    void $ forkFinally (talk states conn) (\_ -> close conn)
+loop :: Socket -> KeterM CliStates b
+loop sock = forever $ do
+    (conn, peer) <- liftIO $ accept sock
+    $logInfo $ T.pack $ "CLI Connection from " <> show peer
+    void $ withRunInIO $ \rio -> 
+        forkFinally (rio $ talk conn) (\_ -> close conn)
 
-listRunningApps :: CliStates -> Socket -> IO ()
-listRunningApps states conn = do
-  txt <- atomically $ renderApps $ csAppManager states
-  sendAll conn $ T.encodeUtf8 txt <> "\n"
+listRunningApps :: Socket -> KeterM CliStates ()
+listRunningApps conn = do
+  MkCliStates{..} <- ask
+  txt <- liftIO $ atomically $ renderApps csAppManager 
+  liftIO $ sendAll conn $ T.encodeUtf8 txt <> "\n"
 
-talk :: CliStates -> Socket -> IO ()
-talk states conn = do
-    msg <- recv conn 1024
+talk :: Socket -> KeterM CliStates ()
+talk conn = do
+    msg <- liftIO $ recv conn 1024
     unless (S.null msg) $ do
       case T.decodeUtf8' msg of
-        Left exception -> sendAll conn ("decode error: " <> T.encodeUtf8 (T.pack $ show exception))
+        Left exception -> liftIO $ sendAll conn ("decode error: " <> T.encodeUtf8 (T.pack $ show exception))
         Right txt -> do
           let res = execParserPure defaultPrefs (info (commandParser <**> helper)
                                                 (fullDesc <> header "server repl" <> progDesc (
                         "repl for inspecting program state. You can connect to a socket and ask predefined questions")) ) (T.unpack <$> T.words txt)
           isLoop <- case res of
-            (Success (CmdListRunningApps)) -> True <$ listRunningApps states conn
-            (Success (CmdExit   )) -> False <$ sendAll conn "bye\n"
-            (CompletionInvoked x) -> True <$ sendAll conn "completion ignored \n"
+            (Success (CmdListRunningApps)) -> True <$ listRunningApps conn
+            (Success (CmdExit   )) -> False <$ liftIO (sendAll conn "bye\n")
+            (CompletionInvoked x) -> True <$ liftIO (sendAll conn "completion ignored \n")
             Failure failure        ->
-              True <$ sendAll conn (T.encodeUtf8 (T.pack $ fst $ renderFailure failure "") <> "\n")
-          when isLoop $ talk states conn
+              True <$ liftIO (sendAll conn (T.encodeUtf8 (T.pack $ fst $ renderFailure failure "") <> "\n"))
+          when isLoop $ talk conn
diff --git a/src/Keter/Common.hs b/src/Keter/Common.hs
--- a/src/Keter/Common.hs
+++ b/src/Keter/Common.hs
@@ -56,107 +56,6 @@
 getAppname :: FilePath -> Text
 getAppname = pack . takeBaseName
 
-data LogMessage
-    = ProcessCreated FilePath
-    | InvalidBundle FilePath SomeException
-    | ProcessDidNotStart FilePath
-    | ExceptionThrown Text SomeException
-    | RemovingPort Int
-    | UnpackingBundle FilePath
-    | TerminatingApp Text
-    | FinishedReloading Text
-    | TerminatingOldProcess AppId
-    | RemovingOldFolder FilePath
-    | ReceivedInotifyEvent Text
-    | ProcessWaiting FilePath
-    | OtherMessage Text
-    | ErrorStartingBundle Text SomeException
-    | SanityChecksPassed
-    | ReservingHosts AppId (Set Host)
-    | ForgetingReservations AppId (Set Host)
-    | ActivatingApp AppId (Set Host)
-    | DeactivatingApp AppId (Set Host)
-    | ReactivatingApp AppId (Set Host) (Set Host)
-    | WatchedFile Text FilePath
-    | ReloadFrom (Maybe String) String
-    | Terminating String
-    | LaunchInitial
-    | LaunchCli
-    | StartWatching
-    | StartListening
-    | BindCli AddrInfo
-    | ReceivedCliConnection SockAddr
-    | KillingApp Port Text
-    | ProxyException Wai.Request SomeException
-
-instance Show LogMessage where
-    show (ProcessCreated f) = "Created process: " ++ f
-    show (ReloadFrom app input) = "Reloading from: " ++ show app  ++ " to " ++ show input
-    show (Terminating app) = "Terminating " ++ show app
-    show (InvalidBundle f e) = concat
-        [ "Unable to parse bundle file '"
-        , f
-        , "': "
-        , show e
-        ]
-    show (ProcessDidNotStart fp) = concat
-        [ "Could not start process within timeout period: "
-        , fp
-        ]
-    show (ExceptionThrown t e) = concat
-        [ unpack t
-        , ": "
-        , show e
-        ]
-    show (RemovingPort p) = "Port in use, removing from port pool: " ++ show p
-    show (UnpackingBundle b) = concat
-        [ "Unpacking bundle '"
-        , b
-        , "'"
-        ]
-    show (TerminatingApp t) = "Shutting down app: " ++ unpack t
-    show (FinishedReloading t) = "App finished reloading: " ++ unpack t
-    show (TerminatingOldProcess (AINamed t)) = "Sending old process TERM signal: " ++ unpack t
-    show (TerminatingOldProcess AIBuiltin) = "Sending old process TERM signal: builtin"
-    show (RemovingOldFolder fp) = "Removing unneeded folder: " ++ fp
-    show (ReceivedInotifyEvent t) = "Received unknown INotify event: " ++ unpack t
-    show (ProcessWaiting f) = "Process restarting too quickly, waiting before trying again: " ++ f
-    show (OtherMessage t) = unpack t
-    show (ErrorStartingBundle name e) = concat
-        [ "Error occured when launching bundle "
-        , unpack name
-        , ": "
-        , show e
-        ]
-    show SanityChecksPassed = "Sanity checks passed"
-    show (ReservingHosts app hosts) = "Reserving hosts for app " ++ show app ++ ": " ++ unwords (map (unpack . original) $ Set.toList hosts)
-    show (ForgetingReservations app hosts) = "Forgetting host reservations for app " ++ show app ++ ": " ++ unwords (map (unpack . original) $ Set.toList hosts)
-    show (ActivatingApp app hosts) = "Activating app " ++ show app ++ " with hosts: " ++ unwords (map (unpack . original) $ Set.toList hosts)
-    show (DeactivatingApp app hosts) = "Deactivating app " ++ show app ++ " with hosts: " ++ unwords (map (unpack . original) $ Set.toList hosts)
-    show (ReactivatingApp app old new) = concat
-        [ "Reactivating app "
-        , show app
-        , ".  Old hosts: "
-        , unwords (map (unpack . original) $ Set.toList old)
-        , ". New hosts: "
-        , unwords (map (unpack . original) $ Set.toList new)
-        , "."
-        ]
-    show (WatchedFile action fp) = concat
-        [ "Watched file "
-        , unpack action
-        , ": "
-        , fp
-        ]
-    show LaunchInitial = "Launching initial"
-    show (KillingApp port txt) = "Killing " <> unpack txt <> " running on port: "  <> show port
-    show LaunchCli     = "Launching cli"
-    show StartWatching = "Started watching"
-    show StartListening = "Started listening"
-    show (BindCli addr) = "Bound cli to " <> show addr
-    show (ReceivedCliConnection peer) = "CLI Connection from " <> show peer
-    show (ProxyException req except) = "Got a proxy exception on request " <> show req <> " with exception "  <> show except
-
 data KeterException = CannotParsePostgres FilePath
                     | ExitCodeFailure FilePath ExitCode
                     | NoPortsAvailable
@@ -168,18 +67,6 @@
                     | EnsureAliveShouldBeBiggerThenZero { keterExceptionGot:: !Int }
     deriving (Show, Typeable)
 instance Exception KeterException
-
-logEx :: TH.Q TH.Exp
-logEx = do
-    let showLoc TH.Loc { TH.loc_module = m, TH.loc_start = (l, c) } = concat
-            [ m
-            , ":"
-            , show l
-            , ":"
-            , show c
-            ]
-    loc <- fmap showLoc TH.qLocation
-    [|(. ExceptionThrown (pack $(TH.lift loc)))|]
 
 data AppId = AIBuiltin | AINamed !Appname
     deriving (Eq, Ord)
diff --git a/src/Keter/Conduit/LogFile.hs b/src/Keter/Conduit/LogFile.hs
deleted file mode 100644
--- a/src/Keter/Conduit/LogFile.hs
+++ /dev/null
@@ -1,140 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Keter.Conduit.LogFile
-    ( RotatingLog
-    , openRotatingLog
-    , addChunk
-    , close
-    , defaultMaxTotal
-    , dummy
-    ) where
-
-import           Control.Concurrent             (forkIO)
-import           Control.Concurrent.STM         (atomically)
-import           Control.Concurrent.STM.TBQueue
-import           Control.Concurrent.STM.TVar
-import           Control.Exception              (bracket, bracketOnError,
-                                                 finally)
-import           Control.Monad                  (void, when)
-import qualified Data.ByteString                as S
-import           Data.Time                      (UTCTime, getCurrentTime)
-import           Data.Word                      (Word)
-import           System.Directory               (createDirectoryIfMissing,
-                                                 doesFileExist, renameFile)
-import           System.FilePath                ((<.>), (</>))
-import qualified System.IO                      as SIO
-import           System.IO.Unsafe               (unsafePerformIO)
-import           System.Mem.Weak                (addFinalizer)
-
-data Command = AddChunk !S.ByteString
-             | Close
-
--- | Represents a folder used for totating log files.
---
--- Since 0.2.1
-data RotatingLog = RotatingLog !(TVar State)
--- Use a data instead of a newtype so that we can attach a finalizer.
-
--- | A @RotatingLog@ which performs no logging.
---
--- Since 0.2.1
-dummy :: RotatingLog
-dummy = RotatingLog $! unsafePerformIO $! newTVarIO Closed
-
-data State = Closed
-           | Running !SIO.Handle !(TBQueue Command)
-
-queue :: Command -> RotatingLog -> IO ()
-queue cmd (RotatingLog ts) = atomically $ do
-    s <- readTVar ts
-    case s of
-        Closed -> return ()
-        Running _ q -> writeTBQueue q cmd
-
-addChunk :: RotatingLog -> S.ByteString -> IO ()
-addChunk lf bs = queue (AddChunk bs) lf
-
-close :: RotatingLog -> IO ()
-close = queue Close
-
--- | Create a new @RotatingLog@.
---
--- Since 0.2.1
-openRotatingLog :: FilePath -- ^ folder to contain logs
-                -> Word -- ^ maximum log file size, in bytes
-                -> IO RotatingLog
-openRotatingLog dir maxTotal = do
-    createDirectoryIfMissing True dir
-    bracketOnError (moveCurrent dir) SIO.hClose $ \handle -> do
-        queue' <- newTBQueueIO 5
-        let s = Running handle queue'
-        ts <- newTVarIO s
-        void $ forkIO $ loop dir ts maxTotal
-        let rl = RotatingLog ts
-        addFinalizer rl (atomically (writeTBQueue queue' Close))
-        return rl
-
-current :: FilePath -- ^ folder containing logs
-        -> FilePath
-current = (</> "current.log")
-
-moveCurrent :: FilePath -- ^ folder containing logs
-            -> IO SIO.Handle -- ^ new handle
-moveCurrent dir = do
-    let curr = current dir
-    x <- doesFileExist curr
-    when x $ do
-        now <- getCurrentTime
-        renameFile curr $ dir </> suffix now
-    SIO.openFile curr SIO.WriteMode
-
-suffix :: UTCTime -> FilePath
-suffix now =
-    (concatMap fix $ takeWhile (/= '.') $ show now) <.> "log"
-  where
-    fix ' ' = "_"
-    fix c | '0' <= c && c <= '9' = [c]
-    fix _ = ""
-
-loop :: FilePath -- ^ folder containing logs
-     -> TVar State
-     -> Word -- ^ maximum total log size
-     -> IO ()
-loop dir ts maxTotal =
-    go 0 `finally` (closeCurrentHandle `finally` atomically (writeTVar ts Closed))
-  where
-    closeCurrentHandle = bracket
-        (atomically $ do
-            s <- readTVar ts
-            case s of
-                Closed -> return Nothing
-                Running h _ -> return $! Just h)
-        (maybe (return ()) SIO.hClose)
-        (const $ return ())
-
-    go total = do
-        res <- atomically $ do
-            s <- readTVar ts
-            case s of
-                Closed -> return Nothing
-                Running handle queue' -> do
-                    cmd <- readTBQueue queue'
-                    case cmd of
-                        Close -> return Nothing
-                        AddChunk bs -> return $! Just (handle, queue', bs)
-        case res of
-            Nothing -> return ()
-            Just (handle, queue', bs) -> do
-                let total' = total + fromIntegral (S.length bs)
-                S.hPut handle bs
-                SIO.hFlush handle
-                if total' > maxTotal
-                    then do
-                        bracket
-                            (SIO.hClose handle >> moveCurrent dir)
-                            (\handle' -> atomically $ writeTVar ts $ Running handle' queue')
-                            (const $ return ())
-                        go 0
-                    else go total'
-
-defaultMaxTotal :: Word
-defaultMaxTotal = 5 * 1024 * 1024 -- 5 MB
diff --git a/src/Keter/Conduit/Process/Unix.hs b/src/Keter/Conduit/Process/Unix.hs
--- a/src/Keter/Conduit/Process/Unix.hs
+++ b/src/Keter/Conduit/Process/Unix.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE OverloadedStrings        #-}
 {-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TemplateHaskell          #-}
 
 module Keter.Conduit.Process.Unix
     ( -- * Process tracking
@@ -21,6 +22,7 @@
     ) where
 
 import           Data.Text(Text, pack)
+import           Data.Text.Encoding              (decodeUtf8)
 import           Control.Applicative             ((<$>), (<*>), pure)
 import           Control.Arrow                   ((***))
 import           Control.Concurrent              (forkIO)
@@ -34,6 +36,9 @@
                                                   handle, mask_,
                                                   throwIO, try)
 import           Control.Monad                   (void)
+import           Control.Monad.IO.Class
+import           Control.Monad.IO.Unlift
+import           Control.Monad.Logger            
 import           Data.ByteString                 (ByteString)
 import qualified Data.ByteString.Char8           as S8
 import           Data.Conduit                    (ConduitM, (.|), runConduit)
@@ -199,7 +204,7 @@
                -> Maybe (ConduitM () ByteString IO ()) -- ^ stdin
                -> (ByteString -> IO ()) -- ^ both stdout and stderr will be sent to this location
                -> IO ProcessHandle
-forkExecuteLog cmd args menv mwdir mstdin rlog = bracketOnError
+forkExecuteLog cmd args menv mwdir mstdin log = bracketOnError
     setupPipe
     cleanupPipes
     usePipes
@@ -238,7 +243,7 @@
             }
         ignoreExceptions $ addAttachMessage pipes ph
         void $ forkIO $ ignoreExceptions $
-            (runConduit $ sourceHandle readerH .| CL.mapM_ rlog) `finally` hClose readerH
+            (runConduit $ sourceHandle readerH .| CL.mapM_ log) `finally` hClose readerH
         case (min, mstdin) of
             (Just h, Just source) -> void $ forkIO $ ignoreExceptions $
                 (runConduit $ source .| sinkHandle h) `finally` hClose h
@@ -250,7 +255,7 @@
         now <- getCurrentTime
         case p_ of
             ClosedHandle ec -> do
-                rlog $ S8.concat
+                log $ S8.concat
                     [ "\n\n"
                     , S8.pack $ show now
                     , ": Process immediately died with exit code "
@@ -259,7 +264,7 @@
                     ]
                 cleanupPipes pipes
             OpenHandle h -> do
-                rlog $ S8.concat
+                log $ S8.concat
                     [ "\n\n"
                     , S8.pack $ show now
                     , ": Attached new process "
@@ -272,8 +277,8 @@
 
 -- | Run the given command, restarting if the process dies.
 monitorProcess
-    :: (ByteString -> IO ()) -- ^ log
-    -> ProcessTracker
+    :: (MonadUnliftIO m, MonadLogger m)
+    => ProcessTracker
     -> Maybe S8.ByteString -- ^ setuid
     -> S8.ByteString -- ^ executable
     -> S8.ByteString -- ^ working directory
@@ -281,47 +286,48 @@
     -> [(S8.ByteString, S8.ByteString)] -- ^ environment
     -> (ByteString -> IO ())
     -> (ExitCode -> IO Bool) -- ^ should we restart?
-    -> IO MonitoredProcess
-monitorProcess log processTracker msetuid exec dir args env' rlog shouldRestart = do
-    mstatus <- newMVar NeedsRestart
-    let loop mlast = do
-            next <- modifyMVar mstatus $ \status ->
-                case status of
-                    NoRestart -> return (NoRestart, return ())
-                    _ -> do
-                        now <- getCurrentTime
-                        case mlast of
-                            Just last | diffUTCTime now last < 5 -> do
-                                log $ "Process restarting too quickly, waiting before trying again: " `S8.append` exec
-                                threadDelay $ 5 * 1000 * 1000
-                            _ -> return ()
-                        let (cmd, args') =
-                                case msetuid of
-                                    Nothing -> (exec, args)
-                                    Just setuid -> ("sudo", "-E" : "-u" : setuid : "--" : exec : args)
-                        res <- try $ forkExecuteLog
-                            cmd
-                            args'
-                            (Just env')
-                            (Just dir)
-                            (Just $ return ())
-                            rlog
-                        case res of
-                            Left e -> do
-                                log $ "Data.Conduit.Process.Unix.monitorProcess: " `S8.append` S8.pack (show (e :: SomeException))
-                                return (NeedsRestart, return ())
-                            Right pid -> do
-                                log $ "Process created: " `S8.append` exec
-                                return (Running pid, do
-                                    TrackedProcess _ _ wait <- trackProcess processTracker pid
-                                    ec <- wait
-                                    shouldRestart' <- shouldRestart ec
-                                    if shouldRestart'
-                                        then loop (Just now)
-                                        else return ())
-            next
-    _ <- forkIO $ loop Nothing
-    return $ MonitoredProcess mstatus
+    -> m MonitoredProcess
+monitorProcess processTracker msetuid exec dir args env' rlog shouldRestart =
+    withRunInIO $ \rio -> do
+        mstatus <- newMVar NeedsRestart
+        let loop mlast = do
+                next <- modifyMVar mstatus $ \status ->
+                    case status of
+                        NoRestart -> return (NoRestart, return ())
+                        _ -> do
+                            now <- getCurrentTime
+                            case mlast of
+                                Just last | diffUTCTime now last < 5 -> do
+                                    rio $ $logWarn $ "Process restarting too quickly, waiting before trying again: " <> decodeUtf8 exec
+                                    threadDelay $ 5 * 1000 * 1000
+                                _ -> return ()
+                            let (cmd, args') =
+                                    case msetuid of
+                                        Nothing -> (exec, args)
+                                        Just setuid -> ("sudo", "-E" : "-u" : setuid : "--" : exec : args)
+                            res <- try $ forkExecuteLog
+                                cmd
+                                args'
+                                (Just env')
+                                (Just dir)
+                                (Just $ return ())
+                                rlog
+                            case res of
+                                Left e -> do
+                                    rio $ $logError $ "Data.Conduit.Process.Unix.monitorProcess: " <> pack (show (e :: SomeException))
+                                    return (NeedsRestart, return ())
+                                Right pid -> do
+                                    rio $ $logInfo $ "Process created: " <> decodeUtf8 exec
+                                    return (Running pid, do
+                                        TrackedProcess _ _ wait <- trackProcess processTracker pid
+                                        ec <- wait
+                                        shouldRestart' <- shouldRestart ec
+                                        if shouldRestart'
+                                            then loop (Just now)
+                                            else return ())
+                next
+        _ <- forkIO $ loop Nothing
+        return $ MonitoredProcess mstatus
 
 -- | Abstract type containing information on a process which will be restarted.
 newtype MonitoredProcess = MonitoredProcess (MVar Status)
diff --git a/src/Keter/Config/V10.hs b/src/Keter/Config/V10.hs
--- a/src/Keter/Config/V10.hs
+++ b/src/Keter/Config/V10.hs
@@ -112,6 +112,7 @@
     , kconfigUnknownHostResponse  :: !(Maybe F.FilePath)
     , kconfigMissingHostResponse  :: !(Maybe F.FilePath)
     , kconfigProxyException       :: !(Maybe F.FilePath)
+    , kconfigRotateLogs           :: !Bool
     }
 
 instance ToCurrent KeterConfig where
@@ -131,6 +132,7 @@
         , kconfigUnknownHostResponse  = Nothing
         , kconfigMissingHostResponse = Nothing
         , kconfigProxyException      = Nothing
+        , kconfigRotateLogs = True
         }
       where
         getSSL Nothing = V.empty
@@ -154,10 +156,11 @@
         , kconfigExternalHttpsPort = 443
         , kconfigEnvironment = Map.empty
         , kconfigConnectionTimeBound = V04.fiveMinutes
-        , kconfigCliPort             = Nothing
-        , kconfigUnknownHostResponse  = Nothing
+        , kconfigCliPort = Nothing
+        , kconfigUnknownHostResponse = Nothing
         , kconfigMissingHostResponse = Nothing
-        , kconfigProxyException      = Nothing
+        , kconfigProxyException = Nothing
+        , kconfigRotateLogs = True
         }
 
 instance ParseYamlFile KeterConfig where
@@ -182,6 +185,7 @@
             <*> o .:? "missing-host-response-file"
             <*> o .:? "unknown-host-response-file"
             <*> o .:? "proxy-exception-response-file"
+            <*> o .:? "rotate-logs" .!= True
 
 -- | Whether we should force redirect to HTTPS routes.
 type RequiresSecure = Bool
diff --git a/src/Keter/Context.hs b/src/Keter/Context.hs
new file mode 100644
--- /dev/null
+++ b/src/Keter/Context.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies         #-}
+
+module Keter.Context where
+
+import           Keter.Common
+import           Control.Monad.Trans       (lift)
+import           Control.Monad.IO.Class   (MonadIO)
+import           Control.Monad.IO.Unlift   (MonadUnliftIO)
+import           Control.Monad.Logger      (MonadLogger, MonadLoggerIO, LoggingT(..), runLoggingT)
+import           Control.Monad.Reader      (MonadReader, ReaderT, runReaderT, ask
+                                           , withReaderT)
+
+-- | The top-level keter context monad, carrying around the main logger and some locally relevant configuration structure.
+--
+-- See this blog post for an explanation of the design philosophy: https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/
+--
+-- TODO: generalize as /contexts/ instead of /configs/? Since not every state being passed
+-- around can be intuitively thought of as a config per se. Ex. AppManager
+newtype KeterM cfg a = KeterM { runKeterM :: LoggingT (ReaderT cfg IO) a }
+  deriving newtype (Functor, Applicative, Monad,
+                    MonadUnliftIO,
+                    MonadIO, MonadLogger, MonadLoggerIO,
+                    MonadReader cfg)
+
+withMappedConfig :: (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
+withMappedConfig f (KeterM ctx) = 
+    KeterM $ LoggingT $ \logger -> withReaderT f $ runLoggingT ctx logger
diff --git a/src/Keter/HostManager.hs b/src/Keter/HostManager.hs
--- a/src/Keter/HostManager.hs
+++ b/src/Keter/HostManager.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE TemplateHaskell     #-}
 module Keter.HostManager
     ( -- * Types
       HostManager
@@ -16,11 +17,16 @@
     , start
     ) where
 
+import Keter.Context
 import           Control.Applicative
 import           Control.Exception   (assert, throwIO)
+import           Control.Monad.Logger
+import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad.Reader    (ask)
 import qualified Data.CaseInsensitive as CI
 import           Data.Either         (partitionEithers)
 import           Data.IORef
+import           Data.Text           (pack, unpack)
 import qualified Data.Map            as Map
 import qualified Data.Set            as Set
 import           Data.Text.Encoding  (encodeUtf8)
@@ -59,18 +65,22 @@
 --
 -- 4. Otherwise, the hosts which were reserved are returned as @Right@. This
 --    does /not/ include previously active hosts.
-reserveHosts :: (LogMessage -> IO ())
-             -> HostManager
-             -> AppId
+reserveHosts :: AppId
              -> Set.Set Host
-             -> IO Reservations
-reserveHosts log (HostManager mstate) aid hosts = do
-  log $ ReservingHosts aid hosts
-  either (throwIO . CannotReserveHosts aid) return =<< atomicModifyIORef mstate (\entries0 ->
-    case partitionEithers $ map (checkHost entries0) $ Set.toList hosts of
-        ([], Set.unions -> toReserve) ->
-            (Set.foldr reserve entries0 toReserve, Right toReserve)
-        (conflicts, _) -> (entries0, Left $ Map.fromList conflicts))
+             -> KeterM HostManager Reservations
+reserveHosts aid hosts = do
+  (HostManager mstate) <- ask
+  $logInfo $ pack $ 
+      "Reserving hosts for app " 
+      ++ show aid
+      ++ ": " 
+      ++ unwords (map (unpack . CI.original) $ Set.toList hosts)
+  liftIO $ either (throwIO . CannotReserveHosts aid) return 
+    =<< atomicModifyIORef mstate (\entries0 ->
+      case partitionEithers $ map (checkHost entries0) $ Set.toList hosts of
+          ([], Set.unions -> toReserve) ->
+              (Set.foldr reserve entries0 toReserve, Right toReserve)
+          (conflicts, _) -> (entries0, Left $ Map.fromList conflicts))
   where
     checkHost entries0 host =
         case LabelMap.labelAssigned hostBS entries0 of
@@ -92,14 +102,17 @@
         hostBS = encodeUtf8 $ CI.original host
 
 -- | Forget previously made reservations.
-forgetReservations :: (LogMessage -> IO ())
-                   -> HostManager
-                   -> AppId
+forgetReservations :: AppId
                    -> Reservations
-                   -> IO ()
-forgetReservations log (HostManager mstate) app hosts = do
-    log $ ForgetingReservations app hosts
-    atomicModifyIORef mstate $ \state0 ->
+                   -> KeterM HostManager ()
+forgetReservations app hosts = do
+    (HostManager mstate) <- ask
+    $logInfo $ pack $ 
+        "Forgetting host reservations for app " 
+        ++ show app 
+        ++ ": " 
+        ++ unwords (map (unpack . CI.original) $ Set.toList hosts)
+    liftIO $ atomicModifyIORef mstate $ \state0 ->
         (Set.foldr forget state0 hosts, ())
   where
     forget host state =
@@ -113,14 +126,18 @@
                 Just HVActive{} -> False
 
 -- | Activate a new app. Note that you /must/ first reserve the hostnames you'll be using.
-activateApp :: (LogMessage -> IO ())
-            -> HostManager
-            -> AppId
+activateApp :: AppId
             -> Map.Map Host (ProxyAction, TLS.Credentials)
-            -> IO ()
-activateApp log (HostManager mstate) app actions = do
-    log $ ActivatingApp app $ Map.keysSet actions
-    atomicModifyIORef mstate $ \state0 ->
+            -> KeterM HostManager ()
+activateApp app actions = do
+    (HostManager mstate) <- ask
+    $logInfo $ pack $ concat
+        [ "Activating app "
+        , show app
+        , " with hosts: "
+        , unwords (map (unpack . CI.original) $ Set.toList (Map.keysSet actions))
+        ]
+    liftIO $ atomicModifyIORef mstate $ \state0 ->
         (activateHelper app state0 actions, ())
 
 activateHelper :: AppId -> LabelMap HostValue -> Map Host (ProxyAction, TLS.Credentials) -> LabelMap HostValue
@@ -137,14 +154,13 @@
                 Just (HVReserved app') -> app == app'
                 Just (HVActive app' _ _) -> app == app'
 
-deactivateApp :: (LogMessage -> IO ())
-              -> HostManager
-              -> AppId
+deactivateApp :: AppId
               -> Set Host
-              -> IO ()
-deactivateApp log (HostManager mstate) app hosts = do
-    log $ DeactivatingApp app hosts
-    atomicModifyIORef mstate $ \state0 ->
+              -> KeterM HostManager ()
+deactivateApp app hosts = do
+    $logInfo $ pack $ "Deactivating app " ++ show app ++ " with hosts: " ++ unwords (map (unpack . CI.original) $ Set.toList hosts)
+    (HostManager mstate) <- ask
+    liftIO $ atomicModifyIORef mstate $ \state0 ->
         (deactivateHelper app state0 hosts, ())
 
 deactivateHelper :: AppId -> LabelMap HostValue -> Set Host -> LabelMap HostValue
@@ -161,15 +177,22 @@
                 Just (HVActive app' _ _) -> app == app'
                 Just HVReserved {} -> False
 
-reactivateApp :: (LogMessage -> IO ())
-              -> HostManager
-              -> AppId
+reactivateApp :: AppId
               -> Map Host (ProxyAction, TLS.Credentials)
               -> Set Host
-              -> IO ()
-reactivateApp log (HostManager mstate) app actions hosts = do
-    log $ ReactivatingApp app hosts (Map.keysSet actions)
-    atomicModifyIORef mstate $ \state0 ->
+              -> KeterM HostManager ()
+reactivateApp app actions hosts = do
+    (HostManager mstate) <- ask
+    $logInfo $ pack $ concat
+        [ "Reactivating app "
+        , show app
+        , ".  Old hosts: "
+        , unwords (map (unpack . CI.original) $ Set.toList hosts)
+        , ". New hosts: "
+        , unwords (map (unpack . CI.original) $ Set.toList (Map.keysSet actions))
+        , "."
+        ]
+    liftIO $ atomicModifyIORef mstate $ \state0 ->
         (activateHelper app (deactivateHelper app state0 hosts) actions, ())
 
 lookupAction :: HostManager
diff --git a/src/Keter/Logger.hs b/src/Keter/Logger.hs
new file mode 100644
--- /dev/null
+++ b/src/Keter/Logger.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
+module Keter.Logger
+    ( Logger(..)
+    , createLoggerViaConfig
+    , defaultRotationSpec
+    , defaultMaxTotal
+    , defaultBufferSize
+    ) where
+
+import Data.Time
+import Debug.Trace
+import qualified System.Log.FastLogger as FL
+import System.Directory
+import System.FilePath
+import Control.Monad.Logger
+import Control.Monad.Reader
+import Control.Monad.IO.Class
+import Control.Monad.IO.Unlift
+import Keter.Context
+import Keter.Config.V10
+
+-- | Record wrapper over a fast logger (log,close) function tuple, just to make it less unwieldy and obscure.
+-- The 'LogType' is also tracked, in case formatting depends on it.
+data Logger = Logger
+  { loggerLog :: forall a. FL.ToLogStr a => a -> IO ()
+  , loggerClose :: IO () 
+  , loggerType :: FL.LogType
+  }
+
+-- | Create a logger based on a 'KeterConfig'.
+-- If log rotation is enabled in the config, this will return a rotating file logger;
+-- and a stderr logger otherwise.
+createLoggerViaConfig :: KeterConfig
+                      -> String -- ^ Log file name
+                      -> IO Logger
+createLoggerViaConfig KeterConfig{..} name = do
+  let logFile = kconfigDir </> "log" </> name <.> "log"
+  let logType =
+       if kconfigRotateLogs
+         then FL.LogFile (defaultRotationSpec logFile) defaultBufferSize
+         else FL.LogStderr defaultBufferSize
+  liftIO $ createDirectoryIfMissing True (takeDirectory logFile)
+  mkLogger logType <$> FL.newFastLogger logType
+  where
+    mkLogger logType (logFn, closeFn) = Logger (logFn . FL.toLogStr) closeFn logType
+
+defaultRotationSpec :: FilePath -> FL.FileLogSpec
+defaultRotationSpec dir =
+    FL.FileLogSpec dir defaultMaxTotal maxBound -- TODO: do we want to overwrite logs after a certain point? leaving this INT_MAX for now
+
+-- | The default total file size before for a log file before it needs to be rotated
+defaultMaxTotal :: Integer
+defaultMaxTotal = 5 * 1024 * 1024 -- 5 MB
+
+-- | The default log message buffer size
+defaultBufferSize :: Int
+defaultBufferSize = 256 -- 256 bytes, TODO: Reasonable value?
diff --git a/src/Keter/Main.hs b/src/Keter/Main.hs
--- a/src/Keter/Main.hs
+++ b/src/Keter/Main.hs
@@ -1,9 +1,12 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE TypeFamilies               #-}
 
 module Keter.Main
     ( keter
@@ -14,7 +17,7 @@
 import qualified Keter.TempTarball as TempFolder
 import           Control.Concurrent.Async  (waitAny, withAsync)
 import           Control.Monad             (unless)
-import qualified Keter.Conduit.LogFile      as LogFile
+import qualified Keter.Logger              as Log
 import           Data.Monoid               (mempty)
 import           Data.String               (fromString)
 import qualified Data.Vector               as V
@@ -30,9 +33,15 @@
                                             sigHUP)
 
 import           Control.Applicative       ((<$>))
-import           Control.Exception         (throwIO, try, SomeException)
-import           Control.Monad             (forM)
-import           Control.Monad             (void, when)
+import           Control.Exception         (throwIO, try, bracket, SomeException)
+import           Control.Monad             (forM, void, when)
+import           Control.Monad.IO.Class    (MonadIO, liftIO)
+import           Control.Monad.Trans.Class (MonadTrans, lift)
+import qualified Control.Monad.Logger      as L
+import           Control.Monad.Logger      (MonadLogger, MonadLoggerIO, LoggingT, 
+                                            runLoggingT, askLoggerIO, logInfo, logDebug)
+import           Control.Monad.Reader      (MonadReader, ReaderT, runReaderT, ask)
+import           Control.Monad.IO.Unlift   (MonadUnliftIO, withRunInIO)
 import           Keter.Conduit.Process.Unix (initProcessTracker)
 import qualified Data.Map                  as Map
 import qualified Data.Text                 as T
@@ -45,8 +54,9 @@
                                             createDirectoryIfMissing,
                                             doesDirectoryExist, doesFileExist,
                                             getDirectoryContents)
-import           System.FilePath           (takeExtension, (</>))
+import           System.FilePath           (takeExtension, takeDirectory, (</>))
 import qualified System.FSNotify           as FSN
+import qualified System.Log.FastLogger     as FL
 import           System.Posix.User         (getUserEntryForID,
                                             getUserEntryForName, userGroupID,
                                             userID, userName)
@@ -55,32 +65,38 @@
 import           Filesystem.Path.CurrentOS (encodeString)
 #endif
 import Keter.Cli
+import Keter.Context
 
 keter :: FilePath -- ^ root directory or config file
       -> [FilePath -> IO Plugin]
       -> IO ()
-keter input mkPlugins = withManagers input mkPlugins $ \kc hostman appMan log -> do
-    log LaunchCli
-    void $ forM (kconfigCliPort kc) $ \port ->
-      launchCli (MkCliStates
-                { csAppManager = appMan
-                , csLog        = log
-                , csPort       = port
-                })
-    log LaunchInitial
-    launchInitial kc appMan
-    log StartWatching
-    startWatching kc appMan log
-    log StartListening
-    startListening log kc hostman
+keter input mkPlugins =
+    runKeterConfigReader input . runKeterLogger . runKeterM $
+        withManagers mkPlugins $ \hostman appMan -> do
+            cfg@KeterConfig{..} <- ask
+            $logInfo "Launching cli"
+            void $ forM kconfigCliPort $ \port ->
+              withMappedConfig
+                  (const $ MkCliStates
+                      { csAppManager = appMan
+                      , csPort       = port
+                      })
+                  $ launchCli
+            $logInfo "Launching initial"
+            launchInitial appMan
+            $logInfo "Started watching"
+            startWatching appMan
+            $logInfo "Started listening"
+            startListening hostman
 
--- | Load up Keter config.
-withConfig :: FilePath
-           -> (KeterConfig -> IO a)
-           -> IO a
-withConfig input f = do
-    exists <- doesFileExist input
-    config <-
+-- | Load up Keter config and evaluate a ReaderT context with it
+runKeterConfigReader :: MonadIO m
+                     => FilePath
+                     -> ReaderT KeterConfig m a
+                     -> m a
+runKeterConfigReader input ctx = do
+    exists <- liftIO $ doesFileExist input
+    config <- liftIO $
         if exists
             then do
                 eres <- decodeFileRelative input
@@ -88,41 +104,53 @@
                     Left e -> throwIO $ InvalidKeterConfigFile input e
                     Right x -> return x
             else return defaultKeterConfig { kconfigDir = input }
-    f config
-
-withLogger :: FilePath
-           -> (KeterConfig -> (LogMessage -> IO ()) -> IO a)
-           -> IO a
-withLogger fp f = withConfig fp $ \config -> do
-    mainlog <- LogFile.openRotatingLog
-        (kconfigDir config </> "log" </> "keter")
-        LogFile.defaultMaxTotal
+    runReaderT ctx config
 
-    f config $ \ml -> do
-        now <- getCurrentTime
-        let bs = encodeUtf8 $ T.pack $ concat
-                [ take 22 $ show now
-                , ": "
-                , show ml
-                , "\n"
-                ]
-        LogFile.addChunk mainlog bs
+-- | Running the Keter logger requires a context with access to a KeterConfig, hence the
+-- MonadReader constraint. This is versatile: 'runKeterConfigReader', or use the free 
+-- ((->) KeterConfig) instance.
+runKeterLogger :: (MonadReader KeterConfig m, MonadIO m, MonadUnliftIO m)
+               => LoggingT m a
+               -> m a
+runKeterLogger ctx = do
+    cfg@KeterConfig{..} <- ask
+    withRunInIO $ \rio -> bracket (Log.createLoggerViaConfig cfg "keter") Log.loggerClose $
+        rio . runLoggingT ctx . formatLog 
+    where
+        formatLog logger loc _ lvl msg = do
+            now <- liftIO getCurrentTime
+            -- Format: "{keter|}$time|$module$:$line_num|$log_level> $msg"
+            let tag = case Log.loggerType logger of { FL.LogStderr _ -> "keter|"; _ -> mempty }
+            let bs = mconcat
+                    [ tag
+                    , L.toLogStr $ take 22 $ show now
+                    , "|"
+                    , L.toLogStr (L.loc_module loc)
+                    , ":"
+                    , L.toLogStr (fst $ L.loc_start loc)
+                    , "|"
+                    , L.toLogStr $ drop 5 $ show lvl
+                    , "> "
+                    , msg
+                    , "\n"
+                    ]
+            Log.loggerLog logger bs
 
-withManagers :: FilePath
-             -> [FilePath -> IO Plugin]
-             -> (KeterConfig -> HostMan.HostManager -> AppMan.AppManager -> (LogMessage -> IO ()) -> IO a)
-             -> IO a
-withManagers input mkPlugins f = withLogger input $ \kc@KeterConfig {..} log -> do
-    processTracker <- initProcessTracker
-    hostman <- HostMan.start
-    portpool <- PortPool.start kconfigPortPool
-    tf <- TempFolder.setup $ kconfigDir </> "temp"
-    plugins <- mapM ($ kconfigDir) mkPlugins
+withManagers :: [FilePath -> IO Plugin]
+             -> (HostMan.HostManager -> AppMan.AppManager -> KeterM KeterConfig a)
+             -> KeterM KeterConfig a
+withManagers mkPlugins f = do
+    cfg@KeterConfig{..} <- ask
+    processTracker <- liftIO initProcessTracker
+    hostman <- liftIO HostMan.start
+    portpool <- liftIO $ PortPool.start kconfigPortPool
+    tf <- liftIO $ TempFolder.setup $ kconfigDir </> "temp"
+    plugins <- mapM (liftIO . ($ kconfigDir)) mkPlugins
     muid <-
         case kconfigSetuid of
             Nothing -> return Nothing
             Just t -> do
-                x <- try $
+                x <- liftIO $ try $
                     case Data.Text.Read.decimal t of
                         Right (i, "") -> getUserEntryForID i
                         _ -> getUserEntryForName $ T.unpack t
@@ -137,24 +165,22 @@
             , ascHostManager = hostman
             , ascPortPool = portpool
             , ascPlugins = plugins
-            , ascLog = log
-            , ascKeterConfig = kc
+            , ascKeterConfig = cfg
             }
-    appMan <- AppMan.initialize log appStartConfig
-    f kc hostman appMan log
-
-launchInitial :: KeterConfig -> AppMan.AppManager -> IO ()
-launchInitial kc@KeterConfig {..} appMan = do
-    createDirectoryIfMissing True incoming
-    bundles0 <- filter isKeter <$> listDirectoryTree incoming
-    mapM_ (AppMan.addApp appMan) bundles0
+    appMan <- withMappedConfig (const appStartConfig) $ AppMan.initialize
+    f hostman appMan
 
-    unless (V.null kconfigBuiltinStanzas) $ AppMan.perform
-        appMan
-        AIBuiltin
-        (AppMan.Reload $ AIData $ BundleConfig kconfigBuiltinStanzas mempty)
-  where
-    incoming = getIncoming kc
+launchInitial :: AppMan.AppManager -> KeterM KeterConfig ()
+launchInitial appMan = do
+    kc@KeterConfig{..} <- ask
+    let incoming = getIncoming kc
+    liftIO $ createDirectoryIfMissing True incoming
+    bundles0 <- liftIO $ filter isKeter <$> listDirectoryTree incoming
+    withMappedConfig (const appMan) $ do
+        mapM_ AppMan.addApp bundles0
+        unless (V.null kconfigBuiltinStanzas) $ AppMan.perform
+            AIBuiltin
+            (AppMan.Reload $ AIData $ BundleConfig kconfigBuiltinStanzas mempty)
 
 getIncoming :: KeterConfig -> FilePath
 getIncoming kc = kconfigDir kc </> "incoming"
@@ -162,38 +188,37 @@
 isKeter :: FilePath -> Bool
 isKeter fp = takeExtension fp == ".keter"
 
-startWatching :: KeterConfig -> AppMan.AppManager -> (LogMessage -> IO ()) -> IO ()
-startWatching kc appMan log = do
+startWatching :: AppMan.AppManager -> KeterM KeterConfig ()
+startWatching appMan = do
+    incoming <- getIncoming <$> ask
     -- File system watching
-    wm <- FSN.startManager
-    _ <- FSN.watchTree wm (fromString incoming) (const True) $ \e -> do
-        e' <-
-            case e of
-                FSN.Removed fp _ _ -> do
-                    log $ WatchedFile "removed" (fromFilePath fp)
-                    return $ Left $ fromFilePath fp
-                FSN.Added fp _ _ -> do
-                    log $ WatchedFile "added" (fromFilePath fp)
-                    return $ Right $ fromFilePath fp
-                FSN.Modified fp _ _ -> do
-                    log $ WatchedFile "modified" (fromFilePath fp)
-                    return $ Right $ fromFilePath fp
-                _ -> do
-                    log $ WatchedFile "unknown" []
-                    return $ Left []
-        case e' of
-            Left fp -> when (isKeter fp) $ AppMan.terminateApp appMan $ getAppname fp
-            Right fp -> when (isKeter fp) $ AppMan.addApp appMan $ incoming </> fp
-
-    -- Install HUP handler for cases when inotify cannot be used.
-    void $ flip (installHandler sigHUP) Nothing $ Catch $ do
-        bundles <- fmap (filter isKeter) $ listDirectoryTree incoming
-        newMap <- fmap Map.fromList $ forM bundles $ \bundle -> do
-            time <- modificationTime <$> getFileStatus bundle
-            return (getAppname bundle, (bundle, time))
-        AppMan.reloadAppList appMan newMap
-  where
-    incoming = getIncoming kc
+    wm <- liftIO FSN.startManager
+    withMappedConfig (const appMan) $ withRunInIO $ \rio -> do
+        _ <- FSN.watchTree wm (fromString incoming) (const True) $ \e -> do
+                e' <-
+                    case e of
+                        FSN.Removed fp _ _ -> do
+                            rio $ $logInfo $ "Watched file removed: " <> T.pack (fromFilePath fp)
+                            return $ Left $ fromFilePath fp
+                        FSN.Added fp _ _ -> do
+                            rio $ $logInfo $ "Watched file added: " <> T.pack (fromFilePath fp)
+                            return $ Right $ fromFilePath fp
+                        FSN.Modified fp _ _ -> do
+                            rio $ $logInfo $ "Watched file modified: " <> T.pack (fromFilePath fp)
+                            return $ Right $ fromFilePath fp
+                        _ -> do
+                            rio $ $logInfo $ "Watched file unknown" <> T.pack mempty
+                            return $ Left []
+                rio $ case e' of
+                    Left fp -> when (isKeter fp) $ AppMan.terminateApp $ getAppname fp
+                    Right fp -> when (isKeter fp) $ AppMan.addApp $ incoming </> fp
+        -- Install HUP handler for cases when inotify cannot be used.
+        void $ flip (installHandler sigHUP) Nothing $ Catch $ do
+            bundles <- fmap (filter isKeter) $ listDirectoryTree incoming
+            newMap <- fmap Map.fromList $ forM bundles $ \bundle -> do
+                time <- modificationTime <$> getFileStatus bundle
+                return (getAppname bundle, (bundle, time))
+            rio $ AppMan.reloadAppList newMap
 
 
 -- compatibility with older versions of fsnotify which used
@@ -219,10 +244,14 @@
              return [fp1]
            ) (filter (\x -> x /= "." && x /= "..") dir)
 
-startListening :: (LogMessage -> IO ()) -> KeterConfig -> HostMan.HostManager -> IO ()
-startListening log config hostman = do
-    settings <- Proxy.makeSettings log config hostman
-    runAndBlock (kconfigListeners config) $ Proxy.reverseProxy settings
+startListening :: HostMan.HostManager -> KeterM KeterConfig ()
+startListening hostman = do
+    cfg@KeterConfig{..} <- ask
+    logger <- askLoggerIO
+    settings <- Proxy.makeSettings hostman
+    withMappedConfig (const settings) $ withRunInIO $ \rio ->
+        liftIO $ runAndBlock kconfigListeners $ \ls -> 
+            rio $ Proxy.reverseProxy ls
 
 runAndBlock :: NonEmptyVector a
             -> (a -> IO ())
diff --git a/src/Keter/PortPool.hs b/src/Keter/PortPool.hs
--- a/src/Keter/PortPool.hs
+++ b/src/Keter/PortPool.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
 -- | Manages a pool of available ports and allocates them.
 module Keter.PortPool
     ( -- * Types
@@ -13,9 +14,14 @@
     ) where
 
 import           Keter.Common
+import           Keter.Context
+import           Data.Text           (pack)
 import           Control.Applicative     ((<$>))
 import           Control.Concurrent.MVar
 import           Control.Exception
+import           Control.Monad.IO.Class (liftIO)
+import           Control.Monad.IO.Unlift (withRunInIO)
+import           Control.Monad.Logger
 import           Keter.Config
 import           Network.Socket
 import           Prelude                 hiding (log)
@@ -28,28 +34,31 @@
 newtype PortPool = PortPool (MVar PPState)
 
 -- | Gets an unassigned port number.
-getPort :: (LogMessage -> IO ())
-        -> PortPool
-        -> IO (Either SomeException Port)
-getPort log (PortPool mstate) =
-    modifyMVar mstate loop
+getPort :: PortPool
+        -> KeterM cfg (Either SomeException Port)
+getPort (PortPool mstate) =
+    withRunInIO $ \rio -> modifyMVar mstate (rio . loop)
   where
-    loop :: PPState -> IO (PPState, Either SomeException Port)
+    removePortMsg p = pack $
+        "Port in use, removing from port pool: "
+        ++ show p
+
+    loop :: PPState -> KeterM cfg (PPState, Either SomeException Port)
     loop PPState {..} =
         case ppAvail of
             p:ps -> do
                 let next = PPState ps ppRecycled
-                res <- try $ listenOn $ show p
+                res <- liftIO $ try $ listenOn $ show p
                 case res of
                     Left (_ :: SomeException) -> do
-                        log $ RemovingPort p
+                        $logInfo $ removePortMsg p
                         loop next
                     Right socket' -> do
-                        res' <- try $ close socket'
+                        res' <- liftIO $ try @SomeException $ close socket'
                         case res' of
                             Left e -> do
-                                $logEx log e
-                                log $ RemovingPort p
+                                $logError $ pack $ show e
+                                $logInfo $ removePortMsg p
                                 loop next
                             Right () -> return (next, Right p)
             [] ->
diff --git a/src/Keter/Proxy.hs b/src/Keter/Proxy.hs
--- a/src/Keter/Proxy.hs
+++ b/src/Keter/Proxy.hs
@@ -17,6 +17,8 @@
 import           Blaze.ByteString.Builder          (copyByteString, toByteString)
 import           Blaze.ByteString.Builder.Html.Word(fromHtmlEscapedByteString)
 import           Control.Applicative               ((<$>), (<|>))
+import           Control.Monad.Reader              (ask)
+import           Control.Monad.IO.Unlift           (withRunInIO)
 import           Control.Monad.IO.Class            (liftIO)
 import qualified Data.ByteString                   as S
 import qualified Data.ByteString.Char8             as S8
@@ -24,6 +26,7 @@
 import           Network.Wai.Middleware.Gzip       (def)
 #endif
 import           Data.Monoid                       (mappend, mempty)
+import           Data.Text                         (pack)
 import           Data.Text.Encoding                (decodeUtf8With, encodeUtf8)
 import           Data.Text.Encoding.Error          (lenientDecode)
 import qualified Data.Vector                       as V
@@ -52,6 +55,7 @@
 import           Data.ByteString            (ByteString)
 import Keter.Common
 import           System.FilePath            (FilePath)
+import           Control.Monad.Logger
 import           Control.Exception          (SomeException)
 import           Network.HTTP.Types                (mkStatus,
                                                     status301, status302,
@@ -68,6 +72,7 @@
 import           WaiAppStatic.Listing              (defaultListing)
 import qualified Network.TLS as TLS
 import qualified System.Directory as Dir
+import Keter.Context
 
 #if !MIN_VERSION_http_reverse_proxy(0,6,0)
 defaultWaiProxySettings = def
@@ -87,30 +92,29 @@
   , psUnkownHost     :: ByteString -> ByteString
   , psMissingHost    :: ByteString
   , psProxyException :: ByteString
-  , psLogException   :: Wai.Request -> SomeException -> IO ()
   }
 
-makeSettings :: (LogMessage -> IO ()) -> KeterConfig -> HostMan.HostManager -> IO ProxySettings
-makeSettings log KeterConfig {..} hostman = do
-    psManager <- HTTP.newManager HTTP.tlsManagerSettings
+makeSettings :: HostMan.HostManager -> KeterM KeterConfig ProxySettings
+makeSettings hostman = do
+    KeterConfig{..} <- ask
+    psManager <- liftIO $ HTTP.newManager HTTP.tlsManagerSettings
     psMissingHost <- case kconfigMissingHostResponse of
       Nothing -> pure defaultMissingHostBody
-      Just x -> taggedReadFile "unknown-host-response-file" x
+      Just x -> liftIO $ taggedReadFile "unknown-host-response-file" x
     psUnkownHost <- case kconfigUnknownHostResponse  of
                 Nothing -> pure defaultUnknownHostBody
-                Just x -> const <$> taggedReadFile "missing-host-response-file" x
+                Just x ->  fmap const $ liftIO $ taggedReadFile "missing-host-response-file" x
     psProxyException <- case kconfigProxyException of
                 Nothing -> pure defaultProxyException
-                Just x -> taggedReadFile "proxy-exception-response-file" x
+                Just x -> liftIO $ taggedReadFile "proxy-exception-response-file" x
+    -- calculate the number of microseconds since the
+    -- configuration option is in milliseconds
+    let psConnectionTimeBound = kconfigConnectionTimeBound * 1000
+    let psIpFromHeader = kconfigIpFromHeader
     pure $ MkProxySettings{..}
     where
-        psLogException a b = log $ ProxyException a b
         psHostLookup = HostMan.lookupAction hostman . CI.mk
 
-        -- | calculate the number of microseconds since the
-        --   configuration option is in milliseconds
-        psConnectionTimeBound = kconfigConnectionTimeBound * 1000
-        psIpFromHeader   = kconfigIpFromHeader
 
 taggedReadFile :: String -> FilePath -> IO ByteString
 taggedReadFile tag file = do
@@ -119,20 +123,23 @@
           wd <- Dir.getCurrentDirectory
           error $ "could not find " <> tag <> " on path '" <> file <> "' with working dir '" <> wd <> "'"
 
-reverseProxy :: ProxySettings -> ListeningPort -> IO ()
-reverseProxy settings listener =
-    run $ gzip def{gzipFiles = GzipPreCompressed GzipIgnore} $ withClient isSecure settings
+reverseProxy :: ListeningPort -> KeterM ProxySettings ()
+reverseProxy listener = do
+  settings <- ask
+  let (run, isSecure) =
+          case listener of
+              LPInsecure host port -> 
+                  (liftIO . Warp.runSettings (warp host port), False)
+              LPSecure host port cert chainCerts key session -> 
+                  (liftIO . WarpTLS.runTLS
+                      (connectClientCertificates (psHostLookup settings) session $ WarpTLS.tlsSettingsChain
+                          cert
+                          (V.toList chainCerts)
+                          key)
+                      (warp host port), True)
+  withClient isSecure >>= run . gzip def{gzipFiles = GzipPreCompressed GzipIgnore}
   where
     warp host port = Warp.setHost host $ Warp.setPort port Warp.defaultSettings
-    (run, isSecure) =
-        case listener of
-            LPInsecure host port -> (Warp.runSettings (warp host port), False)
-            LPSecure host port cert chainCerts key session -> (WarpTLS.runTLS
-                (connectClientCertificates (psHostLookup settings) session $ WarpTLS.tlsSettingsChain
-                    cert
-                    (V.toList chainCerts)
-                    key)
-                (warp host port), True)
 
 connectClientCertificates :: (ByteString -> IO (Maybe (ProxyAction, TLS.Credentials))) -> Bool -> WarpTLS.TLSSettings -> WarpTLS.TLSSettings
 connectClientCertificates hl session s =
@@ -148,37 +155,37 @@
           , WarpTLS.tlsSessionManagerConfig = if session then (Just TLSSession.defaultConfig) else Nothing }
 
 
-
 withClient :: Bool -- ^ is secure?
-           -> ProxySettings
-           -> Wai.Application
-withClient isSecure MkProxySettings {..} =
-    waiProxyToSettings
-       (error "First argument to waiProxyToSettings forced, even thought wpsGetDest provided")
-       defaultWaiProxySettings
-        { wpsSetIpHeader =
-            if useHeader
-                then SIHFromHeader
-                else SIHFromSocket
-        ,  wpsGetDest = Just getDest
-        ,  wpsOnExc = handleProxyException psLogException psProxyException
-        } psManager
+           -> KeterM ProxySettings Wai.Application
+withClient isSecure = do
+    cfg@MkProxySettings{..} <- ask
+    let useHeader = psIpFromHeader
+    withRunInIO $ \rio ->
+        pure $ waiProxyToSettings
+           (error "First argument to waiProxyToSettings forced, even thought wpsGetDest provided")
+           defaultWaiProxySettings
+            { wpsSetIpHeader =
+                if useHeader
+                    then SIHFromHeader
+                    else SIHFromSocket
+            ,  wpsGetDest = Just (getDest cfg)
+            ,  wpsOnExc = handleProxyException (\app e -> rio $ logException app e) psProxyException
+            } psManager
   where
-    useHeader :: Bool
-    useHeader = psIpFromHeader
+    logException :: Wai.Request -> SomeException -> KeterM ProxySettings ()
+    logException a b = logErrorN $ pack $ 
+      "Got a proxy exception on request " <> show a <> " with exception "  <> show b
 
-    bound :: Int
-    bound = psConnectionTimeBound
 
-    getDest :: Wai.Request -> IO (LocalWaiProxySettings, WaiProxyResponse)
-    getDest req =
+    getDest :: ProxySettings -> Wai.Request -> IO (LocalWaiProxySettings, WaiProxyResponse)
+    getDest cfg@MkProxySettings{..} req =
         case Wai.requestHeaderHost req of
             Nothing -> do
               return (defaultLocalWaiProxySettings, WPRResponse $ missingHostResponse psMissingHost)
-            Just host -> processHost req host
+            Just host -> processHost cfg req host
 
-    processHost :: Wai.Request -> S.ByteString -> IO (LocalWaiProxySettings, WaiProxyResponse)
-    processHost req host = do
+    processHost :: ProxySettings -> Wai.Request -> S.ByteString -> IO (LocalWaiProxySettings, WaiProxyResponse)
+    processHost cfg@MkProxySettings{..} req host = do
         -- Perform two levels of lookup. First: look up the entire host. If
         -- that fails, try stripping off any port number and try again.
         mport <- liftIO $ do
@@ -194,11 +201,11 @@
             Nothing -> do -- we don't know the host that was asked for
               return (defaultLocalWaiProxySettings, WPRResponse $ unknownHostResponse host (psUnkownHost host))
             Just ((action, requiresSecure), _)
-                | requiresSecure && not isSecure -> performHttpsRedirect host req
-                | otherwise -> performAction psManager isSecure bound req action
+                | requiresSecure && not isSecure -> performHttpsRedirect cfg host req
+                | otherwise -> performAction psManager isSecure psConnectionTimeBound req action
 
-    performHttpsRedirect host =
-        return . (addjustGlobalBound bound Nothing,) . WPRResponse . redirectApp config
+    performHttpsRedirect MkProxySettings{..} host =
+        return . (addjustGlobalBound psConnectionTimeBound Nothing,) . WPRResponse . redirectApp config
       where
         host' = CI.mk $ decodeUtf8With lenientDecode host
         config = RedirectConfig
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,27 +1,28 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module Main where
 
-import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout)
 import Network.HTTP.Types.Status(ok200)
 import qualified Network.Wai.Handler.Warp as Warp
 import Keter.Config.V10
-import           Control.Concurrent        (forkIO)
+import           Control.Concurrent        (forkIO, threadDelay)
 import Data.Maybe (isJust)
 import Keter.LabelMap as LM
 import Test.Tasty
 import Test.Tasty.HUnit
 import Control.Monad
+import Control.Monad.Reader
+import Control.Monad.Logger
 import           Control.Exception          (SomeException)
 import           Network.HTTP.Conduit              (Manager)
-import Control.Lens
-import Network.Wreq(Options)
 import Data.ByteString(ByteString)
 import qualified Network.Wreq as Wreq
 import Control.Monad.STM
 import Control.Concurrent.STM.TQueue
 import qualified Network.Wai                       as Wai
 import qualified Network.HTTP.Conduit      as HTTP
+import Keter.Context
 import Keter.Proxy
 
 main :: IO ()
@@ -32,8 +33,8 @@
   testGroup
     "Tests"
     [ testCase "Subdomain Integrity" caseSubdomainIntegrity
-    , testCase "Head then post doesn't crash" headThenPostNoCrash
     , testCase "Wildcard Domains" caseWildcards
+    , testCase "Head then post doesn't crash" headThenPostNoCrash
     ]
 
 caseSubdomainIntegrity :: IO ()
@@ -58,15 +59,21 @@
 headThenPostNoCrash = do
   manager <- HTTP.newManager HTTP.tlsManagerSettings
   exceptions <- newTQueueIO
-
+  
   forkIO $ do
     Warp.run 6781 $ \req resp -> do
       void $ Wai.strictRequestBody req
       resp $ Wai.responseLBS ok200 [] "ok"
 
-  forkIO $ do
-    reverseProxy (settings exceptions manager) $ LPInsecure "*" 6780
+  forkIO $ 
+    flip runReaderT (settings manager) $ 
+      flip runLoggingT (\_ _ _ msg -> atomically $ writeTQueue exceptions msg) $
+        filterLogger isException $ 
+          runKeterM $ 
+            reverseProxy $ LPInsecure "*" 6780
 
+  threadDelay 0_100_000
+
   res <- Wreq.head_ "http://localhost:6780"
 
   void $ Wreq.post "http://localhost:6780" content
@@ -76,16 +83,19 @@
   where
     content :: ByteString
     content = "a"
+    
+    -- For 'reverseProxy', only exceptions (and strictly exceptions!) are logged as LevelError.
+    isException :: LogSource -> LogLevel -> Bool
+    isException _ LevelError = True
+    isException _ _ = False
 
-    settings :: TQueue (Wai.Request, SomeException) ->  Manager -> ProxySettings
-    settings expections manager = MkProxySettings {
+    settings :: Manager -> ProxySettings
+    settings manager = MkProxySettings {
         psHostLookup     = const $ pure $ Just ((PAPort 6781 Nothing, False), error "unused tls certificate")
       , psManager        = manager
       , psUnkownHost     = const ""
       , psMissingHost    = ""
       , psProxyException = ""
-      , psLogException   = \req exception ->
-          atomically $ writeTQueue expections (req, exception)
       , psIpFromHeader   = False
       , psConnectionTimeBound = 5 * 60 * 1000
       }
