{- |
Copyright:  (c) 2018-2022 Kowainik, 2023 Co-Log
SPDX-License-Identifier: MPL-2.0
Stability:  experimental

__NOTE:__ This functionality is not to be considered stable
or ready for production use. While we enourage you
to try it out and report bugs, we cannot assure you
that everything will work as advertised :)
-}

module Colog.Rotation
       ( Limit(..)
       , withLogRotation
       ) where

import Control.Monad (when, (>=>))
import Control.Monad.IO.Class (MonadIO (..))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List (isPrefixOf)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe, mapMaybe)
import Numeric.Natural (Natural)
import System.FilePath.Posix ((<.>))
import System.IO (Handle, IOMode (AppendMode), hClose, hFileSize, openFile)
import Text.Read (readMaybe)

import Colog.Core.Action (LogAction (..), (<&))

import qualified Data.List.NonEmpty as NE
import qualified System.Directory as D
import qualified System.FilePath.Posix as POS


{- | Limit for the logger rotation. Used for two purposes:

1. Limit the number of kept files.
2. Limit the size of the files.
-}
data Limit
    = LimitTo Natural
    | Unlimited
    deriving stock (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
/= :: Limit -> Limit -> Bool
Eq, Eq Limit
Eq Limit =>
(Limit -> Limit -> Ordering)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Bool)
-> (Limit -> Limit -> Limit)
-> (Limit -> Limit -> Limit)
-> Ord Limit
Limit -> Limit -> Bool
Limit -> Limit -> Ordering
Limit -> Limit -> Limit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Limit -> Limit -> Ordering
compare :: Limit -> Limit -> Ordering
$c< :: Limit -> Limit -> Bool
< :: Limit -> Limit -> Bool
$c<= :: Limit -> Limit -> Bool
<= :: Limit -> Limit -> Bool
$c> :: Limit -> Limit -> Bool
> :: Limit -> Limit -> Bool
$c>= :: Limit -> Limit -> Bool
>= :: Limit -> Limit -> Bool
$cmax :: Limit -> Limit -> Limit
max :: Limit -> Limit -> Limit
$cmin :: Limit -> Limit -> Limit
min :: Limit -> Limit -> Limit
Ord, Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
(Int -> Limit -> ShowS)
-> (Limit -> String) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limit -> ShowS
showsPrec :: Int -> Limit -> ShowS
$cshow :: Limit -> String
show :: Limit -> String
$cshowList :: [Limit] -> ShowS
showList :: [Limit] -> ShowS
Show)

{- | Logger rotation action. Takes name of the logging file @file.foo@. Always
writes new logs to file named @file.foo@ (given file name, also called as /hot log/).

* If the size of the file exceeds given limit for file sizes then this action
  renames @file.foo@ to @file.foo.(n + 1)@ (where @n@ is the number of latest
  renamed file).
* If the number of files on the filesystem is bigger than the files number limit
  then the given @FilePath -> IO ()@ action is called on the oldest file. As
  simple solution, you can pass @removeFile@ function to delete old files but
  you can also pass some archiving function if you don't want to lose old logs.
-}
withLogRotation
    :: forall r msg m .
       MonadIO m
    => Limit
    -- ^ Max allowed file size in bytes
    -> Limit
    -- ^ Max allowed number of files to have
    -> FilePath
    -- ^ File path to log
    -> (FilePath -> IO ())
    -- ^ What to do with old files; pass @removeFile@ here for deletion
    -> (Handle -> LogAction m msg)
    -- ^ Action that writes to file handle
    -> (LogAction m msg -> IO r)
    -- ^ Continuation action
    -> IO r
withLogRotation :: forall r msg (m :: * -> *).
MonadIO m =>
Limit
-> Limit
-> String
-> (String -> IO ())
-> (Handle -> LogAction m msg)
-> (LogAction m msg -> IO r)
-> IO r
withLogRotation Limit
sizeLimit Limit
filesLimit String
path String -> IO ()
cleanup Handle -> LogAction m msg
mkAction LogAction m msg -> IO r
cont = do
    -- TODO: figure out how to use bracket to safely manage
    -- possible exceptions
    Handle
handle <- String -> IOMode -> IO Handle
openFile String
path IOMode
AppendMode
    IORef Handle
handleRef <- Handle -> IO (IORef Handle)
forall a. a -> IO (IORef a)
newIORef Handle
handle
    LogAction m msg -> IO r
cont (LogAction m msg -> IO r) -> LogAction m msg -> IO r
forall a b. (a -> b) -> a -> b
$ IORef Handle -> LogAction m msg
rotationAction IORef Handle
handleRef
  where
    rotationAction :: IORef Handle -> LogAction m msg
    rotationAction :: IORef Handle -> LogAction m msg
rotationAction IORef Handle
refHandle = (msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> LogAction m msg)
-> (msg -> m ()) -> LogAction m msg
forall a b. (a -> b) -> a -> b
$ \msg
msg -> do
        Handle
handle <- IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ IORef Handle -> IO Handle
forall a. IORef a -> IO a
readIORef IORef Handle
refHandle
        Handle -> LogAction m msg
mkAction Handle
handle LogAction m msg -> msg -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& msg
msg

        Bool
