{-# 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
  { Logger -> forall a. ToLogStr a => a -> IO ()
loggerLog :: forall a. FL.ToLogStr a => a -> IO ()
  , Logger -> IO ()
loggerClose :: IO () 
  , Logger -> LogType
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 -> String -> IO Logger
createLoggerViaConfig KeterConfig{Bool
Int
String
Maybe Int
Maybe String
Maybe Text
Map Text Text
Vector (Stanza ())
NonEmptyVector ListeningPort
PortSettings
kconfigRotateLogs :: KeterConfig -> Bool
kconfigProxyException :: KeterConfig -> Maybe String
kconfigMissingHostResponse :: KeterConfig -> Maybe String
kconfigUnknownHostResponse :: KeterConfig -> Maybe String
kconfigCliPort :: KeterConfig -> Maybe Int
kconfigConnectionTimeBound :: KeterConfig -> Int
kconfigEnvironment :: KeterConfig -> Map Text Text
kconfigExternalHttpsPort :: KeterConfig -> Int
kconfigExternalHttpPort :: KeterConfig -> Int
kconfigIpFromHeader :: KeterConfig -> Bool
kconfigBuiltinStanzas :: KeterConfig -> Vector (Stanza ())
kconfigSetuid :: KeterConfig -> Maybe Text
kconfigListeners :: KeterConfig -> NonEmptyVector ListeningPort
kconfigPortPool :: KeterConfig -> PortSettings
kconfigDir :: KeterConfig -> String
kconfigRotateLogs :: Bool
kconfigProxyException :: Maybe String
kconfigMissingHostResponse :: Maybe String
kconfigUnknownHostResponse :: Maybe String
kconfigCliPort :: Maybe Int
kconfigConnectionTimeBound :: Int
kconfigEnvironment :: Map Text Text
kconfigExternalHttpsPort :: Int
kconfigExternalHttpPort :: Int
kconfigIpFromHeader :: Bool
kconfigBuiltinStanzas :: Vector (Stanza ())
kconfigSetuid :: Maybe Text
kconfigListeners :: NonEmptyVector ListeningPort
kconfigPortPool :: PortSettings
kconfigDir :: String
..} String
name = do
  let logFile :: String
logFile = String
kconfigDir String -> String -> String
</> String
"log" String -> String -> String
</> String
name String -> String -> String
<.> String
"log"
  let logType :: LogType
logType =
       if Bool
kconfigRotateLogs
         then FileLogSpec -> Int -> LogType
FL.LogFile (String -> FileLogSpec
defaultRotationSpec String
logFile) Int
defaultBufferSize
         else Int -> LogType
FL.LogStderr Int
defaultBufferSize
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
logFile)
  LogType -> (LogStr -> IO (), IO ()) -> Logger
mkLogger LogType
logType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. LogType' v -> IO (v -> IO (), IO ())
FL.newFastLogger LogType
logType
  where
    mkLogger :: LogType -> (LogStr -> IO (), IO ()) -> Logger
mkLogger LogType
logType (LogStr -> IO ()
logFn, IO ()
closeFn) = (forall a. ToLogStr a => a -> IO ()) -> IO () -> LogType -> Logger
Logger (LogStr -> IO ()
logFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg. ToLogStr msg => msg -> LogStr
FL.toLogStr) IO ()
closeFn LogType
logType

defaultRotationSpec :: FilePath -> FL.FileLogSpec
defaultRotationSpec :: String -> FileLogSpec
defaultRotationSpec String
dir =
    String -> Integer -> Int -> FileLogSpec
FL.FileLogSpec String
dir Integer
defaultMaxTotal forall a. Bounded a => a
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 :: Integer
defaultMaxTotal = Integer
5 forall a. Num a => a -> a -> a
* Integer
1024 forall a. Num a => a -> a -> a
* Integer
1024 -- 5 MB

-- | The default log message buffer size
defaultBufferSize :: Int
defaultBufferSize :: Int
defaultBufferSize = Int
256 -- 256 bytes, TODO: Reasonable value?