{-# LANGUAGE CPP #-}

-- | A log is a stack of entries that supports efficient pushing of new entries
-- and fetching of old. It can be considered an extendible array of entries.
--
module Data.Acid.Log
    ( FileLog(..)
    , LogKey(..)
    , EntryId
    , openFileLog
    , closeFileLog
    , pushEntry
    , pushAction
    , ensureLeastEntryId
    , readEntriesFrom
    , rollbackTo
    , rollbackWhile
    , newestEntry
    , askCurrentEntryId
    , cutFileLog
    , archiveFileLog
    , findLogFiles
    ) where

import Data.Acid.Archive (Archiver(..), Entries(..), entriesToList)
import Data.Acid.Core
import System.Directory
import System.FilePath
import System.IO
import FileIO

import Foreign.Ptr
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Unsafe as Strict
import Data.List                                 ( (\\), stripPrefix, sort )
import Data.Maybe
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid                               ( (<>) )
#endif
import Text.Printf                               ( printf )

import Paths_acid_state                          ( version )
import Data.Version                              ( showVersion )
import Control.Exception                         ( handle, IOException )

type EntryId = Int

data FileLog object
    = FileLog { forall object. FileLog object -> LogKey object
logIdentifier  :: LogKey object
              , forall object. FileLog object -> MVar FHandle
logCurrent     :: MVar FHandle -- Handle
              , forall object. FileLog object -> TVar EntryId
logNextEntryId :: TVar EntryId
              , forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue       :: TVar ([Lazy.ByteString], [IO ()])
              , forall object. FileLog object -> [ThreadId]
logThreads     :: [ThreadId]
              }

data LogKey object
    = LogKey
      { forall object. LogKey object -> String
logDirectory :: FilePath
      , forall object. LogKey object -> String
logPrefix    :: String
      , forall object. LogKey object -> Serialiser object
logSerialiser :: Serialiser object
      , forall object. LogKey object -> Archiver
logArchiver   :: Archiver
      }

formatLogFile :: String -> EntryId -> String
formatLogFile :: String -> EntryId -> String
formatLogFile = String -> String -> EntryId -> String
forall r. PrintfType r => String -> r
printf String
"%s-%010d.log"

findLogFiles :: LogKey object -> IO [(EntryId, FilePath)]
findLogFiles :: forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles LogKey object
identifier = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
identifier)
  [String]
