DRAFT WIP = Finish Pact4 / Pact5 migration

cabal.project

@@ -100,7 +100,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/kda-community/pact-5
-    tag: 72f427605406df61be8284091922f1fe1af7541b
+    tag: e5434b0dd6d0b4c193bf7bee9ef678fa11254f41
 
 source-repository-package
     type: git

cabal.project.freeze

@@ -193,7 +193,6 @@ constraints: any.Cabal ==3.12.1.0 || ==3.14.2.0,
              any.ghc-prim ==0.12.0,
              any.gridtables ==0.1.1.0,
              any.groups ==0.5.3,
-             any.growable-vector ==0.1,
              any.haddock-library ==1.11.0,
              any.half ==0.3.3,
              any.happy ==2.2,

chainweb.cabal

@@ -251,6 +251,7 @@ library
         , Chainweb.SPV.RestAPI.Client
         , Chainweb.Sync.WebBlockHeaderStore
         , Chainweb.Time
+        , Chainweb.TransactionHash
         , Chainweb.Pact4.Transaction
         , Chainweb.Pact5.Transaction
         , Chainweb.TreeDB
@@ -410,7 +411,6 @@ library
         , file-embed >= 0.0
         , filepath >= 1.4
         , ghc-compact >= 0.1
-        , growable-vector >= 0.1
         , hashable >= 1.4
         , heaps >= 0.3
         , time-hourglass >=0.2

src/Chainweb/Chainweb.hs

@@ -72,7 +72,7 @@ module Chainweb.Chainweb
 , NowServing(..)
 
 -- ** Mempool integration
-, Mempool.pact4TransactionConfig
+, Mempool.pact5TransactionConfig
 , validatingMempoolConfig
 
 , withChainweb
@@ -162,12 +162,12 @@ import qualified Chainweb.OpenAPIValidation as OpenAPIValidation
 import Chainweb.Pact.Backend.Types(IntraBlockPersistence(..))
 import Chainweb.Pact.RestAPI.Server (PactServerData(..))
 import Chainweb.Pact.Types (PactServiceConfig(..))
-import Chainweb.Pact4.Validations
+import Chainweb.Pact5.Validations
 import Chainweb.Payload.PayloadStore
 import Chainweb.Payload.PayloadStore.RocksDB
 import Chainweb.RestAPI
 import Chainweb.RestAPI.NetworkID
-import qualified Chainweb.Pact4.Transaction as Pact4
+import qualified Chainweb.Pact5.Transaction as Pact5
 import Chainweb.Utils
 import Chainweb.Utils.RequestLog
 import Chainweb.Version
@@ -183,8 +183,8 @@ import P2P.Node.Configuration
 import P2P.Node.PeerDB (PeerDb)
 import P2P.Peer
 
-import qualified Pact.Types.ChainMeta as P
-import qualified Pact.Types.Command as P
+import qualified Pact.Core.ChainData as P
+import qualified Pact.Core.Command.Types as P
 
 -- -------------------------------------------------------------------------- --
 -- Chainweb Resources
@@ -270,7 +270,7 @@ validatingMempoolConfig
     -> Mempool.GasLimit
     -> Mempool.GasPrice
     -> MVar PactExecutionService
-    -> Mempool.InMemConfig Pact4.UnparsedTransaction
+    -> Mempool.InMemConfig Pact5.UnparsedTransaction
 validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
     { Mempool._inmemTxCfg = txcfg
     , Mempool._inmemTxBlockSizeLimit = gl
@@ -281,7 +281,7 @@ validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
     , Mempool._inmemCurrentTxsSize = currentTxsSize
     }
   where
-    txcfg = Mempool.pact4TransactionConfig
+    txcfg = Mempool.pact5TransactionConfig
         -- The mempool doesn't provide a chain context to the codec which means
         -- that the latest version of the parser is used.
 
@@ -294,9 +294,9 @@ validatingMempoolConfig cid v gl gp mv = Mempool.InMemConfig
 
     -- | Validation: Is this TX associated with the correct `ChainId`?
     --
