diff --git a/cabal.project b/cabal.project index f5a73a451d..fa7bc817d6 100644 --- a/cabal.project +++ b/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 diff --git a/cabal.project.freeze b/cabal.project.freeze index d2178df5de..946167af43 100644 --- a/cabal.project.freeze +++ b/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, diff --git a/chainweb.cabal b/chainweb.cabal index d552800538..95e4bb51d2 100644 --- a/chainweb.cabal +++ b/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 diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 28c6246db9..e8f51db986 100644 --- a/src/Chainweb/Chainweb.hs +++ b/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) diff --git a/src/Chainweb/Chainweb/ChainResources.hs b/src/Chainweb/Chainweb/ChainResources.hs index 02573d1b1c..a29392a1e4 100644 --- a/src/Chainweb/Chainweb/ChainResources.hs +++ b/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 diff --git a/src/Chainweb/Chainweb/Configuration.hs b/src/Chainweb/Chainweb/Configuration.hs index fcbca2c303..10eb75857a 100644 --- a/src/Chainweb/Chainweb/Configuration.hs +++ b/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 diff --git a/src/Chainweb/Mempool/Consensus.hs b/src/Chainweb/Mempool/Consensus.hs index 12d2c22336..2c46450c45 100644 --- a/src/Chainweb/Mempool/Consensus.hs +++ b/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,7 +180,7 @@ 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 @@ -188,6 +188,6 @@ chainwebTxsFromPd pd = do -- 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 diff --git a/src/Chainweb/Mempool/InMem.hs b/src/Chainweb/Mempool/InMem.hs index 39c0bc86ca..69ee3180d6 100644 --- a/src/Chainweb/Mempool/InMem.hs +++ b/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) diff --git a/src/Chainweb/Mempool/Mempool.hs b/src/Chainweb/Mempool/Mempool.hs index a6f8ce4319..f7bded11db 100644 --- a/src/Chainweb/Mempool/Mempool.hs +++ b/src/Chainweb/Mempool/Mempool.hs @@ -74,7 +74,7 @@ module Chainweb.Mempool.Mempool , bfTxHashes , bfCount - , pact4TransactionConfig + , pact5TransactionConfig , mockCodec , mockEncode , mockBlockGasLimit @@ -86,8 +86,6 @@ module Chainweb.Mempool.Mempool , syncMempools' , GasLimit(..) , GasPrice(..) - , pact4RequestKeyToTransactionHash - , pact5RequestKeyToTransactionHash ) where ------------------------------------------------------------------------------ @@ -104,11 +102,9 @@ import Data.Bits (bit, shiftL, shiftR, (.&.)) import Data.ByteArray (convert) import qualified Data.ByteString.Base64.URL as B64 import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Short as SB import Data.Decimal (Decimal, DecimalRaw(..)) import Data.Foldable (traverse_) -import Data.Hashable (Hashable(hashWithSalt)) import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Int (Int64) @@ -130,23 +126,22 @@ import System.LogLevel -- internal modules import qualified Pact.JSON.Encode as J -import Pact.Parse (ParsedDecimal(..), ParsedInteger(..)) -import Pact.Types.ChainMeta (TTLSeconds(..), TxCreationTime(..)) -import Pact.Types.Command -import Pact.Types.Gas (GasLimit(..), GasPrice(..)) -import qualified Pact.Types.Hash as Pact4 +import Pact.Core.ChainData (TTLSeconds(..), TxCreationTime(..)) +import Pact.Core.Gas (GasLimit(..), GasPrice(..)) +import qualified Pact.Core.Hash as Pact5 import Chainweb.BlockHash import Chainweb.BlockHeight +import Chainweb.TransactionHash import Chainweb.Time (Micros(..), Time(..), TimeSpan(..)) import qualified Chainweb.Time as Time -import qualified Chainweb.Pact4.Transaction as Pact4 +import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils import Chainweb.Utils.Serialization import Data.LogMessage (LogFunctionText) -import qualified Pact.Types.Command as Pact4 import qualified Pact.Core.Command.Types as Pact5 -import qualified Pact.Core.Hash as Pact5 + +import Pact.Core.StableEncoding ------------------------------------------------------------------------------ data LookupResult t = Missing @@ -362,8 +357,8 @@ noopMempool = do noopCodec = Codec (const "") (const $ Left "unimplemented") noopHasher = const $ chainwebTestHasher "noopMempool" noopHashMeta = chainwebTestHashMeta - noopGasPrice = const 0 - noopSize = const 1 + noopGasPrice = const $ GasPrice 0 + noopSize = const $ Pact5.toGasLimit (0 :: Int) noopMeta = const $ TransactionMetadata Time.minTime Time.maxTime txcfg = TransactionConfig noopCodec noopHasher noopHashMeta noopGasPrice noopSize noopMeta @@ -383,25 +378,23 @@ noopMempool = do ------------------------------------------------------------------------------ -pact4TransactionConfig - :: TransactionConfig Pact4.UnparsedTransaction -pact4TransactionConfig = TransactionConfig - { txCodec = Pact4.rawCommandCodec +pact5TransactionConfig + :: TransactionConfig Pact5.UnparsedTransaction +pact5TransactionConfig = TransactionConfig + { txCodec = Pact5.rawCommandCodec , txHasher = commandHash , txHashMeta = chainwebTestHashMeta , txGasPrice = getGasPrice , txGasLimit = getGasLimit , txMetadata = txmeta } - - where - getGasPrice = view Pact4.cmdGasPrice . fmap Pact4.payloadObj - getGasLimit = view Pact4.cmdGasLimit . fmap Pact4.payloadObj - getTimeToLive = view Pact4.cmdTimeToLive . fmap Pact4.payloadObj - getCreationTime = view Pact4.cmdCreationTime . fmap Pact4.payloadObj - commandHash c = let (Pact4.Hash !h) = Pact4.toUntypedHash $ _cmdHash c - in TransactionHash h + getGasPrice = view Pact5.cmdGasPrice . fmap (view Pact5.payloadObj) + getGasLimit = view Pact5.cmdGasLimit . fmap (view Pact5.payloadObj) + getTimeToLive = view Pact5.cmdTimeToLive . fmap (view Pact5.payloadObj) + getCreationTime = view Pact5.cmdCreationTime . fmap (view Pact5.payloadObj) + commandHash = TransactionHash . Pact5.unHash . view Pact5.cmdHash + txmeta t = TransactionMetadata (toMicros ct) @@ -583,51 +576,6 @@ syncMempools syncMempools log us localMempool remoteMempool = syncMempools' log us localMempool remoteMempool ------------------------------------------------------------------------------- --- | Raw/unencoded transaction hashes. --- --- TODO: production versions of this kind of DB should salt with a --- runtime-generated constant to avoid collision attacks; see the \"hashing and --- security\" section of the hashable docs. -newtype TransactionHash = TransactionHash { unTransactionHash :: SB.ShortByteString } - deriving stock (Read, Eq, Ord, Generic) - deriving anyclass (NFData) - -instance Show TransactionHash where - show = T.unpack . encodeToText - -instance Hashable TransactionHash where - hashWithSalt s (TransactionHash h) = hashWithSalt s (hashCode :: Int) - where - hashCode = either error id $ runGetEitherS (fromIntegral <$> getWord64le) (B.take 8 $ SB.fromShort h) - {-# INLINE hashWithSalt #-} - -instance ToJSON TransactionHash where - toJSON = toJSON . toText - {-# INLINE toJSON #-} - -instance J.Encode TransactionHash where - build = J.text . toText - {-# INLINE build #-} - -instance FromJSON TransactionHash where - parseJSON = withText "TransactionHash" (either (fail . show) return . p) - where - p :: Text -> Either SomeException TransactionHash - !p = (TransactionHash . SB.toShort <$>) . decodeB64UrlNoPaddingText - -instance HasTextRepresentation TransactionHash where - toText (TransactionHash th) = encodeB64UrlNoPaddingText $ SB.fromShort th - fromText = (TransactionHash . SB.toShort <$>) . decodeB64UrlNoPaddingText - {-# INLINE toText #-} - {-# INLINE fromText #-} - -pact4RequestKeyToTransactionHash :: Pact4.RequestKey -> TransactionHash -pact4RequestKeyToTransactionHash = TransactionHash . Pact4.unHash . Pact4.unRequestKey - -pact5RequestKeyToTransactionHash :: Pact5.RequestKey -> TransactionHash -pact5RequestKeyToTransactionHash = TransactionHash . Pact5.unHash . Pact5.unRequestKey - ------------------------------------------------------------------------------ -- data TransactionMetadata = TransactionMetadata @@ -721,8 +669,8 @@ data MockTx = MockTx { instance J.Encode MockTx where build o = J.object [ "mockNonce" J..= J.Aeson (mockNonce o) - , "mockGasPrice" J..= mockGasPrice o - , "mockGasLimit" J..= mockGasLimit o + , "mockGasPrice" J..= (StableEncoding $ mockGasPrice o) + , "mockGasLimit" J..= (StableEncoding $ mockGasLimit o) , "mockMeta" J..= mockMeta o ] {-# INLINE build #-} @@ -735,13 +683,13 @@ instance ToJSON MockTx where instance FromJSON MockTx where parseJSON = withObject "MockTx" $ \o -> MockTx <$> o .: "mockNonce" - <*> o .: "mockGasPrice" - <*> o .: "mockGasLimit" + <*> (_stableEncoding <$> o .: "mockGasPrice") + <*> (_stableEncoding <$> o .: "mockGasLimit") <*> o .: "mockMeta" {-# INLINE parseJSON #-} mockBlockGasLimit :: GasLimit -mockBlockGasLimit = 100_000_000 +mockBlockGasLimit = Pact5.toGasLimit (100_000_000 :: Int) -- | A codec for transactions when sending them over the wire. mockCodec :: Codec MockTx @@ -749,12 +697,12 @@ mockCodec = Codec mockEncode mockDecode mockEncode :: MockTx -> ByteString -mockEncode (MockTx nonce (GasPrice (ParsedDecimal price)) limit meta) = +mockEncode (MockTx nonce (GasPrice price) limit meta) = B64.encode $ runPutS $ do putWord64le $ fromIntegral nonce putDecimal price - putWord64le $ fromIntegral limit + putWord64le $ Pact5.fromGasLimit limit Time.encodeTime $ txMetaCreationTime meta Time.encodeTime $ txMetaExpiryTime meta @@ -796,8 +744,8 @@ mockDecode s = do s' <- B64.decode s runGetEitherS (MockTx <$> getI64 <*> getPrice <*> getGL <*> getMeta) s' where - getPrice = GasPrice . ParsedDecimal <$> getDecimal - getGL = GasLimit . ParsedInteger . fromIntegral <$> getWord64le + getPrice = GasPrice <$> getDecimal + getGL = Pact5.toGasLimit <$> getWord64le getI64 = fromIntegral <$> getWord64le getMeta = TransactionMetadata <$> Time.decodeTime <*> Time.decodeTime diff --git a/src/Chainweb/Miner/Config.hs b/src/Chainweb/Miner/Config.hs index 97fc76fbd4..31caabbd50 100644 --- a/src/Chainweb/Miner/Config.hs +++ b/src/Chainweb/Miner/Config.hs @@ -56,7 +56,7 @@ import Numeric.Natural (Natural) import Options.Applicative import qualified Pact.JSON.Encode as J -import Pact.Types.Term (mkKeySet, PublicKeyText(..)) +import Pact.Core.Guards -- internal modules @@ -252,7 +252,7 @@ pMiner prefix = pkToMiner <$> pPk where pkToMiner pk = Miner (MinerId $ "k:" <> _pubKey pk) - (MinerKeys $ mkKeySet [pk] "keys-all") + (MinerKeys $ KeySet (S.singleton pk) KeysAll) pPk = strOption % long (prefix <> "mining-public-key") <> help "public key of a miner in hex decimal encoding. The account name is the public key prefix by 'k:'. (This option can be provided multiple times.)" @@ -306,4 +306,4 @@ defaultNodeMining = NodeMiningConfig } invalidMiner :: Miner -invalidMiner = Miner "" . MinerKeys $ mkKeySet [] "keys-all" +invalidMiner = Miner "" . MinerKeys $ KeySet S.empty KeysAll diff --git a/src/Chainweb/Miner/Miners.hs b/src/Chainweb/Miner/Miners.hs index 0b9b3de4ad..1120cd81a0 100644 --- a/src/Chainweb/Miner/Miners.hs +++ b/src/Chainweb/Miner/Miners.hs @@ -66,7 +66,7 @@ import Chainweb.Miner.Coordinator import Chainweb.Miner.Core import Chainweb.Miner.Pact import Chainweb.RestAPI.Orphans () -import qualified Chainweb.Pact4.Transaction as Pact4 +import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils import Chainweb.Utils.Serialization import Chainweb.Version @@ -123,7 +123,7 @@ localTest lf v coord m cdb gen miners = -- mempoolNoopMiner :: LogFunction - -> HashMap ChainId (MempoolBackend Pact4.UnparsedTransaction) + -> HashMap ChainId (MempoolBackend Pact5.UnparsedTransaction) -> IO () mempoolNoopMiner lf chainRes = runForever lf "Chainweb.Miner.Miners.mempoolNoopMiner" $ do diff --git a/src/Chainweb/Miner/Pact.hs b/src/Chainweb/Miner/Pact.hs index 99343addfd..92759fefef 100644 --- a/src/Chainweb/Miner/Pact.hs +++ b/src/Chainweb/Miner/Pact.hs @@ -54,6 +54,7 @@ import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Vector as V import Data.Word +import Data.Set as S -- internal modules @@ -62,7 +63,8 @@ import Chainweb.Payload import Chainweb.Utils import qualified Pact.JSON.Encode as J -import qualified Pact.Types.KeySet as Pact4 +import qualified Pact.Core.Guards as Pact5 +import Pact.Core.StableEncoding -- -------------------------------------------------------------------------- -- -- Miner data @@ -77,10 +79,16 @@ newtype MinerId = MinerId { _minerId :: Text } -- | `MinerKeys` are a thin wrapper around a Pact `KeySet` to differentiate it -- from user keysets. -- -newtype MinerKeys = MinerKeys Pact4.KeySet +newtype MinerKeys = MinerKeys Pact5.KeySet deriving stock (Eq, Ord, Generic) deriving newtype (Show, NFData) +instance J.Encode MinerKeys where + build (MinerKeys ks) = J.build $ StableEncoding ks + +instance FromJSON MinerKeys where + parseJSON = fmap (MinerKeys . _stableEncoding) . parseJSON + -- | Miner info data consists of a miner id (text), and its keyset (a pact -- type). -- @@ -97,15 +105,17 @@ data Miner = Miner !MinerId !MinerKeys instance J.Encode Miner where build (Miner (MinerId m) (MinerKeys ks)) = J.object [ "account" J..= m - , "predicate" J..= Pact4._ksPredFun ks - , "public-keys" J..= J.Array (Pact4._ksKeys ks) + , "predicate" J..= (StableEncoding $ Pact5._ksPredFun ks) + , "public-keys" J..= J.Array (S.map StableEncoding $ Pact5._ksKeys ks) ] {-# INLINE build #-} instance FromJSON Miner where parseJSON = withObject "Miner" $ \o -> Miner <$> (MinerId <$> o .: "account") - <*> (MinerKeys <$> (Pact4.KeySet <$> o .: "public-keys" <*> o .: "predicate")) + <*> (MinerKeys <$> (Pact5.KeySet + <$> (S.fromList . fmap _stableEncoding <$> o .: "public-keys") + <*> (_stableEncoding <$> o .: "predicate"))) -- | A lens into the miner id of a miner. -- @@ -125,16 +135,16 @@ minerKeys = lens (\(Miner _ k) -> k) (\(Miner i _) b -> Miner i b) defaultMiner :: Miner defaultMiner = Miner (MinerId "miner") $ MinerKeys - $ Pact4.mkKeySet - ["f880a433d6e2a13a32b6169030f56245efdd8c1b8a5027e9ce98a88e886bef27"] - "keys-all" + $ Pact5.KeySet + (S.singleton $ Pact5.PublicKeyText "f880a433d6e2a13a32b6169030f56245efdd8c1b8a5027e9ce98a88e886bef27") + Pact5.KeysAll {-# NOINLINE defaultMiner #-} -- | A trivial Miner. -- noMiner :: Miner -noMiner = Miner (MinerId "NoMiner") (MinerKeys $ Pact4.mkKeySet [] "<") +noMiner = Miner (MinerId "NoMiner") (MinerKeys $ Pact5.KeySet S.empty Pact5.KeysAll) {-# NOINLINE noMiner #-} -- | Convert from Pact `Miner` to Chainweb `MinerData`. diff --git a/src/Chainweb/Pact/Conversion.hs b/src/Chainweb/Pact/Conversion.hs index 4003bdf572..21a2e03e01 100644 --- a/src/Chainweb/Pact/Conversion.hs +++ b/src/Chainweb/Pact/Conversion.hs @@ -2,23 +2,51 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Chainweb.Pact.Conversion - ( fromLegacyQualifiedName + ( toLegacyKeyset + , toLegacyGas + , fromLegacyGas + , fromLegacyVerifier + , fromLegacyQualifiedName , fromLegacyPactValue) where +import Chainweb.Utils + +import qualified Pact.JSON.Encode as J + import qualified Pact.Types.Term as Legacy import qualified Pact.Types.Exp as Legacy import qualified Pact.Types.PactValue as Legacy +import qualified Pact.Types.Verifier as Legacy + import qualified Data.Set as S import qualified Data.Map.Strict as M +import Control.Monad.Catch + import Pact.Core.ModRefs import Pact.Core.Literal import Pact.Core.Names import Pact.Core.Guards +import Pact.Core.Gas +import Pact.Core.Verifiers import Pact.Core.PactValue +toLegacyKeyset :: KeySet -> Legacy.KeySet +toLegacyKeyset (KeySet pks prd) = Legacy.mkKeySet (fmap (Legacy.PublicKeyText . _pubKey) $ S.toList pks) + (predicateToText prd) +toLegacyGas :: Gas -> Legacy.Gas +toLegacyGas = Legacy.Gas . fromIntegral . _gas + +fromLegacyGas :: Legacy.Gas -> Gas +fromLegacyGas = Gas . fromIntegral + +-- I don't like parsing / unparsing , but thats the easiesy and safest way, and it's just +-- intended to replay few old Pact-4 transactions +fromLegacyVerifier :: MonadThrow m => Legacy.Verifier Legacy.ParsedVerifierProof -> m (Verifier ParsedVerifierProof) +fromLegacyVerifier = decodeStrictOrThrow . J.encodeStrict + fromLegacyQualifiedName :: Legacy.QualifiedName -> QualifiedName diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 85ec113f9f..1e9dd3c324 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -50,10 +50,9 @@ import Control.Exception.Safe import Control.Lens hiding ((:>)) import Control.Monad import Control.Monad.Reader -import Control.Monad.State.Strict import Data.Either -import Data.Foldable (toList) +import Data.Coerce (coerce) import Data.IORef import qualified Data.HashMap.Strict as HM import Data.LogMessage @@ -74,13 +73,9 @@ import Prelude hiding (lookup) import qualified Streaming as Stream import qualified Streaming.Prelude as Stream -import qualified Pact.Gas as Pact4 -import Pact.Interpreter(PactDbEnv(..)) import qualified Pact.JSON.Encode as J import qualified Pact.Types.Command as Pact4 import qualified Pact.Types.Hash as Pact4 -import qualified Pact.Types.Runtime as Pact4 hiding (catchesPactError) -import qualified Pact.Types.Pretty as Pact4 import qualified Pact.Core.Builtin as Pact5 import qualified Pact.Core.Persistence as Pact5 @@ -91,7 +86,6 @@ import qualified Pact.Core.Command.RPC as Pact5 import qualified Pact.Core.Hash as Pact5 import qualified Chainweb.Pact4.TransactionExec as Pact4 -import qualified Chainweb.Pact4.Validations as Pact4 import Chainweb.BlockHash import Chainweb.BlockHeader @@ -106,7 +100,6 @@ import Chainweb.Pact.PactService.Pact4.ExecBlock import qualified Chainweb.Pact4.Backend.ChainwebPactDb as Pact4 import Chainweb.Pact.Service.PactQueue (PactQueue, getNextRequest) import Chainweb.Pact.Types -import Chainweb.Pact4.SPV qualified as Pact4 import Chainweb.Pact5.SPV qualified as Pact5 import Chainweb.Payload import Chainweb.Payload.PayloadStore @@ -125,7 +118,6 @@ import qualified Chainweb.Pact.PactService.Pact4.ExecBlock as Pact4 import qualified Chainweb.Pact4.Types as Pact4 import qualified Chainweb.Pact5.Backend.ChainwebPactDb as Pact5 import qualified Data.ByteString.Short as SB -import Data.Coerce (coerce) import Data.Void import qualified Chainweb.Pact5.Types as Pact5 import qualified Chainweb.Pact.PactService.Pact5.ExecBlock as Pact5 @@ -136,10 +128,10 @@ import qualified Chainweb.Pact5.TransactionExec as Pact5 import qualified Chainweb.Pact5.Transaction as Pact5 import Control.Monad.Except import qualified Chainweb.Pact5.NoCoinbase as Pact5 -import qualified Pact.Parse as Pact4 import qualified Control.Parallel.Strategies as Strategies import qualified Chainweb.Pact5.Validations as Pact5 import qualified Pact.Core.Errors as Pact5 +import qualified Pact.Core.ChainData as Pact5 import Chainweb.Pact.Backend.Types import qualified Chainweb.Pact.PactService.Checkpointer as Checkpointer import Chainweb.Pact.PactService.Checkpointer (SomeBlockM(..)) @@ -498,39 +490,7 @@ execNewBlock mpAccess miner fill newBlockParent = pactLabel "execNewBlock" $ do -- TODO: after the Pact 5 fork is complete, the Pact 4 case below will -- be unnecessary; the genesis blocks are already handled by 'execNewGenesisBlock'. SomeBlockM $ Pair - (do - blockDbEnv <- view psBlockDbEnv - initCache <- initModuleCacheForBlock - coinbaseOutput <- Pact4.runCoinbase - miner - (Pact4.EnforceCoinbaseFailure True) (Pact4.CoinbaseUsePrecompiled True) - initCache - let pactDb = Pact4._cpPactDbEnv blockDbEnv - finalBlockState <- fmap Pact4._benvBlockState - $ liftIO - $ readMVar - $ pdPactDbVar - $ pactDb - let blockInProgress = BlockInProgress - { _blockInProgressModuleCache = Pact4ModuleCache initCache - -- ^ we do not use the module cache populated by coinbase in - -- subsequent transactions - , _blockInProgressHandle = BlockHandle (Pact4._bsTxId finalBlockState) (Pact4._bsPendingBlock finalBlockState) - , _blockInProgressParentHeader = Just newBlockParent - , _blockInProgressRemainingGasLimit = blockGasLimit - , _blockInProgressTransactions = Transactions - { _transactionCoinbase = coinbaseOutput - , _transactionPairs = mempty - } - , _blockInProgressMiner = miner - , _blockInProgressPactVersion = Pact4T - , _blockInProgressChainwebVersion = v - , _blockInProgressChainId = cid - } - case fill of - NewBlockFill -> ForPact4 <$> Pact4.continueBlock mpAccess blockInProgress - NewBlockEmpty -> return (ForPact4 blockInProgress) - ) + (error "No new block with Pact 4") (do coinbaseOutput <- Pact5.runCoinbase miner >>= \case @@ -569,7 +529,7 @@ execContinueBlock mpAccess blockInProgress = pactLabel "execNewBlock" $ do case _blockInProgressPactVersion blockInProgress of -- TODO: after the Pact 5 fork is complete, the Pact 4 case below will -- be unnecessary; the genesis blocks are already handled by 'execNewGenesisBlock'. - Pact4T -> SomeBlockM $ Pair (Pact4.continueBlock mpAccess blockInProgress) (error "pact5") + Pact4T -> SomeBlockM $ Pair (error "No new block with Pact 4") (error "pact5") Pact5T -> SomeBlockM $ Pair (error "pact4") (Pact5.continueBlock mpAccess blockInProgress) where newBlockParent = _blockInProgressParentHeader blockInProgress @@ -579,7 +539,7 @@ execContinueBlock mpAccess blockInProgress = pactLabel "execNewBlock" $ do execNewGenesisBlock :: (Logger logger, CanReadablePayloadCas tbl) => Miner - -> Vector Pact4.UnparsedTransaction + -> Vector Pact5.UnparsedTransaction -> PactServiceM logger tbl PayloadWithOutputs execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ do historicalBlock <- Checkpointer.readFrom Nothing $ SomeBlockM $ Pair @@ -587,7 +547,7 @@ execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ do logger <- view (psServiceEnv . psLogger) v <- view chainwebVersion cid <- view chainId - txs <- liftIO $ traverse (runExceptT . Pact4.checkParse logger v cid (genesisBlockHeight v cid)) newTrans + txs <- liftIO $ traverse (runExceptT . Pact4.checkParse logger v cid (genesisBlockHeight v cid)) $ fmap pact5to4 newTrans parsedTxs <- case partitionEithers (V.toList txs) of ([], validTxs) -> return (V.fromList validTxs) (errs, _) -> internalError $ "Invalid genesis txs: " <> sshow errs @@ -598,6 +558,8 @@ execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ do (Pact4.CoinbaseUsePrecompiled False) Nothing Nothing >>= throwCommandInvalidError return $! toPayloadWithOutputs Pact4T miner results + + ) (do v <- view chainwebVersion @@ -624,7 +586,7 @@ execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ do , _blockInProgressChainwebVersion = v , _blockInProgressChainId = cid -- fake gas limit, gas is free for genesis - , _blockInProgressRemainingGasLimit = GasLimit (Pact4.ParsedInteger 999_999_999) + , _blockInProgressRemainingGasLimit = GasLimit 999_999_999 , _blockInProgressTransactions = Transactions { _transactionCoinbase = absurd <$> Pact5.noCoinbase , _transactionPairs = mempty @@ -636,6 +598,11 @@ execNewGenesisBlock miner newTrans = pactLabel "execNewGenesisBlock" $ do case historicalBlock of NoHistory -> internalError "PactService.execNewGenesisBlock: Impossible error, unable to rewind before genesis" Historical block -> return block + where + pact5to4::Pact5.UnparsedTransaction -> Pact4.UnparsedTransaction + pact5to4 = (either (\e -> error $ "Error when parsign Genesis Transactions:" <> e) id) + . (codecDecode Pact4.rawCommandCodec) + . (codecEncode Pact5.rawCommandCodec) execReadOnlyReplay :: forall logger tbl @@ -753,7 +720,7 @@ execReadOnlyReplay lowerBound maybeUpperBound = pactLabel "execReadOnlyReplay" $ execLocal :: (Logger logger, CanReadablePayloadCas tbl) - => Pact4.UnparsedTransaction + => Pact5.UnparsedTransaction -> Maybe LocalPreflightSimulation -- ^ preflight flag -> Maybe LocalSignatureVerification @@ -765,8 +732,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do e@PactServiceEnv{..} <- ask - let !cmd = Pact4.payloadObj <$> cwtx - !pm = Pact4.publicMetaOf cmd + let !cmd = view Pact5.payloadObj <$> cwtx !v = _chainwebVersion e !cid = _chainId e @@ -781,108 +747,19 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do | _psEnableLocalTimeout = Just (2 * 1_000_000) | otherwise = Nothing - let localPact4 = do - pc <- view psParentHeader - let spv = Pact4.pactSPV bhdb (_parentHeader pc) - ctx <- Pact4.getTxContext noMiner pm - let bh = Pact4.ctxCurrentBlockHeight ctx - let gasModel = Pact4.getGasModel ctx - mc <- Pact4.getInitCache - dbEnv <- Pact4._cpPactDbEnv <$> view psBlockDbEnv - logger <- view (psServiceEnv . psLogger) - - evalContT $ withEarlyReturn $ \earlyReturn -> do - pact4Cwtx <- liftIO (runExceptT (Pact4.checkParse logger v cid bh cwtx)) >>= \case - Left err -> earlyReturn $ - let - parseError = Pact4.CommandResult - { _crReqKey = Pact4.cmdToRequestKey cmd - , _crTxId = Nothing - , _crResult = Pact4.PactResult (Left (Pact4.PactError Pact4.SyntaxError Pact4.noInfo [] (sshow err))) - , _crGas = cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit . to int - , _crLogs = Nothing - , _crContinuation = Nothing - , _crMetaData = Nothing - , _crEvents = [] - } - in case preflight of - Just PreflightSimulation -> Pact4LocalResultWithWarns parseError [] - _ -> Pact4LocalResultLegacy parseError - Right pact4Cwtx -> return pact4Cwtx - case (preflight, sigVerify) of - (_, Just NoVerify) -> do - let payloadBS = SB.fromShort (Pact4._cmdPayload $ Pact4.payloadBytes <$> cwtx) - let validated = Pact4.verifyHash @'Pact4.Blake2b_256 (Pact4._cmdHash cmd) payloadBS - case validated of - Left err -> earlyReturn $ review _MetadataValidationFailure $ NonEmpty.singleton $ Text.pack err - Right _ -> return () - _ -> do - let validated = Pact4.assertCommand pact4Cwtx (validPPKSchemes v cid bh) (isWebAuthnPrefixLegal v cid bh) - case validated of - Left err -> earlyReturn $ review _MetadataValidationFailure (pure $ displayAssertCommandError err) - Right () -> return () - - -- - -- if the ?preflight query parameter is set to True, we run the `applyCmd` workflow - -- otherwise, we prefer the old (default) behavior. When no preflight flag is - -- specified, we run the old behavior. When it is set to true, we also do metadata - -- validations. - -- - case preflight of - Just PreflightSimulation -> do - lift (Pact4.liftPactServiceM (Pact4.assertPreflightMetadata cmd ctx sigVerify)) >>= \case - Left err -> earlyReturn $ review _MetadataValidationFailure err - Right () -> return () - let initialGas = Pact4.initialGasOf $ Pact4._cmdPayload pact4Cwtx - T3 cr _mc warns <- liftIO $ Pact4.applyCmd - _psVersion _psLogger _psGasLogger Nothing dbEnv - noMiner gasModel ctx (TxBlockIdx 0) spv (Pact4.payloadObj <$> pact4Cwtx) - initialGas mc ApplyLocal - - let cr' = hashPact4TxLogs cr - warns' = Pact4.renderCompactText <$> toList warns - pure $ Pact4LocalResultWithWarns cr' warns' - _ -> liftIO $ do - let execConfig = Pact4.mkExecutionConfig $ - [ Pact4.FlagAllowReadInLocal | _psAllowReadsInLocal ] ++ - Pact4.enablePactEvents' v cid bh ++ - Pact4.enforceKeysetFormats' v cid bh ++ - Pact4.disableReturnRTC v cid bh - - cr <- Pact4.applyLocal - _psLogger _psGasLogger dbEnv - gasModel ctx spv - pact4Cwtx mc execConfig - - let cr' = hashPact4TxLogs cr - pure $ Pact4LocalResultLegacy cr' - + let localPact4 = error "Local Pact4 Unsupported" let localPact5 = do ph <- view psParentHeader - let pact5RequestKey = Pact5.RequestKey (Pact5.Hash $ Pact4.unHash $ Pact4.toUntypedHash $ Pact4._cmdHash cwtx) + let requestKey = Pact5.RequestKey $ Pact5._cmdHash cwtx evalContT $ withEarlyReturn $ \earlyReturn -> do - pact5Cmd <- case Pact5.parsePact4Command cwtx of - Left (Left errText) -> do + pact5Cmd <- case Pact5.parseTransaction cwtx of + Left (fmap Pact5.spanInfoToLineInfo -> parseError) -> earlyReturn $ Pact5LocalResultLegacy Pact5.CommandResult - { _crReqKey = pact5RequestKey - , _crTxId = Nothing - , _crResult = Pact5.PactResultErr $ - Pact5.pactErrorToOnChainError $ Pact5.PEParseError - (Pact5.ParsingError $ "pact 4/5 parsing compatibility mismatch: " <> errText) - (Pact5.LineInfo 0) - , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit - , _crLogs = Nothing - , _crContinuation = Nothing - , _crMetaData = Nothing - , _crEvents = [] - } - Left (Right (fmap Pact5.spanInfoToLineInfo -> parseError)) -> - earlyReturn $ Pact5LocalResultLegacy Pact5.CommandResult - { _crReqKey = pact5RequestKey + { _crReqKey = requestKey , _crTxId = Nothing , _crResult = Pact5.PactResultErr $ Pact5.pactErrorToOnChainError parseError - , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit + , _crGas = coerce $ cmd ^. Pact5.cmdPayload . Pact5.pMeta . Pact5.pmGasLimit , _crLogs = Nothing , _crContinuation = Nothing , _crMetaData = Nothing @@ -895,7 +772,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do -- TODO: unify preflight, newblock, and validateblock tx metadata validation case (preflight, sigVerify) of (_, Just NoVerify) -> do - let payloadBS = SB.fromShort (Pact4._cmdPayload $ Pact4.payloadBytes <$> cwtx) + let payloadBS = SB.fromShort $ cwtx ^. Pact5.cmdPayload . Pact5.payloadBytes let validated = Pact5.verifyHash (Pact5._cmdHash pact5Cmd) payloadBS case validated of Left err -> earlyReturn $ @@ -926,7 +803,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do commandResult <- case applyCmdResult of Left err -> earlyReturn $ Pact5LocalResultWithWarns Pact5.CommandResult - { _crReqKey = Pact5.RequestKey (Pact5.Hash $ Pact4.unHash $ Pact4.toUntypedHash $ Pact4._cmdHash cwtx) + { _crReqKey = Pact5.RequestKey $ Pact5._cmdHash cwtx , _crTxId = Nothing , _crResult = Pact5.PactResultErr $ Pact5.PactOnChainError @@ -935,7 +812,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do (Pact5.ErrorType "EvalError") (Pact5.mkBoundedText $ prettyPact5GasPurchaseFailure err) (Pact5.LocatedErrorInfo Pact5.TopLevelErrorOrigin Pact5.noInfo) - , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit + , _crGas = coerce $ cmd ^. Pact5.cmdPayload . Pact5.pMeta . Pact5.pmGasLimit , _crLogs = Nothing , _crContinuation = Nothing , _crMetaData = Nothing @@ -1005,7 +882,7 @@ execValidateBlock => MemPoolAccess -> BlockHeader -> CheckablePayload - -> PactServiceM logger tbl (PayloadWithOutputs, Pact4.Gas) + -> PactServiceM logger tbl (PayloadWithOutputs, Pact5.Gas) execValidateBlock memPoolAccess headerToValidate payloadToValidate = pactLabel "execValidateBlock" $ do bhdb <- view psBlockHeaderDb payloadDb <- view psPdb @@ -1072,12 +949,12 @@ execValidateBlock memPoolAccess headerToValidate payloadToValidate = pactLabel " -- validate its hashes let runThisBlock = Stream.yield $ SomeBlockM $ Pair (do - !output <- Pact4.execBlock headerToValidate payloadToValidate - return ([output], headerToValidate) + !(gas, pwo) <- Pact4.execBlock headerToValidate payloadToValidate + return ([(fromIntegral gas, pwo)], headerToValidate) ) (do !(gas, pwo) <- Pact5.execExistingBlock headerToValidate payloadToValidate - return ([(fromIntegral (Pact5._gas gas), pwo)], headerToValidate) + return ([(gas, pwo)], headerToValidate) ) -- here we rewind to the common ancestor block, run the @@ -1144,33 +1021,16 @@ execHistoricalLookup bh d k = execPreInsertCheckReq :: (CanReadablePayloadCas tbl, Logger logger) - => Vector Pact4.UnparsedTransaction + => Vector Pact5.UnparsedTransaction -> PactServiceM logger tbl (Vector (Maybe Mempool.InsertError)) execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do - let requestKeys = V.map Pact4.cmdToRequestKey txs + let requestKeys = V.map Pact5.cmdToRequestKey txs logInfoPact $ "(request keys = " <> sshow requestKeys <> ")" psEnv <- ask - psState <- get logger <- view psLogger let timeoutLimit = fromIntegral $ (\(Micros n) -> n) $ _psPreInsertCheckTimeout psEnv let act = Checkpointer.readFromLatest $ SomeBlockM $ Pair - (do - pdb <- view psBlockDbEnv - pc <- view psParentHeader - let - parentTime = ParentCreationTime (view blockCreationTime $ _parentHeader pc) - currHeight = succ $ view blockHeight $ _parentHeader pc - v = _chainwebVersion pc - cid = _chainId pc - liftIO $ forM txs $ \tx -> do - let isGenesis = False - fmap (either Just (\_ -> Nothing)) $ runExceptT $ do - parsedTx <- Pact4.validateRawChainwebTx - logger v cid pdb parentTime currHeight tx - ExceptT $ evalPactServiceM psState psEnv . Pact4.runPactBlockM pc isGenesis pdb - $ attemptBuyGasPact4 noMiner parsedTx - return parsedTx - ) + (error "Pact v4") (do db <- view psBlockDbEnv ph <- view psParentHeader @@ -1219,47 +1079,6 @@ execPreInsertCheckReq txs = pactLabel "execPreInsertCheckReq" $ do logDebug_ logger $ "Mempool pre-insert check result: " <> sshow result pure result - where - attemptBuyGasPact4 - :: forall logger tbl. (Logger logger) - => Miner - -> Pact4.Transaction - -> Pact4.PactBlockM logger tbl (Either InsertError ()) - attemptBuyGasPact4 miner tx = Pact4.localLabelBlock ("transaction", "attemptBuyGas") $ do - mcache <- Pact4.getInitCache - l <- view (psServiceEnv . psLogger) - do - let cmd = Pact4.payloadObj <$> tx - gasPrice = view Pact4.cmdGasPrice cmd - gasLimit = fromIntegral $ view Pact4.cmdGasLimit cmd - txst = Pact4.TransactionState - { _txCache = mcache - , _txLogs = mempty - , _txGasUsed = 0 - , _txGasId = Nothing - , _txGasModel = Pact4._geGasModel Pact4.freeGasEnv - , _txWarnings = mempty - } - let !nid = Pact4.networkIdOf cmd - let !rk = Pact4.cmdToRequestKey cmd - pd <- Pact4.getTxContext miner (Pact4.publicMetaOf cmd) - bhdb <- view (psServiceEnv . psBlockHeaderDb) - dbEnv <- Pact4._cpPactDbEnv <$> view psBlockDbEnv - spv <- Pact4.pactSPV bhdb . _parentHeader <$> view psParentHeader - let ec = Pact4.mkExecutionConfig $ - [ Pact4.FlagDisableModuleInstall - , Pact4.FlagDisableHistoryInTransactionalMode ] ++ - Pact4.disableReturnRTC (Pact4.ctxVersion pd) (Pact4.ctxChainId pd) (Pact4.ctxCurrentBlockHeight pd) - let buyGasEnv = Pact4.TransactionEnv Pact4.Transactional dbEnv l Nothing (Pact4.ctxToPublicData pd) spv nid gasPrice rk gasLimit ec Nothing Nothing - - cr <- liftIO - $! Pact4.catchesPactError l Pact4.CensorsUnexpectedError - $! Pact4.execTransactionM buyGasEnv txst - $! Pact4.buyGas pd cmd miner - - return $ bimap (InsertErrorBuyGas . sshow) (\_ -> ()) cr - - execLookupPactTxs :: (CanReadablePayloadCas tbl, Logger logger) => Maybe ConfirmationDepth diff --git a/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs b/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs index a0fb97a8c1..7399941899 100644 --- a/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs @@ -26,7 +26,6 @@ module Chainweb.Pact.PactService.Pact4.ExecBlock ( execBlock , execTransactions - , continueBlock , toPayloadWithOutputs , validateParsedChainwebTx , validateRawChainwebTx @@ -90,6 +89,7 @@ import Chainweb.Pact4.NoCoinbase import qualified Chainweb.Pact4.Transaction as Pact4 import qualified Chainweb.Pact4.TransactionExec as Pact4 import qualified Chainweb.Pact4.Validations as Pact4 +import qualified Pact.Core.Gas as Pact5 import Chainweb.Payload import Chainweb.Payload.PayloadStore import Chainweb.Time @@ -99,16 +99,10 @@ import Chainweb.ForkState (pact4ForkNumber) import Chainweb.Version.Guards import Chainweb.Pact4.Backend.ChainwebPactDb import Data.Coerce -import Data.Word -import GrowableVector.Lifted (Vec) -import Control.Monad.Primitive -import qualified GrowableVector.Lifted as Vec -import qualified Data.Set as S import Chainweb.Pact4.Types import Chainweb.Pact4.ModuleCache import Control.Monad.Except import qualified Data.List.NonEmpty as NE -import Chainweb.Pact.Backend.Types (BlockHandle(..)) -- | Execute a block -- only called in validate either for replay or for validating current block. @@ -542,7 +536,7 @@ applyPactCmd txIdxInBlock miner txTimeLimit cmd = StateT $ \(T2 mcache maybeBloc parent <- view psParentHeader let spv = Pact4.pactSPV bhdb (_parentHeader parent) let - !timeoutError = TxTimeout (pact4RequestKeyToTransactionHash $ Pact4.cmdToRequestKey cmd) + !timeoutError = TxTimeout (Pact4.requestKeyToTransactionHash $ Pact4.cmdToRequestKey cmd) txTimeout io = case txTimeLimit of Nothing -> do logFunctionText logger Debug $ "txTimeLimit was not set - defaulting to a function of the block gas limit" @@ -567,7 +561,7 @@ applyPactCmd txIdxInBlock miner txTimeLimit cmd = StateT $ \(T2 mcache maybeBloc Just blockGasRemaining | Left _ <- Pact4._pactResult (Pact4._crResult result) , blockGasRemaining < fromIntegral requestedTxGasLimit - -> throwM $ BlockGasLimitExceeded (fromIntegral requestedTxGasLimit - blockGasRemaining) + -> throwM $ BlockGasLimitExceeded $ Pact5.Gas $ fromIntegral requestedTxGasLimit - fromIntegral blockGasRemaining -- ^ this tx attempted to consume more gas than remains in the -- block, so the block is invalid. we know this because failing -- transactions consume their entire gas limit. @@ -650,232 +644,6 @@ validateHashes bHeader payload miner transactions = newHash = _payloadWithOutputsPayloadHash actualPwo prevHash = view blockPayloadHash bHeader -type GrowableVec = Vec (PrimState IO) - --- | Continue adding transactions to an existing block. -continueBlock - :: forall logger tbl - . (Logger logger, CanReadablePayloadCas tbl) - => MemPoolAccess - -> BlockInProgress Pact4 - -> PactBlockM logger tbl (BlockInProgress Pact4) -continueBlock mpAccess blockInProgress = do - v <- view chainwebVersion - cid <- view chainId - ParentHeader parent <- view psParentHeader - let pHeight = view blockHeight parent - let pHash = view blockHash parent - liftIO $ do - mpaProcessFork mpAccess parent - mpaSetLastHeader mpAccess parent - liftPactServiceM $ - logInfoPact $ "(parent height = " <> sshow pHeight <> ")" - <> " (parent hash = " <> sshow pHash <> ")" - - blockDbEnv <- view psBlockDbEnv - let pactDb = _cpPactDbEnv blockDbEnv - -- restore the block state from the block being continued - liftIO $ - modifyMVar_ (pdPactDbVar pactDb) $ \blockEnv -> - return - $! blockEnv - & benvBlockState . bsPendingBlock .~ _blockHandlePending (_blockInProgressHandle blockInProgress) - & benvBlockState . bsTxId .~ _blockHandleTxId (_blockInProgressHandle blockInProgress) - - blockGasLimit <- view (psServiceEnv . psBlockGasLimit) - mTxTimeLimit <- view (psServiceEnv . psTxTimeLimit) - - let txTimeHeadroomFactor :: Double - txTimeHeadroomFactor = 5 - let txTimeLimit :: Micros - -- 2.5 microseconds per unit gas - txTimeLimit = fromMaybe - (round $ (2.5 * txTimeHeadroomFactor) * fromIntegral blockGasLimit) - mTxTimeLimit - - let Pact4ModuleCache initCache = _blockInProgressModuleCache blockInProgress - let cb = _transactionCoinbase (_blockInProgressTransactions blockInProgress) - let startTxs = _transactionPairs (_blockInProgressTransactions blockInProgress) - - successes <- liftIO $ Vec.fromFoldable startTxs - failures <- liftIO $ Vec.new @_ @_ @TransactionHash - - let initState = BlockFill - (_blockInProgressRemainingGasLimit blockInProgress) - (S.fromList $ pact4RequestKeyToTransactionHash . Pact4._crReqKey . snd <$> V.toList startTxs) - 0 - - -- Heuristic: limit fetches to count of 1000-gas txs in block. - let fetchLimit = fromIntegral $ blockGasLimit `div` 1000 - T2 - finalModuleCache - BlockFill { _bfTxHashes = requestKeys, _bfGasLimit = finalGasLimit } - <- refill fetchLimit txTimeLimit successes failures initCache initState - - liftPactServiceM $ logInfoPact $ "(request keys = " <> sshow requestKeys <> ")" - - liftIO $ do - txHashes <- Vec.toLiftedVector failures - mpaBadlistTx mpAccess txHashes - - txs <- liftIO $ Vec.toLiftedVector successes - -- edmund: we need to be careful about timeouts. - -- If a tx times out, it must not be in the block state, otherwise - -- the "block in progress" will contain pieces of state from that tx. - -- - -- this cannot happen now because applyPactCmd doesn't let it. - finalBlockState <- fmap _benvBlockState - $ liftIO - $ readMVar - $ pdPactDbVar - $ pactDb - let !blockInProgress' = BlockInProgress - { _blockInProgressModuleCache = Pact4ModuleCache finalModuleCache - , _blockInProgressHandle = BlockHandle - { _blockHandleTxId = _bsTxId finalBlockState - , _blockHandlePending = _bsPendingBlock finalBlockState - } - , _blockInProgressParentHeader = newBlockParent - , _blockInProgressRemainingGasLimit = finalGasLimit - , _blockInProgressTransactions = Transactions - { _transactionCoinbase = cb - , _transactionPairs = txs - } - , _blockInProgressMiner = _blockInProgressMiner blockInProgress - , _blockInProgressPactVersion = Pact4T - , _blockInProgressChainwebVersion = v - , _blockInProgressChainId = cid - } - return blockInProgress' - where - newBlockParent = _blockInProgressParentHeader blockInProgress - - - getBlockTxs :: BlockFill -> PactBlockM logger tbl (Vector Pact4.Transaction) - getBlockTxs bfState = do - dbEnv <- view psBlockDbEnv - psEnv <- ask - let v = _chainwebVersion psEnv - cid = _chainId psEnv - logger <- view (psServiceEnv . psLogger) - -- parent time needs to know if we're *actually* at genesis - let parentTime = - maybe - (v ^?! versionGenesis . genesisTime . atChain cid) - (view blockCreationTime . _parentHeader) - newBlockParent - ParentHeader parent <- view psParentHeader - let pHeight = view blockHeight parent - let pHash = view blockHash parent - let validate bhi _bha txs = forM txs $ \tx -> runExceptT $ do - validateRawChainwebTx logger v cid dbEnv (ParentCreationTime parentTime) bhi tx - - liftIO $! - mpaGetBlock mpAccess bfState validate (pHeight + 1) pHash parentTime - - refill - :: Word64 - -> Micros - -> GrowableVec (Pact4.Transaction, Pact4.CommandResult [Pact4.TxLogJson]) - -> GrowableVec TransactionHash - -> ModuleCache - -> BlockFill - -> PactBlockM logger tbl (T2 ModuleCache BlockFill) - refill fetchLimit txTimeLimit successes failures = go - where - go :: ModuleCache -> BlockFill -> PactBlockM logger tbl (T2 ModuleCache BlockFill) - go mc unchanged@bfState = do - - case unchanged of - BlockFill g _ c -> do - (goodLength, badLength) <- liftIO $ (,) <$> Vec.length successes <*> Vec.length failures - liftPactServiceM $ logDebugPact $ "Block fill: count=" <> sshow c - <> ", gaslimit=" <> sshow g <> ", good=" - <> sshow goodLength <> ", bad=" <> sshow badLength - - -- LOOP INVARIANT: limit absolute recursion count - if _bfCount bfState > fetchLimit then liftPactServiceM $ do - logInfoPact $ "Refill fetch limit exceeded (" <> sshow fetchLimit <> ")" - pure (T2 mc unchanged) - else do - when (_bfGasLimit bfState < 0) $ - throwM $ MempoolFillFailure $ "Internal error, negative gas limit: " <> sshow bfState - - if _bfGasLimit bfState == 0 then pure (T2 mc unchanged) else do - - newTrans <- getBlockTxs bfState - if V.null newTrans then pure (T2 mc unchanged) else do - - T2 pairs mc' <- do - T2 txOuts mcOut <- applyPactCmds newTrans (_blockInProgressMiner blockInProgress) mc Nothing (Just txTimeLimit) - return $! T2 (V.force (V.zip newTrans txOuts)) mcOut - - oldSuccessesLength <- liftIO $ Vec.length successes - - (newState, timedOut) <- splitResults successes failures unchanged (V.toList pairs) - - -- LOOP INVARIANT: gas must not increase - when (_bfGasLimit newState > _bfGasLimit bfState) $ - throwM $ MempoolFillFailure $ "Gas must not increase: " <> sshow (bfState,newState) - - newSuccessesLength <- liftIO $ Vec.length successes - let addedSuccessCount = newSuccessesLength - oldSuccessesLength - - if timedOut - then - -- a transaction timed out, so give up early and make the block - pure (T2 mc' (incCount newState)) - else if _bfGasLimit newState >= _bfGasLimit bfState && addedSuccessCount > 0 - then - -- INVARIANT: gas must decrease if any transactions succeeded - throwM $ MempoolFillFailure - $ "Invariant failure, gas did not decrease: " - <> sshow (bfState,newState,V.length newTrans,addedSuccessCount) - else - go mc' (incCount newState) - - incCount :: BlockFill -> BlockFill - incCount b = over bfCount succ b - - -- | Split the results of applying each command into successes and failures, - -- and return the final 'BlockFill'. - -- - -- If we encounter a 'TxTimeout', we short-circuit, and only return - -- what we've put into the block before the timeout. We also report - -- that we timed out, so that `refill` can stop early. - -- - -- The failed txs are later badlisted. - splitResults :: () - => GrowableVec (Pact4.Transaction, Pact4.CommandResult [Pact4.TxLogJson]) - -> GrowableVec TransactionHash -- ^ failed txs - -> BlockFill - -> [(Pact4.Transaction, Either CommandInvalidError (Pact4.CommandResult [Pact4.TxLogJson]))] - -> PactBlockM logger tbl (BlockFill, Bool) - splitResults successes failures = go - where - go acc@(BlockFill g rks i) = \case - [] -> pure (acc, False) - (t, r) : rest -> case r of - Right cr -> do - !rks' <- enforceUnique rks (pact4RequestKeyToTransactionHash $ Pact4._crReqKey cr) - -- Decrement actual gas used from block limit - let !g' = g - fromIntegral (Pact4._crGas cr) - liftIO $ Vec.push successes (t, cr) - go (BlockFill g' rks' i) rest - Left (CommandInvalidGasPurchaseFailure (Pact4GasPurchaseFailure h _)) -> do - !rks' <- enforceUnique rks h - -- Gas buy failure adds failed request key to fail list only - liftIO $ Vec.push failures h - go (BlockFill g rks' i) rest - Left (CommandInvalidTxTimeout (TxTimeout h)) -> do - liftIO $ Vec.push failures h - liftPactServiceM $ logErrorPact $ "timed out on " <> sshow h - return (acc, True) - - enforceUnique rks rk - | S.member rk rks = - throwM $ MempoolFillFailure $ "Duplicate transaction: " <> sshow rk - | otherwise = return $ S.insert rk rks -- | This timeout variant returns Nothing if the timeout elapsed, regardless of whether or not it was actually able to interrupt its argument. -- This is more robust in the face of scheduler behavior than the standard 'System.Timeout.timeout', with small timeouts. diff --git a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs index 567da7aa93..3037945bba 100644 --- a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs @@ -26,7 +26,7 @@ module Chainweb.Pact.PactService.Pact5.ExecBlock import Chainweb.BlockHeader import Chainweb.BlockHeight import Chainweb.Logger -import Chainweb.Mempool.Mempool(BlockFill (..), pact5RequestKeyToTransactionHash, InsertError (..)) +import Chainweb.Mempool.Mempool(BlockFill (..), InsertError (..)) import Chainweb.MinerReward import Chainweb.Miner.Pact import Chainweb.Pact5.Backend.ChainwebPactDb (Pact5Db(doPact5DbTransaction)) @@ -70,12 +70,10 @@ import qualified Pact.JSON.Encode as J import System.Timeout import Utils.Logging.Trace import qualified Data.Set as S -import qualified Pact.Types.Gas as Pact4 import qualified Pact.Core.Gas as P import qualified Data.Text.Encoding as T import qualified Data.HashMap.Strict as HashMap import qualified Chainweb.Pact5.Backend.ChainwebPactDb as Pact5 -import qualified Chainweb.Pact4.Transaction as Pact4 import qualified Chainweb.Pact5.Transaction as Pact5 import qualified Chainweb.Pact5.Validations as Pact5 import Pact.Core.Pretty qualified as Pact5 @@ -181,7 +179,7 @@ continueBlock mpAccess blockInProgress = do let startTxs = _transactionPairs (_blockInProgressTransactions blockInProgress) let startTxsRequestKeys = - foldMap' (S.singleton . pact5RequestKeyToTransactionHash . view Pact5.crReqKey . snd) startTxs + foldMap' (S.singleton . Pact5.requestKeyToTransactionHash . view Pact5.crReqKey . snd) startTxs let initState = BlockFill { _bfTxHashes = startTxsRequestKeys , _bfGasLimit = _blockInProgressRemainingGasLimit blockInProgress @@ -196,7 +194,7 @@ continueBlock mpAccess blockInProgress = do finalBlockHandle <- use pbBlockHandle liftIO $ mpaBadlistTx mpAccess - (V.fromList $ fmap pact5RequestKeyToTransactionHash $ concat invalids) + (V.fromList $ fmap Pact5.requestKeyToTransactionHash $ concat invalids) liftPactServiceM $ logDebugPact $ "Order of completed transactions: " <> sshow (map (Pact5.unRequestKey . Pact5._crReqKey . snd) $ concat $ reverse valids) let !blockInProgress' = blockInProgress @@ -249,10 +247,10 @@ continueBlock mpAccess blockInProgress = do , _bfGasLimit = newBlockGasLimit , _bfTxHashes = flip - (foldr (S.insert . pact5RequestKeyToTransactionHash . view (_2 . Pact5.crReqKey))) + (foldr (S.insert . Pact5.requestKeyToTransactionHash . view (_2 . Pact5.crReqKey))) newCompletedTransactions $ flip - (foldr (S.insert . pact5RequestKeyToTransactionHash)) + (foldr (S.insert . Pact5.requestKeyToTransactionHash)) newInvalidTransactions $ prevTxHashes } @@ -270,18 +268,17 @@ continueBlock mpAccess blockInProgress = do execNewTransactions :: Miner - -> Pact4.GasLimit + -> Pact5.GasLimit -> Micros -> Vector Pact5.Transaction - -> PactBlockM logger tbl (CompletedTransactions, InvalidTransactions, Pact4.GasLimit, Bool) + -> PactBlockM logger tbl (CompletedTransactions, InvalidTransactions, Pact5.GasLimit, Bool) execNewTransactions miner remainingGas timeLimit txs = do env <- ask startBlockHandle <- use pbBlockHandle - let p5RemainingGas = Pact5.GasLimit $ Pact5.Gas $ fromIntegral remainingGas logger' <- view (psServiceEnv . psLogger) isGenesis <- view psIsGenesis ((txResults, timedOut), (finalBlockHandle, Identity finalRemainingGas)) <- - liftIO $ flip runStateT (startBlockHandle, Identity p5RemainingGas) $ foldr + liftIO $ flip runStateT (startBlockHandle, Identity remainingGas) $ foldr (\(txIdxInBlock, tx) rest -> StateT $ \s -> do let logger = addLabel ("transactionHash", sshow (Pact5._cmdHash tx)) logger' let env' = env & psServiceEnv . psLogger .~ logger @@ -318,8 +315,7 @@ continueBlock mpAccess blockInProgress = do (zip [0..] (V.toList txs)) pbBlockHandle .= finalBlockHandle let (invalidTxHashes, completedTxs) = partitionEithers txResults - let p4FinalRemainingGas = fromIntegral @Pact5.SatWord @Pact4.GasLimit $ finalRemainingGas ^. Pact5._GasLimit . to Pact5._gas - return (completedTxs, Pact5.RequestKey <$> invalidTxHashes, p4FinalRemainingGas, timedOut) + return (completedTxs, Pact5.RequestKey <$> invalidTxHashes, finalRemainingGas, timedOut) getBlockTxs :: BlockFill -> PactBlockM logger tbl (Vector Pact5.Transaction) getBlockTxs blockFillState = do @@ -563,10 +559,10 @@ validateRawChainwebTx -- ^ Current block height -> Bool -- ^ Genesis? - -> Pact4.UnparsedTransaction + -> Pact5.UnparsedTransaction -> ExceptT InsertError IO Pact5.Transaction validateRawChainwebTx logger v cid db blockHandle parentTime bh isGenesis tx = do - tx' <- either (throwError . InsertErrorPactParseError . either id Pact5.renderText) return $ Pact5.parsePact4Command tx + tx' <- either (throwError . InsertErrorPactParseError . Pact5.renderText) return $ Pact5.parseTransaction tx liftIO $ do logDebug_ logger $ "validateRawChainwebTx: parse succeeded" validateParsedChainwebTx logger v cid db blockHandle parentTime bh isGenesis tx' diff --git a/src/Chainweb/Pact/RestAPI.hs b/src/Chainweb/Pact/RestAPI.hs index 16a4ffff30..58eea2289d 100644 --- a/src/Chainweb/Pact/RestAPI.hs +++ b/src/Chainweb/Pact/RestAPI.hs @@ -56,8 +56,6 @@ module Chainweb.Pact.RestAPI import Data.Text (Text) -import qualified Pact.Types.Command as Pact -import qualified Pact.Server.API as Pact4 import Pact.Utils.Servant import Servant @@ -71,17 +69,19 @@ import Chainweb.Pact.Types import Chainweb.RestAPI.Utils import Chainweb.SPV.PayloadProof import Chainweb.Version +import qualified Pact.Core.Command.Client as Pact5 import qualified Pact.Core.Command.Server as Pact5 +import qualified Pact.Core.Command.Types as Pact5 -- -------------------------------------------------------------------------- -- -- @POST /chainweb///chain//pact/@ --- TODO unify with Pact versioning + type PactApi_ = "pact" :> "api" :> "v1" - :> ( Pact4.ApiSend + :> ( ApiSend :<|> PactPollWithQueryApi_ :<|> ApiListen :<|> PactLocalWithQueryApi_ @@ -106,11 +106,23 @@ type PactV1ApiEndpoint (v :: ChainwebVersionT) (c :: ChainIdT) api :> "v1" :> api -type PactLocalApi v c = PactV1ApiEndpoint v c Pact4.ApiLocal -type PactSendApi v c = PactV1ApiEndpoint v c Pact4.ApiSend +type PactLocalApi v c = PactV1ApiEndpoint v c ApiLocal +type PactSendApi v c = PactV1ApiEndpoint v c ApiSend type PactListenApi v c = PactV1ApiEndpoint v c ApiListen -type ApiListen = ("listen" :> ReqBody '[PactJson] Pact5.ListenRequest :> Post '[PactJson] Pact5.ListenResponse) + +type ApiLocal = "local" + :> ReqBody '[PactJson] (Pact5.Command Text) + :> Post '[PactJson] LocalResult + +type ApiSend = "send" + :> ReqBody '[PactJson] Pact5.SubmitBatch + :> Post '[PactJson] Pact5.RequestKeys + +type ApiListen = "listen" + :> ReqBody '[PactJson] Pact5.ListenRequest + :> Post '[PactJson] Pact5.ListenResponse + pactLocalApi :: forall (v :: ChainwebVersionT) (c :: ChainIdT) @@ -135,7 +147,7 @@ type PactLocalWithQueryApi_ :> QueryParam "preflight" LocalPreflightSimulation :> QueryParam "signatureVerification" LocalSignatureVerification :> QueryParam "rewindDepth" RewindDepth - :> ReqBody '[PactJson] (Pact.Command Text) + :> ReqBody '[PactJson] (Pact5.Command Text) :> Post '[PactJson] LocalResult type PactLocalWithQueryApi v c = PactV1ApiEndpoint v c PactLocalWithQueryApi_ diff --git a/src/Chainweb/Pact/RestAPI/Client.hs b/src/Chainweb/Pact/RestAPI/Client.hs index e416b0961d..de4218fbac 100644 --- a/src/Chainweb/Pact/RestAPI/Client.hs +++ b/src/Chainweb/Pact/RestAPI/Client.hs @@ -34,10 +34,6 @@ module Chainweb.Pact.RestAPI.Client import qualified Data.Text as T -import Pact.Types.API -import Pact.Types.Command -import Pact.Types.Hash - import Servant.Client -- internal modules @@ -50,6 +46,8 @@ import Chainweb.Pact.Types import Chainweb.SPV.PayloadProof import Chainweb.Version import qualified Pact.Core.Command.Server as Pact5 +import qualified Pact.Core.Command.Client as Pact5 +import qualified Pact.Core.Command.Types as Pact5 -- -------------------------------------------------------------------------- -- -- Pact Spv Transaction Output Proof Client @@ -138,15 +136,15 @@ pactLocalApiClient_ :: forall (v :: ChainwebVersionT) (c :: ChainIdT) . KnownChainwebVersionSymbol v => KnownChainIdSymbol c - => Command T.Text - -> ClientM (CommandResult Hash) + => Pact5.Command T.Text + -> ClientM LocalResult pactLocalApiClient_ = client (pactLocalApi @v @c) pactLocalApiClient :: ChainwebVersion -> ChainId - -> Command T.Text - -> ClientM (CommandResult Hash) + -> Pact5.Command T.Text + -> ClientM LocalResult pactLocalApiClient (FromSingChainwebVersion (SChainwebVersion :: Sing v)) (FromSingChainId (SChainId :: Sing c)) @@ -159,7 +157,7 @@ pactLocalWithQueryApiClient_ => Maybe LocalPreflightSimulation -> Maybe LocalSignatureVerification -> Maybe RewindDepth - -> Command T.Text + -> Pact5.Command T.Text -> ClientM LocalResult pactLocalWithQueryApiClient_ = client (pactLocalWithQueryApi @v @c) @@ -169,7 +167,7 @@ pactLocalWithQueryApiClient -> Maybe LocalPreflightSimulation -> Maybe LocalSignatureVerification -> Maybe RewindDepth - -> Command T.Text + -> Pact5.Command T.Text -> ClientM LocalResult pactLocalWithQueryApiClient (FromSingChainwebVersion (SChainwebVersion :: Sing v)) @@ -204,15 +202,15 @@ pactSendApiClient_ :: forall (v :: ChainwebVersionT) (c :: ChainIdT) . KnownChainwebVersionSymbol v => KnownChainIdSymbol c - => SubmitBatch - -> ClientM RequestKeys + => Pact5.SubmitBatch + -> ClientM Pact5.RequestKeys pactSendApiClient_ = client (pactSendApi @v @c) pactSendApiClient :: ChainwebVersion -> ChainId - -> SubmitBatch - -> ClientM RequestKeys + -> Pact5.SubmitBatch + -> ClientM Pact5.RequestKeys pactSendApiClient (FromSingChainwebVersion (SChainwebVersion :: Sing v)) (FromSingChainId (SChainId :: Sing c)) diff --git a/src/Chainweb/Pact/RestAPI/SPV.hs b/src/Chainweb/Pact/RestAPI/SPV.hs index bee0c09456..93a06625d2 100644 --- a/src/Chainweb/Pact/RestAPI/SPV.hs +++ b/src/Chainweb/Pact/RestAPI/SPV.hs @@ -27,7 +27,7 @@ import GHC.Generics import Numeric.Natural -import Pact.Types.Command +import Pact.Core.Command.Types hiding (ChainId) import Pact.JSON.Legacy.Value -- internal modules @@ -139,4 +139,3 @@ instance FromJSON Spv2Request where <$> o .: "subjectIdentifier" <*> o .:? "minimalProofDepth" .!= Nothing <*> o .: "algorithm" - diff --git a/src/Chainweb/Pact/RestAPI/Server.hs b/src/Chainweb/Pact/RestAPI/Server.hs index 80f7ea94ea..8a6d84f0b5 100644 --- a/src/Chainweb/Pact/RestAPI/Server.hs +++ b/src/Chainweb/Pact/RestAPI/Server.hs @@ -98,13 +98,12 @@ import qualified Chainweb.CutDB as CutDB import Chainweb.Graph import Chainweb.Logger import Chainweb.Mempool.Mempool - (InsertError(..), InsertType(..), MempoolBackend(..), TransactionHash(..), pact5RequestKeyToTransactionHash) + (InsertError(..), InsertType(..), MempoolBackend(..), TransactionHash(..)) import Chainweb.Pact.RestAPI import Chainweb.Pact.RestAPI.EthSpv import Chainweb.Pact.RestAPI.SPV import Chainweb.Pact.Types -import Chainweb.Pact4.SPV qualified as Pact4 -import Pact.Types.ChainMeta qualified as Pact4 +import Chainweb.Pact5.SPV qualified as Pact5 import Chainweb.Payload import Chainweb.Payload.PayloadStore import Chainweb.RestAPI.Orphans () @@ -124,14 +123,12 @@ import Chainweb.WebPactExecutionService import qualified Pact.JSON.Encode as J import qualified Pact.Parse as Pact4 -import qualified Pact.Types.API as Pact4 -import qualified Pact.Types.ChainId as Pact4 import qualified Pact.Types.Command as Pact4 -import qualified Pact.Types.Hash as Pact4 import qualified Pact.Core.Command.Types as Pact5 import qualified Pact.Core.Pretty as Pact5 import qualified Chainweb.Pact5.Transaction as Pact5 +import qualified Pact.Core.Command.Client as Pact5 import qualified Chainweb.Pact5.Types as Pact5 import qualified Chainweb.Pact5.Validations as Pact5 import Data.Coerce @@ -139,12 +136,13 @@ import qualified Pact.Core.Command.Server as Pact5 import qualified Pact.Core.Errors as Pact5 import qualified Pact.Core.Hash as Pact5 import qualified Pact.Core.Gas as Pact5 +import qualified Pact.Core.ChainData as Pact5 -- -------------------------------------------------------------------------- -- data PactServerData logger tbl = PactServerData { _pactServerDataCutDb :: !(CutDB.CutDb tbl) - , _pactServerDataMempool :: !(MempoolBackend Pact4.UnparsedTransaction) + , _pactServerDataMempool :: !(MempoolBackend Pact5.UnparsedTransaction) , _pactServerDataLogger :: !logger , _pactServerDataPact :: !PactExecutionService } @@ -219,10 +217,10 @@ somePactServers v = mconcat . fmap (somePactServer . uncurry (somePactServerData v)) data PactCmdLog - = PactCmdLogSend (NonEmpty (Pact4.Command Text)) + = PactCmdLogSend (NonEmpty (Pact5.Command Text)) | PactCmdLogPoll (NonEmpty Text) | PactCmdLogListen Text - | PactCmdLogLocal (Pact4.Command Text) + | PactCmdLogLocal (Pact5.Command Text) | PactCmdLogSpv Text deriving (Show, Generic, NFData) @@ -252,26 +250,29 @@ instance ToJSON PactCmdLog where -- -------------------------------------------------------------------------- -- -- Send Handler --- TODO: convert to Pact 5 sendHandler :: Logger logger => logger - -> MempoolBackend Pact4.UnparsedTransaction - -> Pact4.SubmitBatch - -> Handler Pact4.RequestKeys -sendHandler logger mempool (Pact4.SubmitBatch cmds) = Handler $ do + -> MempoolBackend Pact5.UnparsedTransaction + -> Pact5.SubmitBatch + -> Handler Pact5.RequestKeys +sendHandler logger mempool (Pact5.SubmitBatch cmds) = Handler $ do liftIO $ logg Info (PactCmdLogSend cmds) - let cmdPayloads :: Either String (NonEmpty (Pact4.Command (ByteString, Pact4.Payload Pact4.PublicMeta Text))) - cmdPayloads = traverse (traverse (\t -> (encodeUtf8 t,) <$> eitherDecodeStrictText t)) cmds + let cmdPayloads :: Either String (NonEmpty (Pact5.Command (ByteString, Pact5.Payload Pact5.PublicMeta Text))) + cmdPayloads = traverse (traverse (\t -> (encodeUtf8 t,) <$> decodePayload t)) cmds case cmdPayloads of - Right (fmap Pact4.mkPayloadWithText -> cmdsWithParsedPayloads) -> do + Right (fmap Pact5.mkPayloadWithText -> cmdsWithParsedPayloads) -> do let cmdsWithParsedPayloadsV = V.fromList $ NEL.toList cmdsWithParsedPayloads -- If any of the txs in the batch fail validation, we reject them all. liftIO (mempoolInsertCheckVerbose mempool cmdsWithParsedPayloadsV) >>= checkResult liftIO (mempoolInsert mempool UncheckedInsert cmdsWithParsedPayloadsV) - return $! Pact4.RequestKeys $ NEL.map Pact4.cmdToRequestKey cmdsWithParsedPayloads + return $! Pact5.RequestKeys $ NEL.map Pact5.cmdToRequestKey cmdsWithParsedPayloads Left err -> failWith $ "reading JSON for transaction failed: " <> T.pack err where + + decodePayload :: Text -> Either String (Pact5.Payload Pact5.PublicMeta Text) + decodePayload t = fmap (Pact5.pMeta %~ Pact5._stableEncoding) $ eitherDecodeStrictText t + failWith :: Text -> ExceptT ServerError IO a failWith err = do liftIO $ logFunctionText logger Info err @@ -279,7 +280,7 @@ sendHandler logger mempool (Pact4.SubmitBatch cmds) = Handler $ do logg = logFunctionJson (setComponent "send-handler" logger) - checkResult :: Vector (T2 TransactionHash (Either InsertError Pact4.UnparsedTransaction)) -> ExceptT ServerError IO () + checkResult :: Vector (T2 TransactionHash (Either InsertError Pact5.UnparsedTransaction)) -> ExceptT ServerError IO () checkResult vec | V.null vec = return () | otherwise = do @@ -296,14 +297,13 @@ sendHandler logger mempool (Pact4.SubmitBatch cmds) = Handler $ do -- -------------------------------------------------------------------------- -- -- Poll Handler --- TODO: convert to Pact 5? pollHandler :: (HasCallStack, CanReadablePayloadCas tbl, Logger logger) => logger -> CutDB.CutDb tbl -> ChainId -> PactExecutionService - -> MempoolBackend Pact4.UnparsedTransaction + -> MempoolBackend Pact5.UnparsedTransaction -> Maybe ConfirmationDepth -> Pact5.PollRequest -> Handler Pact5.PollResponse @@ -325,7 +325,7 @@ listenHandler -> CutDB.CutDb tbl -> ChainId -> PactExecutionService - -> MempoolBackend Pact4.UnparsedTransaction + -> MempoolBackend Pact5.UnparsedTransaction -> Pact5.ListenRequest -> Handler Pact5.ListenResponse listenHandler logger cdb cid pact mem (Pact5.ListenRequest key) = do @@ -382,7 +382,7 @@ localHandler -- ^ No sig verification flag -> Maybe RewindDepth -- ^ Rewind depth - -> Pact4.Command Text + -> Pact5.Command Text -> Handler LocalResult localHandler logger pact preflight sigVerify rewindDepth cmd = do liftIO $ logg Info $ PactCmdLogLocal cmd @@ -411,15 +411,21 @@ localHandler logger pact preflight sigVerify rewindDepth cmd = do -- down in the 'execLocal' code, 'noSigVerify' triggers a nop on -- checking again if 'preflight' is set. -- - let payloadBS = encodeUtf8 (Pact4._cmdPayload cmd) + let payloadBS = encodeUtf8 (Pact5._cmdPayload cmd) - void $ Pact4.verifyHash @'Pact4.Blake2b_256 (Pact4._cmdHash cmd) payloadBS - decoded <- eitherDecodeStrict' payloadBS + void $ Pact5.verifyHash (Pact5._cmdHash cmd) payloadBS + decoded <- decodePayload payloadBS - let cmd' = cmd { Pact4._cmdPayload = (payloadBS, decoded) } - pure $ Pact4.mkPayloadWithText cmd' - | otherwise = Pact4.mkPayloadWithText <$> - traverse (\bs -> (encodeUtf8 bs,) <$> eitherDecodeStrictText bs) cmd + let cmd' = cmd { Pact5._cmdPayload = (payloadBS, decoded) } + pure $ Pact5.mkPayloadWithText cmd' + | otherwise = Pact5.mkPayloadWithText <$> + traverse (\bs -> (encodeUtf8 bs,) <$> decodePayloadText bs) cmd + + decodePayload :: ByteString -> Either String (Pact5.Payload Pact5.PublicMeta Text) + decodePayload bs = fmap (Pact5.pMeta %~ Pact5._stableEncoding) $ eitherDecodeStrict bs + + decodePayloadText :: Text -> Either String (Pact5.Payload Pact5.PublicMeta Text) + decodePayloadText t = fmap (Pact5.pMeta %~ Pact5._stableEncoding) $ eitherDecodeStrictText t -- -------------------------------------------------------------------------- -- -- Cross Chain SPV Handler @@ -441,19 +447,19 @@ spvHandler -- Also contains the request key of of the cross-chain transfer -- tx request. -> Handler TransactionOutputProofB64 -spvHandler l cdb cid (SpvRequest rk (Pact4.ChainId ptid)) = do +spvHandler l cdb cid (SpvRequest rk (Pact5.ChainId ptid)) = do validateRequestKey rk liftIO $! logg (sshow ph) - T2 bhe _bha <- liftIO (try $ _pactLookup pe cid Nothing (pure $ coerce $ Pact4.toUntypedHash ph)) >>= \case + T2 bhe _bha <- liftIO (try $ _pactLookup pe cid Nothing (pure ph)) >>= \case Left (e :: PactException) -> toErr $ "Internal error: transaction hash lookup failed: " <> sshow e - Right v -> case HM.lookup (coerce $ Pact4.toUntypedHash ph) v of + Right v -> case HM.lookup ph v of Nothing -> toErr $ "Transaction hash not found: " <> sshow ph Just t -> return t - idx <- liftIO (Pact4.getTxIdx bdb pdb bhe ph) >>= \case + idx <- liftIO (Pact5.getTxIdx bdb pdb bhe (Pact5.unRequestKey rk)) >>= \case Left e -> toErr $ "Internal error: Index lookup for hash failed: " <> sshow e @@ -472,7 +478,8 @@ spvHandler l cdb cid (SpvRequest rk (Pact4.ChainId ptid)) = do return $! b64 p where pe = _webPactExecutionService $ view CutDB.cutDbPactService cdb - ph = Pact4.fromUntypedHash $ Pact4.unRequestKey rk + ph :: SB.ShortByteString + ph = coerce $ Pact5.unRequestKey rk bdb = fromJuste $ preview (CutDB.cutDbBlockHeaderDb cid) cdb pdb = view CutDB.cutDbPayloadDb cdb b64 = TransactionOutputProofB64 @@ -520,15 +527,15 @@ spv2Handler l cdb cid r = case _spvSubjectIdType sid of :: forall a . MerkleHashAlgorithm a => MerkleHashAlgorithmName a - => (BlockHeaderDb -> PayloadDb tbl -> Natural -> BlockHash -> Pact4.RequestKey -> IO (PayloadProof a)) + => (BlockHeaderDb -> PayloadDb tbl -> Natural -> BlockHash -> Pact5.RequestKey -> IO (PayloadProof a)) -> Handler SomePayloadProof proof f = SomePayloadProof <$> do validateRequestKey rk liftIO $! logg (sshow ph) - T2 bhe bha <- liftIO (try $ _pactLookup pe cid Nothing (pure $ coerce ph)) >>= \case + T2 bhe bha <- liftIO (try $ _pactLookup pe cid Nothing (pure ph)) >>= \case Left (e :: PactException) -> toErr $ "Internal error: transaction hash lookup failed: " <> sshow e - Right v -> case HM.lookup (coerce ph) v of + Right v -> case HM.lookup ph v of Nothing -> toErr $ "Transaction hash not found: " <> sshow ph Just t -> return t @@ -542,7 +549,8 @@ spv2Handler l cdb cid r = case _spvSubjectIdType sid of rk = _spvSubjectIdReqKey sid pe = _webPactExecutionService $ view CutDB.cutDbPactService cdb - ph = Pact4.unRequestKey rk + ph :: SB.ShortByteString + ph = coerce $ Pact5.unRequestKey rk bdb = fromJuste $ preview (CutDB.cutDbBlockHeaderDb cid) cdb pdb = view CutDB.cutDbPayloadDb cdb @@ -610,7 +618,7 @@ internalPoll => logger -> PayloadDb tbl -> BlockHeaderDb - -> MempoolBackend Pact4.UnparsedTransaction + -> MempoolBackend Pact5.UnparsedTransaction -> PactExecutionService -> Maybe ConfirmationDepth -> NonEmpty Pact5.RequestKey @@ -680,7 +688,7 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do checkBadList :: Vector Pact5.RequestKey -> IO (Vector (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)) checkBadList rkeys = do - let !hashes = V.map pact5RequestKeyToTransactionHash rkeys + let !hashes = V.map Pact5.requestKeyToTransactionHash rkeys out <- mempoolCheckBadList mempool hashes let bad = V.map (Pact5.RequestKey . Pact5.Hash . unTransactionHash . fst) $ V.filter snd $ V.zip hashes out @@ -743,12 +751,12 @@ validatePact5Command _v cmdText = case parsedCmd of -- | Validate the length of the request key's underlying hash. -- -validateRequestKey :: Pact4.RequestKey -> Handler () -validateRequestKey (Pact4.RequestKey h'@(Pact4.Hash h)) - | keyLength == blakeHashLength = return () +validateRequestKey :: Pact5.RequestKey -> Handler () +validateRequestKey (Pact5.RequestKey h'@(Pact5.Hash h)) + | keyLength == Pact5.pactHashLength = return () | otherwise = throwError $ setErrText ( "Request Key " - <> Pact4.hashToText h' + <> Pact5.hashToText h' <> " has incorrect hash of length " <> sshow keyLength ) err400 @@ -757,9 +765,4 @@ validateRequestKey (Pact4.RequestKey h'@(Pact4.Hash h)) -- keyLength = SB.length h - -- Blake hash length = 32 - the length of a - -- Blake2b_256 hash - -- - blakeHashLength :: Int - blakeHashLength = Pact4.hashLength Pact4.Blake2b_256 {-# INLINE validateRequestKey #-} diff --git a/src/Chainweb/Pact/Service/BlockValidation.hs b/src/Chainweb/Pact/Service/BlockValidation.hs index 9137e762f1..85f4a1b7d2 100644 --- a/src/Chainweb/Pact/Service/BlockValidation.hs +++ b/src/Chainweb/Pact/Service/BlockValidation.hs @@ -41,16 +41,16 @@ import Chainweb.Miner.Pact import Chainweb.Pact.Service.PactQueue import Chainweb.Pact.Types import Chainweb.Payload -import qualified Chainweb.Pact4.Transaction as Pact4 +import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils import Chainweb.Version import Data.ByteString.Short (ShortByteString) import qualified Pact.Core.Names as Pact5 import qualified Pact.Core.Builtin as Pact5 import qualified Pact.Core.Evaluate as Pact5 -import qualified Pact.Types.ChainMeta as Pact4 +import qualified Pact.Core.ChainData as Pact5 +import qualified Pact.Core.Command.Types as Pact5 import Data.Text (Text) -import qualified Pact.Types.Command as Pact4 newBlock :: Miner -> NewBlockFill -> ParentHeader -> PactQueue -> IO (Historical (ForSomePactVersion BlockInProgress)) newBlock mi fill parent reqQ = do @@ -83,7 +83,7 @@ local :: Maybe LocalPreflightSimulation -> Maybe LocalSignatureVerification -> Maybe RewindDepth - -> Pact4.UnparsedTransaction + -> Pact5.UnparsedTransaction -> PactQueue -> IO LocalResult local preflight sigVerify rd ct reqQ = do @@ -118,7 +118,7 @@ pactReadOnlyReplay l u reqQ = do submitRequestAndWait reqQ msg pactPreInsertCheck - :: Vector (Pact4.Command (Pact4.PayloadWithText Pact4.PublicMeta Text)) + :: Vector (Pact5.Command (Pact5.PayloadWithText Pact5.PublicMeta Text)) -> PactQueue -> IO (Vector (Maybe InsertError)) pactPreInsertCheck txs reqQ = do diff --git a/src/Chainweb/Pact/Service/PactInProcApi.hs b/src/Chainweb/Pact/Service/PactInProcApi.hs index 490b3e5fa9..9f6c7e7f3e 100644 --- a/src/Chainweb/Pact/Service/PactInProcApi.hs +++ b/src/Chainweb/Pact/Service/PactInProcApi.hs @@ -46,7 +46,7 @@ import Chainweb.Pact.Types import qualified Chainweb.Pact.PactService as PS import Chainweb.Pact.Service.PactQueue import Chainweb.Payload.PayloadStore -import qualified Chainweb.Pact4.Transaction as Pact4 +import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils import Chainweb.Version @@ -133,7 +133,7 @@ pactMemPoolGetBlock => MempoolConsensus -> logger -> BlockFill - -> (MempoolPreBlockCheck Pact4.UnparsedTransaction to + -> (MempoolPreBlockCheck Pact5.UnparsedTransaction to -> BlockHeight -> BlockHash -> BlockCreationTime diff --git a/src/Chainweb/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index 8dcb5f3d4f..947207dbb8 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -252,6 +252,8 @@ import Data.List.NonEmpty (NonEmpty) import qualified Pact.Core.Names as Pact5 import GHC.Stack import Streaming +import Pact.Core.StableEncoding +import qualified Pact.Core.Gas as Pact5 import qualified Pact.Core.Command.Types as Pact5 import qualified Pact.Types.Runtime as Pact4 import qualified Pact.JSON.Encode as J @@ -364,7 +366,7 @@ data PactException = BlockValidationFailure !BlockValidationFailureMsg -- TODO: use this CallStack in the Show instance somehow, or the displayException impl. | PactInternalError !CallStack !Text - | PactTransactionExecError !Pact4.PactHash !Text + | PactTransactionExecError !Pact4.PactHash !Text --Only for Pact 4 Fatal errors | CoinbaseFailure !CoinbaseFailure | NoBlockValidatedYet | Pact4TransactionValidationException !(NonEmpty (Pact4.PactHash, Text)) @@ -385,7 +387,7 @@ data PactException | Pact4BuyGasFailure !Pact4GasPurchaseFailure | Pact5BuyGasFailure !Pact5GasPurchaseFailure | MempoolFillFailure !Text - | BlockGasLimitExceeded !Pact4.Gas + | BlockGasLimitExceeded !Pact5.Gas | FullHistoryRequired { _earliestBlockHeight :: !BlockHeight , _genesisHeight :: !BlockHeight @@ -417,7 +419,7 @@ instance J.Encode PactException where build (MempoolFillFailure msg) = tagged "MempoolFillFailure" msg build (Pact5GenesisCommandFailed hash text) = tagged "BlockGasLimitExceeded" (J.Array $ [sshow @_ @Text hash, text]) build (Pact5GenesisCommandsInvalid errs) = tagged "BlockGasLimitExceeded" (J.Array $ sshow @_ @Text <$> errs) - build (BlockGasLimitExceeded gas) = tagged "BlockGasLimitExceeded" gas + build (BlockGasLimitExceeded gas) = tagged "BlockGasLimitExceeded" (StableEncoding $ Pact5.GasLimit gas) build o@(FullHistoryRequired{}) = tagged "FullHistoryRequired" $ J.object [ "_fullHistoryRequiredEarliestBlockHeight" J..= J.Aeson @Int (fromIntegral $ _earliestBlockHeight o) , "_fullHistoryRequiredGenesisHeight" J..= J.Aeson @Int (fromIntegral $ _genesisHeight o) @@ -468,7 +470,7 @@ newtype RewindLimit = RewindLimit { _rewindLimit :: Word64 } data MemPoolAccess = MemPoolAccess { mpaGetBlock :: !(forall to. BlockFill - -> MempoolPreBlockCheck Pact4.UnparsedTransaction to + -> MempoolPreBlockCheck Pact5.UnparsedTransaction to -> BlockHeight -> BlockHash -> BlockCreationTime @@ -503,7 +505,7 @@ data PactServiceEnv logger tbl = PactServiceEnv , _psLogger :: !logger , _psGasLogger :: !(Maybe logger) - , _psBlockGasLimit :: !Pact4.GasLimit + , _psBlockGasLimit :: !Pact5.GasLimit , _psEnableLocalTimeout :: !Bool , _psTxFailuresCounter :: !(Maybe (Counter "txFailures")) @@ -548,7 +550,7 @@ data PactServiceConfig = PactServiceConfig -- ^ blow away pact dbs , _pactUnlimitedInitialRewind :: !Bool -- ^ disable initial rewind limit - , _pactNewBlockGasLimit :: !Pact4.GasLimit + , _pactNewBlockGasLimit :: !Pact5.GasLimit -- ^ the gas limit for new block creation, not for validation , _pactLogGas :: !Bool -- ^ whether to write transaction gas logs at INFO @@ -590,7 +592,7 @@ testPactServiceConfig = PactServiceConfig -- | This default value is only relevant for testing. In a chainweb-node the @GasLimit@ -- is initialized from the @_configBlockGasLimit@ value of @ChainwebConfiguration@. -- -testBlockGasLimit :: Pact4.GasLimit +testBlockGasLimit :: Pact5.GasLimit testBlockGasLimit = 100000 newtype ReorgLimitExceeded = ReorgLimitExceeded Text @@ -1056,7 +1058,7 @@ data ValidateBlockReq = ValidateBlockReq } deriving stock Show data LocalReq = LocalReq - { _localRequest :: !Pact4.UnparsedTransaction + { _localRequest :: !Pact5.UnparsedTransaction , _localPreflight :: !(Maybe LocalPreflightSimulation) , _localSigVerification :: !(Maybe LocalSignatureVerification) , _localRewindDepth :: !(Maybe RewindDepth) @@ -1072,7 +1074,7 @@ instance Show LookupPactTxsReq where "LookupPactTxsReq@" ++ show m data PreInsertCheckReq = PreInsertCheckReq - { _preInsCheckTxs :: !(Vector (Pact4.Command (Pact4.PayloadWithText Pact4.PublicMeta Text))) + { _preInsCheckTxs :: !(Vector (Pact5.Command (Pact5.PayloadWithText Pact5.PublicMeta Text))) } instance Show PreInsertCheckReq where show (PreInsertCheckReq v) = @@ -1109,14 +1111,14 @@ data SyncToBlockReq = SyncToBlockReq instance Show SyncToBlockReq where show SyncToBlockReq{..} = show _syncToBlockHeader data SpvRequest = SpvRequest - { _spvRequestKey :: !Pact4.RequestKey - , _spvTargetChainId :: !Pact4.ChainId + { _spvRequestKey :: !Pact5.RequestKey + , _spvTargetChainId :: !Pact5.ChainId } deriving (Eq, Show, Generic) instance J.Encode SpvRequest where build r = J.object [ "requestKey" J..= _spvRequestKey r - , "targetChainId" J..= _spvTargetChainId r + , "targetChainId" J..= (StableEncoding $ _spvTargetChainId r) ] {-# INLINE build #-} @@ -1124,7 +1126,7 @@ instance J.Encode SpvRequest where instance FromJSON SpvRequest where parseJSON = withObject "SpvRequest" $ \o -> SpvRequest <$> o .: "requestKey" - <*> o .: "targetChainId" + <*> (_stableEncoding <$> o .: "targetChainId") {-# INLINE parseJSON #-} newtype TransactionOutputProofB64 = TransactionOutputProofB64 Text @@ -1156,7 +1158,7 @@ data BlockInProgress pv = BlockInProgress , _blockInProgressParentHeader :: !(Maybe ParentHeader) , _blockInProgressChainwebVersion :: !ChainwebVersion , _blockInProgressChainId :: !ChainId - , _blockInProgressRemainingGasLimit :: !Pact4.GasLimit + , _blockInProgressRemainingGasLimit :: !Pact5.GasLimit , _blockInProgressMiner :: !Miner , _blockInProgressTransactions :: !(Transactions pv (CommandResultFor pv)) , _blockInProgressPactVersion :: !(PactVersionT pv) diff --git a/src/Chainweb/Pact/Utils.hs b/src/Chainweb/Pact/Utils.hs index c42ad1e1e7..fdbeadfaf0 100644 --- a/src/Chainweb/Pact/Utils.hs +++ b/src/Chainweb/Pact/Utils.hs @@ -14,6 +14,8 @@ module Chainweb.Pact.Utils ( -- * combinators aeson , fromPactChainId + , fromPact4ChainId + , fromPact5ChainId , toTxCreationTime -- * k:account helper functions @@ -30,14 +32,13 @@ module Chainweb.Pact.Utils import Data.Aeson import qualified Data.Text as T +import qualified Data.Set as S import Control.Monad.Catch -import Pact.Parse -import qualified Pact.Types.ChainId as P -import qualified Pact.Types.Term as P -import Pact.Types.ChainMeta -import Pact.Types.KeySet (ed25519HexFormat) +import qualified Pact.Types.ChainId as Pact4 +import qualified Pact.Core.Guards as Pact5 +import qualified Pact.Core.ChainData as Pact5 import qualified Pact.JSON.Encode as J @@ -48,8 +49,14 @@ import Chainweb.Miner.Pact import Chainweb.Payload import Chainweb.Time -fromPactChainId :: MonadThrow m => P.ChainId -> m ChainId -fromPactChainId (P.ChainId t) = chainIdFromText t +fromPactChainId :: MonadThrow m => Pact5.ChainId -> m ChainId +fromPactChainId = fromPact5ChainId + +fromPact5ChainId :: MonadThrow m => Pact5.ChainId -> m ChainId +fromPact5ChainId (Pact5.ChainId t) = chainIdFromText t + +fromPact4ChainId :: MonadThrow m => Pact4.ChainId -> m ChainId +fromPact4ChainId (Pact4.ChainId t) = chainIdFromText t -- | This is the recursion principle of an 'Aeson' 'Result' of type 'a'. -- Similar to 'either', 'maybe', or 'bool' combinators @@ -58,9 +65,9 @@ aeson :: (String -> b) -> (a -> b) -> Result a -> b aeson f _ (Error a) = f a aeson _ g (Success a) = g a -toTxCreationTime :: Time Micros -> TxCreationTime +toTxCreationTime :: Time Micros -> Pact5.TxCreationTime toTxCreationTime (Time timespan) = - TxCreationTime $ ParsedInteger $ fromIntegral $ timeSpanToSeconds timespan + Pact5.TxCreationTime $ fromIntegral $ timeSpanToSeconds timespan @@ -68,20 +75,20 @@ validateKAccount :: T.Text -> Bool validateKAccount acctName = case T.take 2 acctName of "k:" -> - let pubKey = P.PublicKeyText $ T.drop 2 acctName - in ed25519HexFormat pubKey + let pubKey = Pact5.PublicKeyText $ T.drop 2 acctName + in Pact5.ed25519HexFormat pubKey _ -> False -extractPubKeyFromKAccount :: T.Text -> Maybe P.PublicKeyText +extractPubKeyFromKAccount :: T.Text -> Maybe Pact5.PublicKeyText extractPubKeyFromKAccount kacct | validateKAccount kacct = - Just $ P.PublicKeyText $ T.drop 2 kacct + Just $ Pact5.PublicKeyText $ T.drop 2 kacct | otherwise = Nothing -generateKAccountFromPubKey :: P.PublicKeyText -> Maybe T.Text +generateKAccountFromPubKey :: Pact5.PublicKeyText -> Maybe T.Text generateKAccountFromPubKey pubKey - | ed25519HexFormat pubKey = - let pubKeyText = P._pubKey pubKey + | Pact5.ed25519HexFormat pubKey = + let pubKeyText = Pact5._pubKey pubKey in Just $ "k:" <> pubKeyText | otherwise = Nothing @@ -89,15 +96,15 @@ generateKAccountFromPubKey pubKey -- Warning: Only use if already certain that PublicKeyText -- is valid. -- Note: We are assuming the k: account is ED25519. -pubKeyToKAccountKeySet :: P.PublicKeyText -> P.KeySet -pubKeyToKAccountKeySet pubKey = P.mkKeySet [pubKey] "keys-all" +pubKeyToKAccountKeySet :: Pact5.PublicKeyText -> Pact5.KeySet +pubKeyToKAccountKeySet pubKey = Pact5.KeySet (S.singleton pubKey) Pact5.KeysAll -generateKeySetFromKAccount :: T.Text -> Maybe P.KeySet +generateKeySetFromKAccount :: T.Text -> Maybe Pact5.KeySet generateKeySetFromKAccount kacct = do pubKey <- extractPubKeyFromKAccount kacct pure $ pubKeyToKAccountKeySet pubKey -validateKAccountKeySet :: T.Text -> P.KeySet -> Bool +validateKAccountKeySet :: T.Text -> Pact5.KeySet -> Bool validateKAccountKeySet kacct actualKeySet = case generateKeySetFromKAccount kacct of Nothing -> False diff --git a/src/Chainweb/Pact4/Templates.hs b/src/Chainweb/Pact4/Templates.hs index a8f62002bb..fbc0c2663f 100644 --- a/src/Chainweb/Pact4/Templates.hs +++ b/src/Chainweb/Pact4/Templates.hs @@ -111,7 +111,7 @@ mkFundTxTerm -> Text -- ^ Address of the sender from the command -> GasSupply -- ^ The gas limit total * price -> (Term Name,ExecMsg ParsedCode) -mkFundTxTerm (MinerId mid) (MinerKeys ks) sender total = (populatedTerm, execMsg) +mkFundTxTerm (MinerId mid) ks sender total = (populatedTerm, execMsg) where (term, senderS, minerS) = fundTxTemplate populatedTerm = set senderS sender $ set minerS mid term execMsg = ExecMsg dummyParsedCode (toLegacyJsonViaEncode buyGasData) @@ -121,6 +121,7 @@ mkFundTxTerm (MinerId mid) (MinerKeys ks) sender total = (populatedTerm, execMsg ] {-# INLINABLE mkFundTxTerm #-} + mkBuyGasTerm :: Text -- ^ Address of the sender from the command -> GasSupply -- ^ The gas limit total * price @@ -140,7 +141,7 @@ mkRedeemGasTerm -> GasSupply -- ^ The gas limit total * price -> GasSupply -- ^ The gas used * price -> (Term Name,ExecMsg ParsedCode) -mkRedeemGasTerm (MinerId mid) (MinerKeys ks) sender total fee = (populatedTerm, execMsg) +mkRedeemGasTerm (MinerId mid) ks sender total fee = (populatedTerm, execMsg) where (term, senderS, minerS) = redeemGasTemplate populatedTerm = set senderS sender $ set minerS mid term execMsg = ExecMsg dummyParsedCode (toLegacyJsonViaEncode redeemGasData) @@ -163,7 +164,7 @@ coinbaseTemplate = {-# NOINLINE coinbaseTemplate #-} mkCoinbaseTerm :: MinerId -> MinerKeys -> ParsedDecimal -> (Term Name,ExecMsg ParsedCode) -mkCoinbaseTerm (MinerId mid) (MinerKeys ks) reward = (populatedTerm, execMsg) +mkCoinbaseTerm (MinerId mid) ks reward = (populatedTerm, execMsg) where (term, minerS) = coinbaseTemplate populatedTerm = set minerS mid term @@ -177,7 +178,7 @@ mkCoinbaseTerm (MinerId mid) (MinerKeys ks) reward = (populatedTerm, execMsg) -- | "Old method" to build a coinbase 'ExecMsg' for back-compat. -- mkCoinbaseCmd :: MinerId -> MinerKeys -> ParsedDecimal -> IO (ExecMsg ParsedCode) -mkCoinbaseCmd (MinerId mid) (MinerKeys ks) reward = +mkCoinbaseCmd (MinerId mid) ks reward = buildExecParsedCode $ mconcat [ "(coin.coinbase" , " \"" <> mid <> "\"" diff --git a/src/Chainweb/Pact4/Transaction.hs b/src/Chainweb/Pact4/Transaction.hs index eb74a6f31b..8f554d87e3 100644 --- a/src/Chainweb/Pact4/Transaction.hs +++ b/src/Chainweb/Pact4/Transaction.hs @@ -31,6 +31,7 @@ module Chainweb.Pact4.Transaction , payloadBytes , payloadObj , parsePact + , requestKeyToTransactionHash ) where import Control.DeepSeq @@ -55,6 +56,7 @@ import qualified Pact.JSON.Encode as J import Pact.JSON.Legacy.Value import Chainweb.Utils +import Chainweb.TransactionHash import Chainweb.Utils.Serialization -- | A product type representing a `Payload PublicMeta ParsedCode` coupled with @@ -188,3 +190,6 @@ cmdTimeToLive = cmdPayload . pMeta . pmTTL cmdCreationTime :: Lens' (Command (Payload PublicMeta c)) TxCreationTime cmdCreationTime = cmdPayload . pMeta . pmCreationTime {-# INLINE cmdCreationTime #-} + +requestKeyToTransactionHash :: RequestKey -> TransactionHash +requestKeyToTransactionHash = TransactionHash . unHash . unRequestKey diff --git a/src/Chainweb/Pact4/TransactionExec.hs b/src/Chainweb/Pact4/TransactionExec.hs index 7d324be85b..c1d3d00b4d 100644 --- a/src/Chainweb/Pact4/TransactionExec.hs +++ b/src/Chainweb/Pact4/TransactionExec.hs @@ -56,7 +56,6 @@ module Chainweb.Pact4.TransactionExec , applyCmd , applyGenesisCmd - , applyLocal , applyExec , applyExec' , applyContinuation @@ -115,6 +114,7 @@ import qualified System.LogLevel as L -- internal Pact modules import Chainweb.Counter +import Chainweb.Pact.Conversion import Pact.Eval (eval, liftTerm) import Pact.Gas (freeGasEnv) import Pact.Interpreter @@ -147,7 +147,6 @@ import Chainweb.BlockHeight import Chainweb.ForkState (pact4ForkNumber) import Chainweb.Logger import qualified Chainweb.ChainId as Chainweb -import Chainweb.Mempool.Mempool (pact4RequestKeyToTransactionHash) import Chainweb.Miner.Pact import Chainweb.Pact4.Templates import Chainweb.Pact.Types @@ -346,7 +345,7 @@ applyCmd v logger gasLogger txFailuresCounter pdbenv miner gasModel txCtx txIdxI | chainweb217Pact' = gasModel | otherwise = _geGasModel freeGasEnv txst = TransactionState mcache0 mempty 0 Nothing stGasModel mempty - quirkGasFee = v ^? versionQuirks . quirkGasFees . ixg cid . ix (ctxCurrentBlockHeight txCtx, txIdxInBlock) + quirkGasFee = toLegacyGas <$> v ^? versionQuirks . quirkGasFees . ixg cid . ix (ctxCurrentBlockHeight txCtx, txIdxInBlock) executionConfigNoHistory = ExecutionConfig $ S.singleton FlagDisableHistoryInTransactionalMode @@ -387,7 +386,7 @@ applyCmd v logger gasLogger txFailuresCounter pdbenv miner gasModel txCtx txIdxI applyBuyGas = catchesPactError logger (onChainErrorPrintingFor txCtx) (buyGas txCtx cmd miner) >>= \case Left e -> view txRequestKey >>= \rk -> - throwM $ Pact4BuyGasFailure $ Pact4GasPurchaseFailure (pact4RequestKeyToTransactionHash rk) e + throwM $ Pact4BuyGasFailure $ Pact4GasPurchaseFailure (requestKeyToTransactionHash rk) e Right _ -> checkTooBigTx initialGas gasLimit applyVerifiers redeemAllGas displayPactError e = do @@ -404,13 +403,14 @@ applyCmd v logger gasLogger txFailuresCounter pdbenv miner gasModel txCtx txIdxI applyVerifiers = do if chainweb223Pact' then do + pact5Verifiers <- mapM fromLegacyVerifier $ fromMaybe [] (cmd ^. cmdPayload . pVerifiers) gasUsed <- use txGasUsed - let initGasRemaining = fromIntegral gasLimit - gasUsed + let initGasRemaining = Gas $ fromIntegral gasLimit - fromIntegral gasUsed verifierResult <- liftIO $ runVerifierPlugins (ctxVersion txCtx, cid, currHeight) - logger allVerifiers initGasRemaining - (fromMaybe [] (cmd ^. cmdPayload . pVerifiers)) + logger allVerifiers (fromLegacyGas initGasRemaining) + pact5Verifiers case verifierResult of Left err -> do let errMsg = "Tx verifier error: " <> _verifierError err @@ -419,7 +419,7 @@ applyCmd v logger gasLogger txFailuresCounter pdbenv miner gasModel txCtx txIdxI errMsg redeemAllGas cmdResult Right verifierGasRemaining -> do - txGasUsed += initGasRemaining - verifierGasRemaining + txGasUsed += initGasRemaining - toLegacyGas verifierGasRemaining applyPayload else applyPayload @@ -571,7 +571,7 @@ applyCoinbase v logger dbEnv reward@(ParsedDecimal d) txCtx when chainweb213Pact' $ enforceKeyFormats (\k -> throwM $ CoinbaseFailure $ Pact4CoinbaseFailure $ "Invalid miner key: " <> sshow k) (validKeyFormats v (ctxChainId txCtx) (ctxCurrentBlockHeight txCtx)) - mk + (toLegacyKeyset mk) let (cterm, cexec) = mkCoinbaseTerm mid mks reward interp = Interpreter $ \_ -> do put initState; fmap pure (eval cterm) @@ -635,80 +635,6 @@ applyCoinbase v logger dbEnv reward@(ParsedDecimal d) txCtx } upgradedModuleCache -applyLocal - :: (Logger logger) - => logger - -- ^ Pact logger - -> Maybe logger - -- ^ Pact gas logger - -> PactDbEnv p - -- ^ Pact db environment - -> GasModel - -- ^ Gas model (pact Service config) - -> TxContext - -- ^ tx metadata and parent header - -> SPVSupport - -- ^ SPV support (validates cont proofs) - -> Transaction - -- ^ command with payload to execute - -> ModuleCache - -> ExecutionConfig - -> IO (CommandResult [TxLogJson]) -applyLocal logger gasLogger dbEnv gasModel txCtx spv cmdIn mc execConfig = - evalTransactionM tenv txst go - where - !cmd = payloadObj <$> cmdIn `using` traverse rseq - !rk = cmdToRequestKey cmd - !nid = networkIdOf cmd - !chash = toUntypedHash $ _cmdHash cmd - !signers = _pSigners $ _cmdPayload cmd - !verifiers = fromMaybe [] $ _pVerifiers $ _cmdPayload cmd - !gasPrice = view cmdGasPrice cmd - !gasLimit = view cmdGasLimit cmd - tenv = TransactionEnv Local dbEnv logger gasLogger (ctxToPublicData txCtx) spv nid gasPrice - rk (fromIntegral gasLimit) execConfig Nothing Nothing - txst = TransactionState mc mempty 0 Nothing gasModel mempty - gas0 = initialGasOf (_cmdPayload cmdIn) - currHeight = ctxCurrentBlockHeight txCtx - cid = V._chainId txCtx - v = _chainwebVersion txCtx - - allVerifiers = verifiersAt v cid pact4ForkNumber currHeight - -- Note [Throw out verifier proofs eagerly] - !verifiersWithNoProof = - (fmap . fmap) (\_ -> ()) verifiers - `using` (traverse . traverse) rseq - - applyVerifiers m = do - let initGasRemaining = fromIntegral gasLimit - gas0 - verifierResult <- - liftIO $ runVerifierPlugins - (v, cid, currHeight) logger allVerifiers initGasRemaining - (fromMaybe [] $ cmd ^. cmdPayload . pVerifiers) - case verifierResult of - Left err -> do - let errMsg = "Tx verifier error: " <> _verifierError err - failTxWith - (PactError TxFailure noInfo [] (pretty errMsg)) - errMsg - Right verifierGasRemaining -> do - let gas1 = (initGasRemaining - verifierGasRemaining) + gas0 - applyPayload gas1 m - - applyPayload gas1 m = do - interp <- gasInterpreter gas1 - cr <- catchesPactError logger PrintsUnexpectedError $! case m of - Exec em -> - applyExec gas1 interp em signers verifiersWithNoProof chash managedNamespacePolicy - Continuation cm -> - applyContinuation gas1 interp cm signers chash managedNamespacePolicy - - case cr of - Left e -> failTxWith e "applyLocal" - Right r -> return $! r { _crMetaData = Just (J.toJsonViaEncode $ ctxToPublicData' txCtx) } - - go = checkTooBigTx gas0 gasLimit (applyVerifiers $ _pPayload $ _cmdPayload cmd) return - readInitModules :: forall logger tbl. (Logger logger) => PactBlockM logger tbl ModuleCache diff --git a/src/Chainweb/Pact4/Validations.hs b/src/Chainweb/Pact4/Validations.hs index d279ec439e..2a15dcb247 100644 --- a/src/Chainweb/Pact4/Validations.hs +++ b/src/Chainweb/Pact4/Validations.hs @@ -17,10 +17,9 @@ -- - The codepath for letting users test their transaction via /local -- module Chainweb.Pact4.Validations -( -- * Local metadata _validation - assertPreflightMetadata - -- * Validation checks -, assertParseChainId +(-- * Validation checks + assertParseChainId +, assertBlockGasLimit , assertChainId , assertGasPrice , assertNetworkId @@ -46,10 +45,8 @@ import Control.Lens import Data.Decimal (decimalPlaces) import Data.Bifunctor (first) -import Data.Maybe (isJust, catMaybes, fromMaybe) +import Data.Maybe (isJust, fromMaybe) import Data.Either (isRight) -import Data.List.NonEmpty (NonEmpty, nonEmpty) -import Data.Text (Text) import qualified Data.Text as Text import qualified Data.ByteString.Short as SBS import Data.Word (Word8) @@ -59,11 +56,10 @@ import Data.Word (Word8) import Chainweb.BlockHeader import Chainweb.BlockCreationTime (BlockCreationTime(..)) import Chainweb.Pact.Types -import Chainweb.Pact.Utils (fromPactChainId) +import Chainweb.Pact.Utils (fromPact4ChainId) import Chainweb.Time (Seconds(..), Time(..), secondsToTimeSpan, scaleTimeSpan, second, add) import Chainweb.Pact4.Transaction import Chainweb.Version -import Chainweb.Version.Guards (isWebAuthnPrefixLegal, validPPKSchemes) import qualified Pact.Types.Gas as P import qualified Pact.Types.Hash as P @@ -72,64 +68,13 @@ import qualified Pact.Types.Command as P import qualified Pact.Types.ChainMeta as P import qualified Pact.Types.KeySet as P import qualified Pact.Parse as P -import Chainweb.Pact4.Types import Chainweb.Utils (ebool_) --- | Check whether a local Api request has valid metadata --- -assertPreflightMetadata - :: P.Command (P.Payload P.PublicMeta c) - -> TxContext - -> Maybe LocalSignatureVerification - -> PactServiceM logger tbl (Either (NonEmpty Text) ()) -assertPreflightMetadata cmd@(P.Command pay sigs hsh) txCtx sigVerify = do - v <- view psVersion - cid <- view chainId - bgl <- view psBlockGasLimit - - let bh = ctxCurrentBlockHeight txCtx - let validSchemes = validPPKSchemes v cid bh - let webAuthnPrefixLegal = isWebAuthnPrefixLegal v cid bh - - let P.PublicMeta pcid _ gl gp _ _ = P._pMeta pay - nid = P._pNetworkId pay - signers = P._pSigners pay - - let errs = catMaybes - [ eUnless "Unparseable transaction chain id" $ assertParseChainId pcid - , eUnless "Chain id mismatch" $ assertChainId cid pcid - -- TODO - , eUnless "Transaction Gas limit exceeds block gas limit" $ assertBlockGasLimit bgl gl - , eUnless "Gas price decimal precision too high" $ assertGasPrice gp - , eUnless "Network id mismatch" $ assertNetworkId v nid - , eUnless "Signature list size too big" $ assertSigSize sigs - , eUnless "Invalid transaction signatures" $ sigValidate validSchemes webAuthnPrefixLegal signers - , eUnless "Tx time outside of valid range" $ assertTxTimeRelativeToParent pct cmd - ] - - pure $ case nonEmpty errs of - Nothing -> Right () - Just vs -> Left vs - where - sigValidate validSchemes webAuthnPrefixLegal signers - | Just NoVerify <- sigVerify = True - | otherwise = isRight $ assertValidateSigs validSchemes webAuthnPrefixLegal hsh signers sigs - - pct = ParentCreationTime - . view blockCreationTime - . _parentHeader - . _tcParentHeader - $ txCtx - - eUnless t assertion - | assertion = Nothing - | otherwise = Just t - -- | Check whether a particular Pact chain id is parseable -- assertParseChainId :: P.ChainId -> Bool -assertParseChainId = isJust . fromPactChainId +assertParseChainId = isJust . fromPact4ChainId -- | Check whether the chain id defined in the metadata of a Pact/Chainweb -- command payload matches a given chain id. diff --git a/src/Chainweb/Pact5/SPV.hs b/src/Chainweb/Pact5/SPV.hs index f921cecfae..8a7d7511db 100644 --- a/src/Chainweb/Pact5/SPV.hs +++ b/src/Chainweb/Pact5/SPV.hs @@ -4,29 +4,36 @@ , OverloadedStrings , ScopedTypeVariables , TypeApplications + , BangPatterns + , FlexibleContexts #-} -module Chainweb.Pact5.SPV (pactSPV) where - -import Chainweb.BlockHeader (BlockHeader, blockHeight) +module Chainweb.Pact5.SPV (pactSPV, getTxIdx) where +import Control.Lens hiding (index) +import Chainweb.BlockHeader (BlockHeader, blockHeight, blockPayloadHash) +import Chainweb.BlockHeight import Chainweb.BlockHeaderDB (BlockHeaderDb) import Chainweb.BlockHeaderDB.HeaderOracle qualified as Oracle -import Chainweb.Payload (TransactionOutput(..)) +import Chainweb.Payload (TransactionOutput(..), Transaction(..), PayloadWithOutputs_(..)) +import Chainweb.Payload.PayloadStore +import Chainweb.TreeDB +import Control.Error import Chainweb.SPV (SpvException(..), TransactionOutputProof(..), outputProofChainId) import Chainweb.SPV.VerifyProof (verifyTransactionOutputProof) -import Chainweb.Utils (decodeB64UrlNoPaddingText) +import Chainweb.Utils (decodeB64UrlNoPaddingText, int, decodeStrictOrThrow') import Chainweb.Version qualified as CW import Chainweb.Version.Guards qualified as CW -import Control.Lens import Control.Monad (when) -import Control.Monad.Catch (catch, throwM) -import Control.Monad.Except (ExceptT, runExceptT, throwError) +import Control.Monad.Catch (catch, throwM, MonadThrow) +import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import Crypto.Hash.Algorithms (SHA512t_256) import Data.Aeson qualified as Aeson import Data.Text (Text) +import Numeric.Natural import Data.Text.Encoding qualified as Text -import Pact.Core.Command.Types (CommandResult(..), PactResult(..)) +import Streaming.Prelude qualified as S +import Pact.Core.Command.Types (CommandResult(..), PactResult(..), Command(..)) import Pact.Core.DefPacts.Types (DefPactExec(..)) import Pact.Core.Hash (Hash(..)) import Pact.Core.PactValue (ObjectData(..), PactValue(..)) @@ -94,7 +101,7 @@ verifySPV bdb bh proofType proof = runExceptT $ do oracle <- liftIO $ Oracle.createSpv bdb bh outputProof <- case pactObjectOutputProof proof of - Left err -> throwError err + Left e -> throwError e Right u -> return u when (view outputProofChainId outputProof /= cid) $ @@ -136,3 +143,51 @@ catchAndDisplaySPVError bh eio = SpvExceptionVerificationFailed m -> throwError ("spv verification failed: " <> m) spvErr -> throwM spvErr else eio + + +-- | Look up pact tx hash at some block height in the +-- payload db, and return the tx index for proof creation. +-- +-- Note: runs in O(n) - this should be revisited if possible +-- +getTxIdx + :: CanReadablePayloadCas tbl + => BlockHeaderDb + -> PayloadDb tbl + -> BlockHeight + -> Hash + -> IO (Either Text Int) +getTxIdx bdb pdb bh th = do + -- get BlockPayloadHash + m <- maxEntry bdb + ph <- seekAncestor bdb m (int bh) >>= \case + Just x -> return $ Right $! view blockPayloadHash x + Nothing -> return $ Left "unable to find payload associated with transaction hash" + + case ph of + (Left !s) -> return $ Left s + (Right !a) -> do + -- get payload + Just payload <- lookupPayloadWithHeight pdb (Just bh) a + + -- Find transaction index + r <- S.each (_payloadWithOutputsTransactions payload) + & S.map fst + & S.mapM toTxHash + & sindex (== th) + + r & note "unable to find transaction at the given block height" + & fmap int + & return + where + toPactTx :: MonadThrow m => Transaction -> m (Command Text) + toPactTx (Transaction b) = decodeStrictOrThrow' b + + toTxHash :: MonadThrow m => Transaction -> m Hash + toTxHash = fmap _cmdHash . toPactTx + + sfind :: Monad m => (a -> Bool) -> S.Stream (S.Of a) m () -> m (Maybe a) + sfind p = S.head_ . S.dropWhile (not . p) + + sindex :: Monad m => (a -> Bool) -> S.Stream (S.Of a) m () -> m (Maybe Natural) + sindex p s = S.zip (S.each [0..]) s & sfind (p . snd) & fmap (fmap fst) \ No newline at end of file diff --git a/src/Chainweb/Pact5/Templates.hs b/src/Chainweb/Pact5/Templates.hs index b2540e418f..9910ccb704 100644 --- a/src/Chainweb/Pact5/Templates.hs +++ b/src/Chainweb/Pact5/Templates.hs @@ -36,9 +36,9 @@ import Pact.Core.Syntax.ParseTree import Pact.Core.PactValue import qualified Data.Map as Map import Chainweb.Utils (decodeOrThrow) -import Pact.Core.StableEncoding (StableEncoding(_stableEncoding)) +import Pact.Core.StableEncoding import Control.Exception.Safe (impureThrow) -import qualified Pact.Types.KeySet as Pact4 +import qualified Pact.Core.Guards as Pact5 import Chainweb.Pact5.Types fundTxTemplate :: Text -> Text -> Expr () @@ -95,9 +95,9 @@ mkFundTxTerm (MinerId mid) (MinerKeys ks) sender total = -- we configure the miner keyset as a Pact4 keyset -- TODO: change this? -convertKeySet :: Pact4.KeySet -> PactValue +convertKeySet :: Pact5.KeySet -> PactValue convertKeySet = - either impureThrow _stableEncoding . decodeOrThrow . J.encode + either impureThrow _stableEncoding . decodeOrThrow . J.encode . StableEncoding {-# INLINABLE mkFundTxTerm #-} mkBuyGasTerm diff --git a/src/Chainweb/Pact5/Transaction.hs b/src/Chainweb/Pact5/Transaction.hs index 4c264b1b6e..74a6410900 100644 --- a/src/Chainweb/Pact5/Transaction.hs +++ b/src/Chainweb/Pact5/Transaction.hs @@ -1,7 +1,10 @@ {-# language DeriveAnyClass #-} +{-# LANGUAGE BangPatterns #-} {-# language DeriveFunctor #-} {-# language DeriveGeneric #-} +{-# language DeriveTraversable #-} {-# language DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# language FlexibleContexts #-} {-# language ImportQualifiedPost #-} {-# language LambdaCase #-} @@ -13,17 +16,33 @@ module Chainweb.Pact5.Transaction ( Transaction , PayloadWithText + , UnparsedTransaction + , HashableTrans(..) + , mkPayloadWithText + , cmdGasLimit + , cmdGasPrice + , cmdTimeToLive + , cmdCreationTime , payloadBytes , payloadObj , payloadCodec , parseCommand + , parseTransaction , parsePact4Command + , rawCommandCodec + , toGasLimit + , fromGasLimit + , requestKeyToTransactionHash ) where +import Data.Hashable + +import Data.Coerce (coerce) import "aeson" Data.Aeson qualified as Aeson import "base" Data.Function import "base" GHC.Generics (Generic) import "bytestring" Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B import "bytestring" Data.ByteString.Short qualified as SB import "deepseq" Control.DeepSeq import "lens" Control.Lens @@ -32,21 +51,27 @@ import "pact-json" Pact.JSON.Encode (Encode(..)) import "pact-tng" Pact.Core.ChainData import "pact-tng" Pact.Core.Command.Types import "pact-tng" Pact.Core.Errors +import "pact-tng" Pact.Core.Gas +import "pact-tng" Pact.Core.Hash import "pact-tng" Pact.Core.Info import "pact-tng" Pact.Core.Pretty qualified as Pact5 import "text" Data.Text (Text) import "text" Data.Text.Encoding (decodeUtf8, encodeUtf8) import Chainweb.Pact4.Transaction qualified as Pact4 import Chainweb.Utils +import Chainweb.TransactionHash +import Chainweb.Utils.Serialization type Transaction = Command (PayloadWithText PublicMeta ParsedCode) +type UnparsedTransaction = Command (PayloadWithText PublicMeta Text) + data PayloadWithText meta code = UnsafePayloadWithText { _payloadBytes :: !SB.ShortByteString , _payloadObj :: !(Payload meta code) } deriving stock (Show, Generic) - deriving stock (Functor) + deriving stock (Functor, Traversable, Foldable) deriving anyclass (NFData) instance Eq (PayloadWithText meta code) where @@ -66,6 +91,35 @@ payloadObj :: Getter (PayloadWithText meta code) (Payload meta code) payloadObj = to _payloadObj {-# inline conlike payloadObj #-} +mkPayloadWithText :: Command (ByteString, Payload meta code) -> Command (PayloadWithText meta code) +mkPayloadWithText = over cmdPayload $ \(bs, p) -> UnsafePayloadWithText + { _payloadBytes = SB.toShort bs + , _payloadObj = p + } + +-- | Hashable newtype of Transaction +newtype HashableTrans a = HashableTrans { unHashable :: Command a } + deriving (Eq, Functor, Ord) + +instance (Eq code, Eq meta) => Hashable (HashableTrans (PayloadWithText meta code)) where + hashWithSalt s (HashableTrans t) = hashWithSalt s hashCode + where + hc = unHash $ _cmdHash t + decHC = runGetEitherS getWord64le + !hashCode = either error id $ decHC (B.take 8 $ SB.fromShort hc) + {-# INLINE hashWithSalt #-} + +rawCommandCodec :: Codec UnparsedTransaction +rawCommandCodec = Codec enc dec + where + enc cmd = J.encodeStrict $ J.text . decodeUtf8 . SB.fromShort . _payloadBytes <$> cmd + dec bs = do + cmd' :: (Command Text) <- Aeson.eitherDecodeStrict' bs + let p = encodeUtf8 $ _cmdPayload cmd' + payloadObject <- over (_Right . pMeta) _stableEncoding $ Aeson.eitherDecodeStrict' p + let payloadWithText = UnsafePayloadWithText { _payloadBytes = SB.toShort p, _payloadObj = payloadObject } + return $ payloadWithText <$ cmd' + -- | A codec for Pact5's (Command PayloadWithText) transactions. -- payloadCodec @@ -87,9 +141,15 @@ parseCommand cmd = do parsedCmd <- over (_Right . cmdPayload . pMeta) _stableEncoding $ unsafeParseCommand cmd' return (parsedCmd & cmdPayload %~ \obj -> UnsafePayloadWithText { _payloadBytes = code, _payloadObj = obj }) +parseTransaction :: UnparsedTransaction -> Either (PactError SpanInfo) Transaction +parseTransaction = traverse (traverse parsePact) + + encodePayload :: PayloadWithText meta code -> ByteString encodePayload = SB.fromShort . _payloadBytes + +-- TODO Remove this when possible ... That's ugly parsePact4Command :: Pact4.UnparsedTransaction -> Either (Either Text (PactError SpanInfo)) Transaction parsePact4Command bs = case Aeson.decodeStrict' (codecEncode Pact4.rawCommandCodec bs) of @@ -108,3 +168,31 @@ parsePact4Command bs = -- over pMeta _stableEncoding payload -- return $! PayloadWithText (SB.toShort bs) p -- Nothing -> Left "decoding Payload failed" + +-- | Access the gas limit/supply of a public chain command payload +cmdGasLimit :: Lens' (Command (Payload PublicMeta c)) GasLimit +cmdGasLimit = cmdPayload . pMeta . pmGasLimit +{-# INLINE cmdGasLimit #-} + +-- | Get the gas price of a public chain command payload +cmdGasPrice :: Lens' (Command (Payload PublicMeta c)) GasPrice +cmdGasPrice = cmdPayload . pMeta . pmGasPrice +{-# INLINE cmdGasPrice #-} + +cmdTimeToLive :: Lens' (Command (Payload PublicMeta c)) TTLSeconds +cmdTimeToLive = cmdPayload . pMeta . pmTTL +{-# INLINE cmdTimeToLive #-} + +cmdCreationTime :: Lens' (Command (Payload PublicMeta c)) TxCreationTime +cmdCreationTime = cmdPayload . pMeta . pmCreationTime +{-# INLINE cmdCreationTime #-} + + +toGasLimit:: Integral a => a -> GasLimit +toGasLimit = GasLimit . Gas . fromIntegral + +fromGasLimit:: Integral a => GasLimit -> a +fromGasLimit = fromIntegral . _gas . coerce + +requestKeyToTransactionHash :: RequestKey -> TransactionHash +requestKeyToTransactionHash = TransactionHash . unHash . unRequestKey \ No newline at end of file diff --git a/src/Chainweb/Pact5/TransactionExec.hs b/src/Chainweb/Pact5/TransactionExec.hs index f88e8b3d7f..68a799cf20 100644 --- a/src/Chainweb/Pact5/TransactionExec.hs +++ b/src/Chainweb/Pact5/TransactionExec.hs @@ -59,7 +59,7 @@ import Control.Parallel.Strategies(using, rseq) import qualified Data.ByteString as B import qualified Data.ByteString.Short as SB -import Data.Coerce (coerce) +--import Data.Coerce (coerce) import Data.Decimal (Decimal, roundTo) import Data.IORef import qualified Data.Map.Strict as Map @@ -70,7 +70,7 @@ import qualified Data.Text.Encoding as T import qualified System.LogLevel as L -- internal Pact modules -import qualified Pact.JSON.Decode as J +--import qualified Pact.JSON.Decode as J import qualified Pact.JSON.Encode as J @@ -94,7 +94,7 @@ import Pact.Core.SPV import Pact.Core.Serialise.LegacyPact () import Pact.Core.Signer import Pact.Core.StableEncoding -import Pact.Core.Verifiers +--import Pact.Core.Verifiers import Pact.Core.Syntax.ParseTree qualified as Lisp import Pact.Core.Gas.Utils qualified as Pact5 @@ -123,18 +123,12 @@ import Chainweb.Version.Utils as V import Pact.Core.Command.Types import Data.ByteString (ByteString) import Pact.Core.Command.RPC -import qualified Pact.Types.Gas as Pact4 import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Vector as Vector import Data.Set (Set) import Data.Void import Control.Monad.Except -import Data.Int -import qualified Pact.Types.Verifier as Pact4 -import qualified Pact.Types.Capability as Pact4 -import qualified Pact.Types.Names as Pact4 -import qualified Pact.Types.Runtime as Pact4 import qualified Pact.Core.Errors as Pact5 -- Note [Throw out verifier proofs eagerly] @@ -191,63 +185,35 @@ runVerifiers txCtx cmd = do let v = _chainwebVersion txCtx let gasLimit = cmd ^. cmdPayload . pMeta . pmGasLimit gasUsed <- liftIO . readIORef . _geGasRef . _txEnvGasEnv =<< ask - let initGasRemaining = MilliGas $ case (gasToMilliGas (gasLimit ^. _GasLimit), gasUsed) of - (MilliGas gasLimitMilliGasWord, MilliGas gasUsedMilliGasWord) -> gasLimitMilliGasWord - gasUsedMilliGasWord + let initGasRemaining = gasToMilliGas $ fromIntegral gasLimit - fromIntegral gasUsed + let allVerifiers = verifiersAt v (_chainId txCtx) (ctxParentForkNumber txCtx) (ctxCurrentBlockHeight txCtx) - let toModuleName m = - Pact4.ModuleName - { Pact4._mnName = _mnName m - , Pact4._mnNamespace = coerce <$> _mnNamespace m - } - let toQualifiedName qn = - Pact4.QualifiedName - { Pact4._qnQual = toModuleName $ _qnModName qn - , Pact4._qnName = _qnName qn - , Pact4._qnInfo = Pact4.Info Nothing - } - -- TODO: correct error handling here? we should probably charge the user - let convertPactValue pv = fromJuste $ J.decodeStrict $ encodeStable pv - let pact4TxVerifiers = - [ Pact4.Verifier - { Pact4._verifierName = case _verifierName pact5Verifier of - VerifierName n -> Pact4.VerifierName n - , Pact4._verifierProof = - -- TODO: correct error handling here? we should probably charge the user - Pact4.ParsedVerifierProof $ fromJuste $ - convertPactValue $ coerce @ParsedVerifierProof @PactValue $ _verifierProof pact5Verifier - , Pact4._verifierCaps = - [ Pact4.SigCapability (toQualifiedName n) (convertPactValue <$> args) - | SigCapability (CapToken n args) <- _verifierCaps pact5Verifier - ] - } - | pact5Verifier <- fromMaybe [] $ cmd ^. cmdPayload . pVerifiers - ] + verifierResult <- liftIO $ runVerifierPlugins (_chainwebVersion txCtx, _chainId txCtx, ctxCurrentBlockHeight txCtx) logger allVerifiers - (Pact4.Gas $ fromIntegral @SatWord @Int64 $ _gas $ milliGasToGas $ initGasRemaining) - pact4TxVerifiers + (milliGasToGas initGasRemaining) + (fromMaybe [] $ cmd ^. cmdPayload . pVerifiers) case verifierResult of Left err -> do throwError (Pact5.PEVerifierError err noInfo) - Right (Pact4.Gas pact4VerifierGasRemaining) -> do + Right afterGasRemaining -> do -- TODO: crash properly on negative? - let verifierGasRemaining = fromIntegral @Int64 @SatWord pact4VerifierGasRemaining -- NB: this is not nice. -- TODO: better gas info here -- Explanation by cases: -- Case 1: - -- gasToMilliGas verifierGasRemaining is less than initGasRemaining, + -- gasToMilliGas afterGasRemaining is less than initGasRemaining, -- in which case the verifier charges gas. -- In that case we can subtract it from initGasRemaining and charge that safely. -- Case 2: - -- gasToMilliGas verifierGasRemaining is greater than or equal to initGasRemaining, + -- gasToMilliGas afterGasRemaining is greater than or equal to initGasRemaining, -- in which case the verifier has not charged gas, or has charged less than -- rounding error. -- In that case we do not charge gas at all. -- - when (gasToMilliGas (Gas verifierGasRemaining) < initGasRemaining) $ - chargeGas noInfo $ GAConstant $ MilliGas $ coerce initGasRemaining - coerce (gasToMilliGas (Gas verifierGasRemaining)) + when (gasToMilliGas afterGasRemaining < initGasRemaining) $ + chargeGas noInfo $ GAConstant $ initGasRemaining - gasToMilliGas afterGasRemaining applyLocal :: (Logger logger) diff --git a/src/Chainweb/Pact5/Validations.hs b/src/Chainweb/Pact5/Validations.hs index bdafd74796..fb960464a5 100644 --- a/src/Chainweb/Pact5/Validations.hs +++ b/src/Chainweb/Pact5/Validations.hs @@ -17,6 +17,7 @@ module Chainweb.Pact5.Validations ( -- * Local metadata _validation assertPreflightMetadata -- * Validation checks +, assertParseChainId , assertChainId , assertGasPrice , assertNetworkId @@ -51,14 +52,13 @@ import Chainweb.BlockCreationTime (BlockCreationTime(..)) import Chainweb.Pact.Types import Chainweb.Time (Seconds(..), Time(..), secondsToTimeSpan, scaleTimeSpan, second, add) import Chainweb.Version +import Chainweb.Pact.Utils (fromPact5ChainId) import qualified Pact.Core.Command.Types as P import qualified Pact.Core.ChainData as P -import qualified Pact.Core.Gas.Types as P import qualified Pact.Core.Hash as P import qualified Chainweb.Pact5.Transaction as P -import qualified Pact.Types.Gas as Pact4 -import qualified Pact.Parse as Pact4 +import qualified Pact.Core.Gas as P import Chainweb.Pact5.Types import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils (ebool_) @@ -74,17 +74,18 @@ assertPreflightMetadata assertPreflightMetadata cmd@(P.Command pay sigs hsh) txCtx sigVerify = do v <- view psVersion cid <- view chainId - Pact4.GasLimit (Pact4.ParsedInteger bgl) <- view psBlockGasLimit + bgl <- view psBlockGasLimit let P.PublicMeta pcid _ gl gp _ _ = P._pMeta pay nid = P._pNetworkId pay signers = P._pSigners pay let errs = catMaybes - [ eUnless "Chain id mismatch" $ assertChainId cid pcid + [ eUnless "Unparseable transaction chain id" $ assertParseChainId pcid + , eUnless "Chain id mismatch" $ assertChainId cid pcid -- TODO: use failing conversion , eUnless "Transaction Gas limit exceeds block gas limit" - $ assertBlockGasLimit (P.GasLimit $ P.Gas (fromIntegral @Integer @P.SatWord bgl)) gl + $ assertBlockGasLimit bgl gl , eUnless "Gas price decimal precision too high" $ assertGasPrice gp , eUnless "Network id mismatch" $ assertNetworkId v nid , eUnless "Signature list size too big" $ assertSigSize sigs @@ -110,6 +111,11 @@ assertPreflightMetadata cmd@(P.Command pay sigs hsh) txCtx sigVerify = do | assertion = Nothing | otherwise = Just t +-- | Check whether a particular Pact chain id is parseable +-- +assertParseChainId :: P.ChainId -> Bool +assertParseChainId = isJust . fromPact5ChainId + -- | Check whether the chain id defined in the metadata of a Pact/Chainweb -- command payload matches a given chain id. -- diff --git a/src/Chainweb/SPV/EventProof.hs b/src/Chainweb/SPV/EventProof.hs index a8320b7d66..9ab69aa8f9 100644 --- a/src/Chainweb/SPV/EventProof.hs +++ b/src/Chainweb/SPV/EventProof.hs @@ -97,7 +97,6 @@ module Chainweb.SPV.EventProof ) where import Chainweb.Crypto.MerkleLog - import Control.DeepSeq import Control.Exception (throw) import Control.Lens (view) @@ -129,6 +128,9 @@ import Pact.Types.PactValue import Pact.Types.Pretty import Pact.Types.Runtime hiding (fromText) +import qualified Pact.Core.Command.Types as Pact5 +import qualified Pact.Core.Hash as Pact5 + -- internal modules import Chainweb.BlockHash @@ -528,14 +530,14 @@ eventsMerkleProof . MonadThrow m => MerkleHashAlgorithm a => PayloadWithOutputs_ h - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> m (MerkleProof a) eventsMerkleProof p reqKey = do events <- getBlockEvents @_ @a p -- the pact events of the tx output with @reqKey@ within the block - i <- case V.findIndex ((== reqKey) . _outputEventsRequestKey) (_blockEventsEvents events) of + i <- case V.findIndex ((== pact4reqKey) . _outputEventsRequestKey) (_blockEventsEvents events) of Nothing -> throwM $ RequestKeyNotFoundException reqKey Just x -> return x @@ -543,11 +545,14 @@ eventsMerkleProof p reqKey = do let (!subj, !pos, !t) = bodyTree events i merkleProof subj pos t + where + pact4reqKey = RequestKey $ Hash $ Pact5.unHash $ Pact5.unRequestKey reqKey + createEventsProof_ :: forall a . MerkleHashAlgorithm a => PayloadWithOutputs - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof a) createEventsProof_ payload reqKey = do @@ -559,14 +564,14 @@ createEventsProof_ payload reqKey = do createEventsProof :: PayloadWithOutputs - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof ChainwebMerkleHashAlgorithm) createEventsProof = createEventsProof_ createEventsProofKeccak256 :: PayloadWithOutputs - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof Keccak_256) createEventsProofKeccak256 = createEventsProof_ @@ -585,7 +590,7 @@ createEventsProofDb_ -- header of the chain has depth 0. -> BlockHash -- ^ the target header of the proof - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof a) createEventsProofDb_ headerDb payloadDb d h reqKey = do @@ -614,7 +619,7 @@ createEventsProofDb -- header of the chain has depth 0. -> BlockHash -- ^ the target header of the proof - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof ChainwebMerkleHashAlgorithm) createEventsProofDb = createEventsProofDb_ @@ -628,7 +633,7 @@ createEventsProofDbKeccak256 -- header of the chain has depth 0. -> BlockHash -- ^ the target header of the proof - -> RequestKey + -> Pact5.RequestKey -- ^ RequestKey of the transaction -> IO (PayloadProof Keccak_256) createEventsProofDbKeccak256 = createEventsProofDb_ diff --git a/src/Chainweb/SPV/OutputProof.hs b/src/Chainweb/SPV/OutputProof.hs index adb6794501..5bd3a7d0ef 100644 --- a/src/Chainweb/SPV/OutputProof.hs +++ b/src/Chainweb/SPV/OutputProof.hs @@ -46,8 +46,8 @@ import GHC.Stack import Numeric.Natural -import Pact.Types.Command -import Pact.Types.Runtime hiding (ChainId) +import Pact.Core.Command.Types +import Pact.Core.Errors -- internal modules @@ -79,7 +79,7 @@ findTxIdx findTxIdx p reqKey = do -- get request keys reqKeys <- forM (_payloadWithOutputsTransactions p) $ \(_, o) -> do - result <- decodeStrictOrThrow @_ @(CommandResult Hash) $ _transactionOutputBytes o + result <- decodeStrictOrThrow @_ @(CommandResult Hash PactOnChainError) $ _transactionOutputBytes o return (_crReqKey result) -- find tx index case V.findIndex (== reqKey) reqKeys of @@ -100,7 +100,7 @@ getRequestKey getRequestKey p txIdx = case _payloadWithOutputsTransactions p V.!? txIdx of Nothing -> throwM $ TxIndexOutOfBoundsException txIdx Just (_, o) -> _crReqKey - <$> decodeStrictOrThrow @_ @(CommandResult Hash) (_transactionOutputBytes o) + <$> decodeStrictOrThrow @_ @(CommandResult Hash PactOnChainError) (_transactionOutputBytes o) -- -------------------------------------------------------------------------- -- -- Transaction Output Proofs By Index diff --git a/src/Chainweb/SPV/PayloadProof.hs b/src/Chainweb/SPV/PayloadProof.hs index 23853a7700..ab3e0c1957 100644 --- a/src/Chainweb/SPV/PayloadProof.hs +++ b/src/Chainweb/SPV/PayloadProof.hs @@ -51,7 +51,7 @@ import qualified Data.Text as T import GHC.Generics -import Pact.Types.Command +import Pact.Core.Command.Types -- internal modules @@ -209,4 +209,3 @@ runPayloadProof p = (_payloadProofRootType p, root,) <$> proofSubject blob where root = MerkleLogHash $ runMerkleProof blob blob = _payloadProofBlob p - diff --git a/src/Chainweb/TransactionHash.hs b/src/Chainweb/TransactionHash.hs new file mode 100644 index 0000000000..36d3f76fa8 --- /dev/null +++ b/src/Chainweb/TransactionHash.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} + +module Chainweb.TransactionHash + (TransactionHash(..) + ) where + +import GHC.Generics + +import Control.DeepSeq (NFData) +import Control.Exception +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Short as SB +import Data.Text (Text) +import qualified Data.Text as T + +import Data.Aeson +import Data.Hashable (Hashable(hashWithSalt)) + +import qualified Pact.JSON.Encode as J + +import Chainweb.Utils +import Chainweb.Utils.Serialization + +------------------------------------------------------------------------------ +-- | Raw/unencoded transaction hashes. +-- +-- TODO: production versions of this kind of DB should salt with a +-- runtime-generated constant to avoid collision attacks; see the \"hashing and +-- security\" section of the hashable docs. +newtype TransactionHash = TransactionHash { unTransactionHash :: SB.ShortByteString } + deriving stock (Read, Eq, Ord, Generic) + deriving anyclass (NFData) + +instance Show TransactionHash where + show = T.unpack . encodeToText + +instance Hashable TransactionHash where + hashWithSalt s (TransactionHash h) = hashWithSalt s (hashCode :: Int) + where + hashCode = either error id $ runGetEitherS (fromIntegral <$> getWord64le) (B.take 8 $ SB.fromShort h) + {-# INLINE hashWithSalt #-} + +instance ToJSON TransactionHash where + toJSON = toJSON . toText + {-# INLINE toJSON #-} + +instance J.Encode TransactionHash where + build = J.text . toText + {-# INLINE build #-} + +instance FromJSON TransactionHash where + parseJSON = withText "TransactionHash" (either (fail . show) return . p) + where + p :: Text -> Either SomeException TransactionHash + !p = (TransactionHash . SB.toShort <$>) . decodeB64UrlNoPaddingText + +instance HasTextRepresentation TransactionHash where + toText (TransactionHash th) = encodeB64UrlNoPaddingText $ SB.fromShort th + fromText = (TransactionHash . SB.toShort <$>) . decodeB64UrlNoPaddingText + {-# INLINE toText #-} + {-# INLINE fromText #-} diff --git a/src/Chainweb/VerifierPlugin.hs b/src/Chainweb/VerifierPlugin.hs index 4399a5e066..7dc51a9438 100644 --- a/src/Chainweb/VerifierPlugin.hs +++ b/src/Chainweb/VerifierPlugin.hs @@ -35,10 +35,11 @@ import Data.Set(Set) import qualified Data.Set as Set import Data.STRef -import Pact.Types.Capability -import Pact.Types.Gas -import Pact.Types.PactValue -import Pact.Types.Verifier +import Pact.Core.Gas +import Pact.Core.Names +import Pact.Core.Signer +import Pact.Core.PactValue +import Pact.Core.Verifiers import Chainweb.Version import Chainweb.BlockHeight diff --git a/src/Chainweb/VerifierPlugin/Allow.hs b/src/Chainweb/VerifierPlugin/Allow.hs index 24676750ca..cc5fca841a 100644 --- a/src/Chainweb/VerifierPlugin/Allow.hs +++ b/src/Chainweb/VerifierPlugin/Allow.hs @@ -10,9 +10,9 @@ import Data.Aeson import qualified Data.Set as Set import qualified Data.Text.Encoding as Text -import Pact.Types.Capability -import Pact.Types.Exp -import Pact.Types.PactValue +import Pact.Core.Literal +import Pact.Core.PactValue +import Pact.Core.Signer import Pact.Core.Errors (VerifierError(..)) import Chainweb.VerifierPlugin diff --git a/src/Chainweb/VerifierPlugin/Hyperlane/Announcement.hs b/src/Chainweb/VerifierPlugin/Hyperlane/Announcement.hs index fa60c09723..fa62d6e0de 100644 --- a/src/Chainweb/VerifierPlugin/Hyperlane/Announcement.hs +++ b/src/Chainweb/VerifierPlugin/Hyperlane/Announcement.hs @@ -23,9 +23,10 @@ import qualified Data.Set as Set import Ethereum.Misc hiding (Word256) -import Pact.Types.Runtime -import Pact.Types.PactValue -import Pact.Types.Capability +import Pact.Core.Capabilities +import Pact.Core.Signer +import Pact.Core.PactValue +import Pact.Core.Literal import Chainweb.VerifierPlugin.Hyperlane.Utils import Chainweb.Utils.Serialization (putRawByteString, runPutS, putWord32be) @@ -38,7 +39,7 @@ plugin :: VerifierPlugin plugin = VerifierPlugin $ \_ proof caps gasRef -> do -- extract capability values (capLocation, capSigner, capMailboxAddress) <- case Set.toList caps of - [cap] -> case _scArgs cap of + [cap] -> case (_ctArgs . _sigCapability) cap of [location, sig, mailbox] -> return (location, sig, mailbox) _ -> throwError $ VerifierError "Incorrect number of capability arguments. Expected: storageLocation, signer." _ -> throwError $ VerifierError "Expected one capability." diff --git a/src/Chainweb/VerifierPlugin/Hyperlane/Message/After225.hs b/src/Chainweb/VerifierPlugin/Hyperlane/Message/After225.hs index 4397c89cf4..a9f4c3fa95 100644 --- a/src/Chainweb/VerifierPlugin/Hyperlane/Message/After225.hs +++ b/src/Chainweb/VerifierPlugin/Hyperlane/Message/After225.hs @@ -34,9 +34,12 @@ import Data.STRef import Ethereum.Misc hiding (Word256) -import Pact.Types.Runtime hiding (ChainId) -import Pact.Types.PactValue -import Pact.Types.Capability +import Pact.Core.Gas +import Pact.Core.Literal +import Pact.Core.PactValue +import Pact.Core.Signer +import Pact.Core.Capabilities +import Pact.Core.Names import Chainweb.Utils.Serialization (putRawByteString, runPutS, runGetS, putWord32be) @@ -71,7 +74,7 @@ runPlugin proof caps gasRef = do -> return i _ -> throwError $ VerifierError $ k <> " is not an integer" - (capMessageId, capMessage, capSigners, capThreshold) <- case _scArgs of + (capMessageId, capMessage, capSigners, capThreshold) <- case _ctArgs _sigCapability of [mid, mb, PList sigs, PLiteral literalThreshold] -> do threshold <- parseInt "Threshold" literalThreshold parsedSigners <- forM sigs $ \case @@ -80,9 +83,9 @@ runPlugin proof caps gasRef = do parsedObject <- case mb of - PObject (ObjectMap m) -> do + PObject m -> do let - parseField k = case (m ^? at (FieldKey k) . _Just . _PLiteral) of + parseField k = case (m ^? at (Field k) . _Just . _PLiteral) of Just l -> PLiteral . LInteger <$> parseInt k l _ -> throwError $ VerifierError $ k <> " is missing" @@ -91,7 +94,7 @@ runPlugin proof caps gasRef = do origin <- parseField "originDomain" destination <- parseField "destinationDomain" - return $ PObject $ ObjectMap $ m + return $ PObject $ m & at "version" .~ Just version & at "nonce" .~ Just nonce & at "originDomain" .~ Just origin @@ -135,7 +138,7 @@ runPlugin proof caps gasRef = do hmRecipientPactValue = PLiteral $ LString $ encodeB64UrlNoPaddingText hmRecipient hmMessageBodyPactValue = PLiteral $ LString $ encodeB64UrlNoPaddingText hmMessageBody - hmMessagePactValue = PObject . ObjectMap . M.fromList $ + hmMessagePactValue = PObject . M.fromList $ [ ("version", hmVersionPactValue) , ("nonce", hmNoncePactValue) , ("originDomain", hmOriginDomainPactValue) diff --git a/src/Chainweb/VerifierPlugin/Hyperlane/Message/Before225.hs b/src/Chainweb/VerifierPlugin/Hyperlane/Message/Before225.hs index 78f858859c..8e292cfc2e 100644 --- a/src/Chainweb/VerifierPlugin/Hyperlane/Message/Before225.hs +++ b/src/Chainweb/VerifierPlugin/Hyperlane/Message/Before225.hs @@ -28,9 +28,11 @@ import Data.STRef import Ethereum.Misc hiding (Word256) -import Pact.Types.Runtime hiding (ChainId) -import Pact.Types.PactValue -import Pact.Types.Capability +import Pact.Core.Gas +import Pact.Core.Literal +import Pact.Core.PactValue +import Pact.Core.Capabilities +import Pact.Core.Signer import Chainweb.Utils.Serialization (putRawByteString, runPutS, runGetS, putWord32be) @@ -54,7 +56,7 @@ runPlugin proof caps gasRef = do [cap] -> return cap _ -> throwError $ VerifierError "Expected one capability." - (capMessageBody, capRecipient, capSigners) <- case _scArgs of + (capMessageBody, capRecipient, capSigners) <- case _ctArgs _sigCapability of [mb, r, sigs] -> return (mb, r, sigs) _ -> throwError $ VerifierError $ "Incorrect number of capability arguments. Expected: messageBody, recipient, signers." diff --git a/src/Chainweb/VerifierPlugin/SignedList.hs b/src/Chainweb/VerifierPlugin/SignedList.hs index 168e8f5d50..4368913d7a 100644 --- a/src/Chainweb/VerifierPlugin/SignedList.hs +++ b/src/Chainweb/VerifierPlugin/SignedList.hs @@ -37,6 +37,7 @@ import qualified Data.Vector as V import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Short as SBS +import qualified Data.Map.Strict as M import Data.ByteArray (convert) import Crypto.Hash (hashWith, SHA3_256(..)) @@ -47,11 +48,11 @@ import Crypto.PubKey.ECC.Types (CurveName(SEC_p256k1), getCurveByName, Point(..) import Crypto.Secp256k1 (ecdsaPublicKeyFromCompressed, ecdsaPublicKeyBytes) import Pact.Core.Errors (VerifierError(..)) -import Pact.Types.PactValue -import Pact.Types.Capability (SigCapability(..)) -import Pact.Types.Exp (Literal(..)) -import Pact.Types.Term (objectMapToListWith,Gas(..)) - +import Pact.Core.Signer +import Pact.Core.Gas +import Pact.Core.Literal +import Pact.Core.PactValue +import Pact.Core.Capabilities import Chainweb.VerifierPlugin (VerifierPlugin(..), chargeGas) import Data.STRef @@ -90,7 +91,7 @@ data HashList parseHashList :: PactValue -> Either T.Text HashList parseHashList (PList vec) = HLList <$> traverse parseHashListNode (V.toList vec) parseHashList (PObject om) = - case objectMapToListWith (,) om of + case M.toList om of [("0x", PLiteral (LString hexStr))] -> Right $ HLHashHex hexStr _ -> Left $ "Malformed binary object at top-level, expected exactly one key '0x'" parseHashList _ = Left $ "Expected a list or binary object at the top-level" @@ -99,7 +100,7 @@ parseHashListNode :: PactValue -> Either T.Text HashListNode parseHashListNode = \case PLiteral (LString t) -> Right $ HLNString t PLiteral (LDecimal d) -> Right $ HLNDecimal d - PObject om -> case objectMapToListWith (,) om of + PObject om -> case M.toList om of [("0x", PLiteral (LString hexStr))] -> Right $ HLNHashHex hexStr -- decoding is in foldHashList _ -> Left $ "Malformed binary object, expected exactly one key '0x'" PList lst -> HLNList <$> traverse parseHashListNode (V.toList lst) @@ -115,7 +116,7 @@ foldHashList -> ExceptT VerifierError (ST s) (BS.ByteString, PactValue) foldHashList gp gasRef = \case -- Top-level precomputed digest provided as hex. - + HLHashHex hexTxt -> do bs <- decodeHex hexTxt pure (bs, PList V.empty) @@ -165,7 +166,7 @@ plugin = VerifierPlugin $ \_ proof caps gasRef -> do -- Extract and validate capability arguments (capArgs :: [PactValue]) <- case Set.toList caps of - [SigCapability{_scArgs = as}] -> pure as + [SigCapability{_sigCapability = ct}] -> pure $ _ctArgs ct _ -> throwError $ VerifierError "Expected exactly one capability" (capMsgParts, capPubKeyTxt) <- case capArgs of diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index 7860efa058..1b0267bf03 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -173,7 +173,6 @@ import Data.Word import GHC.Generics(Generic) import GHC.TypeLits import GHC.Stack -import Pact.Types.Runtime (Gas) import Chainweb.BlockCreationTime import Chainweb.BlockHeight import Chainweb.ChainId @@ -192,7 +191,8 @@ import Chainweb.Utils.Rule import Chainweb.Utils.Serialization import Data.Singletons import P2P.Peer -import Pact.Types.Verifier +import Pact.Core.Names +import Pact.Core.Gas -- | Data type representing changes to block validation, whether in the payload -- or in the header. Always add new forks at the end, not in the middle of the diff --git a/src/Chainweb/Version/Development.hs b/src/Chainweb/Version/Development.hs index 401b50d623..a7023dcc4e 100644 --- a/src/Chainweb/Version/Development.hs +++ b/src/Chainweb/Version/Development.hs @@ -19,7 +19,7 @@ import Chainweb.Utils import Chainweb.Utils.Rule import Chainweb.Version -import Pact.Types.Verifier +import Pact.Core.Names import qualified Chainweb.BlockHeader.Genesis.Development0Payload as DN0 import qualified Chainweb.BlockHeader.Genesis.Development1to19Payload as DNN diff --git a/src/Chainweb/Version/Mainnet.hs b/src/Chainweb/Version/Mainnet.hs index acdcdbc7d6..4adf80f6b0 100644 --- a/src/Chainweb/Version/Mainnet.hs +++ b/src/Chainweb/Version/Mainnet.hs @@ -23,8 +23,8 @@ import Chainweb.Utils.Rule import Chainweb.Version import P2P.BootstrapNodes -import Pact.Types.Runtime (Gas(..)) -import Pact.Types.Verifier +import Pact.Core.Gas +import Pact.Core.Names import qualified Chainweb.BlockHeader.Genesis.Mainnet0Payload as MN0 import qualified Chainweb.BlockHeader.Genesis.Mainnet1Payload as MN1 diff --git a/src/Chainweb/Version/RecapDevelopment.hs b/src/Chainweb/Version/RecapDevelopment.hs index 42e059526d..d31b35ba0a 100644 --- a/src/Chainweb/Version/RecapDevelopment.hs +++ b/src/Chainweb/Version/RecapDevelopment.hs @@ -22,7 +22,7 @@ import Chainweb.Utils import Chainweb.Utils.Rule import Chainweb.Version -import Pact.Types.Verifier +import Pact.Core.Names import qualified Chainweb.BlockHeader.Genesis.RecapDevelopment0Payload as RDN0 import qualified Chainweb.BlockHeader.Genesis.RecapDevelopment1to9Payload as RDNN diff --git a/src/Chainweb/Version/Testnet04.hs b/src/Chainweb/Version/Testnet04.hs index 514b80c57c..8d5939356e 100644 --- a/src/Chainweb/Version/Testnet04.hs +++ b/src/Chainweb/Version/Testnet04.hs @@ -25,8 +25,8 @@ import Chainweb.Utils.Rule import Chainweb.Version import P2P.BootstrapNodes -import Pact.Types.Runtime (Gas(..)) -import Pact.Types.Verifier +import Pact.Core.Gas +import Pact.Core.Names import qualified Chainweb.Pact.Transactions.CoinV3Transactions as CoinV3 import qualified Chainweb.Pact.Transactions.CoinV4Transactions as CoinV4 @@ -140,7 +140,7 @@ testnet04 = ChainwebVersion Chainweb31 -> AllChains ForkNever Chainweb32 -> AllChains ForkNever MigratePlatformShare -> AllChains ForkNever - + , _versionGraphs = (to20ChainsTestnet, twentyChainGraph) `Above` Bottom (minBound, petersenChainGraph) diff --git a/src/Chainweb/Version/Testnet06.hs b/src/Chainweb/Version/Testnet06.hs index c5c42d2b00..15c2ac848c 100644 --- a/src/Chainweb/Version/Testnet06.hs +++ b/src/Chainweb/Version/Testnet06.hs @@ -23,7 +23,7 @@ import Chainweb.Utils.Rule import Chainweb.Version import P2P.BootstrapNodes -import Pact.Types.Verifier +import Pact.Core.Names import qualified Chainweb.Pact.Transactions.OtherTransactions as CoinV2 import qualified Chainweb.Pact.Transactions.CoinV3Transactions as CoinV3 diff --git a/src/Chainweb/Version/Utils.hs b/src/Chainweb/Version/Utils.hs index 797003476d..6856210521 100644 --- a/src/Chainweb/Version/Utils.hs +++ b/src/Chainweb/Version/Utils.hs @@ -91,7 +91,7 @@ import Chainweb.Utils.Rule import Chainweb.Version import Chainweb.Version.Mainnet -import Pact.Types.Verifier +import Pact.Core.Names -- -------------------------------------------------------------------------- -- -- Utils diff --git a/src/Chainweb/WebPactExecutionService.hs b/src/Chainweb/WebPactExecutionService.hs index 0e689c1775..b8489a09e4 100644 --- a/src/Chainweb/WebPactExecutionService.hs +++ b/src/Chainweb/WebPactExecutionService.hs @@ -39,7 +39,7 @@ import Chainweb.Pact.Service.PactQueue import Chainweb.Pact.Types import Chainweb.Pact.Utils import Chainweb.Payload -import qualified Chainweb.Pact4.Transaction as Pact4 +import qualified Chainweb.Pact5.Transaction as Pact5 import Chainweb.Utils import qualified Pact.Core.Persistence as Pact5 @@ -48,8 +48,7 @@ import Data.ByteString.Short (ShortByteString) import qualified Pact.Core.Names as Pact5 import qualified Pact.Core.Builtin as Pact5 import qualified Pact.Core.Evaluate as Pact5 -import qualified Pact.Types.Command as Pact4 -import qualified Pact.Types.ChainMeta as Pact4 +import qualified Pact.Core.Command.Types as Pact5 import Data.Text (Text) import Chainweb.BlockCreationTime (BlockCreationTime) @@ -108,7 +107,7 @@ data PactExecutionService = PactExecutionService Maybe LocalPreflightSimulation -> Maybe LocalSignatureVerification -> Maybe RewindDepth -> - Pact4.UnparsedTransaction -> + Pact5.UnparsedTransaction -> IO LocalResult) -- ^ Directly execute a single transaction in "local" mode (all DB interactions rolled back). -- Corresponds to `local` HTTP endpoint. @@ -129,7 +128,7 @@ data PactExecutionService = PactExecutionService -- ^ Lookup pact hashes as of a block header to detect duplicates , _pactPreInsertCheck :: !( ChainId - -> Vector (Pact4.Command (Pact4.PayloadWithText Pact4.PublicMeta Text)) + -> Vector (Pact5.Command (Pact5.PayloadWithText Pact5.PublicMeta Text)) -> IO (Vector (Maybe InsertError))) -- ^ Run speculative checks to find bad transactions (ie gas buy failures, etc) , _pactBlockTxHistory :: !(