add a compaction unit test that demonstrates rowid ordering resiliency

test/Chainweb/Test/Pact/PactSingleChainTest.hs

@@ -22,10 +22,13 @@ import Control.DeepSeq
 import Control.Lens hiding ((.=), matching)
 import Control.Monad
 import Control.Monad.Catch
+import Data.Ord (Down(..))
 import Patience qualified as PatienceL
 import Patience.Map qualified as PatienceM
 import Patience.Map (Delta(..))
+import Streaming.Prelude qualified as S
 
+import Data.Int (Int64)
 import Data.Aeson (object, (.=), Value(..), eitherDecode)
 import qualified Data.ByteString.Lazy as BL
 import Data.Either (isLeft, isRight, fromRight)
@@ -40,6 +43,7 @@ import Data.Text (Text)
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as T
 import qualified Data.Vector as V
+import Database.SQLite3 qualified as Lite
 
 import GHC.Stack
 
@@ -89,6 +93,8 @@ import Chainweb.Utils
 import Chainweb.Version
 import Chainweb.Version.Utils
 import Chainweb.WebBlockHeaderDB (getWebBlockHeaderDb)
+import Pact.Types.SQLite (SType(..), RType(..))
+import Pact.Types.SQLite qualified as Pact
 
 import Chainweb.Storage.Table.RocksDB
 
@@ -132,6 +138,7 @@ tests rdb = testGroup testName
   , compactionUserTablesDropped rdb
   , compactionGrandHashUnchanged rdb
   , compactionDoesNotDisruptDuplicateDetection rdb
+  , compactionResilientToRowIdOrdering rdb
   ]
   where
     testName = "Chainweb.Test.Pact.PactSingleChainTest"
@@ -423,34 +430,7 @@ pactStateSamePreAndPostCompaction rdb =
     Utils.sigmaCompact testVersion cr.srcSqlEnv cr.targetSqlEnv (BlockHeight numBlocks)
     statePostCompaction <- getLatestPactState cr.targetSqlEnv
 
-    let stateDiff = M.filter (not . PatienceM.isSame) (PatienceM.diff statePreCompaction statePostCompaction)
-    when (not (null stateDiff)) $ do
-      T.putStrLn ""
-      forM_ (M.toList stateDiff) $ \(tbl, delta) -> do
-        T.putStrLn ""
-        T.putStrLn tbl
-        case delta of
-          Same _ -> do
-            pure ()
-          Old x -> do
-            putStrLn $ "a pre-only value appeared in the pre- and post-compaction diff: " ++ show x
-          New x -> do
-            putStrLn $ "a post-only value appeared in the pre- and post-compaction diff: " ++ show x
-          Delta x1 x2 -> do
-            let daDiff = M.filter (not . PatienceM.isSame) (PatienceM.diff x1 x2)
-            forM_ daDiff $ \item -> do
-              case item of
-                Old x -> do
-                  putStrLn $ "old: " ++ show x
-                New x -> do
-                  putStrLn $ "new: " ++ show x
-                Same _ -> do
-                  pure ()
-                Delta x y -> do
-                  putStrLn $ "old: " ++ show x
-                  putStrLn $ "new: " ++ show y
-                  putStrLn ""
-      assertFailure "pact state check failed"
+    comparePactStateBeforeAndAfter statePreCompaction statePostCompaction
 
 compactionIsIdempotent :: ()
   => RocksDb
@@ -646,6 +626,92 @@ compactionGrandHashUnchanged rdb =
 
     assertEqual "GrandHash pre- and post-compaction are the same" hashPreCompaction hashPostCompaction
 
