fix bench and tests for new compactPactState

kadena-io · Jul 15, 2024 · d3d292d · d3d292d
1 parent 5b44f61
commit d3d292d
Show file tree

Hide file tree

Showing 6 changed files with 17 additions and 18 deletions.
diff --git a/bench/Chainweb/Pact/Backend/ForkingBench.hs b/bench/Chainweb/Pact/Backend/ForkingBench.hs
@@ -314,7 +314,7 @@ withResources rdb trunkLength logLevel compact p f = C.envWithCleanup create des
             then do
               targetSqlEnv <- openSQLiteConnection "" {- temporary SQLite db -} chainwebBenchPragmas
               C.withDefaultLogger Error $ \lgr -> do
-                C.compactPactState lgr testVer (BlockHeight trunkLength) srcSqlEnv targetSqlEnv
+                C.compactPactState lgr (BlockHeight trunkLength) srcSqlEnv targetSqlEnv
               targetPactService <-
                startPact testVer logger blockHeaderDb payloadDb mp targetSqlEnv
               pure (targetSqlEnv, targetPactService)

diff --git a/test/Chainweb/Test/MultiNode.hs b/test/Chainweb/Test/MultiNode.hs
@@ -363,7 +363,7 @@ compactLiveNodeTest logLevel v n rocksDb srcPactDir targetPactDir step = do
               let logger' = addLabel ("nodeId", sshow nid) $ addLabel ("chainId", chainIdToText cid) lgr
               withSqliteDb cid logger' (srcPactDir </> show nid) False $ \srcDb -> do
                 withSqliteDb cid logger' (targetPactDir </> show nid) False $ \targetDb -> do
-                  sigmaCompact v srcDb targetDb (BlockHeight 25)
+                  sigmaCompact srcDb targetDb (BlockHeight 25)
 
   let run = Chronos.stopwatch_ $ do
         -- It may seem a bit strange that we never run the node against the
@@ -547,7 +547,7 @@ compactAndResumeTest logLevel v n srcRocksDb targetRocksDb srcPactDir targetPact
         let logger' = addLabel ("nodeId", sshow nid) $ addLabel ("chainId", chainIdToText cid) logger
         withSqliteDb cid logger' (srcPactDir </> show nid) False $ \srcDb -> do
           withSqliteDb cid logger' (targetPactDir </> show nid) False $ \targetDb -> do
-            sigmaCompact v srcDb targetDb (BlockHeight 25)
+            sigmaCompact srcDb targetDb (BlockHeight 25)
 
     logFun "phase 2.2...compacting RocksDB"
     forM_ [0 .. int @_ @Word n - 1] $ \nid -> do

diff --git a/test/Chainweb/Test/Pact/PactMultiChainTest.hs b/test/Chainweb/Test/Pact/PactMultiChainTest.hs
@@ -1823,7 +1823,7 @@ withCompacted height pt  = do
   let dbs :: M.Map ChainId (SQLiteEnv, SQLiteEnv)
       dbs = M.merge M.dropMissing M.dropMissing (M.zipWithMatched (\_ e1 e2 -> (fst e1, fst e2))) srcDbs targetDbs
   forM_ (M.toList dbs) $ \(_, (srcDb, targetDb)) -> do
-    liftIO $ sigmaCompact testVersion srcDb targetDb height
+    liftIO $ sigmaCompact srcDb targetDb height
 
   targetPacts <- view menvCompactedPacts
   local (\me -> me & menvPacts .~ targetPacts) pt
diff --git a/test/Chainweb/Test/Pact/PactSingleChainTest.hs b/test/Chainweb/Test/Pact/PactSingleChainTest.hs
@@ -362,7 +362,7 @@ rosettaFailsWithoutFullHistory rdb =
           replicateM_ 10 $ void $ runBlock q bdb second
 
           targetSqlEnv <- targetSqlEnvIO
-          Utils.sigmaCompact testVersion srcSqlEnv targetSqlEnv (BlockHeight 5)
+          Utils.sigmaCompact srcSqlEnv targetSqlEnv (BlockHeight 5)
 
         -- This needs to run after the previous test
         -- Annoyingly, we must inline the PactService util starts here.
@@ -393,7 +393,7 @@ rewindPastMinBlockHeightFails rdb =
   compactionSetup "rewindPastMinBlockHeightFails" rdb testPactServiceConfig $ \cr -> do
     replicateM_ 10 $ runBlock cr.srcPactQueue cr.blockDb second
 
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv (BlockHeight 5)
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv (BlockHeight 5)
 
     -- Genesis block header; compacted away by now
     let bh = genesisBlockHeader testVersion cid
@@ -427,7 +427,7 @@ pactStateSamePreAndPostCompaction rdb =
         $ \n _ _ bHeader -> makeTx n bHeader
 
     statePreCompaction <- getLatestPactState cr.srcSqlEnv
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv (BlockHeight numBlocks)
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv (BlockHeight numBlocks)
     statePostCompaction <- getLatestPactState cr.targetSqlEnv
 
     comparePactStateBeforeAndAfter statePreCompaction statePostCompaction
