From 2d5ec87be498f7f441d4a1470ef40346daa1e942 Mon Sep 17 00:00:00 2001
From: Edmund Noble <edmundnoble@gmail.com>
Date: Sat, 25 Jan 2025 19:06:28 -0500
Subject: [PATCH] Produce NoSuchTable Pact error, and clean up ChainwebPactDb

NoSuchTable is a new Pact error case as of Pact 5, but we never throw
it. Instead, when a table is missing, sqlite throws an exception, and
this is recorded as an "unknown database error" by Pact. But we can
easily throw it, as shown here, and simultaneously clean up some of
the more repetitious and error-prone conditionals in Pact 5's
ChainwebPactDb.

Change-Id: Id000000030817f20e355d569ca29864db3d777cf
---
 src/Chainweb/Pact/Backend/InMemDb.hs          |  19 +-
 src/Chainweb/Pact/Backend/Types.hs            |  15 +-
 src/Chainweb/Pact/Backend/Utils.hs            |  93 +--
 .../Pact/PactService/Checkpointer/Internal.hs |  16 +-
 src/Chainweb/Pact4/Backend/ChainwebPactDb.hs  |  97 ++-
 src/Chainweb/Pact5/Backend/ChainwebPactDb.hs  | 648 ++++++++++--------
 test/unit/Chainweb/Test/Pact4/Checkpointer.hs |   3 +-
 .../Test/Pact4/PactSingleChainTest.hs         |   4 +-
 .../Chainweb/Test/Pact5/CheckpointerTest.hs   |   5 +-
 .../Test/Pact5/TransactionExecTest.hs         |  25 +
 10 files changed, 499 insertions(+), 426 deletions(-)

diff --git a/src/Chainweb/Pact/Backend/InMemDb.hs b/src/Chainweb/Pact/Backend/InMemDb.hs
index 2baa61fb81..6552ce23bd 100644
--- a/src/Chainweb/Pact/Backend/InMemDb.hs
+++ b/src/Chainweb/Pact/Backend/InMemDb.hs
@@ -14,6 +14,8 @@ module Chainweb.Pact.Backend.InMemDb
     , _ReadEntry
     , _WriteEntry
     , empty
+    , markTableSeen
+    , checkTableSeen
     , insert
     , lookup
     , keys
@@ -22,8 +24,12 @@ module Chainweb.Pact.Backend.InMemDb
 import Prelude hiding (lookup)
 import Control.Lens
 import Data.ByteString (ByteString)
+import Data.Hashable
 import Data.HashMap.Strict(HashMap)
 import Data.HashMap.Strict qualified as HashMap
+import Data.HashSet (HashSet)
+import Data.HashSet qualified as HashSet
+import Data.Maybe
 
 import Pact.Core.Persistence
 import Pact.Core.Builtin
@@ -33,8 +39,6 @@ import Pact.Core.Names
 import Pact.Core.Namespace
 import Pact.Core.DefPacts.Types
 import Pact.Core.IR.Term (ModuleCode)
-import Data.Hashable
-import Data.Maybe
 
 data Entry a
     = ReadEntry !Int !a
@@ -53,11 +57,19 @@ data Store = Store
     , namespaces :: HashMap NamespaceName (Entry Namespace)
     , defPacts :: HashMap DefPactId (Entry (Maybe DefPactExec))
     , moduleSources :: HashMap HashedModuleName (Entry ModuleCode)
+    , seenTables :: HashSet TableName
     }
     deriving (Show, Eq)
 
 empty :: Store
-empty = Store mempty mempty mempty mempty mempty mempty
+empty = Store mempty mempty mempty mempty mempty mempty mempty
+
+markTableSeen :: TableName -> Store -> Store
+markTableSeen tn Store{..} = Store
+    {seenTables = HashSet.insert tn seenTables, ..}
+
+checkTableSeen :: TableName -> Store -> Bool
+checkTableSeen tn Store{..} = HashSet.member tn seenTables
 
 insert
     :: forall k v
@@ -103,3 +115,4 @@ takeLatestEntry ReadEntry {} newEntry = newEntry
 -- we would never overwrite with a read.
 takeLatestEntry oldEntry ReadEntry {} = oldEntry
 takeLatestEntry _ newEntry = newEntry
