diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,36 @@ +0.17.0 +====== + +_Jeremy Shaw, 2026-10-29_ + +- `createCheckpointAndClose` no longer writes a checkpoint when this + process has already made one durable and no events have been logged + since, making shutdown fast right after `createCheckpoint` (e.g. via the + remote `CreateCheckpoint` command) + ([#181](https://github.com/acid-state/acid-state/pull/181)). + A checkpoint is still written when the state is freshly created, when + events follow the last checkpoint, and when closing a state whose only + checkpoint is the one loaded at open (so SafeCopy migrations are still + saved). + +**Breaking changes and changed behaviour** + +- `LocalState` has a new field, `localLastCheckpoint`. Code that builds a + `LocalState` with positional arguments will no longer compile. Code that + builds one with record syntax will still compile (with only a + `-Wmissing-fields` warning), but leaves the field undefined: the next + `createCheckpoint` will then kill the log writer thread, and later + updates, checkpoints and closes will hang. Initialise the field with + `newIORef Nothing`. +- `createCheckpointAndClose` no longer always appends a checkpoint. After + `createCheckpoint` followed by `createArchive`, the newest + `checkpoints-*.log` file is left empty and the latest checkpoint is in + the file before it. acid-state itself restores correctly, but backup, + replication or monitoring scripts that copy or check only the newest + checkpoint file must be updated to look at earlier files too. +- Tools that use the checkpoint log's size, modification time or entry + count to confirm a clean shutdown may no longer see a change at close. + 0.16.1.4 ========= diff --git a/acid-state.cabal b/acid-state.cabal --- a/acid-state.cabal +++ b/acid-state.cabal @@ -1,6 +1,6 @@ Cabal-version: 1.18 Name: acid-state -Version: 0.16.1.4 +Version: 0.17.0 Synopsis: Add ACID guarantees to any serializable Haskell data structure. Description: Use regular Haskell data structures as your database and get stronger ACID guarantees than most RDBMS offer. Homepage: https://github.com/acid-state/acid-state @@ -13,8 +13,8 @@ tested-with: GHC == 9.14.1 - GHC == 9.12.2 - GHC == 9.10.2 + GHC == 9.12.4 + GHC == 9.10.3 GHC == 9.8.4 GHC == 9.6.7 GHC == 9.4.8 @@ -117,13 +117,16 @@ build-depends: base , acid-state , deepseq + , directory + , filepath , hspec , mtl , safecopy , template-haskell build-tool-depends: hspec-discover:hspec-discover ghc-options: -threaded -rtsopts -with-rtsopts=-N - other-modules: Data.Acid.TemplateHaskellSpec + other-modules: Data.Acid.CheckpointSpec + Data.Acid.TemplateHaskellSpec default-language: Haskell2010 test-suite state-machine diff --git a/src/Data/Acid/Local.hs b/src/Data/Acid/Local.hs --- a/src/Data/Acid/Local.hs +++ b/src/Data/Acid/Local.hs @@ -73,6 +73,11 @@ , localEvents :: FileLog (Tagged ByteString) , localCheckpoints :: FileLog (Checkpoint st) , localLock :: FileLock + , localLastCheckpoint :: IORef (Maybe EntryId) + -- ^ Event cutoff of the most recent checkpoint made durable + -- by this process, if any. Used by + -- 'createCheckpointAndClose' to avoid writing a checkpoint + -- identical to one already on disk. } newtype StateIsLocked = StateIsLocked FilePath deriving (Show) @@ -193,19 +198,35 @@ withCoreState (localCore acidState) $ \st -> do eventId <- askCurrentEntryId (localEvents acidState) pushAction (localEvents acidState) $ - pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ()) + pushEntry (localCheckpoints acidState) (Checkpoint eventId st) $ + do recordCheckpoint acidState eventId + putMVar mvar () takeMVar mvar +-- | Note that a checkpoint with the given event cutoff is durable. +-- Checkpoints may complete out of order, so keep the largest cutoff. +recordCheckpoint :: LocalState st -> EntryId -> IO () +recordCheckpoint acidState eventId + = atomicModifyIORef' (localLastCheckpoint acidState) $ \old -> + (Just (maybe eventId (max eventId) old), ()) + -- | Save a snapshot to disk and close the AcidState as a single atomic -- action. This is useful when you want to make sure that no events -- are saved to disk after a checkpoint. +-- +-- If this process has already made a checkpoint durable and no events +-- have been logged since, that checkpoint already reflects the current +-- state, so no new checkpoint is written. createCheckpointAndClose :: (IsAcidic st, Typeable st) => AcidState st -> IO () createCheckpointAndClose abstract_state = do mvar <- newEmptyMVar closeCore' (localCore acidState) $ \st -> do eventId <- askCurrentEntryId (localEvents acidState) + lastCheckpoint <- readIORef (localLastCheckpoint acidState) pushAction (localEvents acidState) $ - pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ()) + if lastCheckpoint == Just eventId + then putMVar mvar () + else pushEntry (localCheckpoints acidState) (Checkpoint eventId st) (putMVar mvar ()) takeMVar mvar closeFileLog (localEvents acidState) closeFileLog (localCheckpoints acidState) @@ -408,12 +429,17 @@ checkpointsLog <- openFileLog checkpointsLogKey stateCopy <- newIORef undefined withCoreState core (writeIORef stateCopy) + -- The checkpoint loaded above is deliberately not recorded here: it + -- may have been written with an older SafeCopy version, and closing + -- with createCheckpointAndClose is how such data gets migrated. + lastCheckpoint <- newIORef Nothing return $ toAcidState LocalState { localCore = core , localCopy = stateCopy , localEvents = eventsLog , localCheckpoints = checkpointsLog , localLock = lock + , localLastCheckpoint = lastCheckpoint } maybeLockFile path = do createDirectoryIfMissing True (takeDirectory path) diff --git a/test/Data/Acid/CheckpointSpec.hs b/test/Data/Acid/CheckpointSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Acid/CheckpointSpec.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +-- | Tests that 'createCheckpointAndClose' does not write a checkpoint +-- identical to one this process has already made durable. +module Data.Acid.CheckpointSpec where + +import Test.Hspec + +import Control.Exception (bracket_) +import Control.Monad.Reader (ask) +import Control.Monad.State (modify) +import Data.SafeCopy (base, deriveSafeCopy) +import System.Directory (getTemporaryDirectory, removePathForcibly) +import System.FilePath (()) + +import Data.Acid +import Data.Acid.Local (Checkpoint, createCheckpointAndClose, + defaultSerialisationLayer, mkCheckpointsLogKey) +import Data.Acid.Log (FileLog, askCurrentEntryId, closeFileLog, openFileLog) + +newtype Counter = Counter Int + +$(deriveSafeCopy 0 'base ''Counter) + +increment :: Update Counter () +increment = modify (\(Counter n) -> Counter (n + 1)) + +current :: Query Counter Int +current = do Counter n <- ask + return n + +$(makeAcidic ''Counter ['increment, 'current]) + +spec :: Spec +spec = around withStateDir $ + describe "createCheckpointAndClose" $ do + it "writes a checkpoint when events were logged" $ \dir -> do + n <- closeAfter dir $ \acid -> update acid Increment + n `shouldBe` 1 + valueIn dir `shouldReturn` 1 + + it "writes a checkpoint for a fresh state with no events" $ \dir -> do + n <- closeAfter dir $ \_ -> return () + n `shouldBe` 1 + -- The initial value must have been saved, so a different + -- initial value at reopen is ignored. + reopened <- openLocalStateFrom dir (Counter 42) + query reopened Current `shouldReturn` 0 + closeAcidState reopened + + it "rewrites the checkpoint it loaded, even with no new events" $ \dir -> do + _ <- closeAfter dir $ \acid -> update acid Increment + n <- closeAfter dir $ \_ -> return () + -- The loaded checkpoint may need a SafeCopy migration, so + -- closing must still write one. + n `shouldBe` 1 + valueIn dir `shouldReturn` 1 + + it "skips the checkpoint right after createCheckpoint" $ \dir -> do + n <- closeAfter dir $ \acid -> do + update acid Increment + createCheckpoint acid + -- Only the explicit checkpoint; the close wrote nothing. + n `shouldBe` 1 + valueIn dir `shouldReturn` 1 + + it "skips the checkpoint after repeated checkpoints with no events" $ \dir -> do + n <- closeAfter dir $ \acid -> do + update acid Increment + createCheckpoint acid + createCheckpoint acid + n `shouldBe` 2 + valueIn dir `shouldReturn` 1 + + it "writes a checkpoint when events follow the last checkpoint" $ \dir -> do + n <- closeAfter dir $ \acid -> do + update acid Increment + createCheckpoint acid + update acid Increment + n `shouldBe` 2 + valueIn dir `shouldReturn` 2 + + it "keeps the state recoverable across repeated skipped closes" $ \dir -> do + let cycle_ = closeAfter dir $ \acid -> do + update acid Increment + createCheckpoint acid + counts <- sequence [cycle_, cycle_, cycle_] + counts `shouldBe` [1, 1, 1] + valueIn dir `shouldReturn` 3 + +-- | Open the state in @dir@, run the action, then 'createCheckpointAndClose'. +-- Returns the number of checkpoints written while the state was open. +closeAfter :: FilePath -> (AcidState Counter -> IO ()) -> IO Int +closeAfter dir action = do + countBefore <- checkpointCount dir + acid <- openLocalStateFrom dir (Counter 0) + action acid + createCheckpointAndClose acid + countAfter <- checkpointCount dir + return (countAfter - countBefore) + +valueIn :: FilePath -> IO Int +valueIn dir = do + acid <- openLocalStateFrom dir (Counter 0) + n <- query acid Current + closeAcidState acid + return n + +-- | Number of entries in the checkpoint log. Only valid while the state +-- is closed. +checkpointCount :: FilePath -> IO Int +checkpointCount dir = do + fLog <- openFileLog (mkCheckpointsLogKey dir defaultSerialisationLayer) + :: IO (FileLog (Checkpoint Counter)) + n <- askCurrentEntryId fLog + closeFileLog fLog + return n + +withStateDir :: (FilePath -> IO ()) -> IO () +withStateDir action = do + tmp <- getTemporaryDirectory + let dir = tmp "acid-state-checkpoint-spec" + bracket_ (removePathForcibly dir) (removePathForcibly dir) (action dir)