-    preInsertSingle :: Pact4.UnparsedTransaction -> Either Mempool.InsertError Pact4.UnparsedTransaction
+    preInsertSingle :: Pact5.UnparsedTransaction -> Either Mempool.InsertError Pact5.UnparsedTransaction
     preInsertSingle tx = do
-        let !pay = Pact4.payloadObj . P._cmdPayload $ tx
+        let !pay = view Pact5.payloadObj . P._cmdPayload $ tx
             pcid = P._pmChainId $ P._pMeta pay
             sigs = P._cmdSigs tx
             ver  = P._pNetworkId pay
@@ -316,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 Pact4.UnparsedTransaction)
+        :: V.Vector (T2 Mempool.TransactionHash Pact5.UnparsedTransaction)
         -> IO (V.Vector (Either (T2 Mempool.TransactionHash Mempool.InsertError)
-                                (T2 Mempool.TransactionHash Pact4.UnparsedTransaction)))
+                                (T2 Mempool.TransactionHash Pact5.UnparsedTransaction)))
     preInsertBatch txs
         | V.null txs = return V.empty
         | otherwise = do
@@ -774,7 +774,7 @@ runChainweb cw nowServing = do
     chainDbsToServe :: [(ChainId, BlockHeaderDb)]
     chainDbsToServe = proj _chainResBlockHeaderDb
 
-    mempoolsToServe :: [(ChainId, Mempool.MempoolBackend Pact4.UnparsedTransaction)]
+    mempoolsToServe :: [(ChainId, Mempool.MempoolBackend Pact5.UnparsedTransaction)]
     mempoolsToServe = proj _chainResMempool
 
     peerDb = _peerResDb (_chainwebPeer cw)

src/Chainweb/Chainweb/ChainResources.hs

@@ -49,7 +49,7 @@ import Chainweb.Mempool.Mempool (MempoolBackend)
 import Chainweb.Pact.Service.PactInProcApi
 import Chainweb.Pact.Types
 import Chainweb.Payload.PayloadStore
-import qualified Chainweb.Pact4.Transaction as Pact4
+import qualified Chainweb.Pact5.Transaction as Pact5
 import Chainweb.Version
 import Chainweb.WebPactExecutionService
 
@@ -62,7 +62,7 @@ import Chainweb.Counter
 data ChainResources logger = ChainResources
     { _chainResBlockHeaderDb :: !BlockHeaderDb
     , _chainResLogger :: !logger
-    , _chainResMempool :: !(MempoolBackend Pact4.UnparsedTransaction)
+    , _chainResMempool :: !(MempoolBackend Pact5.UnparsedTransaction)
     , _chainResPact :: PactExecutionService
     }
 
@@ -85,7 +85,7 @@ withChainResources
     -> ChainId
     -> RocksDb
     -> logger
-    -> (MVar PactExecutionService -> Mempool.InMemConfig Pact4.UnparsedTransaction)
+    -> (MVar PactExecutionService -> Mempool.InMemConfig Pact5.UnparsedTransaction)
     -> PayloadDb tbl
     -> FilePath
         -- ^ database directory for checkpointer

src/Chainweb/Chainweb/Configuration.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |
 -- Module: Chainweb.Chainweb.Configuration
 -- Copyright: Copyright © 2021 Kadena LLC.
@@ -125,6 +126,8 @@ import Chainweb.Time
 import P2P.Node.Configuration
 import Chainweb.Pact.Backend.DbCache (DbCacheLimitBytes)
 
+import Pact.Core.StableEncoding
+
 -- -------------------------------------------------------------------------- --
 -- Throttling Configuration
 
@@ -375,6 +378,19 @@ pBackupConfig = id
   where
     backup = Just "backup"
 
+instance FromJSON Mempool.GasLimit where
+    parseJSON = fmap _stableEncoding . parseJSON
+
+instance J.Encode Mempool.GasLimit where
+    build = J.build . StableEncoding
+
+instance FromJSON Mempool.GasPrice where
+    parseJSON = fmap _stableEncoding . parseJSON
+
+instance J.Encode Mempool.GasPrice where
+    build =J.build . StableEncoding
+
+
 -- -------------------------------------------------------------------------- --
 -- Chainweb Configuration
 

