Change the compaction command line interface

1. Fixes a bug in the command line flags.

The flag parsers did not match the constructor fields.

2. Makes only compacting sqlite the default.
3. Makes keeping TransactionIndex the default.

This way the default is "safe" and does not lose any data any user might
want. They can compact rocksdb and TransactionIndex in addition if they
want, but that should be a conscious choice, so that their API still
serves all relevant data.

Author: edmundnoble

src/Chainweb/Pact/Backend/Compaction.hs

@@ -15,6 +15,8 @@
   , PackageImports
   , ScopedTypeVariables
   , TypeApplications
+  , RecordWildCards
+  , ApplicativeDo
 #-}
 
 module Chainweb.Pact.Backend.Compaction
@@ -23,8 +25,8 @@ module Chainweb.Pact.Backend.Compaction
     main
 
   -- * Exported for testing
-  , compactPactState
-  , compactRocksDb
+  , doCompactPactState
+  , doCompactRocksDb
   , Retainment(..)
   , defaultRetainment
 
@@ -147,23 +149,24 @@ data Config = Config
   , toDir :: FilePath
   , concurrent :: ConcurrentChains
   , logDir :: FilePath
-  , noRocksDb :: Bool
-    -- ^ Don't produce a new RocksDB at all.
-  , noPactState :: Bool
-    -- ^ Don't produce a new Pact State at all.
-  , keepFullTransactionIndex :: Bool
-    -- ^ Whether or not to keep the entire TransactionIndex table. Some APIs rely on this table.
+  , compactRocksDb :: Bool
+    -- ^ Compact the RocksDB at all?
+  , compactPactState :: Bool
+    -- ^ Compact the Pact State at all?
+  , compactTransactionIndex :: Bool
+    -- ^ Compact the TransactionIndex table in the Pact state?
+    -- Some APIs (e.g. /poll) rely on this table, so the default is False.
   }
 
 data Retainment = Retainment
