diff --git a/bench/Chainweb/Pact/Backend/ForkingBench.hs b/bench/Chainweb/Pact/Backend/ForkingBench.hs index 4518b76425..41f744896c 100644 --- 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 index bf1b9efd1c..3ad60cbe38 100644 --- 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 index 5954a4a633..a1ebe1f37e 100644 --- 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 index f022defbea..b579b7383f 100644 --- 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 index d1fb33538b..6c1db7d46f 100644 --- 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 index 7e6b30f194..0b0331b977 100644 --- 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 _) =