Divorce transactionExec between pact4 and pact5

Rework pact errors

bench/Chainweb/Pact/Backend/ForkingBench.hs

@@ -488,7 +488,7 @@ safeCapitalize = maybe [] (uncurry (:) . bimap toUpper (Prelude.map toLower)) .
 
 
 -- TODO: Use the new `assertCommand` function.
-validateCommand :: Command Text -> Either String ChainwebTransaction
+validateCommand :: Command Text -> Either String Pact4Transaction
 validateCommand cmdText = case verifyCommand cmdBS of
     ProcSucc cmd -> Right (mkPayloadWithTextOld <$> cmd)
     ProcFail err -> Left err

cabal.project

@@ -69,6 +69,9 @@ package vault
 package yet-another-logger
     flags: -tbmqueue
 
+packages:
+    ../pact-core
+
 -- -------------------------------------------------------------------------- --
 -- Source Repository Packages
 --
@@ -83,11 +86,11 @@ source-repository-package
     tag: 9ccef1fbeff545f07864896094eb2e2bd4c5ffb3
     --sha256: 0pai52mvyikhm527if4gxa1nwsmva3wg3nhvida7qg48rchjrxry
 
-source-repository-package
-    type: git
-    location: https://github.com/kadena-io/pact-5.git
-    tag: c065ebd60ea0460a98779968200e943044fe4939
-    --sha256: sha256-pSDMa5QZDF5/dsccDgZFQMfhgo+/HjDqc0m9W9h7m3g=
+-- source-repository-package
+--     type: git
+--     location: https://github.com/kadena-io/pact-5.git
+--     tag: c065ebd60ea0460a98779968200e943044fe4939
+--     --sha256: sha256-pSDMa5QZDF5/dsccDgZFQMfhgo+/HjDqc0m9W9h7m3g=
 
 source-repository-package
     type: git

src/Chainweb/Chainweb.hs

@@ -72,8 +72,9 @@ module Chainweb.Chainweb
 , NowServing(..)
 
 -- ** Mempool integration
-, ChainwebTransaction
-, Mempool.chainwebTransactionConfig
+, Pact4Transaction
+, Pact5Transaction
+, Mempool.pact4TransactionConfig
 , validatingMempoolConfig
 
 , withChainweb
@@ -269,7 +270,7 @@ validatingMempoolConfig
     -> Mempool.GasLimit
     -> Mempool.GasPrice
     -> MVar PactExecutionService
-    -> Mempool.InMemConfig ChainwebTransaction
+    -> Mempool.InMemConfig Pact4Transaction
 validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
     { Mempool._inmemTxCfg = txcfg
     , Mempool._inmemTxBlockSizeLimit = gl
@@ -280,7 +281,7 @@ validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
     , Mempool._inmemCurrentTxsSize = currentTxsSize
     }
   where
-    txcfg = Mempool.chainwebTransactionConfig (maxBound :: PactParserVersion)
+    txcfg = Mempool.pact4TransactionConfig (maxBound :: PactParserVersion)
         -- The mempool doesn't provide a chain context to the codec which means
         -- that the latest version of the parser is used.
 
@@ -293,7 +294,7 @@ validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
 
     -- | Validation: Is this TX associated with the correct `ChainId`?
     --
-    preInsertSingle :: ChainwebTransaction -> Either Mempool.InsertError ChainwebTransaction
+    preInsertSingle :: Pact4Transaction -> Either Mempool.InsertError Pact4Transaction
     preInsertSingle tx = do
         let !pay = payloadObj . P._cmdPayload $ tx
             pcid = P._pmChainId $ P._pMeta pay
@@ -315,9 +316,9 @@ validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
     -- is gossiped to us from a peer's mempool.
     --
     preInsertBatch
-        :: V.Vector (T2 Mempool.TransactionHash ChainwebTransaction)
+        :: V.Vector (T2 Mempool.TransactionHash Pact4Transaction)
         -> IO (V.Vector (Either (T2 Mempool.TransactionHash Mempool.InsertError)
-                                (T2 Mempool.TransactionHash ChainwebTransaction)))
+                                (T2 Mempool.TransactionHash Pact4Transaction)))
     preInsertBatch txs = do
         pex <- readMVar mv
         rs <- _pactPreInsertCheck pex cid (V.map ssnd txs)
@@ -762,7 +763,7 @@ runChainweb cw nowServing = do
     chainDbsToServe :: [(ChainId, BlockHeaderDb)]
     chainDbsToServe = proj _chainResBlockHeaderDb
 