files <- String -> IO [String]
getDirectoryContents (LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
identifier)
  [(EntryId, String)] -> IO [(EntryId, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return  [ (EntryId
tid, LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
identifier String -> String -> String
</> String
file)
          | String
file <- [String]
files
          , String
logFile <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (LogKey object -> String
forall object. LogKey object -> String
logPrefix LogKey object
identifier String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-") String
file)
          , (EntryId
tid, String
".log") <- ReadS EntryId
forall a. Read a => ReadS a
reads String
logFile ]


saveVersionFile :: LogKey object -> IO ()
saveVersionFile :: forall object. LogKey object -> IO ()
saveVersionFile LogKey object
key = do
  Bool
exist <- String -> IO Bool
doesFileExist String
versionFile
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
versionFile (Version -> String
showVersion Version
version)
 where
  versionFile :: String
versionFile = LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
key String -> String -> String
</> LogKey object -> String
forall object. LogKey object -> String
logPrefix LogKey object
key String -> String -> String
<.> String
"version"

openFileLog :: LogKey object -> IO (FileLog object)
openFileLog :: forall object. LogKey object -> IO (FileLog object)
openFileLog LogKey object
identifier = do
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles LogKey object
identifier
  LogKey object -> IO ()
forall object. LogKey object -> IO ()
saveVersionFile LogKey object
identifier
  MVar FHandle
currentState <- IO (MVar FHandle)
forall a. IO (MVar a)
newEmptyMVar
  TVar ([ByteString], [IO ()])
queue <- ([ByteString], [IO ()]) -> IO (TVar ([ByteString], [IO ()]))
forall a. a -> IO (TVar a)
newTVarIO ([], [])
  TVar EntryId
nextEntryRef <- EntryId -> IO (TVar EntryId)
forall a. a -> IO (TVar a)
newTVarIO EntryId
0
  ThreadId
tid1 <- IO ThreadId
myThreadId
  ThreadId
tid2 <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Archiver
-> MVar FHandle
-> TVar ([ByteString], [IO ()])
-> ThreadId
-> IO ()
fileWriter (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) MVar FHandle
currentState TVar ([ByteString], [IO ()])
queue ThreadId
tid1
  let fLog :: FileLog object
fLog = FileLog { logIdentifier :: LogKey object
logIdentifier  = LogKey object
identifier
                     , logCurrent :: MVar FHandle
logCurrent     = MVar FHandle
currentState
                     , logNextEntryId :: TVar EntryId
logNextEntryId = TVar EntryId
nextEntryRef
                     , logQueue :: TVar ([ByteString], [IO ()])
logQueue       = TVar ([ByteString], [IO ()])
queue
                     , logThreads :: [ThreadId]
logThreads     = [ThreadId
tid2] }
  if [(EntryId, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(EntryId, String)]
logFiles
     then do let currentEntryId :: EntryId
currentEntryId = EntryId
0
             FHandle
handle <- String -> IO FHandle
open (LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
identifier String -> String -> String
</> String -> EntryId -> String
formatLogFile (LogKey object -> String
forall object. LogKey object -> String
logPrefix LogKey object
identifier) EntryId
currentEntryId)
             MVar FHandle -> FHandle -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar FHandle
currentState FHandle
handle
     else do let (EntryId
lastFileEntryId, String
lastFilePath) = [(EntryId, String)] -> (EntryId, String)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [(EntryId, String)]
logFiles
             [ByteString]
entries <- Archiver -> String -> IO [ByteString]
readEntities (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) String
lastFilePath
             let currentEntryId :: EntryId
currentEntryId = EntryId
lastFileEntryId EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
+ [ByteString] -> EntryId
forall a. [a] -> EntryId
forall (t :: * -> *) a. Foldable t => t a -> EntryId
length [ByteString]
entries
             STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar EntryId -> EntryId -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar EntryId
nextEntryRef EntryId
currentEntryId
             FHandle
handle <- String -> IO FHandle
open (LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
identifier String -> String -> String
</> String -> EntryId -> String
formatLogFile (LogKey object -> String
forall object. LogKey object -> String
logPrefix LogKey object
identifier) EntryId
currentEntryId)
             MVar FHandle -> FHandle -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar FHandle
currentState FHandle
handle
  FileLog object -> IO (FileLog object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileLog object
fLog

fileWriter :: Archiver -> MVar FHandle -> TVar ([Lazy.ByteString], [IO ()]) -> ThreadId -> IO ()
fileWriter :: Archiver
-> MVar FHandle
-> TVar ([ByteString], [IO ()])
-> ThreadId
-> IO ()
fileWriter Archiver
archiver MVar FHandle
currentState TVar ([ByteString], [IO ()])
queue ThreadId
parentTid = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ([ByteString]
entries, [IO ()]
actions) <- STM ([ByteString], [IO ()]) -> IO ([ByteString], [IO ()])
forall a. STM a -> IO a
atomically (STM ([ByteString], [IO ()]) -> IO ([ByteString], [IO ()]))
-> STM ([ByteString], [IO ()]) -> IO ([ByteString], [IO ()])
forall a b. (a -> b) -> a -> b
$ do
    ([ByteString]
entries, [IO ()]
actions) <- TVar ([ByteString], [IO ()]) -> STM ([ByteString], [IO ()])
forall a. TVar a -> STM a
readTVar TVar ([ByteString], [IO ()])
queue
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
entries Bool -> Bool -> Bool
&& [IO ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IO ()]
actions) STM ()
forall a. STM a
retry
    TVar ([ByteString], [IO ()]) -> ([ByteString], [IO ()]) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ([ByteString], [IO ()])
queue ([], [])
    ([ByteString], [IO ()]) -> STM ([ByteString], [IO ()])
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
entries, [IO ()] -> [IO ()]
forall a. [a] -> [a]
reverse [IO ()]
actions)
  (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\IOException
e -> ThreadId -> IOException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
parentTid (IOException
e :: IOException)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    MVar FHandle -> (FHandle -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar FHandle
currentState ((FHandle -> IO ()) -> IO ()) -> (FHandle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FHandle
fd -> do
      let arch :: ByteString
arch = Archiver -> [ByteString] -> ByteString
archiveWrite Archiver
archiver [ByteString]
entries
      FHandle -> [ByteString] -> IO ()
writeToDisk FHandle
fd (ByteString -> [ByteString]
repack ByteString
arch)
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
actions
  IO ()
yield

-- | Repack a lazy bytestring into larger blocks that can be efficiently written
-- to disk.
repack :: Lazy.ByteString -> [Strict.ByteString]
repack :: ByteString -> [ByteString]
repack = ByteString -> [ByteString]
worker
  where
    worker :: ByteString -> [ByteString]
worker ByteString
bs
      | ByteString -> Bool
Lazy.null ByteString
bs = []
      | Bool
otherwise    = [ByteString] -> ByteString
Strict.concat (ByteString -> [ByteString]
Lazy.toChunks (Int64 -> ByteString -> ByteString
Lazy.take Int64
blockSize ByteString
bs)) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
worker (Int64 -> ByteString -> ByteString
Lazy.drop Int64
blockSize ByteString
bs)
    blockSize :: Int64
blockSize = Int64
4Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
1024

writeToDisk :: FHandle -> [Strict.ByteString] -> IO ()
writeToDisk :: FHandle -> [ByteString] -> IO ()
writeToDisk FHandle
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeToDisk FHandle
handle [ByteString]
xs = do
  (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> IO ()
worker [ByteString]
xs
  FHandle -> IO ()
flush FHandle
handle
 where
  worker :: ByteString -> IO ()
worker ByteString
bs = do
    let len :: EntryId
len = ByteString -> EntryId
Strict.length ByteString
bs
    Word32
count <- ByteString -> (CString -> IO Word32) -> IO Word32
forall a. ByteString -> (CString -> IO a) -> IO a
Strict.unsafeUseAsCString ByteString
bs ((CString -> IO Word32) -> IO Word32)
-> (CString -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \CString
ptr -> FHandle -> Ptr Word8 -> Word32 -> IO Word32
write FHandle
handle (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (EntryId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral EntryId
len)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32 -> EntryId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count EntryId -> EntryId -> Bool
forall a. Ord a => a -> a -> Bool
< EntryId
len) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       ByteString -> IO ()
worker (EntryId -> ByteString -> ByteString
Strict.drop (Word32 -> EntryId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) ByteString
bs)


closeFileLog :: FileLog object -> IO ()
closeFileLog :: forall object. FileLog object -> IO ()
closeFileLog FileLog object
fLog =
  MVar FHandle -> (FHandle -> IO FHandle) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (FileLog object -> MVar FHandle
forall object. FileLog object -> MVar FHandle
logCurrent FileLog object
fLog) ((FHandle -> IO FHandle) -> IO ())
-> (FHandle -> IO FHandle) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FHandle
handle -> do
    FHandle -> IO ()
close FHandle
handle
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ [ThreadId] -> (ThreadId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (FileLog object -> [ThreadId]
forall object. FileLog object -> [ThreadId]
logThreads FileLog object
fLog) ThreadId -> IO ()
killThread
    FHandle -> IO FHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FHandle -> IO FHandle) -> FHandle -> IO FHandle
forall a b. (a -> b) -> a -> b
$ String -> FHandle
forall a. HasCallStack => String -> a
error String
"Data.Acid.Log: FileLog has been closed"

readEntities :: Archiver -> FilePath -> IO [Lazy.ByteString]
readEntities :: Archiver -> String -> IO [ByteString]
readEntities Archiver
archiver String
path = do
  ByteString
archive <- String -> IO ByteString
Lazy.readFile String
path
  [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ Entries -> [ByteString]
entriesToList (Archiver -> ByteString -> Entries
archiveRead Archiver
archiver ByteString
archive)

ensureLeastEntryId :: FileLog object -> EntryId -> IO ()
ensureLeastEntryId :: forall object. FileLog object -> EntryId -> IO ()
ensureLeastEntryId FileLog object
fLog EntryId
youngestEntry = do
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    EntryId
entryId <- TVar EntryId -> STM EntryId
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog)
    TVar EntryId -> EntryId -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog) (EntryId -> EntryId -> EntryId
forall a. Ord a => a -> a -> a
max EntryId
entryId EntryId
youngestEntry)
  FileLog object -> IO EntryId
forall object. FileLog object -> IO EntryId
cutFileLog FileLog object
fLog
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Read all durable entries younger than the given 'EntryId'. Note that
-- entries written during or after this call won't be included in the returned
-- list.
readEntriesFrom :: FileLog object -> EntryId -> IO [object]
readEntriesFrom :: forall object. FileLog object -> EntryId -> IO [object]
readEntriesFrom FileLog object
fLog EntryId
youngestEntry = do
  -- Cut the log so we can read written entries without interfering
  -- with the writing of new entries.
  EntryId
entryCap <- FileLog object -> IO EntryId
forall object. FileLog object -> IO EntryId
cutFileLog FileLog object
fLog
  -- We're interested in these entries: youngestEntry <= x < entryCap.
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles (FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog)
  let sorted :: [(EntryId, String)]
sorted = [(EntryId, String)] -> [(EntryId, String)]
forall a. Ord a => [a] -> [a]
sort [(EntryId, String)]
logFiles
      relevant :: [(EntryId, String)]
relevant = Maybe EntryId
-> Maybe EntryId -> [(EntryId, String)] -> [(EntryId, String)]
filterLogFiles (EntryId -> Maybe EntryId
forall a. a -> Maybe a
Just EntryId
youngestEntry) (EntryId -> Maybe EntryId
forall a. a -> Maybe a
Just EntryId
entryCap) [(EntryId, String)]
sorted
      firstEntryId :: EntryId
firstEntryId = case [(EntryId, String)]
relevant of
                       []                     -> EntryId
0
                       ( (EntryId, String)
logFile : [(EntryId, String)]
_logFiles) -> (EntryId, String) -> EntryId
forall {a} {b}. (a, b) -> a
rangeStart (EntryId, String)
logFile
  -- XXX: Strict bytestrings are used due to a performance bug in
  -- cereal-0.3.5.2 and binary-0.7.1.0. The code should revert back
  -- to lazy bytestrings once the bug has been fixed.
  ByteString
archive <- ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [ByteString] -> ByteString
Lazy.fromChunks (IO [ByteString] -> IO ByteString)
-> IO [ByteString] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ((EntryId, String) -> IO ByteString)
-> [(EntryId, String)] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> IO ByteString
Strict.readFile (String -> IO ByteString)
-> ((EntryId, String) -> String)
-> (EntryId, String)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntryId, String) -> String
forall a b. (a, b) -> b
snd) [(EntryId, String)]
relevant
  let entries :: [ByteString]
entries = Entries -> [ByteString]
entriesToList (Entries -> [ByteString]) -> Entries -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Archiver -> ByteString -> Entries
archiveRead (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) ByteString
archive
  [object] -> IO [object]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([object] -> IO [object]) -> [object] -> IO [object]
forall a b. (a -> b) -> a -> b
$ (ByteString -> object) -> [ByteString] -> [object]
forall a b. (a -> b) -> [a] -> [b]
map (LogKey object -> ByteString -> object
forall object. LogKey object -> ByteString -> object
decode' LogKey object
identifier)
         ([ByteString] -> [object]) -> [ByteString] -> [object]
forall a b. (a -> b) -> a -> b
$ EntryId -> [ByteString] -> [ByteString]
forall a. EntryId -> [a] -> [a]
take (EntryId
entryCap EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
- EntryId
youngestEntry)             -- Take events under the eventCap.
         ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ EntryId -> [ByteString] -> [ByteString]
forall a. EntryId -> [a] -> [a]
drop (EntryId
youngestEntry EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
- EntryId
firstEntryId) [ByteString]
entries -- Drop entries that are too young.
 where
  rangeStart :: (a, b) -> a
rangeStart (a
firstEntryId, b
_path) = a
firstEntryId
  identifier :: LogKey object
identifier = FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog

-- | Obliterate log entries younger than or equal to the 'EntryId'. Very unsafe,
-- can't be undone
rollbackTo :: LogKey object -> EntryId -> IO ()
rollbackTo :: forall object. LogKey object -> EntryId -> IO ()
rollbackTo LogKey object
identifier EntryId
youngestEntry = do
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles LogKey object
identifier
  let sorted :: [(EntryId, String)]
sorted = [(EntryId, String)] -> [(EntryId, String)]
forall a. Ord a => [a] -> [a]
sort [(EntryId, String)]
logFiles
      loop :: [(EntryId, String)] -> IO ()
loop [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      loop ((EntryId
rangeStart, String
path) : [(EntryId, String)]
xs)
        | EntryId
rangeStart EntryId -> EntryId -> Bool
forall a. Ord a => a -> a -> Bool
>= EntryId
youngestEntry = String -> IO ()
removeFile String
path IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(EntryId, String)] -> IO ()
loop [(EntryId, String)]
xs
        | Bool
otherwise = do
            ByteString
archive <- String -> IO ByteString
Strict.readFile String
path
            Handle
pathHandle <- String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode
            let entries :: [ByteString]
entries = Entries -> [ByteString]
entriesToList (Entries -> [ByteString]) -> Entries -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Archiver -> ByteString -> Entries
archiveRead (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) ([ByteString] -> ByteString
Lazy.fromChunks [ByteString
archive])
                entriesToKeep :: [ByteString]
entriesToKeep = EntryId -> [ByteString] -> [ByteString]
forall a. EntryId -> [a] -> [a]
take (EntryId
youngestEntry EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
- EntryId
rangeStart EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
+ EntryId
1) [ByteString]
entries
                lengthToKeep :: Int64
lengthToKeep = ByteString -> Int64
Lazy.length (Archiver -> [ByteString] -> ByteString
archiveWrite (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) [ByteString]
entriesToKeep)
            Handle -> Integer -> IO ()
hSetFileSize Handle
pathHandle (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
lengthToKeep)
            Handle -> IO ()
hClose Handle
pathHandle
  [(EntryId, String)] -> IO ()
loop ([(EntryId, String)] -> [(EntryId, String)]
forall a. [a] -> [a]
reverse [(EntryId, String)]
sorted)

-- | Obliterate log entries as long as the filter function returns @True@.
rollbackWhile :: LogKey object
  -> (object -> Bool) -- ^ the filter function
  -> IO ()
rollbackWhile :: forall object. LogKey object -> (object -> Bool) -> IO ()
rollbackWhile LogKey object
identifier object -> Bool
filterFn = do
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles LogKey object
identifier
  let sorted :: [(EntryId, String)]
sorted = [(EntryId, String)] -> [(EntryId, String)]
forall a. Ord a => [a] -> [a]
sort [(EntryId, String)]
logFiles
      loop :: [(a, String)] -> IO ()
loop [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      loop ((a
_rangeStart, String
path) : [(a, String)]
xs) = do
        ByteString
archive <- String -> IO ByteString
Strict.readFile String
path
        let entries :: [ByteString]
entries = Entries -> [ByteString]
entriesToList (Entries -> [ByteString]) -> Entries -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Archiver -> ByteString -> Entries
archiveRead (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) ([ByteString] -> ByteString
Lazy.fromChunks [ByteString
archive])
            entriesToSkip :: [ByteString]
entriesToSkip = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (object -> Bool
filterFn (object -> Bool) -> (ByteString -> object) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogKey object -> ByteString -> object
forall object. LogKey object -> ByteString -> object
decode' LogKey object
identifier) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
entries
            skip_size :: Int64
skip_size = ByteString -> Int64
Lazy.length (Archiver -> [ByteString] -> ByteString
archiveWrite (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) [ByteString]
entriesToSkip)
            orig_size :: Int64
orig_size = EntryId -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryId -> Int64) -> EntryId -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> EntryId
Strict.length ByteString
archive
            new_size :: Int64
new_size = Int64
orig_size Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
skip_size
        if Int64
new_size Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
           then do String -> IO ()
removeFile String
path; [(a, String)] -> IO ()
loop [(a, String)]
xs
           else do Handle
pathHandle <- String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode
                   Handle -> Integer -> IO ()
hSetFileSize Handle
pathHandle (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
new_size)
                   Handle -> IO ()
hClose Handle
pathHandle
  [(EntryId, String)] -> IO ()
forall {a}. [(a, String)] -> IO ()
loop ([(EntryId, String)] -> [(EntryId, String)]
forall a. [a] -> [a]
reverse [(EntryId, String)]
sorted)

-- | Filter out log files that are outside the min_entry/max_entry range.
--
--     minEntryId <= x < maxEntryId
filterLogFiles
  :: Maybe EntryId
  -- ^ minEntryId
  -> Maybe EntryId
  -- ^ maxEntryId
  -> [(EntryId, FilePath)] -> [(EntryId, FilePath)]
filterLogFiles :: Maybe EntryId
-> Maybe EntryId -> [(EntryId, String)] -> [(EntryId, String)]
filterLogFiles Maybe EntryId
minEntryIdMb Maybe EntryId
maxEntryIdMb [(EntryId, String)]
logFiles = [(EntryId, String)] -> [(EntryId, String)]
forall {b}. [(EntryId, b)] -> [(EntryId, b)]
worker [(EntryId, String)]
logFiles
  where
    worker :: [(EntryId, b)] -> [(EntryId, b)]
worker [] = []
    worker [ (EntryId, b)
logFile ]
      | EntryId -> Bool
ltMaxEntryId ((EntryId, b) -> EntryId
forall {a} {b}. (a, b) -> a
rangeStart (EntryId, b)
logFile) -- If the logfile starts before our maxEntryId then we're intersted.
      = [ (EntryId, b)
logFile ]
      | Bool
otherwise
      = []
    worker ( (EntryId, b)
left : (EntryId, b)
right : [(EntryId, b)]
xs)
      | EntryId -> Bool
ltMinEntryId ((EntryId, b) -> EntryId
forall {a} {b}. (a, b) -> a
rangeStart (EntryId, b)
right) -- If 'right' starts before our minEntryId then we can discard 'left'.
      = [(EntryId, b)] -> [(EntryId, b)]
worker ((EntryId, b)
right (EntryId, b) -> [(EntryId, b)] -> [(EntryId, b)]
forall a. a -> [a] -> [a]
: [(EntryId, b)]
xs)
      | EntryId -> Bool
ltMaxEntryId ((EntryId, b) -> EntryId
forall {a} {b}. (a, b) -> a
rangeStart (EntryId, b)
left)  -- If 'left' starts before our maxEntryId then we're interested.
      = (EntryId, b)
left (EntryId, b) -> [(EntryId, b)] -> [(EntryId, b)]
forall a. a -> [a] -> [a]
: [(EntryId, b)] -> [(EntryId, b)]
worker ((EntryId, b)
right (EntryId, b) -> [(EntryId, b)] -> [(EntryId, b)]
forall a. a -> [a] -> [a]
: [(EntryId, b)]
xs)
      | Bool
otherwise                       -- If 'left' starts after our maxEntryId then we're done.
      = []
    ltMinEntryId :: EntryId -> Bool
ltMinEntryId = case Maybe EntryId
minEntryIdMb of Maybe EntryId
Nothing         -> Bool -> EntryId -> Bool
forall a b. a -> b -> a
const Bool
False
                                        Just EntryId
minEntryId -> (EntryId -> EntryId -> Bool
forall a. Ord a => a -> a -> Bool
<= EntryId
minEntryId)
    ltMaxEntryId :: EntryId -> Bool
ltMaxEntryId = case Maybe EntryId
maxEntryIdMb of Maybe EntryId
Nothing         -> Bool -> EntryId -> Bool
forall a b. a -> b -> a
const Bool
True
                                        Just EntryId
maxEntryId -> (EntryId -> EntryId -> Bool
forall a. Ord a => a -> a -> Bool
< EntryId
maxEntryId)
    rangeStart :: (a, b) -> a
rangeStart (a
firstEntryId, b
_path) = a
firstEntryId

-- | Move all log files that do not contain entries equal or higher than the
-- given entryId into an @Archive/@ directory.
archiveFileLog :: FileLog object -> EntryId -> IO ()
archiveFileLog :: forall object. FileLog object -> EntryId -> IO ()
archiveFileLog FileLog object
fLog EntryId
entryId = do
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles (FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog)
  let sorted :: [(EntryId, String)]
sorted = [(EntryId, String)] -> [(EntryId, String)]
forall a. Ord a => [a] -> [a]
sort [(EntryId, String)]
logFiles
      relevant :: [(EntryId, String)]
relevant = Maybe EntryId
-> Maybe EntryId -> [(EntryId, String)] -> [(EntryId, String)]
filterLogFiles Maybe EntryId
forall a. Maybe a
Nothing (EntryId -> Maybe EntryId
forall a. a -> Maybe a
Just EntryId
entryId) [(EntryId, String)]
sorted
              [(EntryId, String)] -> [(EntryId, String)] -> [(EntryId, String)]
forall a. Eq a => [a] -> [a] -> [a]
\\ Maybe EntryId
-> Maybe EntryId -> [(EntryId, String)] -> [(EntryId, String)]
filterLogFiles (EntryId -> Maybe EntryId
forall a. a -> Maybe a
Just EntryId
entryId) (EntryId -> Maybe EntryId
forall a. a -> Maybe a
Just (EntryId
entryIdEntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
+EntryId
1))  [(EntryId, String)]
sorted

  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
archiveDir
  [(EntryId, String)] -> ((EntryId, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(EntryId, String)]
relevant (((EntryId, String) -> IO ()) -> IO ())
-> ((EntryId, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(EntryId
_startEntry, String
logFilePath) ->
    String -> String -> IO ()
renameFile String
logFilePath (String
archiveDir String -> String -> String
</> String -> String
takeFileName String
logFilePath)
 where
  archiveDir :: String
archiveDir = LogKey object -> String
forall object. LogKey object -> String
logDirectory (FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog) String -> String -> String
</> String
"Archive"

getNextDurableEntryId :: FileLog object -> IO EntryId
getNextDurableEntryId :: forall object. FileLog object -> IO EntryId
getNextDurableEntryId FileLog object
fLog  = STM EntryId -> IO EntryId
forall a. STM a -> IO a
atomically (STM EntryId -> IO EntryId) -> STM EntryId -> IO EntryId
forall a b. (a -> b) -> a -> b
$ do
  ([ByteString]
entries, [IO ()]
_) <- TVar ([ByteString], [IO ()]) -> STM ([ByteString], [IO ()])
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar ([ByteString], [IO ()])
forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue FileLog object
fLog)
  EntryId
next <- TVar EntryId -> STM EntryId
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog)
  EntryId -> STM EntryId
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (EntryId
next EntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
- [ByteString] -> EntryId
forall a. [a] -> EntryId
forall (t :: * -> *) a. Foldable t => t a -> EntryId
length [ByteString]
entries)

cutFileLog :: FileLog object -> IO EntryId
cutFileLog :: forall object. FileLog object -> IO EntryId
cutFileLog FileLog object
fLog = do
  MVar EntryId
mvar <- IO (MVar EntryId)
forall a. IO (MVar a)
newEmptyMVar
  let action :: IO ()
action = do EntryId
currentEntryId <- FileLog object -> IO EntryId
forall object. FileLog object -> IO EntryId
getNextDurableEntryId FileLog object
fLog
                  MVar FHandle -> (FHandle -> IO FHandle) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (FileLog object -> MVar FHandle
forall object. FileLog object -> MVar FHandle
logCurrent FileLog object
fLog) ((FHandle -> IO FHandle) -> IO ())
-> (FHandle -> IO FHandle) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FHandle
old ->
                    do FHandle -> IO ()
close FHandle
old
                       String -> IO FHandle
open (LogKey object -> String
forall object. LogKey object -> String
logDirectory LogKey object
key String -> String -> String
</> String -> EntryId -> String
formatLogFile (LogKey object -> String
forall object. LogKey object -> String
logPrefix LogKey object
key) EntryId
currentEntryId)
                  MVar EntryId -> EntryId -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar EntryId
mvar EntryId
currentEntryId
  FileLog object -> IO () -> IO ()
forall object. FileLog object -> IO () -> IO ()
pushAction FileLog object
fLog IO ()
action
  MVar EntryId -> IO EntryId
forall a. MVar a -> IO a
takeMVar MVar EntryId
mvar
 where
  key :: LogKey object
key = FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog

-- | Finds the newest entry in the log. Doesn't work on open logs. Do not use
-- after the log has been opened.
--
-- Implementation:
--
-- - Search the newest log files first.
-- - Once a file containing at least one valid entry is found, return the last
--   entry in that file.
newestEntry :: LogKey object -> IO (Maybe object)
newestEntry :: forall object. LogKey object -> IO (Maybe object)
newestEntry LogKey object
identifier = do
  [(EntryId, String)]
logFiles <- LogKey object -> IO [(EntryId, String)]
forall object. LogKey object -> IO [(EntryId, String)]
findLogFiles LogKey object
identifier
  let sorted :: [(EntryId, String)]
sorted = [(EntryId, String)] -> [(EntryId, String)]
forall a. [a] -> [a]
reverse ([(EntryId, String)] -> [(EntryId, String)])
-> [(EntryId, String)] -> [(EntryId, String)]
forall a b. (a -> b) -> a -> b
$ [(EntryId, String)] -> [(EntryId, String)]
forall a. Ord a => [a] -> [a]
sort [(EntryId, String)]
logFiles
      ([EntryId]
_eventIds, [String]
files) = [(EntryId, String)] -> ([EntryId], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(EntryId, String)]
sorted
  [String] -> IO (Maybe object)
worker [String]
files
 where
  worker :: [String] -> IO (Maybe object)
worker [] = Maybe object -> IO (Maybe object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe object
forall a. Maybe a
Nothing
  worker (String
logFile:[String]
logFiles) = do
    -- XXX: Strict bytestrings are used due to a performance bug in
    -- cereal-0.3.5.2 and binary-0.7.1.0. The code should revert back
    -- to lazy bytestrings once the bug has been fixed.
    ByteString
archive <- (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
Lazy.fromStrict (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
Strict.readFile String
logFile
    case Archiver -> ByteString -> Entries
archiveRead (LogKey object -> Archiver
forall object. LogKey object -> Archiver
logArchiver LogKey object
identifier) ByteString
archive of
      Entries
Done            -> [String] -> IO (Maybe object)
worker [String]
logFiles
      Next ByteString
entry Entries
next -> Maybe object -> IO (Maybe object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe object -> IO (Maybe object))
-> Maybe object -> IO (Maybe object)
forall a b. (a -> b) -> a -> b
$ object -> Maybe object
forall a. a -> Maybe a
Just (LogKey object -> ByteString -> object
forall object. LogKey object -> ByteString -> object
decode' LogKey object
identifier (ByteString -> Entries -> ByteString
lastEntry ByteString
entry Entries
next))
      Fail String
msg        -> String -> IO (Maybe object)
forall a. HasCallStack => String -> a
error (String -> IO (Maybe object)) -> String -> IO (Maybe object)
forall a b. (a -> b) -> a -> b
$ String
"Data.Acid.Log: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
  lastEntry :: ByteString -> Entries -> ByteString
lastEntry ByteString
entry Entries
Done          = ByteString
entry
  lastEntry ByteString
entry (Fail String
msg)    = String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Data.Acid.Log: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
  lastEntry ByteString
_ (Next ByteString
entry Entries
next) = ByteString -> Entries -> ByteString
lastEntry ByteString
entry Entries
next

-- | Schedule a new log entry. This call does not block. The given IO action
-- runs once the object is durable. The IO action blocks the serialization of
-- events so it should be swift.
pushEntry :: FileLog object -> object -> IO () -> IO ()
pushEntry :: forall object. FileLog object -> object -> IO () -> IO ()
pushEntry FileLog object
fLog object
object IO ()
finally = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  EntryId
tid <- TVar EntryId -> STM EntryId
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog)
  TVar EntryId -> EntryId -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog) (EntryId -> STM ()) -> EntryId -> STM ()
forall a b. (a -> b) -> a -> b
$! EntryId
tidEntryId -> EntryId -> EntryId
forall a. Num a => a -> a -> a
+EntryId
1
  ([ByteString]
entries, [IO ()]
actions) <- TVar ([ByteString], [IO ()]) -> STM ([ByteString], [IO ()])
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar ([ByteString], [IO ()])
forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue FileLog object
fLog)
  TVar ([ByteString], [IO ()]) -> ([ByteString], [IO ()]) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (FileLog object -> TVar ([ByteString], [IO ()])
forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue FileLog object
fLog) ( ByteString
encoded ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
entries, IO ()
finally IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
: [IO ()]
actions )
 where
  encoded :: ByteString
encoded = [ByteString] -> ByteString
Lazy.fromChunks [ ByteString -> ByteString
Strict.copy (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
              Serialiser object -> object -> ByteString
forall a. Serialiser a -> a -> ByteString
serialiserEncode (LogKey object -> Serialiser object
forall object. LogKey object -> Serialiser object
logSerialiser (FileLog object -> LogKey object
forall object. FileLog object -> LogKey object
logIdentifier FileLog object
fLog)) object
object ]

-- | The given IO action is executed once all previous entries are durable.
pushAction :: FileLog object -> IO () -> IO ()
pushAction :: forall object. FileLog object -> IO () -> IO ()
pushAction FileLog object
fLog IO ()
finally = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ([ByteString]
entries, [IO ()]
actions) <- TVar ([ByteString], [IO ()]) -> STM ([ByteString], [IO ()])
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar ([ByteString], [IO ()])
forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue FileLog object
fLog)
  TVar ([ByteString], [IO ()]) -> ([ByteString], [IO ()]) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (FileLog object -> TVar ([ByteString], [IO ()])
forall object. FileLog object -> TVar ([ByteString], [IO ()])
logQueue FileLog object
fLog) ([ByteString]
entries, IO ()
finally IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
: [IO ()]
actions)

askCurrentEntryId :: FileLog object -> IO EntryId
askCurrentEntryId :: forall object. FileLog object -> IO EntryId
askCurrentEntryId FileLog object
fLog = STM EntryId -> IO EntryId
forall a. STM a -> IO a
atomically (STM EntryId -> IO EntryId) -> STM EntryId -> IO EntryId
forall a b. (a -> b) -> a -> b
$
  TVar EntryId -> STM EntryId
forall a. TVar a -> STM a
readTVar (FileLog object -> TVar EntryId
forall object. FileLog object -> TVar EntryId
logNextEntryId FileLog object
fLog)


-- FIXME: Check for unused input.
decode' :: LogKey object -> Lazy.ByteString -> object
decode' :: forall object. LogKey object -> ByteString -> object
decode' LogKey object
s ByteString
inp =
  case Serialiser object -> ByteString -> Either String object
forall a. Serialiser a -> ByteString -> Either String a
serialiserDecode (LogKey object -> Serialiser object
forall object. LogKey object -> Serialiser object
logSerialiser LogKey object
s) ByteString
inp of
    Left String
msg  -> String -> object
forall a. HasCallStack => String -> a
error (String -> object) -> String -> object
forall a b. (a -> b) -> a -> b
$ String
"Data.Acid.Log: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
    Right object
val -> object
val