@@ -457,11 +457,11 @@ compactionIsIdempotent rdb =
     twiceSqlEnv <- twiceSqlEnvIO
     let targetHeight = BlockHeight numBlocks
     -- Compact 'src' into 'target'
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv targetHeight
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv targetHeight
     -- Get table contents of 'target'
     statePostCompaction1 <- getPactUserTables cr.targetSqlEnv
     -- Compact 'target' into 'twice'
-    Utils.sigmaCompact testVersion cr.targetSqlEnv twiceSqlEnv targetHeight
+    Utils.sigmaCompact cr.targetSqlEnv twiceSqlEnv targetHeight
     -- Get table state of 'twice'
     statePostCompaction2 <- getPactUserTables twiceSqlEnv
 
@@ -508,7 +508,7 @@ compactionDoesNotDisruptDuplicateDetection rdb = do
     e1 <- runTxInBlock cr.mempoolRef cr.srcPactQueue cr.blockDb (\_ _ _ _ -> makeTx)
     assertBool "First tx submission succeeds" (isRight e1)
 
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv =<< PS.getLatestBlockHeight cr.srcSqlEnv
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv =<< PS.getLatestBlockHeight cr.srcSqlEnv
 
     e2 <- runTxInBlock cr.mempoolRef cr.targetPactQueue cr.blockDb (\_ _ _ _ -> makeTx)
     assertBool "First tx submission fails" (isLeft e2)
@@ -588,7 +588,7 @@ compactionUserTablesDropped rdb =
       let msg = "Table " ++ T.unpack tbl ++ " should exist pre-compaction, but it doesn't."
       assertBool msg (isJust (M.lookup tbl statePre))
 
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv (BlockHeight halfwayPoint)
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv (BlockHeight halfwayPoint)
 
     statePost <- getPactUserTables cr.targetSqlEnv
     flip assertBool (isJust (M.lookup freeBeforeTbl statePost)) $
@@ -621,7 +621,7 @@ compactionGrandHashUnchanged rdb =
     let targetHeight = BlockHeight numBlocks
 
     hashPreCompaction <- computeGrandHash (PS.getLatestPactStateAt cr.srcSqlEnv targetHeight)
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv targetHeight
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv targetHeight
     hashPostCompaction <- computeGrandHash (PS.getLatestPactStateAt cr.targetSqlEnv targetHeight)
 
     assertEqual "GrandHash pre- and post-compaction are the same" hashPreCompaction hashPostCompaction
@@ -673,7 +673,7 @@ compactionResilientToRowIdOrdering rdb =
     assertBool "Didn't encounter a sqlite error during rowid shuffling" (isRight e)
 
     -- Compact to the tip
-    Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv (BlockHeight numBlocks)
+    Utils.sigmaCompact cr.srcSqlEnv cr.targetSqlEnv (BlockHeight numBlocks)
 
     -- Get the state post-randomisation and post-compaction
     statePostCompaction <- getLatestPactState cr.targetSqlEnv

diff --git a/test/Chainweb/Test/Pact/RemotePactTest.hs b/test/Chainweb/Test/Pact/RemotePactTest.hs
@@ -312,7 +312,7 @@ txlogsCompactionTest rdb = runResourceT $ do
     liftIO $ Sigma.withDefaultLogger Error $ \logger -> do
       Backend.withSqliteDb cid logger srcPactDir False $ \srcDb -> do
         Backend.withSqliteDb cid logger targetPactDir False $ \targetDb -> do
-          sigmaCompact v srcDb targetDb =<< getLatestBlockHeight srcDb
+          sigmaCompact srcDb targetDb =<< getLatestBlockHeight srcDb
 
     let newNodeDbDirs = (head nodeDbDirs) { nodePactDbDir = targetPactDir } : tail nodeDbDirs
 

diff --git a/test/Chainweb/Test/Pact/Utils.hs b/test/Chainweb/Test/Pact/Utils.hs
@@ -1061,14 +1061,13 @@ getLatestPactState db = do
     (PactState.getLatestPactStateDiffable db)
 
 sigmaCompact :: ()
-  => ChainwebVersion
-  -> SQLiteEnv
+  => SQLiteEnv
   -> SQLiteEnv
   -> BlockHeight
   -> IO ()
-sigmaCompact v srcDb targetDb targetBlockHeight = do
+sigmaCompact srcDb targetDb targetBlockHeight = do
   Sigma.withDefaultLogger Warn $ \logger -> do
-    Sigma.compactPactState logger v targetBlockHeight srcDb targetDb
+    Sigma.compactPactState logger targetBlockHeight srcDb targetDb
 
 getPWOByHeader :: BlockHeader -> TestBlockDb -> IO PayloadWithOutputs
 getPWOByHeader h (TestBlockDb _ pdb _) =