src/Chainweb/Mempool/Consensus.hs

@@ -47,20 +47,20 @@ import Chainweb.Mempool.Mempool
 import Chainweb.Payload
 import Chainweb.Payload.PayloadStore
 import Chainweb.Time
-import qualified Chainweb.Pact4.Transaction as Pact4
+import qualified Chainweb.Pact5.Transaction as Pact5
+import qualified Pact.Core.ChainData as Pact5
 import Chainweb.TreeDB
 import Chainweb.Utils
 
 import Data.LogMessage (JsonLog(..), LogFunction)
-import qualified Pact.Types.ChainMeta as Pact4
 import Data.Text (Text)
 
 ------------------------------------------------------------------------------
 data MempoolConsensus = MempoolConsensus
-    { mpcMempool :: !(MempoolBackend Pact4.UnparsedTransaction)
+    { mpcMempool :: !(MempoolBackend Pact5.UnparsedTransaction)
     , mpcLastNewBlockParent :: !(IORef (Maybe BlockHeader))
     , mpcProcessFork
-        :: LogFunction -> BlockHeader -> IO (Vector Pact4.UnparsedTransaction, Vector Pact4.UnparsedTransaction)
+        :: LogFunction -> BlockHeader -> IO (Vector Pact5.UnparsedTransaction, Vector Pact5.UnparsedTransaction)
     }
 
 data ReintroducedTxsLog = ReintroducedTxsLog
@@ -81,7 +81,7 @@ instance Exception MempoolException
 ------------------------------------------------------------------------------
 mkMempoolConsensus
     :: CanReadablePayloadCas tbl
-    => MempoolBackend Pact4.UnparsedTransaction
+    => MempoolBackend Pact5.UnparsedTransaction
     -> BlockHeaderDb
     -> Maybe (PayloadDb tbl)
     -> IO MempoolConsensus
@@ -103,23 +103,23 @@ processFork
     -> IORef (Maybe BlockHeader)
     -> LogFunction
     -> BlockHeader
-    -> IO (Vector Pact4.UnparsedTransaction, Vector Pact4.UnparsedTransaction)
+    -> IO (Vector Pact5.UnparsedTransaction, Vector Pact5.UnparsedTransaction)
 processFork blockHeaderDb payloadStore lastHeaderRef logFun newHeader = do
     now <- getCurrentTimeIntegral
     lastHeader <- readIORef lastHeaderRef
     (a, b) <- processFork' logFun blockHeaderDb newHeader lastHeader
                            (payloadLookup payloadStore)
                            (processForkCheckTTL now)
-    return (V.map Pact4.unHashable a, V.map Pact4.unHashable b)
+    return (V.map Pact5.unHashable a, V.map Pact5.unHashable b)
 
 
 ------------------------------------------------------------------------------
 processForkCheckTTL
     :: Time Micros
-    -> Pact4.HashableTrans (Pact4.PayloadWithText Pact4.PublicMeta Text) -> Bool
-processForkCheckTTL now (Pact4.HashableTrans t) =
+    -> Pact5.HashableTrans (Pact5.PayloadWithText Pact5.PublicMeta Text) -> Bool
+processForkCheckTTL now (Pact5.HashableTrans t) =
     either (const False) (const True) $
-    txTTLCheck pact4TransactionConfig now t
+    txTTLCheck pact5TransactionConfig now t
 
 
 ------------------------------------------------------------------------------
@@ -168,7 +168,7 @@ payloadLookup
     :: CanReadablePayloadCas tbl
     => Maybe (PayloadDb tbl)
     -> BlockHeader
-    -> IO (HashSet (Pact4.HashableTrans (Pact4.PayloadWithText Pact4.PublicMeta Text)))
+    -> IO (HashSet (Pact5.HashableTrans (Pact5.PayloadWithText Pact5.PublicMeta Text)))
 payloadLookup payloadStore bh =
     case payloadStore of
         Nothing -> return mempty
@@ -180,14 +180,14 @@ payloadLookup payloadStore bh =
 ------------------------------------------------------------------------------
 chainwebTxsFromPd
     :: PayloadData
-    -> IO (HashSet (Pact4.HashableTrans (Pact4.PayloadWithText Pact4.PublicMeta Text)))
+    -> IO (HashSet (Pact5.HashableTrans (Pact5.PayloadWithText Pact5.PublicMeta Text)))
 chainwebTxsFromPd pd = do
     let transSeq = view payloadDataTransactions pd
     let bytes = _transactionBytes <$> transSeq
     let eithers = toCWTransaction <$> bytes
     -- Note: if any transactions fail to convert, the final validation hash will fail to match
     -- the one computed during newBlock
     let theRights  = rights $ toList eithers
-    return $! HS.fromList $ Pact4.HashableTrans <$!> theRights
+    return $! HS.fromList $ Pact5.HashableTrans <$!> theRights
   where
-    toCWTransaction = codecDecode Pact4.rawCommandCodec
+    toCWTransaction = codecDecode Pact5.rawCommandCodec

src/Chainweb/Mempool/InMem.hs

@@ -39,7 +39,7 @@ import Chainweb.Logger
 import Chainweb.Mempool.CurrentTxs
 import Chainweb.Mempool.InMemTypes
 import Chainweb.Mempool.Mempool
-import Chainweb.Pact4.Validations (defaultMaxTTL, defaultMaxCoinDecimalPlaces)
+import Chainweb.Pact5.Validations (defaultMaxTTLSeconds, defaultMaxCoinDecimalPlaces)
 import Chainweb.Time
 import Chainweb.Utils
 import Chainweb.Version (ChainwebVersion)
@@ -72,8 +72,6 @@ import Data.Vector (Vector)
 import Data.Vector qualified as V
 import Data.Vector.Algorithms.Tim qualified as TimSort
 import Numeric.AffineSpace
-import Pact.Parse
-import Pact.Types.ChainMeta qualified as P
 import Prelude hiding (init, lookup, pred)
 import System.LogLevel
 import System.Random
@@ -266,8 +264,7 @@ addToBadListInMem lock txs = withMVarMasked lock $ \mdata -> do
     let !pnd' = foldl' (flip HashMap.delete) pnd txs
     -- we don't have the expiry time here, so just use maxTTL
     now <- getCurrentTimeIntegral
-    let P.TTLSeconds (ParsedInteger mt) = defaultMaxTTL
-    let !endTime = add (secondsToTimeSpan $ fromIntegral mt) now
+    let !endTime = add (secondsToTimeSpan $ fromIntegral defaultMaxTTLSeconds) now
     let !bad' = foldl' (\h tx -> HashMap.insert tx endTime h) bad txs
     writeIORef (_inmemPending mdata) pnd'
     writeIORef (_inmemBadMap mdata) bad'
@@ -348,7 +345,7 @@ insertCheckVerboseInMem logger cfg lock txs
       now <- getCurrentTimeIntegral
       badmap <- withMVarMasked lock $ readIORef . _inmemBadMap
       curTxIdx <- withMVarMasked lock $ readIORef . _inmemCurrentTxs
-      
+
       withHashesAndPositions :: (HashMap TransactionHash (Int, InsertError), HashMap TransactionHash (Int, t)) <- do
         pos <- flip V.imapM txs $ \i tx -> do
           let !h = hasher tx
@@ -446,7 +443,7 @@ validateOne cfg badmap curTxIdx now t h =
     gasPriceRoundingCheck =
         ebool_ (InsertErrorOther msg) (f (txGasPrice txcfg t))
       where
-        f (GasPrice (ParsedDecimal d)) = decimalPlaces d <= defaultMaxCoinDecimalPlaces
+        f (GasPrice d) = decimalPlaces d <= defaultMaxCoinDecimalPlaces
         msg = T.unwords
             [ "This transaction's gas price:"
             , sshow (txGasPrice txcfg t)