{- |
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
Eq, Eq 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
min :: Limit -> Limit -> Limit
$cmin :: Limit -> Limit -> Limit
max :: Limit -> Limit -> Limit
$cmax :: Limit -> Limit -> Limit
>= :: Limit -> Limit -> Bool
$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
compare :: Limit -> Limit -> Ordering
$ccompare :: Limit -> Limit -> Ordering
Ord, Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> String
$cshow :: Limit -> String
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> 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 <- forall a. a -> IO (IORef a)
newIORef Handle
handle
    LogAction m msg -> IO r
cont 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 = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ \msg
msg -> do
        Handle
handle <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Handle
refHandle
        Handle -> LogAction m msg
mkAction Handle
handle forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& msg
msg

        Bool
isLimitReached <- forall (m :: * -> *). MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached Limit
sizeLimit Handle
handle
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLimitReached 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      forall a. IORef a -> IO a
readIORef IORef Handle
refHandle 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 forall a. Num a => a -> a -> a
+ Natural
1) String
path
      [String]
oldFiles <- Limit -> String -> IO [String]
getOldFiles Limit
filesLimit String
path
      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
      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 forall a. Ord a => a -> a -> Bool
<= Integer
0 = Bool
False
  | Bool
otherwise = Integer
size forall a. Ord a => a -> a -> Bool
> 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Integer
fileSize <- Handle -> IO Integer
hFileSize Handle
handle
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Natural
logFileIndex [String]
logFiles)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Natural
0 Maybe Natural
maxFile

getLogFiles :: FilePath -> [FilePath] -> [FilePath]
getLogFiles :: String -> [String] -> [String]
getLogFiles String
logPath = forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> ShowS
POS.takeFileName String
logPath 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
<.> 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 = forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (ShowS
POS.takeExtension String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (String, Natural)
takeFileIndex 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 = 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 = forall a. a -> Maybe a
Just String
p
      | Bool
otherwise       = 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 forall a. Num a => a -> a -> a
+ Natural
l forall a. Ord a => a -> a -> Bool
< Natural
maxN