-    mempoolsToServe :: [(ChainId, Mempool.MempoolBackend ChainwebTransaction)]
+    mempoolsToServe :: [(ChainId, Mempool.MempoolBackend Pact4Transaction)]
     mempoolsToServe = proj _chainResMempool
 
     peerDb = _peerResDb (_chainwebPeer cw)

src/Chainweb/Chainweb/ChainResources.hs

@@ -60,7 +60,7 @@ import Chainweb.Storage.Table.RocksDB
 data ChainResources logger = ChainResources
     { _chainResBlockHeaderDb :: !BlockHeaderDb
     , _chainResLogger :: !logger
-    , _chainResMempool :: !(MempoolBackend ChainwebTransaction)
+    , _chainResMempool :: !(MempoolBackend Pact4Transaction)
     , _chainResPact :: PactExecutionService
     }
 
@@ -83,7 +83,7 @@ withChainResources
     -> ChainId
     -> RocksDb
     -> logger
-    -> (MVar PactExecutionService -> Mempool.InMemConfig ChainwebTransaction)
+    -> (MVar PactExecutionService -> Mempool.InMemConfig Pact4Transaction)
     -> PayloadDb tbl
     -> FilePath
         -- ^ database directory for checkpointer

src/Chainweb/Mempool/Consensus.hs

@@ -56,10 +56,10 @@ import Data.LogMessage (JsonLog(..), LogFunction)
 
 ------------------------------------------------------------------------------
 data MempoolConsensus = MempoolConsensus