+{-# INLINE CONLIKE takeLatestEntry #-}
diff --git a/src/Chainweb/Pact/Backend/Types.hs b/src/Chainweb/Pact/Backend/Types.hs
index 1c9560ae1f..82f31354d3 100644
--- a/src/Chainweb/Pact/Backend/Types.hs
+++ b/src/Chainweb/Pact/Backend/Types.hs
@@ -47,19 +47,22 @@ import Control.Lens
 import Chainweb.Pact.Backend.DbCache
 import Chainweb.Version
 import Database.SQLite3.Direct (Database)
-import qualified Pact.Types.Persistence as Pact4
 import Control.Concurrent.MVar
 import Data.ByteString (ByteString)
-import GHC.Generics
-import qualified Pact.Types.Names as Pact4
+import Data.Text (Text)
 import Data.DList (DList)
 import Data.Map (Map)
 import Data.HashSet (HashSet)
 import Data.HashMap.Strict (HashMap)
 import Data.List.NonEmpty (NonEmpty)
 import Control.DeepSeq (NFData)
+import GHC.Generics
+
 import qualified Chainweb.Pact.Backend.InMemDb as InMemDb
 
+import qualified Pact.Types.Persistence as Pact4
+import qualified Pact.Types.Names as Pact4
+
 -- | Whether we write rows to the database that were already overwritten
 -- in the same block.
 data IntraBlockPersistence = PersistIntraBlockWrites | DoNotPersistIntraBlockWrites
@@ -83,7 +86,7 @@ type SQLiteEnv = Database
 -- the row value.
 --
 data SQLiteRowDelta = SQLiteRowDelta
-    { _deltaTableName :: !ByteString -- utf8?
+    { _deltaTableName :: !Text
     , _deltaTxId :: {-# UNPACK #-} !Pact4.TxId
     , _deltaRowKey :: !ByteString
     , _deltaData :: !ByteString
@@ -103,14 +106,14 @@ type TxLogMap = Map Pact4.TableName (DList Pact4.TxLogJson)
 -- | Between a @restore..save@ bracket, we also need to record which tables
 -- were created during this block (so the necessary @CREATE TABLE@ statements
 -- can be performed upon block save).
-type SQLitePendingTableCreations = HashSet ByteString
+type SQLitePendingTableCreations = HashSet Text
 
 -- | Pact transaction hashes resolved during this block.
 type SQLitePendingSuccessfulTxs = HashSet ByteString
 
 -- | Pending writes to the pact db during a block, to be recorded in 'BlockState'.
 -- Structured as a map from table name to a map from rowkey to inserted row delta.
-type SQLitePendingWrites = HashMap ByteString (HashMap ByteString (NonEmpty SQLiteRowDelta))
+type SQLitePendingWrites = HashMap Text (HashMap ByteString (NonEmpty SQLiteRowDelta))
 
 -- Note [TxLogs in SQLitePendingData]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/src/Chainweb/Pact/Backend/Utils.hs b/src/Chainweb/Pact/Backend/Utils.hs
index dbc6b7af70..16f0c214f5 100644
--- a/src/Chainweb/Pact/Backend/Utils.hs
+++ b/src/Chainweb/Pact/Backend/Utils.hs
@@ -30,9 +30,7 @@ module Chainweb.Pact.Backend.Utils
   , chainDbFileName
     -- * Shared Pact database interactions
   , doLookupSuccessful
-  , createVersionedTable
   , tbl
-  , initSchema
   , rewindDbTo
   , rewindDbToBlock
   , rewindDbToGenesis
@@ -52,7 +50,6 @@ module Chainweb.Pact.Backend.Utils
   , convSavepointName
   , expectSingleRowCol
   , expectSingle
-  , execMulti
   -- * SQLite runners
   , withSqliteDb
   , startSqliteDb
@@ -91,8 +88,6 @@ import qualified Pact.Types.Persistence as Pact4
 import qualified Pact.Types.SQLite as Pact4
 import Pact.Types.Util (AsString(..))
 
-import qualified Pact.Core.Persistence as Pact5
-
 
 -- chainweb
 
@@ -242,19 +237,6 @@ chainwebPragmas =
   , "page_size = 1024"
   ]
 
-execMulti :: Traversable t => SQ3.Database -> SQ3.Utf8 -> t [Pact4.SType] -> IO ()
-execMulti db q rows = bracket (Pact4.prepStmt db q) destroy $ \stmt -> do
-    forM_ rows $ \row -> do
-        SQ3.reset stmt >>= checkError
-        SQ3.clearBindings stmt
-        Pact4.bindParams stmt row
-        SQ3.step stmt >>= checkError
-  where
-    checkError (Left e) = void $ fail $ "error during batch insert: " ++ show e
-    checkError (Right _) = return ()
-
-    destroy x = void (SQ3.finalize x >>= checkError)
-
 withSqliteDb
     :: Logger logger
     => ChainId
@@ -348,22 +330,6 @@ tbl t@(Utf8 b)
     | B8.elem ']' b = error $ "Chainweb.Pact4.Backend.ChainwebPactDb: Code invariant violation. Illegal SQL table name " <> sshow b <> ". Please report this as a bug."
     | otherwise = "[" <> t <> "]"
 
-createVersionedTable :: Utf8 -> Database -> IO ()
-createVersionedTable tablename db = do
-    Pact4.exec_ db createtablestmt
-    Pact4.exec_ db indexcreationstmt
-  where
-    ixName = tablename <> "_ix"
-    createtablestmt =
-      "CREATE TABLE IF NOT EXISTS " <> tbl tablename <> " \
-             \ (rowkey TEXT\
-             \, txid UNSIGNED BIGINT NOT NULL\
-             \, rowdata BLOB NOT NULL\
-             \, UNIQUE (rowkey, txid));"
-    indexcreationstmt =
-        "CREATE INDEX IF NOT EXISTS " <> tbl ixName <> " ON " <> tbl tablename <> "(txid DESC);"
-
-
 doLookupSuccessful :: Database -> BlockHeight -> V.Vector SB.ShortByteString -> IO (HashMap.HashMap SB.ShortByteString (T2 BlockHeight BlockHash))
 doLookupSuccessful db curHeight hashes = do
   fmap buildResultMap $ do -- swizzle results of query into a HashMap
@@ -374,14 +340,14 @@ doLookupSuccessful db curHeight hashes = do
             [ "SELECT blockheight, hash, txhash"
             , "FROM TransactionIndex"
             , "INNER JOIN BlockHistory USING (blockheight)"
-            , "WHERE txhash IN (" <> params <> ")" <> " AND blockheight <= ?;"
+            , "WHERE txhash IN (" <> params <> ")" <> " AND blockheight < ?;"
             ]
         qvals
           -- match query params above. first, hashes
           = map (\h -> Pact4.SBlob $ SB.fromShort h) hss
           -- then, the block height; we don't want to see txs from the
           -- current block in the db, because they'd show up in pending data
-          ++ [Pact4.SInt $ fromIntegral (pred curHeight)]
+          ++ [Pact4.SInt $ fromIntegral curHeight]
 
       Pact4.qry db qtext qvals [Pact4.RInt, Pact4.RBlob, Pact4.RBlob] >>= mapM go
   where
@@ -400,61 +366,6 @@ doLookupSuccessful db curHeight hashes = do
         return $! T3 txhash' (fromIntegral blockheight) blockhash'
     go _ = fail "impossible"
 
--- | Create all tables that exist pre-genesis
--- TODO: migrate this logic to the checkpointer itself?
-initSchema :: (Logger logger) => logger -> SQLiteEnv -> IO ()
-initSchema logger sql =
-    withSavepoint sql DbTransaction $ do
-        createBlockHistoryTable
-        createTableCreationTable
-        createTableMutationTable
-        createTransactionIndexTable
-        create (toUtf8 $ Pact5.renderDomain Pact5.DKeySets)
-        create (toUtf8 $ Pact5.renderDomain Pact5.DModules)
-        create (toUtf8 $ Pact5.renderDomain Pact5.DNamespaces)
-        create (toUtf8 $ Pact5.renderDomain Pact5.DDefPacts)
-        create (toUtf8 $ Pact5.renderDomain Pact5.DModuleSource)
-  where
-    create tablename = do
-      logDebug_ logger $ "initSchema: "  <> fromUtf8 tablename
-      createVersionedTable tablename sql
-
-    createBlockHistoryTable :: IO ()
-    createBlockHistoryTable =
-      Pact4.exec_ sql
-        "CREATE TABLE IF NOT EXISTS BlockHistory \
-        \(blockheight UNSIGNED BIGINT NOT NULL,\
-        \ hash BLOB NOT NULL,\
-        \ endingtxid UNSIGNED BIGINT NOT NULL, \
-        \ CONSTRAINT blockHashConstraint UNIQUE (blockheight));"
-
-    createTableCreationTable :: IO ()
-    createTableCreationTable =
-      Pact4.exec_ sql
-        "CREATE TABLE IF NOT EXISTS VersionedTableCreation\
-        \(tablename TEXT NOT NULL\
-        \, createBlockheight UNSIGNED BIGINT NOT NULL\
-        \, CONSTRAINT creation_unique UNIQUE(createBlockheight, tablename));"
-
-    createTableMutationTable :: IO ()
-    createTableMutationTable =
-      Pact4.exec_ sql
-        "CREATE TABLE IF NOT EXISTS VersionedTableMutation\
-         \(tablename TEXT NOT NULL\
-         \, blockheight UNSIGNED BIGINT NOT NULL\
-         \, CONSTRAINT mutation_unique UNIQUE(blockheight, tablename));"
-
-    createTransactionIndexTable :: IO ()
-    createTransactionIndexTable = do
-      Pact4.exec_ sql
-        "CREATE TABLE IF NOT EXISTS TransactionIndex \
-         \ (txhash BLOB NOT NULL, \
-         \ blockheight UNSIGNED BIGINT NOT NULL, \
-         \ CONSTRAINT transactionIndexConstraint UNIQUE(txhash));"
-      Pact4.exec_ sql
-        "CREATE INDEX IF NOT EXISTS \
-         \ transactionIndexByBH ON TransactionIndex(blockheight)";
-
 getEndTxId :: Text -> SQLiteEnv -> Maybe ParentHeader -> IO (Historical Pact4.TxId)
 getEndTxId msg sql pc = case pc of
     Nothing -> return (Historical 0)
diff --git a/src/Chainweb/Pact/PactService/Checkpointer/Internal.hs b/src/Chainweb/Pact/PactService/Checkpointer/Internal.hs
index 83cd4f70d1..71159a3ffc 100644
--- a/src/Chainweb/Pact/PactService/Checkpointer/Internal.hs
+++ b/src/Chainweb/Pact/PactService/Checkpointer/Internal.hs
@@ -92,7 +92,6 @@ import Chainweb.Utils
 import Chainweb.Utils.Serialization
 import Chainweb.Version
 import Chainweb.Version.Guards
-import qualified Pact.Types.Persistence as Pact4
 import qualified Pact.Core.Builtin as Pact5
 import qualified Pact.Core.Evaluate as Pact5
 import qualified Pact.Core.Names as Pact5
@@ -130,7 +129,7 @@ initCheckpointerResources
     -> ChainId
     -> IO (Checkpointer logger)
 initCheckpointerResources dbCacheLimit sql p loggr v cid = do
-    initSchema loggr sql
+    Pact5.initSchema sql
     moduleCacheVar <- newMVar (emptyDbCache dbCacheLimit)
     return Checkpointer
         { cpLogger = loggr
@@ -202,7 +201,6 @@ readFrom res maybeParent pactVersion doRead = do
             PactDb.getEndTxId "doReadFrom" res.cpSql maybeParent >>= traverse \startTxId -> do
             let
               -- is the parent the latest header, i.e., can we get away without rewinding?
-              -- TODO: just do this inside of the chainwebPactCoreBlockDb function?
               parentIsLatestHeader = case (latestHeader, maybeParent) of
                 (Nothing, Nothing) -> True
                 (Just (_, latestHash), Just (ParentHeader ph)) ->
@@ -215,12 +213,10 @@ readFrom res maybeParent pactVersion doRead = do
                 , Pact5._blockHandlerChainId = res.cpChainId
                 , Pact5._blockHandlerBlockHeight = currentHeight
                 , Pact5._blockHandlerMode = Pact5.Transactional
+                , Pact5._blockHandlerUpperBoundTxId = Pact5.TxId $ fromIntegral startTxId
+                , Pact5._blockHandlerAtTip = parentIsLatestHeader
                 }
-            let upperBound
-                  | parentIsLatestHeader = Nothing
-                  | otherwise = Just (currentHeight, coerce @Pact4.TxId @Pact5.TxId startTxId)
-            let pactDb
-                  = Pact5.chainwebPactBlockDb upperBound blockHandlerEnv
+            let pactDb = Pact5.chainwebPactBlockDb blockHandlerEnv
             r <- doRead pactDb (emptyPact5BlockHandle startTxId)
             return (r, sharedModuleCache)
           | otherwise ->
@@ -358,8 +354,10 @@ restoreAndSave res rewindParent blocks = do
                   , Pact5._blockHandlerBlockHeight = bh
                   , Pact5._blockHandlerChainId = res.cpChainId
                   , Pact5._blockHandlerMode = Pact5.Transactional
+                  , Pact5._blockHandlerUpperBoundTxId = Pact5.TxId $ fromIntegral txid
+                  , Pact5._blockHandlerAtTip = True
                   }
-                pactDb = Pact5.chainwebPactBlockDb Nothing blockEnv
+                pactDb = Pact5.chainwebPactBlockDb blockEnv
               -- run the block
               ((m', nextBlockHeader), blockHandle) <- runBlock pactDb maybeParent (emptyPact5BlockHandle txid)
               -- compute the accumulator early
diff --git a/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs
index 219f7faa0d..80226154d6 100644
--- a/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs
+++ b/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs
@@ -12,6 +12,7 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 -- TODO pact5: fix the orphan PactDbFor instance
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module: Chainweb.Pact4.Backend.ChainwebPactDb
@@ -24,7 +25,6 @@
 module Chainweb.Pact4.Backend.ChainwebPactDb
 ( chainwebPactDb
 , rewoundPactDb
-, initSchema
 , indexPactTransaction
 , vacuumDb
 , toTxLog
@@ -123,8 +123,21 @@ import Chainweb.Pact.Backend.Types
 import Chainweb.Utils.Serialization (runPutS)
 import Data.Foldable
 
-domainTableName :: Domain k v -> SQ3.Utf8
-domainTableName = asStringUtf8
+execMulti :: Traversable t => SQ3.Database -> SQ3.Utf8 -> t [SType] -> IO ()
+execMulti db q rows = bracket (prepStmt db q) destroy $ \stmt -> do
+    forM_ rows $ \row -> do
+        SQ3.reset stmt >>= checkError
+        SQ3.clearBindings stmt
+        bindParams stmt row
+        SQ3.step stmt >>= checkError
+  where
+    checkError (Left e) = void $ fail $ "error during batch insert: " ++ show e
+    checkError (Right _) = return ()
+
+    destroy x = void (SQ3.finalize x >>= checkError)
+
+domainTableName :: Domain k v -> Text
+domainTableName = asString
 
 convKeySetName :: KeySetName -> SQ3.Utf8
 convKeySetName = toUtf8 . asString
@@ -289,7 +302,7 @@ forModuleNameFix :: (Bool -> BlockHandler logger a) -> BlockHandler logger a
 forModuleNameFix f = view blockHandlerModuleNameFix >>= f
 
 -- TODO: speed this up, cache it?
-tableExistsInDbAtHeight :: Utf8 -> BlockHeight -> BlockHandler logger Bool
+tableExistsInDbAtHeight :: Text -> BlockHeight -> BlockHandler logger Bool
 tableExistsInDbAtHeight tableName bh = do
     let knownTbls =
           ["SYS:Pacts", "SYS:Modules", "SYS:KeySets", "SYS:Namespaces", "SYS:ModuleSources"]
@@ -299,7 +312,7 @@ tableExistsInDbAtHeight tableName bh = do
       let tableExistsStmt =
             -- table names are case-sensitive
             "SELECT tablename FROM VersionedTableCreation WHERE createBlockheight < ? AND lower(tablename) = lower(?)"
-      qry db tableExistsStmt [SInt $ max 0 (fromIntegral bh), SText tableName] [RText] >>= \case
+      qry db tableExistsStmt [SInt $ max 0 (fromIntegral bh), SText (toUtf8 tableName)] [RText] >>= \case
         [] -> return False
         _ -> return True
 
@@ -321,7 +334,6 @@ doReadRow mlim d k = forModuleNameFix $ \mnFix ->
         Pacts -> lookupWithKey (convPactId k) noCache
   where
     tableName = domainTableName d
-    (Utf8 tableNameBS) = tableName
 
     lookupWithKey
         :: forall logger v . FromJSON v
@@ -341,7 +353,7 @@ doReadRow mlim d k = forModuleNameFix $ \mnFix ->
         -> MaybeT (BlockHandler logger) v
     lookupInPendingData (Utf8 rowkey) p = do
         -- we get the latest-written value at this rowkey
-        allKeys <- hoistMaybe $ HashMap.lookup tableNameBS (_pendingWrites p)
+        allKeys <- hoistMaybe $ HashMap.lookup tableName (_pendingWrites p)
         ddata <- _deltaData . NE.head <$> hoistMaybe (HashMap.lookup rowkey allKeys)
         MaybeT $ return $! decodeStrict' ddata
 
@@ -360,7 +372,7 @@ doReadRow mlim d k = forModuleNameFix $ \mnFix ->
         let blockLimitStmt = maybe "" (const " AND txid < ?") mlim
         let blockLimitParam = maybe [] (\(TxId txid) -> [SInt $ fromIntegral txid]) (snd <$> mlim)
         let queryStmt =
-                "SELECT rowdata FROM " <> tbl tableName <> " WHERE rowkey = ?" <> blockLimitStmt
+                "SELECT rowdata FROM " <> tbl (toUtf8 tableName) <> " WHERE rowkey = ?" <> blockLimitStmt
                 <> " ORDER BY txid DESC LIMIT 1;"
         result <- lift $ callDb "doReadRow"
                        $ \db -> qry db queryStmt ([SText rowkey] ++ blockLimitParam) [RBlob]
@@ -386,13 +398,11 @@ doReadRow mlim d k = forModuleNameFix $ \mnFix ->
     noCache _key rowdata = MaybeT $ return $! decodeStrict' rowdata
 
 
-checkDbTablePendingCreation :: Utf8 -> MaybeT (BlockHandler logger) ()
+checkDbTablePendingCreation :: Text -> MaybeT (BlockHandler logger) ()
 checkDbTablePendingCreation tableName = do
     pds <- lift getPendingData
     forM_ pds $ \p ->
-        when (HashSet.member tableNameBS (_pendingTableCreation p)) mzero
-  where
-    (Utf8 tableNameBS) = tableName
+        when (HashSet.member tableName (_pendingTableCreation p)) mzero
 
 writeSys
     :: (AsString k, J.Encode v)
@@ -405,9 +415,8 @@ writeSys d k v = gets _bsTxId >>= go
     go txid = do
         forModuleNameFix $ \mnFix ->
           recordPendingUpdate (getKeyString mnFix k) tableName txid v
-        recordTxLog (toTableName tableName) d k v
+        recordTxLog (TableName tableName) d k v
 
-    toTableName (Utf8 str) = TableName $ T.decodeUtf8 str
     tableName = domainTableName d
 
     getKeyString mnFix = case d of
@@ -420,11 +429,11 @@ writeSys d k v = gets _bsTxId >>= go
 recordPendingUpdate
     :: J.Encode v
     => Utf8
-    -> Utf8
+    -> Text
     -> TxId
     -> v
     -> BlockHandler logger ()
-recordPendingUpdate (Utf8 key) (Utf8 tn) txid v = modifyPendingData modf
+recordPendingUpdate (Utf8 key) tn txid v = modifyPendingData modf
   where
     !vs = J.encodeStrict v
     delta = SQLiteRowDelta tn txid key vs
@@ -465,9 +474,8 @@ writeUser
     -> BlockHandler logger ()
 writeUser mlim wt d k rowdata@(RowData _ row) = gets _bsTxId >>= go
   where
-    toTableName = TableName . fromUtf8
     tn = domainTableName d
-    ttn = toTableName tn
+    ttn = TableName tn
 
     go txid = do
         m <- checkInsertIsOK mlim wt d k
@@ -524,26 +532,25 @@ doKeys mlim d = do
     blockLimitStmt = maybe "" (const " WHERE txid < ?;") mlim
     blockLimitParam = maybe [] (\(TxId txid) -> [SInt (fromIntegral txid)]) (snd <$> mlim)
     getDbKeys = do
-        m <- runMaybeT $ checkDbTablePendingCreation $ Utf8 tnS
+        m <- runMaybeT $ checkDbTablePendingCreation $ tn
         case m of
             Nothing -> return mempty
             Just () -> do
                 forM_ mlim (failIfTableDoesNotExistInDbAtHeight "doKeys" tn . fst)
                 ks <- callDb "doKeys" $ \db ->
-                          qry db ("SELECT DISTINCT rowkey FROM " <> tbl tn <> blockLimitStmt) blockLimitParam [RText]
+                          qry db ("SELECT DISTINCT rowkey FROM " <> tbl (toUtf8 tn) <> blockLimitStmt) blockLimitParam [RText]
                 forM ks $ \row -> do
                     case row of
                         [SText k] -> return $! T.unpack $ fromUtf8 k
                         _ -> internalError "doKeys: The impossible happened."
 
     tn = domainTableName d
-    tnS = let (Utf8 x) = tn in x
     collect p =
-        concatMap NE.toList $ HashMap.elems $ fromMaybe mempty $ HashMap.lookup tnS (_pendingWrites p)
+        concatMap NE.toList $ HashMap.elems $ fromMaybe mempty $ HashMap.lookup tn (_pendingWrites p)
 {-# INLINE doKeys #-}
 
 failIfTableDoesNotExistInDbAtHeight
-  :: Text -> Utf8 -> BlockHeight -> BlockHandler logger ()
+  :: Text -> Text -> BlockHeight -> BlockHandler logger ()
 failIfTableDoesNotExistInDbAtHeight caller tn bh = do
     exists <- tableExistsInDbAtHeight tn bh
     -- we must reproduce errors that were thrown in earlier blocks from tables
@@ -567,7 +574,7 @@ doTxIds (TableName tn) _tid@(TxId tid) = do
 
   where
     getFromDb = do
-        m <- runMaybeT $ checkDbTablePendingCreation $ Utf8 tnS
+        m <- runMaybeT $ checkDbTablePendingCreation tn
         case m of
             Nothing -> return mempty
             Just () -> do
@@ -581,13 +588,12 @@ doTxIds (TableName tn) _tid@(TxId tid) = do
 
     stmt = "SELECT DISTINCT txid FROM " <> tbl (toUtf8 tn) <> " WHERE txid > ?"
 
-    tnS = T.encodeUtf8 tn
     collect p =
         let txids = fmap _deltaTxId $
                     concatMap NE.toList $
                     HashMap.elems $
                     fromMaybe mempty $
-                    HashMap.lookup tnS (_pendingWrites p)
+                    HashMap.lookup tn (_pendingWrites p)
         in filter (> _tid) txids
 {-# INLINE doTxIds #-}
 
@@ -626,23 +632,23 @@ doCreateUserTable
     -> BlockHandler logger ()
 doCreateUserTable mbh tn@(TableName ttxt) mn = do
     -- first check if tablename already exists in pending queues
-    m <- runMaybeT $ checkDbTablePendingCreation (Utf8 $ T.encodeUtf8 ttxt)
+    m <- runMaybeT $ checkDbTablePendingCreation ttxt
     case m of
       Nothing -> throwM $ PactDuplicateTableError ttxt
       Just () -> do
           -- then check if it is in the db
           lcTables <- view blockHandlerLowerCaseTables
-          cond <- inDb lcTables $ Utf8 $ T.encodeUtf8 ttxt
+          cond <- inDb lcTables ttxt
           when cond $ throwM $ PactDuplicateTableError ttxt
           modifyPendingData
-            $ over pendingTableCreation (HashSet.insert (T.encodeUtf8 ttxt))
+            $ over pendingTableCreation (HashSet.insert ttxt)
             . over pendingTxLogMap (M.insertWith DL.append (TableName txlogKey) txlogs)
   where
     inDb lcTables t = do
       r <- callDb "doCreateUserTable" $ \db ->
-        qry db (tableLookupStmt lcTables) [SText t] [RText]
+        qry db (tableLookupStmt lcTables) [SText (toUtf8 t)] [RText]
       case r of
-        [[SText rname]] ->
+        [[SText (Utf8 (T.decodeUtf8 -> rname))]] ->
           case mbh of
               -- if lowercase matching, no need to check equality
               -- (wasn't needed before either but leaving alone for replay)
@@ -738,7 +744,6 @@ doGetTxLog d txid = do
 
   where
     tableName = domainTableName d
-    Utf8 tableNameBS = tableName
 
     readFromPending = do
         allPendingData <- getPendingData
@@ -748,7 +753,7 @@ doGetTxLog d txid = do
                 pending <- allPendingData
                 -- all writes to the table
                 let writesAtTableByKey =
-                        fromMaybe mempty $ HashMap.lookup tableNameBS $ _pendingWrites pending
+                        fromMaybe mempty $ HashMap.lookup tableName $ _pendingWrites pending
                 -- a list of all writes to the table for some particular key
                 allWritesForSomeKey <- HashMap.elems writesAtTableByKey
                 -- the single latest write to the table for that key which is
@@ -771,7 +776,7 @@ doGetTxLog d txid = do
             err -> internalError $
               "readHistoryResult: Expected single row with two columns as the \
               \result, got: " <> T.pack (show err)
-    stmt = "SELECT rowkey, rowdata FROM " <> tbl tableName <> " WHERE txid = ?"
+    stmt = "SELECT rowkey, rowdata FROM " <> tbl (toUtf8 tableName) <> " WHERE txid = ?"
 
 
 toTxLog :: MonadThrow m =>
@@ -796,7 +801,7 @@ vacuumDb = callDb "vacuumDb" (`exec_` "VACUUM;")
 commitBlockStateToDatabase :: SQLiteEnv -> BlockHash -> BlockHeight -> BlockHandle Pact4 -> IO ()
 commitBlockStateToDatabase db hsh bh blockHandle = do
   let newTables = _pendingTableCreation $ _blockHandlePending blockHandle
-  mapM_ (\tn -> createUserTable (Utf8 tn)) newTables
+  mapM_ (\tn -> createUserTable tn) newTables
   let writeV = toChunks $ _pendingWrites (_blockHandlePending blockHandle)
   backendWriteUpdateBatch writeV
   indexPendingPactTransactions
@@ -805,7 +810,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
   where
     toChunks writes =
       over _2 (concatMap toList . HashMap.elems) .
-      over _1 Utf8 <$> HashMap.toList writes
+      over _1 toUtf8 <$> HashMap.toList writes
 
     backendWriteUpdateBatch
         :: [(Utf8, [SQLiteRowDelta])]
@@ -843,8 +848,8 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
         stmt =
           "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);"
 
-    createUserTable :: Utf8 -> IO ()
-    createUserTable tablename = do
+    createUserTable :: Text -> IO ()
+    createUserTable (toUtf8 -> tablename) = do
         createVersionedTable tablename db
         markTableCreation tablename
 
@@ -868,3 +873,19 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
             let rows = map toRow $ toList txs
             execMulti db "INSERT INTO TransactionIndex (txhash, blockheight) \
                          \ VALUES (?, ?)" rows
+
+
+createVersionedTable :: Utf8 -> Database -> IO ()
+createVersionedTable tablename db = do
+    exec_ db createtablestmt
+    exec_ db indexcreationstmt
+    where
+    ixName = tablename <> "_ix"
+    createtablestmt =
+        "CREATE TABLE IF NOT EXISTS " <> tbl tablename <> " \
+                \ (rowkey TEXT\
+                \, txid UNSIGNED BIGINT NOT NULL\
+                \, rowdata BLOB NOT NULL\
+                \, UNIQUE (rowkey, txid));"
+    indexcreationstmt =
+        "CREATE INDEX IF NOT EXISTS " <> tbl ixName <> " ON " <> tbl tablename <> "(txid DESC);"
diff --git a/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs
index bb5e1d63eb..9522f96eb6 100644
--- a/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs
+++ b/src/Chainweb/Pact5/Backend/ChainwebPactDb.hs
@@ -69,6 +69,7 @@ module Chainweb.Pact5.Backend.ChainwebPactDb
     , domainTableName
     , convRowKey
     , commitBlockStateToDatabase
+    , initSchema
     ) where
 
 import Control.Applicative
@@ -85,6 +86,7 @@ import Control.Concurrent.MVar
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.DList as DL
+import Data.Foldable
 import Data.List(sort)
 import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HashMap
@@ -92,7 +94,6 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
--- import Data.Default
 import qualified Database.SQLite3.Direct as SQ3
 
 import Prelude hiding (concat, log)
@@ -100,7 +101,6 @@ import Prelude hiding (concat, log)
 -- pact
 
 import qualified Pact.Types.Persistence as Pact4
-import Pact.Types.SQLite hiding (liftEither)
 
 
 import qualified Pact.Core.Evaluate as Pact
@@ -111,6 +111,9 @@ import qualified Pact.Core.Serialise as Pact
 import qualified Pact.Core.Builtin as Pact
 import qualified Pact.Core.Errors as Pact
 import qualified Pact.Core.Gas as Pact
+import Pact.Core.Command.Types (RequestKey (..))
+import Pact.Core.Hash
+import Pact.Core.StableEncoding (encodeStable)
 
 -- chainweb
 
@@ -120,7 +123,7 @@ import Chainweb.Logger
 import Chainweb.Pact.Backend.Utils
 import Chainweb.Pact.Backend.Types
 import Chainweb.Utils (sshow, T2)
-import Pact.Core.StableEncoding (encodeStable)
+import Chainweb.Utils.Serialization (runPutS)
 import Data.Text (Text)
 import Chainweb.Version
 import Data.DList (DList)
@@ -129,21 +132,95 @@ import Chainweb.BlockHash
 import Data.Vector (Vector)
 import qualified Data.ByteString.Short as SB
 import Data.HashMap.Strict (HashMap)
-import Pact.Core.Command.Types (RequestKey (..))
-import Pact.Core.Hash
 import qualified Data.HashMap.Strict as HM
 import qualified Chainweb.Pact.Backend.InMemDb as InMemDb
 import Data.Singletons (Dict(..))
-import Chainweb.Utils.Serialization (runPutS)
-import Data.Foldable
+import Pact.Core.Persistence (throwDbOpErrorGasM)
+import Data.Int
+import GHC.Stack
+
+data InternalDbException = InternalDbException CallStack Text
+instance Show InternalDbException where show = displayException
+instance Exception InternalDbException where
+    displayException (InternalDbException stack text) =
+        T.unpack text <> "\n\n" <>
+        prettyCallStack stack
+
+internalDbError :: HasCallStack => MonadThrow m => Text -> m a
+internalDbError = throwM . InternalDbException callStack
+
+throwOnDbError :: (HasCallStack, MonadThrow m) => ExceptT SQ3.Error m a -> m a
+throwOnDbError act = runExceptT act >>= either (internalDbError . sshow) return
+
+-- | Statement input types
+data SType = SInt Int64 | SDouble Double | SText SQ3.Utf8 | SBlob BS.ByteString deriving (Eq,Show)
+-- | Result types
+data RType = RInt | RDouble | RText | RBlob deriving (Eq,Show)
+
+bindParams :: SQ3.Statement -> [SType] -> ExceptT SQ3.Error IO ()
+bindParams stmt as =
+    forM_ (zip as [1..]) $ \(a,i) -> ExceptT $
+      case a of
+        SInt n -> SQ3.bindInt64 stmt i n
+        SDouble n -> SQ3.bindDouble stmt i n
+        SText n -> SQ3.bindText stmt i n
+        SBlob n -> SQ3.bindBlob stmt i n
+
+prepStmt :: HasCallStack => SQ3.Database -> SQ3.Utf8 -> ExceptT SQ3.Error IO SQ3.Statement
+prepStmt c q = do
+    r <- ExceptT $ SQ3.prepare c q
+    case r of
+        Nothing -> internalDbError "No SQL statements in prepared statement"
+        Just s -> return s
+
+execMulti :: Traversable t => SQ3.Database -> SQ3.Utf8 -> t [SType] -> ExceptT SQ3.Error IO ()
+execMulti db q rows = bracket (prepStmt db q) (liftIO . SQ3.finalize) $ \stmt -> do
+    forM_ rows $ \row -> do
+        ExceptT $ SQ3.reset stmt
+        liftIO $ SQ3.clearBindings stmt
+        bindParams stmt row
+        ExceptT $ SQ3.step stmt
+
+-- | Prepare/execute query with params
+qry :: SQ3.Database -> SQ3.Utf8 -> [SType] -> [RType] -> ExceptT SQ3.Error IO [[SType]]
+qry e q as rts = bracket (prepStmt e q) (ExceptT . SQ3.finalize) $ \stmt -> do
+    bindParams stmt as
+    reverse <$> stepStmt stmt rts
+
+stepStmt :: SQ3.Statement -> [RType] -> ExceptT SQ3.Error IO [[SType]]
+stepStmt stmt rts = do
+    let acc rs SQ3.Done = return rs
+        acc rs SQ3.Row = do
+            as <- lift $ forM (zip rts [0..]) $ \(rt,ci) ->
+                case rt of
+                    RInt -> SInt <$> SQ3.columnInt64 stmt ci
+                    RDouble -> SDouble <$> SQ3.columnDouble stmt ci
+                    RText -> SText <$> SQ3.columnText stmt ci
+                    RBlob -> SBlob <$> SQ3.columnBlob stmt ci
+            sr <- ExceptT $ SQ3.step stmt
+            acc (as:rs) sr
+    sr <- ExceptT $ SQ3.step stmt
+    acc [] sr
+
+-- | Prepare/exec statement with no params
+exec_ :: SQ3.Database -> SQ3.Utf8 -> ExceptT SQ3.Error IO ()
+exec_ e q = ExceptT $ over _Left fst <$> SQ3.exec e q
+
+-- | Prepare/exec statement with params
+exec' :: SQ3.Database -> SQ3.Utf8 -> [SType] -> ExceptT SQ3.Error IO ()
+exec' e q as = bracket (prepStmt e q) (ExceptT . SQ3.finalize) $ \stmt -> do
+    bindParams stmt as
+    void $ ExceptT (SQ3.step stmt)
 
 data BlockHandlerEnv logger = BlockHandlerEnv
     { _blockHandlerDb :: !SQLiteEnv
     , _blockHandlerLogger :: !logger
     , _blockHandlerVersion :: !ChainwebVersion
     , _blockHandlerBlockHeight :: !BlockHeight
+    , _blockHandlerUpperBoundTxId :: !Pact.TxId
     , _blockHandlerChainId :: !ChainId
     , _blockHandlerMode :: !Pact.ExecutionMode
+    , _blockHandlerAtTip :: Bool
     }
 
 -- | The state used by database operations.
@@ -160,6 +237,9 @@ makeLensesWith
         [ ("_blockHandlerDb", "blockHandlerDb")
         , ("_blockHandlerLogger", "blockHandlerLogger")
         , ("_blockHandlerMode", "blockHandlerMode")
+        , ("_blockHandlerUpperBoundTxId", "blockHandlerUpperBoundTxId")
+        , ("_blockHandlerBlockHeight", "blockHandlerBlockHeight")
+        , ("_blockHandlerAtTip", "blockHandlerAtTip")
         ])
     ''BlockHandlerEnv
 
@@ -206,18 +286,6 @@ newtype BlockHandler logger a = BlockHandler
         , MonadReader (BlockHandlerEnv logger)
         )
 
-callDb
-    :: (MonadThrow m, MonadReader (BlockHandlerEnv logger) m, MonadIO m)
-    => T.Text
-    -> (SQ3.Database -> IO b)
-    -> m b
-callDb callerName action = do
-    c <- asks _blockHandlerDb
-    res <- liftIO $ tryAny $ action c
-    case res of
-        Left err -> internalDbError $ "callDb (" <> callerName <> "): " <> sshow err
-        Right r -> return r
-
 domainTableName :: Pact.Domain k v b i -> SQ3.Utf8
 domainTableName = toUtf8 . Pact.renderDomain
 
@@ -243,15 +311,6 @@ convPactId pid = "PactId \"" <> Pact.renderDefPactId pid <> "\""
 convHashedModuleName :: Pact.HashedModuleName -> Text
 convHashedModuleName = Pact.renderHashedModuleName
 
-
-newtype InternalDbException = InternalDbException Text
-  deriving newtype (Eq)
-  deriving stock (Show)
-  deriving anyclass (Exception)
-
-internalDbError :: MonadThrow m => Text -> m a
-internalDbError = throwM . InternalDbException
-
 liftGas :: Pact.GasM Pact.CoreBuiltin Pact.Info a -> BlockHandler logger a
 liftGas g = BlockHandler (lift (lift g))
 
@@ -267,19 +326,19 @@ runOnBlockGassed env stateVar act = do
         return (newState, fmap fst r)
     liftEither r
 
-chainwebPactBlockDb :: (Logger logger) => Maybe (BlockHeight, Pact.TxId) -> BlockHandlerEnv logger -> Pact5Db
-chainwebPactBlockDb maybeLimit env = Pact5Db
+chainwebPactBlockDb :: (Logger logger) => BlockHandlerEnv logger -> Pact5Db
+chainwebPactBlockDb env = Pact5Db
     { doPact5DbTransaction = \blockHandle maybeRequestKey kont -> do
         stateVar <- newMVar $ BlockState blockHandle (_blockHandlePending blockHandle) Nothing
-        let basePactDb = Pact.PactDb
+        let pactDb = Pact.PactDb
                 { Pact._pdbPurity = Pact.PImpure
-                , Pact._pdbRead = \d k -> runOnBlockGassed env stateVar $ doReadRow Nothing d k
+                , Pact._pdbRead = \d k -> runOnBlockGassed env stateVar $ doReadRow d k
                 , Pact._pdbWrite = \wt d k v ->
-                    runOnBlockGassed env stateVar $ doWriteRow Nothing wt d k v
+                    runOnBlockGassed env stateVar $ doWriteRow wt d k v
                 , Pact._pdbKeys = \d ->
-                    runOnBlockGassed env stateVar $ doKeys Nothing d
+                    runOnBlockGassed env stateVar $ doKeys d
                 , Pact._pdbCreateUserTable = \tn ->
-                    runOnBlockGassed env stateVar $ doCreateUserTable Nothing tn
+                    runOnBlockGassed env stateVar $ doCreateUserTable tn
                 , Pact._pdbBeginTx = \m ->
                     runOnBlockGassed env stateVar $ doBegin m
                 , Pact._pdbCommitTx =
@@ -287,24 +346,15 @@ chainwebPactBlockDb maybeLimit env = Pact5Db
                 , Pact._pdbRollbackTx =
                     runOnBlockGassed env stateVar doRollback
                 }
-        let maybeLimitedPactDb = case maybeLimit of
-                Just (bh, endTxId) -> basePactDb
-                    { Pact._pdbRead = \d k -> runOnBlockGassed env stateVar $ doReadRow (Just (bh, endTxId)) d k
-                    , Pact._pdbWrite = \wt d k v -> do
-                        runOnBlockGassed env stateVar $ doWriteRow (Just (bh, endTxId)) wt d k v
-                    , Pact._pdbKeys = \d -> runOnBlockGassed env stateVar $ doKeys (Just (bh, endTxId)) d
-                    , Pact._pdbCreateUserTable = \tn -> do
-                        runOnBlockGassed env stateVar $ doCreateUserTable (Just bh) tn
-                    }
-                Nothing -> basePactDb
-        r <- kont maybeLimitedPactDb
+        r <- kont pactDb
         finalState <- readMVar stateVar
         -- Register a successful transaction in the pending data for the block
         let registerRequestKey = case maybeRequestKey of
                 Just requestKey -> HashSet.insert (SB.fromShort $ unHash $ unRequestKey requestKey)
                 Nothing -> id
         let finalHandle =
-                _bsBlockHandle finalState & blockHandlePending . pendingSuccessfulTxs %~ registerRequestKey
+                _bsBlockHandle finalState
+                    & blockHandlePending . pendingSuccessfulTxs %~ registerRequestKey
 
         return (r, finalHandle)
     , lookupPactTransactions =
@@ -313,117 +363,147 @@ chainwebPactBlockDb maybeLimit env = Pact5Db
         fmap (unHash . unRequestKey)
     }
 
--- TODO: speed this up, cache it?
-tableExistsInDbAtHeight :: SQ3.Utf8 -> BlockHeight -> BlockHandler logger Bool
-tableExistsInDbAtHeight tablename bh = do
-    let knownTbls =
-            ["SYS:Pacts", "SYS:Modules", "SYS:KeySets", "SYS:Namespaces", "SYS:ModuleSources"]
-    if tablename `elem` knownTbls
-    then return True
-    else callDb "tableExists" $ \db -> do
-        let tableExistsStmt =
-                -- table names are case-sensitive
-                "SELECT tablename FROM VersionedTableCreation WHERE createBlockheight < ? AND lower(tablename) = lower(?)"
-        qry db tableExistsStmt [SInt $ max 0 (fromIntegral bh), SText tablename] [RText] >>= \case
-            [] -> return False
-            _ -> return True
-
 doReadRow
     :: forall k v logger
-    . Maybe (BlockHeight, Pact.TxId)
     -- ^ the highest block we should be reading writes from
-    -> Pact.Domain k v Pact.CoreBuiltin Pact.Info
+    . Pact.Domain k v Pact.CoreBuiltin Pact.Info
     -> k
     -> BlockHandler logger (Maybe v)
-doReadRow mlim d k = do
-    pendingData <- use bsPendingTxWrites
-    let !(decodeValue, encodedKey, ordDict :: Dict (Ord k) ()) = case d of
-            Pact.DKeySets ->
-                (Pact._decodeKeySet Pact.serialisePact_lineinfo, convKeySetName k, Dict ())
-            -- TODO: This is incomplete (the modules case), due to namespace
-            -- resolution concerns
-            Pact.DModules ->
-                (Pact._decodeModuleData Pact.serialisePact_lineinfo, convModuleName k, Dict ())
-            Pact.DNamespaces ->
-                (Pact._decodeNamespace Pact.serialisePact_lineinfo, convNamespaceName k, Dict ())
-            Pact.DUserTables _ ->
-                (Pact._decodeRowData Pact.serialisePact_lineinfo, convRowKey k, Dict ())
-            Pact.DDefPacts ->
-                (Pact._decodeDefPactExec Pact.serialisePact_lineinfo, convPactId k, Dict ())
-            Pact.DModuleSource ->
-                (Pact._decodeModuleCode Pact.serialisePact_lineinfo, convHashedModuleName k, Dict ())
-    case ordDict of
-        Dict () -> do
-            lookupWithKey pendingData (toUtf8 encodedKey) (fmap (view Pact.document) . decodeValue) >>= \case
-                Nothing -> return Nothing
-                Just (encodedValueLength, decodedValue) -> do
-                    case d of
-                        Pact.DModules -> do
-                            BlockHandler $ lift $ lift
-                                $ Pact.chargeGasM (Pact.GModuleOp (Pact.MOpLoadModule encodedValueLength))
-                        _ -> return ()
-                    case d of
-                        Pact.DModuleSource -> return ()
-                        _ ->
-                            bsPendingTxWrites . pendingWrites %=
-                                InMemDb.insert d k (InMemDb.ReadEntry encodedValueLength decodedValue)
-                    return (Just decodedValue)
-  where
-    tablename = domainTableName d
-
-    lookupWithKey
-        :: Ord k
-        => SQLitePendingData InMemDb.Store
-        -> SQ3.Utf8
-        -> (BS.ByteString -> Maybe v)
-        -> BlockHandler logger (Maybe (Int, v))
-    lookupWithKey pds key f = do
-        let lookPD = lookupInMem pds
-        let lookDB = lookupInDb f key
-        runMaybeT (lookPD <|> lookDB)
-
-    lookupInMem
-        :: Ord k
-        => SQLitePendingData InMemDb.Store
-        -> MaybeT (BlockHandler logger) (Int, v)
-    lookupInMem p = do
-        -- we get the latest-written value at this rowkey
-        let store = _pendingWrites p
-        case InMemDb.lookup d k store of
-            Nothing -> empty
-            Just (InMemDb.ReadEntry bs a) -> return (bs, a)
-            Just (InMemDb.WriteEntry _ bs a) -> return (BS.length bs, a)
-
-    lookupInDb
-        :: (BS.ByteString -> Maybe v)
-        -> SQ3.Utf8
-        -> MaybeT (BlockHandler logger) (Int, v)
-    lookupInDb decode rowkey = do
-        -- First, check: did we create this table during this block? If so,
-        -- there's no point in looking up the key.
-        checkDbTablePendingCreation tablename
-        lift $ forM_ mlim $ \(bh, _) ->
-            failIfTableDoesNotExistInDbAtHeight "doReadRow" tablename bh
-        -- we inject the endingtx limitation to reduce the scope up to the provided block height
-        let blockLimitStmt = maybe "" (const " AND txid < ?") mlim
-        let blockLimitParam = maybe [] (\(Pact.TxId txid) -> [SInt $ fromIntegral txid]) (snd <$> mlim)
-        let queryStmt =
-                "SELECT rowdata FROM " <> tbl tablename <> " WHERE rowkey = ?" <> blockLimitStmt
-                <> " ORDER BY txid DESC LIMIT 1;"
-        result <- lift $ callDb "doReadRow"
-                       $ \db -> qry db queryStmt ([SText rowkey] ++ blockLimitParam) [RBlob]
-        case result of
-            [] -> mzero
-            [[SBlob a]] -> MaybeT $ return $ (BS.length a,) <$> decode a
-            err -> internalDbError $
-                     "doReadRow: Expected (at most) a single result, but got: " <>
-                     T.pack (show err)
-
-
-checkDbTablePendingCreation :: SQ3.Utf8 -> MaybeT (BlockHandler logger) ()
-checkDbTablePendingCreation (SQ3.Utf8 tablename) = do
+doReadRow d k = do
+    runMaybeT (MaybeT lookupInMem <|> MaybeT lookupInDb) >>= \case
+        Nothing -> return Nothing
+        Just (encodedValueLength, decodedValue) -> do
+            case d of
+                Pact.DModules -> do
+                    BlockHandler $ lift $ lift
+                        $ Pact.chargeGasM (Pact.GModuleOp (Pact.MOpLoadModule encodedValueLength))
+                _ -> return ()
+            bsPendingTxWrites . pendingWrites %=
+                InMemDb.insert d k (InMemDb.ReadEntry encodedValueLength decodedValue)
+            return (Just decodedValue)
+    where
+    (decodeValueDoc, encodedKey) = case d of
+        Pact.DKeySets ->
+            (Pact._decodeKeySet Pact.serialisePact_lineinfo, convKeySetName k)
+        Pact.DModules ->
+            (Pact._decodeModuleData Pact.serialisePact_lineinfo, convModuleName k)
+        Pact.DNamespaces ->
+            (Pact._decodeNamespace Pact.serialisePact_lineinfo, convNamespaceName k)
+        Pact.DUserTables _ ->
+            (Pact._decodeRowData Pact.serialisePact_lineinfo, convRowKey k)
+        Pact.DDefPacts ->
+            (Pact._decodeDefPactExec Pact.serialisePact_lineinfo, convPactId k)
+        Pact.DModuleSource ->
+            (Pact._decodeModuleCode Pact.serialisePact_lineinfo, convHashedModuleName k)
+
+    lookupInMem :: BlockHandler logger (Maybe (Int, v))
+    lookupInMem = do
+            store <- use (bsPendingTxWrites . pendingWrites)
+            return $ InMemDb.lookup d k store <&> \case
+                (InMemDb.ReadEntry len a) -> (len, a)
+                (InMemDb.WriteEntry _ bs a) -> (BS.length bs, a)
+
+    decodeValue = fmap (view Pact.document) . decodeValueDoc
+    encodedKeyUtf8 = toUtf8 encodedKey
+
+    lookupInDb :: BlockHandler logger (Maybe (Int, v))
+    lookupInDb = do
+        case d of
+            Pact.DUserTables pactTableName -> do
+                -- if the table is pending creation, we also return Nothing
+                fmap join $ withTableExistenceCheck pactTableName fetchRowFromDb
+            _ -> throwOnDbError $ fetchRowFromDb
+        where
+        fetchRowFromDb :: ExceptT SQ3.Error (BlockHandler logger) (Maybe (Int, v))
+        fetchRowFromDb = do
+            Pact.TxId txIdUpperBoundWord64 <- view blockHandlerUpperBoundTxId
+            let tablename = domainTableName d
+            let queryStmt =
+                    "SELECT rowdata FROM " <> tbl tablename <> " WHERE rowkey = ? AND txid < ?"
+                    <> " ORDER BY txid DESC LIMIT 1;"
+            db <- view blockHandlerDb
+            result <- mapExceptT liftIO $
+                qry db queryStmt [SText encodedKeyUtf8, SInt (fromIntegral txIdUpperBoundWord64)] [RBlob]
+            case result of
+                [] -> return Nothing
+                [[SBlob a]] -> return $ (BS.length a,) <$> decodeValue a
+                err -> internalDbError $
+                    "doReadRow: Expected (at most) a single result, but got: " <>
+                    sshow err
+
+data TableStatus
+    = TableCreationPending
+    | TableExists
+    | TableDoesNotExist
+
+checkTableStatus :: Pact.TableName -> BlockHandler logger TableStatus
+checkTableStatus tableName = do
     pds <- use bsPendingTxWrites
-    when (HashSet.member tablename (_pendingTableCreation pds)) mzero
+    if
+        Pact.renderTableName tableName
+        `HashSet.member`
+        _pendingTableCreation pds
+    then return TableCreationPending
+
+    else if
+        InMemDb.checkTableSeen tableName (_pendingWrites pds)
+    then
+        return TableExists
+
+    else do
+        exists <- checkTableExistsInDb
+        when exists $
+            bsPendingTxWrites . pendingWrites
+                %= InMemDb.markTableSeen tableName
+        return $
+            if exists then TableExists else TableDoesNotExist
+
+    where
+    checkTableExistsInDb :: BlockHandler logger Bool
+    checkTableExistsInDb = do
+        bh <- view blockHandlerBlockHeight
+        db <- view blockHandlerDb
+        tableExistsResult <- liftIO $ throwOnDbError $
+            qry db tableExistsStmt
+                [SInt $ max 0 (fromIntegral bh), SText $ tableNameToSQL tableName]
+                [RText]
+        tableExists <- case tableExistsResult of
+            [] -> return False
+            _ -> return True
+        return tableExists
+        where
+        tableExistsStmt =
+            -- table names are case-insensitive
+            "SELECT tablename FROM VersionedTableCreation WHERE createBlockheight < ? AND lower(tablename) = lower(?)"
+
+-- we ideally produce `NoSuchTable` errors for accesses to user tables that
+-- don't exist, so when doing such accesses, wrap them with
+-- `withTableExistenceCheck`.  we cache knowledge of tables' existence in
+-- `checkTableStatus`, too.  returns `Nothing` if the table is pending creation
+-- in this block; usually, this means that we halt before accessing the db to
+-- look in the table.
+withTableExistenceCheck :: HasCallStack => Pact.TableName -> ExceptT SQ3.Error (BlockHandler logger) a -> BlockHandler logger (Maybe a)
+withTableExistenceCheck tableName action = do
+    atTip <- view blockHandlerAtTip
+    if atTip
+    -- at tip, speculatively execute the statement, and only check if the table
+    -- was missing if the statement threw an error
+    then runExceptT action >>= \case
+        Left err@SQ3.ErrorError -> do
+            tableStatus <- checkTableStatus tableName
+            case tableStatus of
+                TableDoesNotExist -> liftGas $ throwDbOpErrorGasM $ Pact.NoSuchTable tableName
+                TableCreationPending -> return Nothing
+                TableExists -> internalDbError (sshow err)
+        Left err -> internalDbError (sshow err)
+        Right result -> return (Just result)
+    else do
+        -- if we're rewound, we just check if the table exists first
+        tableStatus <- checkTableStatus tableName
+        case tableStatus of
+            TableDoesNotExist -> liftGas $ throwDbOpErrorGasM $ Pact.NoSuchTable tableName
+            TableCreationPending -> return Nothing
+            TableExists -> throwOnDbError (Just <$> action)
 
 latestTxId :: Lens' BlockState Pact.TxId
 latestTxId = bsBlockHandle . blockHandleTxId . coerced
@@ -434,16 +514,16 @@ writeSys
     -> v
     -> BlockHandler logger ()
 writeSys d k v = do
-  txid <- use latestTxId
-  let (kk, vv) = case d of
-        Pact.DKeySets -> (convKeySetName k, Pact._encodeKeySet Pact.serialisePact_lineinfo v)
-        Pact.DModules ->  (convModuleName k, Pact._encodeModuleData Pact.serialisePact_lineinfo v)
-        Pact.DNamespaces -> (convNamespaceName k, Pact._encodeNamespace Pact.serialisePact_lineinfo v)
-        Pact.DDefPacts -> (convPactId k, Pact._encodeDefPactExec Pact.serialisePact_lineinfo v)
-        Pact.DUserTables _ -> error "impossible"
-        Pact.DModuleSource -> (convHashedModuleName k, Pact._encodeModuleCode Pact.serialisePact_lineinfo v)
-  recordPendingUpdate d k txid (vv, v)
-  recordTxLog d kk vv
+    txid <- use latestTxId
+    let !(!encodedKey, !encodedValue) = case d of
+            Pact.DKeySets -> (convKeySetName k, Pact._encodeKeySet Pact.serialisePact_lineinfo v)
+            Pact.DModules ->  (convModuleName k, Pact._encodeModuleData Pact.serialisePact_lineinfo v)
+            Pact.DNamespaces -> (convNamespaceName k, Pact._encodeNamespace Pact.serialisePact_lineinfo v)
+            Pact.DDefPacts -> (convPactId k, Pact._encodeDefPactExec Pact.serialisePact_lineinfo v)
+            Pact.DUserTables _ -> error "impossible"
+            Pact.DModuleSource -> (convHashedModuleName k, Pact._encodeModuleCode Pact.serialisePact_lineinfo v)
+    recordPendingUpdate d k txid (encodedValue, v)
+    recordTxLog d encodedKey encodedValue
 
 recordPendingUpdate
     :: Pact.Domain k v Pact.CoreBuiltin Pact.Info
@@ -455,75 +535,52 @@ recordPendingUpdate d k txid (encodedValue, decodedValue) =
     bsPendingTxWrites . pendingWrites %=
         InMemDb.insert d k (InMemDb.WriteEntry txid encodedValue decodedValue)
 
-checkInsertIsOK
-    :: Maybe (BlockHeight, Pact.TxId)
-    -> Pact.TableName
-    -- ^ the highest block we should be reading writes from
-    -> Pact.WriteType
-    -> Pact.Domain Pact.RowKey Pact.RowData Pact.CoreBuiltin Pact.Info
-    -> Pact.RowKey
-    -> BlockHandler logger (Maybe Pact.RowData)
-checkInsertIsOK mlim tn wt d k = do
-    olds <- doReadRow mlim d k
-    case (olds, wt) of
-        (Nothing, Pact.Insert) -> return Nothing
-        (Just _, Pact.Insert) -> liftGas $ Pact.throwDbOpErrorGasM (Pact.RowFoundError tn k)
-        (Nothing, Pact.Write) -> return Nothing
-        (Just old, Pact.Write) -> return $ Just old
-        (Just old, Pact.Update) -> return $ Just old
-        (Nothing, Pact.Update) -> liftGas $ Pact.throwDbOpErrorGasM (Pact.NoRowFound tn k)
-
 writeUser
-    :: Maybe (BlockHeight, Pact.TxId)
-    -- ^ the highest block we should be reading writes from
-    -> Pact.WriteType
-    -> Pact.Domain Pact.RowKey Pact.RowData Pact.CoreBuiltin Pact.Info
+    :: Pact.WriteType
+    -> Pact.TableName
     -> Pact.RowKey
     -> Pact.RowData
     -> BlockHandler logger ()
-writeUser mlim wt d k rowdata@(Pact.RowData row) = do
+writeUser wt tableName k (Pact.RowData newRow) = do
     Pact.TxId txid <- use latestTxId
-    let (Pact.DUserTables tname) = d
-    m <- checkInsertIsOK mlim tname wt d k
-    row' <- case m of
-        Nothing -> ins txid
-        Just old -> upd txid old
-    liftGas (Pact._encodeRowData Pact.serialisePact_lineinfo row') >>=
-        \encoded -> recordTxLog d (convRowKey k) encoded
-  where
-
-  upd txid (Pact.RowData oldrow) = do
-      let row' = Pact.RowData (M.union row oldrow)
-      liftGas (Pact._encodeRowData Pact.serialisePact_lineinfo row') >>=
-          \encoded -> do
-              recordPendingUpdate d k (Pact.TxId txid) (encoded, row')
-              return row'
+    maybeExistingValue <- doReadRow (Pact.DUserTables tableName) k
+    checkInsertIsOK maybeExistingValue
+    finalRow <- case maybeExistingValue of
+        Nothing -> return $ Pact.RowData newRow
+        Just (Pact.RowData oldRow) -> return $ Pact.RowData $ M.union newRow oldRow
+    encodedFinalRow <- liftGas (Pact._encodeRowData Pact.serialisePact_lineinfo finalRow)
+    recordTxLog (Pact.DUserTables tableName) (convRowKey k) encodedFinalRow
+    recordPendingUpdate (Pact.DUserTables tableName) k (Pact.TxId txid) (encodedFinalRow, finalRow)
+    where
 
-  ins txid = do
-      liftGas (Pact._encodeRowData Pact.serialisePact_lineinfo rowdata) >>=
-          \encoded -> do
-              recordPendingUpdate d k (Pact.TxId txid) (encoded, rowdata)
-              return rowdata
+    -- only for user tables, we check first if the insertion is legal before doing it.
+    checkInsertIsOK :: Maybe Pact.RowData -> BlockHandler logger ()
+    checkInsertIsOK olds = do
+        case (olds, wt) of
+            (Nothing, Pact.Insert) -> return ()
+            (Just _, Pact.Insert) -> liftGas $ Pact.throwDbOpErrorGasM (Pact.RowFoundError tableName k)
+            (Nothing, Pact.Write) -> return ()
+            (Just _, Pact.Write) -> return ()
+            (Just _, Pact.Update) -> return ()
+            (Nothing, Pact.Update) -> liftGas $ Pact.throwDbOpErrorGasM (Pact.NoRowFound tableName k)
 
 doWriteRow
-    :: Maybe (BlockHeight, Pact.TxId)
     -- ^ the highest block we should be reading writes from
-    -> Pact.WriteType
+    :: Pact.WriteType
     -> Pact.Domain k v Pact.CoreBuiltin Pact.Info
     -> k
     -> v
     -> BlockHandler logger ()
-doWriteRow mlim wt d k v = case d of
-    (Pact.DUserTables _) -> writeUser mlim wt d k v
+doWriteRow wt d k v = case d of
+    Pact.DUserTables tableName -> writeUser wt tableName k v
     _ -> writeSys d k v
 
 doKeys
-    :: forall k v logger .
-       Maybe (BlockHeight, Pact.TxId)
+    :: forall k v logger
     -- ^ the highest block we should be reading writes from
-    -> Pact.Domain k v Pact.CoreBuiltin Pact.Info
+    . Pact.Domain k v Pact.CoreBuiltin Pact.Info
     -> BlockHandler logger [k]
-doKeys mlim d = do
+doKeys d = do
     dbKeys <- getDbKeys
     mptx <- use bsPendingTxWrites
 
@@ -553,34 +610,28 @@ doKeys mlim d = do
             return $ sort (parsedKeys ++ memKeys)
 
     where
-    blockLimitStmt = maybe "" (const " WHERE txid < ?;") mlim
-    blockLimitParam = maybe [] (\(Pact.TxId txid) -> [SInt (fromIntegral txid)]) (snd <$> mlim)
 
     getDbKeys = do
-        m <- runMaybeT $ checkDbTablePendingCreation tn
-        case m of
-            Nothing -> return mempty
-            Just () -> do
-                forM_ mlim (failIfTableDoesNotExistInDbAtHeight "doKeys" tn . fst)
-                ks <- callDb "doKeys" $ \db ->
-                        qry db ("SELECT DISTINCT rowkey FROM " <> tbl tn <> blockLimitStmt <> " ORDER BY rowkey") blockLimitParam [RText]
-                forM ks $ \row -> do
-                    case row of
-                        [SText k] -> return $ fromUtf8 k
-                        _ -> internalDbError "doKeys: The impossible happened."
+            case d of
+                Pact.DUserTables pactTableName -> do
+                    fromMaybe [] <$> withTableExistenceCheck pactTableName fetchKeys
+                _ -> throwOnDbError fetchKeys
+        where
+        fetchKeys :: ExceptT SQ3.Error (BlockHandler logger) [Text]
+        fetchKeys = do
+            Pact.TxId txIdUpperBoundWord64 <- view blockHandlerUpperBoundTxId
+            db <- view blockHandlerDb
+            ks <- mapExceptT liftIO $ qry db
+                ("SELECT DISTINCT rowkey FROM " <> tbl tn <> "WHERE txid < ? ORDER BY rowkey;")
+                [SInt (fromIntegral txIdUpperBoundWord64)] [RText]
+            forM ks $ \row -> do
+                case row of
+                    [SText k] -> return $ fromUtf8 k
+                    _ -> internalDbError "doKeys: The impossible happened."
 
     tn = toUtf8 $ Pact.renderDomain d
     collect p = InMemDb.keys d (_pendingWrites p)
 
-failIfTableDoesNotExistInDbAtHeight
-    :: T.Text -> SQ3.Utf8 -> BlockHeight -> BlockHandler logger ()
-failIfTableDoesNotExistInDbAtHeight caller tn bh = do
-    exists <- tableExistsInDbAtHeight tn bh
-    -- we must reproduce errors that were thrown in earlier blocks from tables
-    -- not existing, if this table does not yet exist.
-    unless exists $
-        internalDbError $ "callDb (" <> caller <> "): user error (Database error: ErrorError)"
-
 recordTxLog
     :: Pact.Domain k v Pact.CoreBuiltin Pact.Info
     -> Text
@@ -601,40 +652,20 @@ recordTableCreationTxLog tn = do
     !uti = Pact.UserTableInfo (Pact._tableModuleName tn)
 
 doCreateUserTable
-    :: Maybe BlockHeight
     -- ^ the highest block we should be seeing tables from
-    -> Pact.TableName
+    :: Pact.TableName
     -> BlockHandler logger ()
-doCreateUserTable mbh tn = do
+doCreateUserTable tableName = do
     -- first check if tablename already exists in pending queues
-    m <- runMaybeT $ checkDbTablePendingCreation (tableNameToSQL tn)
-    case m of
-        Nothing ->
-            liftGas $ Pact.throwDbOpErrorGasM $ Pact.TableAlreadyExists tn
-        Just () -> do
-            -- then check if it is in the db
-            cond <- inDb $ SQ3.Utf8 $ T.encodeUtf8 $ Pact.renderTableName tn
-            when cond $
-                liftGas $ Pact.throwDbOpErrorGasM $ Pact.TableAlreadyExists tn
-
+    checkTableStatus tableName >>= \case
+        TableCreationPending ->
+            liftGas $ Pact.throwDbOpErrorGasM $ Pact.TableAlreadyExists tableName
+        TableExists ->
+            liftGas $ Pact.throwDbOpErrorGasM $ Pact.TableAlreadyExists tableName
+        TableDoesNotExist -> do
             bsPendingTxWrites . pendingTableCreation %=
-                HashSet.insert (T.encodeUtf8 (Pact.renderTableName tn))
-            recordTableCreationTxLog tn
-    where
-    inDb t = do
-        r <- callDb "doCreateUserTable" $ \db ->
-            qry db tableLookupStmt [SText t] [RText]
-        case r of
-            [[SText _]] ->
-                case mbh of
-                    -- if lowercase matching, no need to check equality
-                    -- (wasn't needed before either but leaving alone for replay)
-                    Nothing -> return True
-                    Just bh -> tableExistsInDbAtHeight t bh
-            _ -> return False
-
-    tableLookupStmt =
-        "SELECT name FROM sqlite_master WHERE type='table' and lower(name)=lower(?);"
+                HashSet.insert (Pact.renderTableName tableName)
+            recordTableCreationTxLog tableName
 
 doRollback :: BlockHandler logger ()
 doRollback = do
@@ -680,9 +711,9 @@ toPactTxLog :: Pact.TxLog Pact.RowData -> Pact4.TxLog Pact.RowData
 toPactTxLog (Pact.TxLog d k v) = Pact4.TxLog d k v
 
 commitBlockStateToDatabase :: SQLiteEnv -> BlockHash -> BlockHeight -> BlockHandle Pact5 -> IO ()
-commitBlockStateToDatabase db hsh bh blockHandle = do
+commitBlockStateToDatabase db hsh bh blockHandle = throwOnDbError $ do
     let newTables = _pendingTableCreation $ _blockHandlePending blockHandle
-    mapM_ (\tn -> createUserTable (SQ3.Utf8 tn)) newTables
+    mapM_ (\tn -> createUserTable (toUtf8 tn)) newTables
     backendWriteUpdateBatch (_pendingWrites (_blockHandlePending blockHandle))
     indexPendingPactTransactions
     let nextTxId = _blockHandleTxId blockHandle
@@ -691,7 +722,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
 
     backendWriteUpdateBatch
         :: InMemDb.Store
-        -> IO ()
+        -> ExceptT SQ3.Error IO ()
     backendWriteUpdateBatch store = do
         writeTable (domainToTableName Pact.DKeySets)
             $ mapMaybe (uncurry $ prepRow . convKeySetName)
@@ -719,7 +750,8 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
                 $ HashMap.toList tableContents
 
         where
-        domainToTableName = SQ3.Utf8 . T.encodeUtf8 . Pact.renderDomain
+        domainToTableName =
+            SQ3.Utf8 . T.encodeUtf8 . Pact.renderDomain
         prepRow rowkey (InMemDb.WriteEntry (Pact.TxId txid) rowdataEncoded _) =
             Just
                 [ SText (toUtf8 rowkey)
@@ -728,7 +760,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
                 ]
         prepRow _ InMemDb.ReadEntry {} = Nothing
 
-        writeTable :: SQ3.Utf8 -> [[SType]] -> IO ()
+        writeTable :: SQ3.Utf8 -> [[SType]] -> ExceptT SQ3.Error IO ()
         writeTable table writes = when (not (null writes)) $ do
             execMulti db q writes
             markTableMutation table bh
@@ -743,7 +775,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
             mutq = "INSERT OR IGNORE INTO VersionedTableMutation VALUES (?,?);"
 
     -- | Record a block as being in the history of the checkpointer.
-    blockHistoryInsert :: Pact4.TxId -> IO ()
+    blockHistoryInsert :: Pact4.TxId -> ExceptT SQ3.Error IO ()
     blockHistoryInsert t =
         exec' db stmt
             [ SInt (fromIntegral bh)
@@ -753,7 +785,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
         where
         stmt = "INSERT INTO BlockHistory ('blockheight','hash','endingtxid') VALUES (?,?,?);"
 
-    createUserTable :: SQ3.Utf8 -> IO ()
+    createUserTable :: SQ3.Utf8 -> ExceptT SQ3.Error IO ()
     createUserTable tablename = do
         createVersionedTable tablename db
         markTableCreation tablename
@@ -767,7 +799,7 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
         insertargs = [SText tablename, SInt (fromIntegral bh)]
 
     -- | Commit the index of pending successful transactions to the database
-    indexPendingPactTransactions :: IO ()
+    indexPendingPactTransactions :: ExceptT SQ3.Error IO ()
     indexPendingPactTransactions = do
         let txs = _pendingSuccessfulTxs $ _blockHandlePending blockHandle
         dbIndexTransactions txs
@@ -778,3 +810,73 @@ commitBlockStateToDatabase db hsh bh blockHandle = do
             let rows = map toRow $ toList txs
             let q = "INSERT INTO TransactionIndex (txhash, blockheight) VALUES (?, ?)"
             execMulti db q rows
+
+createVersionedTable :: SQ3.Utf8 -> SQ3.Database -> ExceptT SQ3.Error IO ()
+createVersionedTable tablename db = do
+    exec_ db createtablestmt
+    exec_ db indexcreationstmt
+    where
+    ixName = tablename <> "_ix"
+    createtablestmt =
+        "CREATE TABLE IF NOT EXISTS " <> tbl tablename <> " \
+            \ (rowkey TEXT\
+            \, txid UNSIGNED BIGINT NOT NULL\
+            \, rowdata BLOB NOT NULL\
+            \, UNIQUE (rowkey, txid));"
+    indexcreationstmt =
+        "CREATE INDEX IF NOT EXISTS " <> tbl ixName <> " ON " <> tbl tablename <> "(txid DESC);"
+
+
+-- | Create all tables that exist pre-genesis
+-- TODO: migrate this logic to the checkpointer itself?
+initSchema :: SQLiteEnv -> IO ()
+initSchema sql =
+    withSavepoint sql DbTransaction $ throwOnDbError $ do
+        createBlockHistoryTable
+        createTableCreationTable
+        createTableMutationTable
+        createTransactionIndexTable
+        create (toUtf8 $ Pact.renderDomain Pact.DKeySets)
+        create (toUtf8 $ Pact.renderDomain Pact.DModules)
+        create (toUtf8 $ Pact.renderDomain Pact.DNamespaces)
+        create (toUtf8 $ Pact.renderDomain Pact.DDefPacts)
+        create (toUtf8 $ Pact.renderDomain Pact.DModuleSource)
+  where
+    create tablename = do
+      createVersionedTable tablename sql
+
+    createBlockHistoryTable :: ExceptT SQ3.Error IO ()
+    createBlockHistoryTable =
+      exec_ sql
+        "CREATE TABLE IF NOT EXISTS BlockHistory \
+        \(blockheight UNSIGNED BIGINT NOT NULL,\
+        \ hash BLOB NOT NULL,\
+        \ endingtxid UNSIGNED BIGINT NOT NULL, \
+        \ CONSTRAINT blockHashConstraint UNIQUE (blockheight));"
+
+    createTableCreationTable :: ExceptT SQ3.Error IO ()
+    createTableCreationTable =
+      exec_ sql
+        "CREATE TABLE IF NOT EXISTS VersionedTableCreation\
+        \(tablename TEXT NOT NULL\
+        \, createBlockheight UNSIGNED BIGINT NOT NULL\
+        \, CONSTRAINT creation_unique UNIQUE(createBlockheight, tablename));"
+
+    createTableMutationTable :: ExceptT SQ3.Error IO ()
+    createTableMutationTable =
+      exec_ sql
+        "CREATE TABLE IF NOT EXISTS VersionedTableMutation\
+         \(tablename TEXT NOT NULL\
+         \, blockheight UNSIGNED BIGINT NOT NULL\
+         \, CONSTRAINT mutation_unique UNIQUE(blockheight, tablename));"
+
+    createTransactionIndexTable :: ExceptT SQ3.Error IO ()
+    createTransactionIndexTable = do
+      exec_ sql
+        "CREATE TABLE IF NOT EXISTS TransactionIndex \
+         \ (txhash BLOB NOT NULL, \
+         \ blockheight UNSIGNED BIGINT NOT NULL, \
+         \ CONSTRAINT transactionIndexConstraint UNIQUE(txhash));"
+      exec_ sql
+        "CREATE INDEX IF NOT EXISTS \
+         \ transactionIndexByBH ON TransactionIndex(blockheight)";
diff --git a/test/unit/Chainweb/Test/Pact4/Checkpointer.hs b/test/unit/Chainweb/Test/Pact4/Checkpointer.hs
index 2a0c6c39c3..29aae3758e 100644
--- a/test/unit/Chainweb/Test/Pact4/Checkpointer.hs
+++ b/test/unit/Chainweb/Test/Pact4/Checkpointer.hs
@@ -66,6 +66,7 @@ import Chainweb.Version
 import Chainweb.Test.Orphans.Internal ({- Arbitrary BlockHash -})
 import Chainweb.Pact.Backend.Types
 import qualified Chainweb.Pact.PactService.Checkpointer.Internal as Checkpointer
+import qualified Chainweb.Pact5.Backend.ChainwebPactDb as Pact5
 
 -- -------------------------------------------------------------------------- --
 -- Tests
@@ -761,7 +762,7 @@ simpleBlockEnvInit
     -> (PactDb (BlockEnv logger) -> BlockEnv logger -> (MVar (BlockEnv logger) -> IO ()) -> IO a)
     -> IO a
 simpleBlockEnvInit logger f = withTempSQLiteConnection chainwebPragmas $ \sqlenv ->
-    f chainwebPactDb (blockEnv sqlenv) (\_ -> initSchema logger sqlenv)
+    f chainwebPactDb (blockEnv sqlenv) (\_ -> Pact5.initSchema sqlenv)
   where
     blockEnv sqlenv = BlockEnv
       (mkBlockHandlerEnv testVer testChainId (BlockHeight 0) sqlenv DoNotPersistIntraBlockWrites logger)
diff --git a/test/unit/Chainweb/Test/Pact4/PactSingleChainTest.hs b/test/unit/Chainweb/Test/Pact4/PactSingleChainTest.hs
index dd97770d1f..b3b4ad5214 100644
--- a/test/unit/Chainweb/Test/Pact4/PactSingleChainTest.hs
+++ b/test/unit/Chainweb/Test/Pact4/PactSingleChainTest.hs
@@ -1295,7 +1295,7 @@ goldenNewBlock name mpIO mpRefIO reqIO = golden name $ do
         [ "pendingSuccessfulTxs" J..= J.array
           (encodeB64UrlNoPaddingText <$> List.sort (toList _pendingSuccessfulTxs))
         , "pendingTableCreation" J..= J.array
-            (T.decodeUtf8 <$> List.sort (toList _pendingTableCreation))
+            (List.sort (toList _pendingTableCreation))
         , "pendingWrites" J..= pendingWritesJson
         ]
       , "txId" J..= J.Aeson (fromIntegral @_ @Int $ _blockHandleTxId _blockInProgressHandle)
@@ -1303,7 +1303,7 @@ goldenNewBlock name mpIO mpRefIO reqIO = golden name $ do
       where
       SQLitePendingData{..} = _blockHandlePending _blockInProgressHandle
       pendingWritesJson = J.Object
-            [ (T.decodeUtf8 _dkTable, J.Object
+            [ (_dkTable, J.Object
                 [ (T.decodeUtf8 _dkRowKey, J.Object
                     [ ((sshow @_ @T.Text. fromIntegral @TxId @Word) _deltaTxId, T.decodeUtf8 _deltaData)
                     | SQLiteRowDelta {..} <- toList rowKeyWrites
diff --git a/test/unit/Chainweb/Test/Pact5/CheckpointerTest.hs b/test/unit/Chainweb/Test/Pact5/CheckpointerTest.hs
index cd7d8edcde..c104cbcafd 100644
--- a/test/unit/Chainweb/Test/Pact5/CheckpointerTest.hs
+++ b/test/unit/Chainweb/Test/Pact5/CheckpointerTest.hs
@@ -57,7 +57,6 @@ import Test.Tasty.Hedgehog
 import Chainweb.Test.Pact5.Utils
 import Chainweb.Pact5.Backend.ChainwebPactDb (Pact5Db(doPact5DbTransaction))
 import Chainweb.Pact5.Types (noInfo)
-import GHC.Stack
 import Chainweb.Pact.Backend.Types
 import qualified Chainweb.Pact.PactService.Checkpointer.Internal as Checkpointer
 
@@ -203,7 +202,7 @@ runBlocks cp ph blks = do
 
 -- Check that a block's result at the time it was added to the checkpointer
 -- is consistent with us executing that block with `readFrom`
-assertBlock :: HasCallStack => Checkpointer GenericLogger -> ParentHeader -> (BlockHeader, DbBlock Identity) -> IO ()
+assertBlock :: Checkpointer GenericLogger -> ParentHeader -> (BlockHeader, DbBlock Identity) -> IO ()
 assertBlock cp ph (expectedBh, blk) = do
     hist <- Checkpointer.readFrom cp (Just ph) Pact5T $ \db startHandle -> do
         ((), _endHandle) <- doPact5DbTransaction db startHandle Nothing $ \txdb -> do
@@ -240,7 +239,7 @@ tests = testGroup "Pact5 Checkpointer tests"
     , withResourceT (liftIO . initCheckpointer testVer cid =<< withTempSQLiteResource) $ \cpIO ->
         testProperty "readFrom with linear block history is valid" $ withTests 1000 $ property $ do
             blocks <- forAll genBlockHistory
-            liftIO $ do
+            evalIO $ do
                 cp <- cpIO
                 -- extend this empty chain with the genesis block
                 ((), ()) <- Checkpointer.restoreAndSave cp Nothing $ Stream.yield $ Pact5RunnableBlock $ \_ _ hndl ->
diff --git a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs
index f93038fdef..fd686bf444 100644
--- a/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs
+++ b/test/unit/Chainweb/Test/Pact5/TransactionExecTest.hs
@@ -96,6 +96,7 @@ tests baseRdb = testGroup "Pact5 TransactionExecTest"
     , testCase "event spec" (testEvents baseRdb)
     , testCase "writes from failed transaction should not make it into the db" (testWritesFromFailedTxDontMakeItIn baseRdb)
     , testCase "quirk spec" (quirkSpec baseRdb)
+    , testCase "test writes to nonexistent tables" (testWritesToNonExistentTables baseRdb)
     ]
 
 -- | Run with the context being that the parent block is the genesis block
@@ -895,6 +896,30 @@ testWritesFromFailedTxDontMakeItIn rdb = readFromAfterGenesis v rdb $ do
                 ]
         ]
 
+testWritesToNonExistentTables :: RocksDb -> IO ()
+testWritesToNonExistentTables rdb = readFromAfterGenesis v rdb $ do
+    txCtx <- TxContext <$> view psParentHeader <*> pure noMiner
+    pactTransaction Nothing $ \pactDb -> do
+        cmd <- buildCwCmd v
+            $ set cbRPC (mkExec' $ T.concat
+                [ "(namespace 'free)"
+                , "(module m G"
+                , "(defcap G () true)"
+                , "(defschema o i:integer)"
+                , "(deftable t:{o})"
+                , ")"
+                , "(insert t 'k {'i: 2})"
+                ]
+                )
+            $ defaultCmd cid
+
+        logger <- testLogger
+        applyCmd logger Nothing pactDb txCtx (TxBlockIdx 0) noSPVSupport (Gas 1) (view payloadObj <$> cmd)
+            >>= P.match _Right
+            ? P.fun _crResult
+            ? P.match (_PactResultErr . _PEExecutionError . _1)
+            ? P.equals (DbOpFailure (NoSuchTable (TableName "t" (ModuleName "m" (Just "free")))))
+
 cid :: ChainId
 cid = unsafeChainId 0