-  { keepFullTransactionIndex :: Bool
+  { compactTransactionIndex :: Bool
   , compactThese :: CompactThese
   }
 
 defaultRetainment :: Retainment
 defaultRetainment = Retainment
-  { keepFullTransactionIndex = False
-  , compactThese = CompactBoth
+  { compactTransactionIndex = False
+  , compactThese = CompactOnlyPactState
   }
 
 data CompactThese = CompactOnlyRocksDb | CompactOnlyPactState | CompactBoth | CompactNeither
@@ -180,16 +183,17 @@ getConfig = do
       (O.fullDesc <> O.progDesc "Pact DB Compaction Tool - create a compacted copy of the source database directory Pact DB into the target directory.")
 
     parser :: O.Parser Config
-    parser = Config
-      <$> (parseVersion <$> O.strOption (O.long "chainweb-version" <> O.value "mainnet01"))
-      <*> O.strOption (O.long "from" <> O.help "Directory containing SQLite Pact state and RocksDB block data to compact (expected to be in $DIR/0/{sqlite,rocksDb}")
-      <*> O.strOption (O.long "to" <> O.help "Directory where to place the compacted Pact state and block data. It will place them in $DIR/0/{sqlite,rocksDb}, respectively.")
-      <*> O.flag SingleChain ManyChainsAtOnce (O.long "parallel" <> O.help "Turn on multi-threaded compaction. The threads are per-chain.")
-      <*> O.strOption (O.long "log-dir" <> O.help "Directory where compaction logs will be placed.")
+    parser = do
+      chainwebVersion <- (parseVersion <$> O.strOption (O.long "chainweb-version" <> O.value "mainnet01"))
+      fromDir <- O.strOption (O.long "from" <> O.help "Directory containing SQLite Pact state and RocksDB block data to compact (expected to be in $DIR/0/{sqlite,rocksDb}")
+      toDir <- O.strOption (O.long "to" <> O.help "Directory where to place the compacted Pact state and block data. It will place them in $DIR/0/{sqlite,rocksDb}, respectively.")
+      concurrent <- O.flag SingleChain ManyChainsAtOnce (O.long "parallel" <> O.help "Turn on multi-threaded compaction. The threads are per-chain.")
+      logDir <- O.strOption (O.long "log-dir" <> O.help "Directory where compaction logs will be placed.")
       -- Hidden options
-      <*> O.switch (O.long "keep-full-rocksdb" <> O.hidden)
-      <*> O.switch (O.long "no-rocksdb" <> O.hidden)
-      <*> O.switch (O.long "no-pact" <> O.hidden)
+      compactRocksDb <- O.switch (O.long "compact-rocksdb" <> O.hidden <> O.internal)
+      compactPactState <- not <$> O.switch (O.long "no-compact-pact" <> O.hidden <> O.internal)
+      compactTransactionIndex <- O.switch (O.long "compact-transaction-index" <> O.hidden <> O.internal)
+      return Config {..}
 
     parseVersion :: Text -> ChainwebVersion
     parseVersion =
@@ -201,8 +205,8 @@ main :: IO ()
 main = do
   compact =<< getConfig
 
-compactPactState :: (Logger logger) => logger -> Retainment -> BlockHeight -> SQLiteEnv -> SQLiteEnv -> IO ()
-compactPactState logger rt targetBlockHeight srcDb targetDb = do
+doCompactPactState :: (Logger logger) => logger -> Retainment -> BlockHeight -> SQLiteEnv -> SQLiteEnv -> IO ()
+doCompactPactState logger rt targetBlockHeight srcDb targetDb = do
   let log = logFunctionText logger
 
   -- These pragmas are tuned for fast insertion on systems with a wide range
@@ -262,8 +266,7 @@ compactPactState logger rt targetBlockHeight srcDb targetDb = do
 
   -- Copy over TransactionIndex.
   --
-  -- If the user specifies that they want to keep the entire table, then we do so, otherwise,
-  -- we compact this based on the RocksDB 'blockHeightKeepDepth'.
+  -- If the user specifies that they want to compact the table, then we do so based on the RocksDB 'blockHeightKeepDepth'.
   --
   -- /poll and SPV rely on having this table synchronised with RocksDB.
   -- We need to document APIs which need TransactionIndex.
@@ -272,7 +275,7 @@ compactPactState logger rt targetBlockHeight srcDb targetDb = do
   -- https://tableplus.com/blog/2018/07/sqlite-how-to-copy-table-to-another-database.html
   do
     (qry, args) <-
-      if rt.keepFullTransactionIndex
+      if not rt.compactTransactionIndex
       then do
         log LL.Info "Copying over entire TransactionIndex table. This could take a while"
         let wholeTableQuery = "SELECT txhash, blockheight FROM TransactionIndex ORDER BY blockheight"
@@ -338,11 +341,11 @@ compact :: Config -> IO ()
 compact cfg = do
   let cids = allChains cfg.chainwebVersion
 
-  let _compactThese = case (cfg.noRocksDb, cfg.noPactState) of
-        (True, True) -> CompactNeither
-        (True, False) -> CompactOnlyPactState
-        (False, True) -> CompactOnlyRocksDb
-        (False, False) -> CompactBoth
+  let _compactThese = case (cfg.compactRocksDb, cfg.compactPactState) of
+        (False, False) -> CompactNeither
+        (False, True) -> CompactOnlyPactState
+        (True, False) -> CompactOnlyRocksDb
+        (True, True) -> CompactBoth
 
   -- Get the target blockheight.
   targetBlockHeight <- withDefaultLogger LL.Debug $ \logger -> do
@@ -378,23 +381,23 @@ compact cfg = do
     pure targetBlockHeight
 
   -- Compact RocksDB.
-  when (not cfg.noRocksDb) $ do
+  when cfg.compactRocksDb $ do
     withRocksDbFileLogger cfg.logDir LL.Debug $ \logger -> do
       withReadOnlyRocksDb (rocksDir cfg.fromDir) modernDefaultOptions $ \srcRocksDb -> do
         withRocksDb (rocksDir cfg.toDir) (modernDefaultOptions { compression = NoCompression }) $ \targetRocksDb -> do
-          compactRocksDb (set setLoggerLevel (l2l LL.Info) logger) cfg.chainwebVersion cids (targetBlockHeight - blockHeightKeepDepth) srcRocksDb targetRocksDb
+          doCompactRocksDb (set setLoggerLevel (l2l LL.Info) logger) cfg.chainwebVersion cids (targetBlockHeight - blockHeightKeepDepth) srcRocksDb targetRocksDb
 
   -- Compact the pact state.
   let retainment = Retainment
-        { keepFullTransactionIndex = cfg.keepFullTransactionIndex
+        { compactTransactionIndex = cfg.compactTransactionIndex
         , compactThese = _compactThese
         }
-  when (not cfg.noPactState) $ do
+  when cfg.compactPactState $ do
     forChains_ cfg.concurrent cids $ \cid -> do
       withPerChainFileLogger cfg.logDir cid LL.Debug $ \logger -> do
         withChainDb cid logger (pactDir cfg.fromDir) $ \_ srcDb -> do
           withChainDb cid logger (pactDir cfg.toDir) $ \_ targetDb -> do
-            compactPactState logger retainment targetBlockHeight srcDb targetDb
+            doCompactPactState logger retainment targetBlockHeight srcDb targetDb
 
 compactTable :: (Logger logger)
   => logger      -- ^ logger
@@ -701,15 +704,15 @@ rocksDir :: FilePath -> FilePath
 rocksDir db = db </> "0/rocksDb"
 
 -- | Copy over all CutHashes, all BlockHeaders, and only some Payloads.
-compactRocksDb :: (Logger logger)
+doCompactRocksDb :: (Logger logger)
   => logger
   -> ChainwebVersion -- ^ cw version
   -> [ChainId] -- ^ ChainIds
   -> BlockHeight -- ^ minBlockHeight for payload copying
   -> RocksDb -- ^ source db, should be opened read-only
   -> RocksDb -- ^ target db
   -> IO ()
-compactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
+doCompactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
   let log = logFunctionText logger
 
   -- Copy over entirety of CutHashes table
@@ -768,7 +771,7 @@ compactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
         -- them does not.
         Nothing -> do
           iterFirst it
-        
+
         Just minBlockHeaderHistory -> do
           let runBack =
                 let x = int latestHeader

test/lib/Chainweb/Test/MultiNode.hs

@@ -553,7 +553,7 @@ compactAndResumeTest logLevel v n srcRocksDb targetRocksDb srcPactDir targetPact
     forM_ [0 .. int @_ @Word n - 1] $ \nid -> do
       let srcRdb = srcRocksDb { _rocksDbNamespace = T.encodeUtf8 (toText nid) }
       let tgtRdb = targetRocksDb { _rocksDbNamespace = T.encodeUtf8 (toText nid) }
-      Sigma.compactRocksDb (addLabel ("nodeId", sshow nid) logger) v (allChains v) 20 srcRdb tgtRdb
+      Sigma.doCompactRocksDb (addLabel ("nodeId", sshow nid) logger) v (allChains v) 25 srcRdb tgtRdb
 
     logFun "phase 3... restarting nodes and ensuring progress"
     runNodesForSeconds logLevel logFun (multiConfig v n) { _configFullHistoricPactState = False } n 10 targetRocksDb targetPactDir ct

test/lib/Chainweb/Test/Pact4/Utils.hs

@@ -1102,7 +1102,7 @@ sigmaCompact :: ()
   -> IO ()
 sigmaCompact srcDb targetDb targetBlockHeight = do
   Sigma.withDefaultLogger Warn $ \logger -> do
-    Sigma.compactPactState logger Sigma.defaultRetainment targetBlockHeight srcDb targetDb
+    Sigma.doCompactPactState logger Sigma.defaultRetainment targetBlockHeight srcDb targetDb
 
 getPWOByHeader :: BlockHeader -> TestBlockDb -> IO PayloadWithOutputs
 getPWOByHeader h (TestBlockDb _ pdb _) =