+compactionResilientToRowIdOrdering :: ()
+  => RocksDb
+  -> TestTree
+compactionResilientToRowIdOrdering rdb =
+  compactionSetup "compactionResilientToRowIdOrdering" rdb testPactServiceConfig $ \cr -> do
+
+    let numBlocks :: Num a => a
+        numBlocks = 100
+
+    -- Just run a bunch of blocks
+    setOneShotMempool cr.mempoolRef =<< goldenMemPool
+    let makeTx :: Word -> BlockHeader -> IO ChainwebTransaction
+        makeTx nth bh = buildCwCmd (sshow nth) testVersion
+          $ set cbSigners [mkEd25519Signer' sender00 [mkGasCap, mkTransferCap "sender00" "sender01" 1.0]]
+          $ setFromHeader bh
+          $ set cbRPC (mkExec' "(coin.transfer \"sender00\" \"sender01\" 1.0)")
+          $ defaultCmd
+    replicateM_ numBlocks
+      $ runTxInBlock_ cr.mempoolRef cr.srcPactQueue cr.blockDb
+      $ \n _ _ blockHeader -> makeTx n blockHeader
+
+    -- Get the state after running the blocks but before doing anything else
+    statePreCompaction <- getLatestPactState cr.srcSqlEnv
+
+    -- Reverse all of the rowids in the table. We get all the rows in txid DESC order, like so:
+    --   rk1, txid=100, rowid=100
+    --   rk1, txid=99,  rowid=99
+    --   ...
+    --
+    -- Then we reverse the rowids, so that the table looks like this:
+    --   rk1, txid=100, rowid=0
+    --   rk1, txid=99,  rowid=1
+    --   ...
+    --
+    -- Since the compaction algorithm orders by rowid DESC, it will get the rows in reverse order to how they were inserted.
+    -- If compaction still results in the same end state, this confirms that the compaction algorithm is resilient to rowid ordering.
+    e <- PS.qryStream cr.srcSqlEnv "SELECT rowkey, txid FROM [coin_coin-table] ORDER BY txid ASC" [] [RText, RInt] $ \rows -> do
+      Lite.withStatement cr.srcSqlEnv "UPDATE [coin_coin-table] SET rowid = ?3 WHERE rowkey = ?1 AND txid = ?2" $ \stmt -> do
+        flip S.mapM_ (S.zip (S.enumFrom @_ @(Down Int64) 10_000) rows) $ \(Down newRowId, row) -> case row of
+          [SText rowkey, SInt txid] -> do
+            Pact.bindParams stmt [SText rowkey, SInt txid, SInt newRowId]
+            stepThenReset stmt
+
+          _ -> error "unexpected row shape"
+    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)
+
+    -- Get the state post-randomisation and post-compaction
+    statePostCompaction <- getLatestPactState cr.targetSqlEnv
+
+    -- Same logic as in 'pactStateSamePreAndPostCompaction'
+    comparePactStateBeforeAndAfter statePreCompaction statePostCompaction
+
+comparePactStateBeforeAndAfter :: (Ord k, Eq a, Show k, Show a) => M.Map Text (M.Map k a) -> M.Map Text (M.Map k a) -> IO ()
+comparePactStateBeforeAndAfter statePreCompaction statePostCompaction = do
+  let stateDiff = M.filter (not . PatienceM.isSame) (PatienceM.diff statePreCompaction statePostCompaction)
+  when (not (null stateDiff)) $ do
+    T.putStrLn ""
+    forM_ (M.toList stateDiff) $ \(tbl, delta) -> do
+      T.putStrLn ""
+      T.putStrLn tbl
+      case delta of
+        Same _ -> do
+          pure ()
+        Old x -> do
+          putStrLn $ "a pre-only value appeared in the pre- and post-compaction diff: " ++ show x
+        New x -> do
+          putStrLn $ "a post-only value appeared in the pre- and post-compaction diff: " ++ show x
+        Delta x1 x2 -> do
+          let daDiff = M.filter (not . PatienceM.isSame) (PatienceM.diff x1 x2)
+          forM_ daDiff $ \item -> do
+            case item of
+              Old x -> do
+                putStrLn $ "old: " ++ show x
+              New x -> do
+                putStrLn $ "new: " ++ show x
+              Same _ -> do
+                pure ()
+              Delta x y -> do
+                putStrLn $ "old: " ++ show x
+                putStrLn $ "new: " ++ show y
+                putStrLn ""
+    assertFailure "pact state check failed"
+
 getHistory :: IO (IORef MemPoolAccess) -> IO (SQLiteEnv, PactQueue, TestBlockDb) -> TestTree
 getHistory refIO reqIO = testCase "getHistory" $ do
   (_, q, bdb) <- reqIO
@@ -1163,3 +1229,9 @@ runTxInBlock_ mempoolRef pactQueue blockDb makeTx = do
   runTxInBlock mempoolRef pactQueue blockDb makeTx >>= \case
     Left e -> assertFailure $ "newBlockAndValidate: validate: got failure result: " ++ show e
     Right v -> pure v
+
+-- | Step through a prepared statement, then clear the statement's bindings
+--   and reset the statement.
+stepThenReset :: Lite.Statement -> IO Lite.StepResult
+stepThenReset stmt = do
+  Lite.stepNoCB stmt `finally` (Lite.clearBindings stmt >> Lite.reset stmt)