isLimitReached <- Limit -> Handle -> m Bool
forall (m :: * -> *). MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached Limit
sizeLimit Handle
handle
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLimitReached (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef Handle -> m ()
cleanupAndRotate IORef Handle
refHandle

    cleanupAndRotate :: IORef Handle -> m ()
    cleanupAndRotate :: IORef Handle -> m ()
cleanupAndRotate IORef Handle
refHandle = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      IORef Handle -> IO Handle
forall a. IORef a -> IO a
readIORef IORef Handle
refHandle IO Handle -> (Handle -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose
      Natural
maxN <- String -> IO Natural
maxFileIndex String
path
      Natural -> String -> IO ()
renameFileToNumber (Natural
maxN Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) String
path
      [String]
oldFiles <- Limit -> String -> IO [String]
getOldFiles Limit
filesLimit String
path
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
cleanup [String]
oldFiles
      Handle
newHandle <- String -> IOMode -> IO Handle
openFile String
path IOMode
AppendMode
      IORef Handle -> Handle -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Handle
refHandle Handle
newHandle

-- Checks whether an input is strictly larger than the limit
isLimitedBy :: Integer -> Limit -> Bool
isLimitedBy :: Integer -> Limit -> Bool
isLimitedBy Integer
_ Limit
Unlimited = Bool
False
isLimitedBy Integer
size (LimitTo Natural
limit)
  | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Bool
False
  | Bool
otherwise = Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
limit

isFileSizeLimitReached :: forall m . MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached :: forall (m :: * -> *). MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached Limit
limit Handle
handle = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
  Integer
fileSize <- Handle -> IO Integer
hFileSize Handle
handle
  Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Integer -> Limit -> Bool
isLimitedBy Integer
fileSize Limit
limit

-- if you have files node.log.0, node.log.1 and node.log.2 then this function
-- will return `2` if you give it `node.log`
maxFileIndex :: FilePath -> IO Natural
maxFileIndex :: String -> IO Natural
maxFileIndex String
path = do
  [String]
files <- String -> IO [String]
D.listDirectory (ShowS
POS.takeDirectory String
path)
  let logFiles :: [String]
logFiles = String -> [String] -> [String]
getLogFiles String
path [String]
files
  let maxFile :: Maybe Natural
maxFile = NonEmpty Natural -> Natural
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Natural -> Natural)
-> Maybe (NonEmpty Natural) -> Maybe Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural] -> Maybe (NonEmpty Natural)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((String -> Maybe Natural) -> [String] -> [Natural]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Natural
logFileIndex [String]
logFiles)
  Natural -> IO Natural
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> IO Natural) -> Natural -> IO Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 Maybe Natural
maxFile

getLogFiles :: FilePath -> [FilePath] -> [FilePath]
getLogFiles :: String -> [String] -> [String]
getLogFiles String
logPath = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> ShowS
POS.takeFileName String
logPath String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ShowS
POS.takeFileName String
p)

-- given number 4 and path `node.log` renames file `node.log` to `node.log.4`
renameFileToNumber :: Natural -> FilePath -> IO ()
renameFileToNumber :: Natural -> String -> IO ()
renameFileToNumber Natural
n String
path = String -> String -> IO ()
D.renameFile String
path (String
path String -> ShowS
<.> Natural -> String
forall a. Show a => a -> String
show Natural
n)

-- if you give it name like `node.log.4` then it returns `Just 4`
logFileIndex :: FilePath -> Maybe Natural
logFileIndex :: String -> Maybe Natural
logFileIndex String
path = String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (ShowS
POS.takeExtension String
path) Maybe (NonEmpty Char)
-> (NonEmpty Char -> Maybe Natural) -> Maybe Natural
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Natural
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Natural)
-> (NonEmpty Char -> String) -> NonEmpty Char -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.tail

-- creates list of files with indices who are older on given Limit than the latest one
getOldFiles :: Limit -> FilePath -> IO [FilePath]
getOldFiles :: Limit -> String -> IO [String]
getOldFiles Limit
limit String
path = do
    Natural
currentMaxN <- String -> IO Natural
maxFileIndex String
path
    [String]
files <- String -> IO [String]
D.listDirectory (ShowS
POS.takeDirectory String
path)
    let logFiles :: [String]
logFiles = String -> [String] -> [String]
getLogFiles String
path [String]
files
    [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (String, Natural)
takeFileIndex (String -> Maybe (String, Natural))
-> ((String, Natural) -> Maybe String) -> String -> Maybe String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Natural -> (String, Natural) -> Maybe String
guardFileIndex Natural
currentMaxN) [String]
logFiles
  where
    takeFileIndex  :: FilePath -> Maybe (FilePath, Natural)
    takeFileIndex :: String -> Maybe (String, Natural)
takeFileIndex String
p = (Natural -> (String, Natural))
-> Maybe Natural -> Maybe (String, Natural)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
p,) (String -> Maybe Natural
logFileIndex String
p)

    guardFileIndex :: Natural -> (FilePath, Natural) -> Maybe FilePath
    guardFileIndex :: Natural -> (String, Natural) -> Maybe String
guardFileIndex Natural
maxN (String
p, Natural
n)
      | Natural -> Natural -> Bool
isOldFile Natural
maxN Natural
n = String -> Maybe String
forall a. a -> Maybe a
Just String
p
      | Bool
otherwise       = Maybe String
forall a. Maybe a
Nothing

    isOldFile :: Natural -> Natural -> Bool
    isOldFile :: Natural -> Natural -> Bool
isOldFile Natural
maxN Natural
n = case Limit
limit of
                         Limit
Unlimited -> Bool
False
                         LimitTo Natural
l -> Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
l Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
maxN