Change the compaction command line interface #2277

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,26 @@ 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.help "Compact rocksDB block data. Some interfaces require this data for historical blocks, like the /poll Pact endpoint or the /header Chainweb endpoint, so it is not compacted by default."
+        )
+      compactPactState <- not <$> O.switch
+        (O.long "no-compact-pact"
+        <> O.help "Do not compact Pact state. Pact state is not used by any public interface, so it is compacted by default, and the space savings are usually large on mainnet."
+        )
+      compactTransactionIndex <- O.switch
+        (O.long "compact-transaction-index"
+        <> O.help "Compact the TransactionIndex table in the Pact state. For historical blocks, the /poll Pact endpoint relies on this table, so it is not compacted by default."
+        )
+      return Config {..}
 
     parseVersion :: Text -> ChainwebVersion
     parseVersion =
@@ -201,8 +214,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 +275,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 +284,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 +350,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 +390,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 +713,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 +780,7 @@ compactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
         -- them does not.
         Nothing -> do
           iterFirst it
-        
+
         Just minBlockHeaderHistory -> do
           let runBack =
                 let x = int minBlockHeight

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 _) =