-    { mpcMempool :: !(MempoolBackend ChainwebTransaction)
+    { mpcMempool :: !(MempoolBackend Pact4Transaction)
     , mpcLastNewBlockParent :: !(IORef (Maybe BlockHeader))
     , mpcProcessFork
-        :: LogFunction -> BlockHeader -> IO (Vector ChainwebTransaction, Vector ChainwebTransaction)
+        :: LogFunction -> BlockHeader -> IO (Vector Pact4Transaction, Vector Pact4Transaction)
     }
 
 data ReintroducedTxsLog = ReintroducedTxsLog
@@ -80,7 +80,7 @@ instance Exception MempoolException
 ------------------------------------------------------------------------------
 mkMempoolConsensus
     :: CanReadablePayloadCas tbl
-    => MempoolBackend ChainwebTransaction
+    => MempoolBackend Pact4Transaction
     -> BlockHeaderDb
     -> Maybe (PayloadDb tbl)
     -> IO MempoolConsensus
@@ -102,7 +102,7 @@ processFork
     -> IORef (Maybe BlockHeader)
     -> LogFunction
     -> BlockHeader
-    -> IO (Vector ChainwebTransaction, Vector ChainwebTransaction)
+    -> IO (Vector Pact4Transaction, Vector Pact4Transaction)
 processFork blockHeaderDb payloadStore lastHeaderRef logFun newHeader = do
     now <- getCurrentTimeIntegral
     lastHeader <- readIORef lastHeaderRef
@@ -122,7 +122,7 @@ processForkCheckTTL
     -> HashableTrans PayloadWithText -> Bool
 processForkCheckTTL ppv now (HashableTrans t) =
     either (const False) (const True) $
-    txTTLCheck (chainwebTransactionConfig ppv) now t
+    txTTLCheck (pact4TransactionConfig ppv) now t
 
 
 ------------------------------------------------------------------------------
@@ -194,4 +194,4 @@ chainwebTxsFromPd ppv pd = do
     let theRights  =  rights $ toList eithers
     return $! HS.fromList $ HashableTrans <$!> theRights
   where
-    toCWTransaction = codecDecode (chainwebPayloadCodec ppv)
+    toCWTransaction = codecDecode (pact4PayloadCodec ppv)

src/Chainweb/Mempool/Mempool.hs

@@ -74,7 +74,7 @@ module Chainweb.Mempool.Mempool
   , bfTxHashes
   , bfCount
 
-  , chainwebTransactionConfig
+  , pact4TransactionConfig
   , mockCodec
   , mockEncode
   , mockBlockGasLimit
@@ -363,11 +363,11 @@ noopMempool = do
 
 ------------------------------------------------------------------------------
 
-chainwebTransactionConfig
+pact4TransactionConfig
     :: PactParserVersion
-    -> TransactionConfig ChainwebTransaction
-chainwebTransactionConfig ppv = TransactionConfig
-    { txCodec = chainwebPayloadCodec ppv
+    -> TransactionConfig Pact4Transaction
+pact4TransactionConfig ppv = TransactionConfig
+    { txCodec = pact4PayloadCodec ppv
     , txHasher = commandHash
     , txHashMeta = chainwebTestHashMeta
     , txGasPrice = getGasPrice

src/Chainweb/Miner/Miners.hs

@@ -120,7 +120,7 @@ localTest lf v coord m cdb gen miners =
 --
 mempoolNoopMiner
     :: LogFunction
-    -> HashMap ChainId (MempoolBackend ChainwebTransaction)
+    -> HashMap ChainId (MempoolBackend Pact4Transaction)
     -> IO ()
 mempoolNoopMiner lf chainRes =
     runForever lf "Chainweb.Miner.Miners.mempoolNoopMiner" $ do

src/Chainweb/Pact/Backend/Types.hs

@@ -403,11 +403,11 @@ newtype SQLiteFlag = SQLiteFlag { getFlag :: CInt }
 data MemPoolAccess = MemPoolAccess
   { mpaGetBlock
         :: !(BlockFill
-        -> MempoolPreBlockCheck ChainwebTransaction
+        -> MempoolPreBlockCheck Pact4Transaction
         -> BlockHeight
         -> BlockHash
         -> BlockHeader
-        -> IO (Vector ChainwebTransaction)
+        -> IO (Vector Pact4Transaction)
         )
   , mpaSetLastHeader :: !(BlockHeader -> IO ())
   , mpaProcessFork :: !(BlockHeader -> IO ())

src/Chainweb/Pact/PactService.hs

@@ -483,7 +483,7 @@ execNewBlock mpAccess miner = do
             -- Run the coinbase transaction
             cb <- runCoinbase False miner (EnforceCoinbaseFailure True) (CoinbaseUsePrecompiled True) initCache
 
-            successes <- liftIO $ Vec.new @_ @_ @(ChainwebTransaction, P.CommandResult [P.TxLogJson])
+            successes <- liftIO $ Vec.new @_ @_ @(Pact4Transaction, P.CommandResult [P.TxLogJson])
             failures <- liftIO $ Vec.new @_ @_ @TransactionHash
 
             -- Heuristic: limit fetches to count of 1000-gas txs in block.
@@ -510,7 +510,7 @@ execNewBlock mpAccess miner = do
 
         !parentTime =
           ParentCreationTime (_blockCreationTime $ _parentHeader latestHeader)
-        getBlockTxs :: CurrentBlockDbEnv logger -> BlockFill -> PactServiceM logger tbl (Vector ChainwebTransaction)
+        getBlockTxs :: CurrentBlockDbEnv logger -> BlockFill -> PactServiceM logger tbl (Vector Pact4Transaction)
         getBlockTxs dbEnv bfState = do
           psEnv <- ask
           logger <- view psLogger
@@ -528,7 +528,7 @@ execNewBlock mpAccess miner = do
           liftIO $!
             mpaGetBlock mpAccess bfState validate (pHeight + 1) pHash (_parentHeader latestHeader)
 
-        refill :: Word64 -> Micros -> GrowableVec (ChainwebTransaction, P.CommandResult [P.TxLogJson]) -> GrowableVec TransactionHash -> (ModuleCache, CoreModuleCache) -> BlockFill -> PactBlockM logger tbl BlockFill
+        refill :: Word64 -> Micros -> GrowableVec (Pact4Transaction, P.CommandResult [P.TxLogJson]) -> GrowableVec TransactionHash -> (ModuleCache, CoreModuleCache) -> BlockFill -> PactBlockM logger tbl BlockFill
         refill fetchLimit txTimeLimit successes failures = go
           where
             go :: (ModuleCache, CoreModuleCache) -> BlockFill -> PactBlockM logger tbl BlockFill
@@ -594,10 +594,10 @@ execNewBlock mpAccess miner = do
         --
         --   The failed txs are later badlisted.
         splitResults :: ()
-          => GrowableVec (ChainwebTransaction, P.CommandResult [P.TxLogJson])
+          => GrowableVec (Pact4Transaction, P.CommandResult [P.TxLogJson])
           -> GrowableVec TransactionHash -- ^ failed txs
           -> BlockFill
-          -> [(ChainwebTransaction, Either CommandInvalidError (P.CommandResult [P.TxLogJson]))]
+          -> [(Pact4Transaction, Either CommandInvalidError (P.CommandResult [P.TxLogJson]))]
           -> PactBlockM logger tbl (BlockFill, Bool)
         splitResults successes failures = go
           where
@@ -639,7 +639,7 @@ type GrowableVec = Vec (PrimState IO)
 execNewGenesisBlock
     :: (Logger logger, CanReadablePayloadCas tbl)
     => Miner
-    -> Vector ChainwebTransaction
+    -> Vector Pact4Transaction
     -> PactServiceM logger tbl PayloadWithOutputs
 execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ readFrom Nothing $ do
     -- NEW GENESIS COINBASE: Reject bad coinbase, use date rule for precompilation
@@ -740,7 +740,7 @@ execReadOnlyReplay lowerBound maybeUpperBound = pactLabel "execReadOnlyReplay" $
 
 execLocal
     :: (Logger logger, CanReadablePayloadCas tbl)
-    => ChainwebTransaction
+    => Pact4Transaction
     -> Maybe LocalPreflightSimulation
       -- ^ preflight flag
     -> Maybe LocalSignatureVerification
@@ -989,8 +989,8 @@ execHistoricalLookup bh d k = pactLabel "execHistoricalLookup" $ do
 
 execPreInsertCheckReq
     :: (CanReadablePayloadCas tbl, Logger logger)
-    => Vector ChainwebTransaction
-    -> PactServiceM logger tbl (Vector (Either Mempool.InsertError ChainwebTransaction))
+    => Vector Pact4Transaction
+    -> PactServiceM logger tbl (Vector (Either Mempool.InsertError Pact4Transaction))
 execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do
     let requestKeys = V.map P.cmdToRequestKey txs
     logInfo $ "(request keys = " <> sshow requestKeys <> ")"
@@ -1020,17 +1020,17 @@ execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do
     attemptBuyGas
         :: forall logger tbl. (Logger logger)
         => Miner
-        -> Vector (Either InsertError ChainwebTransaction)
-        -> PactBlockM logger tbl (Vector (Either InsertError ChainwebTransaction))
+        -> Vector (Either InsertError Pact4Transaction)
+        -> PactBlockM logger tbl (Vector (Either InsertError Pact4Transaction))
     attemptBuyGas miner txsOrErrs = localLabelBlock ("transaction", "attemptBuyGas") $ do
             (mc, cmc) <- getInitCache
             l <- view (psServiceEnv . psLogger)
             V.fromList . toList . sfst <$> V.foldM (buyGasFor l) (T2 mempty (mc, cmc)) txsOrErrs
       where
         buyGasFor :: logger
-          -> T2 (DL.DList (Either InsertError ChainwebTransaction)) (ModuleCache, CoreModuleCache)
-          -> Either InsertError ChainwebTransaction
-          -> PactBlockM logger tbl (T2 (DL.DList (Either InsertError ChainwebTransaction)) (ModuleCache, CoreModuleCache))
+          -> T2 (DL.DList (Either InsertError Pact4Transaction)) (ModuleCache, CoreModuleCache)
+          -> Either InsertError Pact4Transaction
+          -> PactBlockM logger tbl (T2 (DL.DList (Either InsertError Pact4Transaction)) (ModuleCache, CoreModuleCache))
         buyGasFor _l (T2 dl (mcache,cmcache)) err@Left {} = return (T2 (DL.snoc dl err) (mcache,cmcache))
         buyGasFor l (T2 dl (mcache,cmcache)) (Right tx) = do
             T2 mcache' !res <- do
@@ -1057,8 +1057,8 @@ execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do
                     [ P.FlagDisableModuleInstall
                     , P.FlagDisableHistoryInTransactionalMode ] ++
                     disableReturnRTC (ctxVersion pd) (ctxChainId pd) (ctxCurrentBlockHeight pd)
-              let usePactTng = False
-              let buyGasEnv = TransactionEnv P.Transactional (_cpPactDbEnv dbEnv) (_cpPactCoreDbEnv dbEnv) l Nothing (ctxToPublicData pd) spv nid gasPrice rk gasLimit ec Nothing usePactTng
+              let usePact5 = False
+              let buyGasEnv = TransactionEnv P.Transactional (_cpPactDbEnv dbEnv) (_cpPactCoreDbEnv dbEnv) l Nothing (ctxToPublicData pd) spv nid gasPrice rk gasLimit ec Nothing usePact5
 
               cr <- liftIO
                 $! catchesPactError l CensorsUnexpectedError