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

@@ -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 #-}

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]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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)

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