{- |
Copyright:  (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>
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
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
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 :: Limit
-> Limit
-> String
-> (String -> IO ())
-> (Handle -> LogAction m msg)
-> (LogAction m msg -> IO r)
-> IO r
withLogRotation sizeLimit :: Limit
sizeLimit filesLimit :: Limit
filesLimit path :: String
path cleanup :: String -> IO ()
cleanup mkAction :: Handle -> LogAction m msg
mkAction cont :: 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 refHandle :: 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
msg -> do
        Handle
handle <- IO Handle -> m Handle
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 refHandle :: IORef Handle
refHandle = IO () -> m ()
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 (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
+ 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 _ Unlimited = Bool
False
isLimitedBy size :: Integer
size (LimitTo limit :: Natural
limit)
  | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 :: Limit -> Handle -> m Bool
isFileSizeLimitReached limit :: Limit
limit handle :: Handle
handle = IO Bool -> m Bool
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 (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 path :: 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 (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 (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 0 Maybe Natural
maxFile

getLogFiles :: FilePath -> [FilePath] -> [FilePath]
getLogFiles :: String -> [String] -> [String]
getLogFiles logPath :: String
logPath = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\p :: 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 n :: Natural
n path :: 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 path :: String
path = (NonEmpty Char -> String) -> Maybe (NonEmpty Char) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.tail (String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (ShowS
POS.takeExtension String
path)) Maybe String -> (String -> Maybe Natural) -> Maybe Natural
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Natural
forall a. Read a => String -> Maybe a
readMaybe

-- 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
limit path :: 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 (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 p :: String
p = (Natural -> (String, Natural))
-> Maybe Natural -> Maybe (String, Natural)
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 maxN :: Natural
maxN (p :: String
p, n :: 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 maxN :: Natural
maxN n :: Natural
n = case Limit
limit of
                         Unlimited -> Bool
False
                         LimitTo l :: 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