0 | ||| Size-based rotation for file-backed loggers.
  1 | |||
  2 | ||| `withRotatingLogFile` is a continuation-style entry point that gives
  3 | ||| the user a `LogAction` writing to a file. When the file's size exceeds
  4 | ||| a configured limit, the action rotates the file (renaming
  5 | ||| `app.log` to `app.log.1`, shifting older files up, and deleting
  6 | ||| anything beyond a count limit), then continues writing to a fresh
  7 | ||| file at the original path.
  8 | module Log4Types.File.Rotation
  9 |
 10 | import Data.IORef
 11 | import System.File
 12 | import System.File.Meta
 13 | import Log4Types.Core
 14 | import Log4Types.File
 15 |
 16 | %default total
 17 |
 18 | ----------------------------------------------------------------------
 19 | -- FFI for renameFile
 20 | ----------------------------------------------------------------------
 21 |
 22 | %foreign "C:rename,libc 6"
 23 |          "node:lambda:(from, to) => { try { require('fs').renameSync(from, to); return 0; } catch (e) { return -1; } }"
 24 | prim__rename : (from : String) -> (to : String) -> PrimIO Int
 25 |
 26 | ||| Rename a file. Returns `Left` on failure (most often: source missing or
 27 | ||| permission denied). The `FileError` is `GenericFileError` carrying the
 28 | ||| platform's raw return code, since structured errnos are not available
 29 | ||| across all backends.
 30 | export
 31 | renameFile : HasIO io => (from : String) -> (to : String) -> io (Either FileError ())
 32 | renameFile from to = do
 33 |   res <- primIO (prim__rename from to)
 34 |   if res == 0 then pure (Right ()) else pure (Left (GenericFileError res))
 35 |
 36 | ----------------------------------------------------------------------
 37 | -- Configuration
 38 | ----------------------------------------------------------------------
 39 |
 40 | ||| Configuration for size-based file rotation.
 41 | public export
 42 | record RotationConfig where
 43 |   constructor MkRotationConfig
 44 |   ||| Maximum bytes in the current file before rotation triggers.
 45 |   maxBytes : Integer
 46 |   ||| Maximum number of rotated files to keep (file.1, file.2, ...).
 47 |   ||| Files beyond this are deleted after rotation.
 48 |   maxFiles : Nat
 49 |
 50 | ||| Default rotation: 10 MB per file, keep 5 rotated copies.
 51 | public export
 52 | defaultRotation : RotationConfig
 53 | defaultRotation = MkRotationConfig 10_000_000 5
 54 |
 55 | ----------------------------------------------------------------------
 56 | -- Internals
 57 | ----------------------------------------------------------------------
 58 |
 59 | record RotatingState where
 60 |   constructor MkRotatingState
 61 |   basePath  : String
 62 |   config    : RotationConfig
 63 |   handleRef : IORef File
 64 |   bytesRef  : IORef Integer
 65 |
 66 | rotatedPath : String -> Nat -> String
 67 | rotatedPath base i = base ++ "." ++ show i
 68 |
 69 | ||| Rename `base.i` to `base.(i+1)` for `i` from `start` down to 1.
 70 | ||| Pre-existing targets are removed first.
 71 | shiftRotated : HasIO io => (basePath : String) -> (start : Nat) -> io ()
 72 | shiftRotated _    Z     = pure ()
 73 | shiftRotated base (S k) = do
 74 |   let source = rotatedPath base (S k)
 75 |   let target = rotatedPath base (S (S k))
 76 |   ignore $ removeFile target
 77 |   ignore $ renameFile source target
 78 |   shiftRotated base k
 79 |
 80 | rotate : HasIO io => RotatingState -> io ()
 81 | rotate st = do
 82 |   current <- readIORef st.handleRef
 83 |   ignore $ closeFile current
 84 |   case st.config.maxFiles of
 85 |     Z   => pure ()
 86 |     S k => shiftRotated st.basePath k
 87 |   ignore $ renameFile st.basePath (rotatedPath st.basePath 1)
 88 |   Right fresh <- openFile st.basePath WriteTruncate
 89 |     | Left _ => pure ()
 90 |   writeIORef st.handleRef fresh
 91 |   writeIORef st.bytesRef 0
 92 |
 93 | rotateIfNeeded : HasIO io => RotatingState -> io ()
 94 | rotateIfNeeded st = do
 95 |   bytes <- readIORef st.bytesRef
 96 |   when (bytes >= st.config.maxBytes && st.config.maxFiles > 0) (rotate st)
 97 |
 98 | writeAndCount : HasIO io => RotatingState -> String -> io ()
 99 | writeAndCount st msg = do
100 |   current <- readIORef st.handleRef
101 |   ignore $ fPutStrLn current msg
102 |   ignore $ fflush current
103 |   modifyIORef st.bytesRef (+ cast (length msg + 1))
104 |   rotateIfNeeded st
105 |
106 | ----------------------------------------------------------------------
107 | -- Public API
108 | ----------------------------------------------------------------------
109 |
110 | ||| Run a computation with a rotating file-backed `LogAction`.
111 | |||
112 | ||| Writes go to `basePath`. When size exceeds `config.maxBytes`,
113 | ||| `basePath` is renamed to `basePath.1`, previous `.1` becomes `.2`,
114 | ||| and so on up to `config.maxFiles`. Files beyond that count are
115 | ||| deleted on rotation.
116 | |||
117 | ||| Returns `Left FileError` if the initial open failed, otherwise
118 | ||| `Right` with the callback's result.
119 | export
120 | withRotatingLogFile
121 |   :  HasIO io
122 |   => (basePath : String)
123 |   -> (config   : RotationConfig)
124 |   -> (LogAction io String -> io a)
125 |   -> io (Either FileError a)
126 | withRotatingLogFile basePath config k = do
127 |   Right h <- openFile basePath Append
128 |     | Left err => pure (Left err)
129 |   initialBytes <- case !(fileSize h) of
130 |                     Right n => pure (cast {to = Integer} n)
131 |                     Left _  => pure 0
132 |   hRef <- newIORef h
133 |   bRef <- newIORef initialBytes
134 |   let st = MkRotatingState basePath config hRef bRef
135 |   result <- k (MkLogAction (writeAndCount st))
136 |   finalH <- readIORef hRef
137 |   ignore $ closeFile finalH
138 |   pure (Right result)
139 |