{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Keter.Logger
    ( Logger(..)
    , createLoggerViaConfig
    , defaultRotationSpec
    , defaultMaxTotal
    , defaultBufferSize
    ) where

import Control.Monad.IO.Class
import Keter.Config.V10
import System.Directory
import System.FilePath
import System.Log.FastLogger qualified as FL

-- | 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
kconfigDir :: String
kconfigPortPool :: PortSettings
kconfigListeners :: NonEmptyVector ListeningPort
kconfigSetuid :: Maybe Text
kconfigBuiltinStanzas :: Vector (Stanza ())
kconfigIpFromHeader :: Bool
kconfigExternalHttpPort :: Int
kconfigExternalHttpsPort :: Int
kconfigEnvironment :: Map Text Text
kconfigConnectionTimeBound :: Int
kconfigCliPort :: Maybe Int
kconfigUnknownHostResponse :: Maybe String
kconfigMissingHostResponse :: Maybe String
kconfigProxyException :: Maybe String
kconfigRotateLogs :: Bool
kconfigHealthcheckPath :: Maybe Text
kconfigDir :: KeterConfig -> String
kconfigPortPool :: KeterConfig -> PortSettings
kconfigListeners :: KeterConfig -> NonEmptyVector ListeningPort
kconfigSetuid :: KeterConfig -> Maybe Text
kconfigBuiltinStanzas :: KeterConfig -> Vector (Stanza ())
kconfigIpFromHeader :: KeterConfig -> Bool
kconfigExternalHttpPort :: KeterConfig -> Int
kconfigExternalHttpsPort :: KeterConfig -> Int
kconfigEnvironment :: KeterConfig -> Map Text Text
kconfigConnectionTimeBound :: KeterConfig -> Int
kconfigCliPort :: KeterConfig -> Maybe Int
kconfigUnknownHostResponse :: KeterConfig -> Maybe String
kconfigMissingHostResponse :: KeterConfig -> Maybe String
kconfigProxyException :: KeterConfig -> Maybe String
kconfigRotateLogs :: KeterConfig -> Bool
kconfigHealthcheckPath :: KeterConfig -> Maybe Text
..} 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
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
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 ((LogStr -> IO (), IO ()) -> Logger)
-> IO (LogStr -> IO (), IO ()) -> IO Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogType -> IO (LogStr -> IO (), IO ())
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 (LogStr -> IO ()) -> (a -> LogStr) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
FL.toLogStr) IO ()
closeFn LogType
logType

defaultRotationSpec :: FilePath -> FL.FileLogSpec
defaultRotationSpec :: String -> FileLogSpec
defaultRotationSpec String
dir =
    FL.FileLogSpec
      { log_file :: String
log_file = String
dir
      , log_file_size :: Integer
log_file_size = Integer
defaultMaxTotal
      , log_backup_number :: Int
log_backup_number = Int
20
      }

-- | The default total file size before for a log file before it needs to be rotated
defaultMaxTotal :: Integer
defaultMaxTotal :: Integer
defaultMaxTotal = Integer
5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1024 Integer -> Integer -> Integer
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?