From 5b251882081156e971687236e22dcd8fa5ee0330 Mon Sep 17 00:00:00 2001 From: chessai Date: Thu, 22 Aug 2024 16:55:18 -0500 Subject: [PATCH 1/2] update to new pact master Change-Id: I8f19cbcf06f3589c7c01c16075f1f870b4b4def9 --- cabal.project | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index e202aa560..47eecccf1 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,4 @@ packages: chainweb.cabal -packages: ../pact-core/pact-tng.cabal debug-info: True @@ -84,6 +83,12 @@ source-repository-package tag: 532d74dcf36f1b0119412af8ec14bb0f3298fb91 --sha256: sha256-2+eD0hyPmz+VflAlg4BMpc/ExOf3x+C29Q20Wj008/c= +source-repository-package + type: git + location: https://github.com/kadena-io/pact-5.git + tag: c5b62b11a7acf9c32c90a5ae059e2dd99870e26c + --sha256: 1amalvlxixjlgacvigmpj3psaycglgw2004s43q0v5fyks616w7m + source-repository-package type: git location: https://github.com/kadena-io/pact-json.git @@ -118,7 +123,7 @@ source-repository-package type: git location: https://github.com/edmundnoble/hs-hashes.git tag: 9665a5d82c9bf890ded0346f58e6bde9843a9320 - --sha256: 18xdml1fwqzb6lzcc53qy65d3i5y6fjs76q85dh4g17zzcaibl81 + --sha256: sha256-6zK5nPiGGy7EIDj8l9nBQxcBkZlzUiz3/LYKhGemhdg= source-repository-package type: git From 9dadbcf650c1ea69e1b087144b5166b1155e359f Mon Sep 17 00:00:00 2001 From: chessai Date: Thu, 22 Aug 2024 16:55:52 -0500 Subject: [PATCH 2/2] implement conversion from pact4 cmd -> pact5 cmd Change-Id: I53734ee40a6fbd5b6dd46fc60187627e7cf3ce0a --- src/Chainweb/Pact5/Transaction.hs | 193 ++++++++++++++++++++++++++---- 1 file changed, 169 insertions(+), 24 deletions(-) diff --git a/src/Chainweb/Pact5/Transaction.hs b/src/Chainweb/Pact5/Transaction.hs index 7dea69843..41a108aab 100644 --- a/src/Chainweb/Pact5/Transaction.hs +++ b/src/Chainweb/Pact5/Transaction.hs @@ -1,8 +1,13 @@ {-# language DeriveAnyClass #-} +{-# language DeriveFunctor #-} {-# language DeriveGeneric #-} {-# language DerivingStrategies #-} -{-# language ScopedTypeVariables #-} {-# language FlexibleContexts #-} +{-# language ImportQualifiedPost #-} +{-# language LambdaCase #-} +{-# language PackageImports #-} +{-# language ScopedTypeVariables #-} +{-# language TypeApplications #-} module Chainweb.Pact5.Transaction ( Transaction @@ -14,30 +19,54 @@ module Chainweb.Pact5.Transaction , parsePact4Command ) where -import Control.DeepSeq -import Control.Lens - -import qualified Data.Aeson as Aeson -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Short as SB -import Data.Function -import Data.Hashable -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8, encodeUtf8) - -import GHC.Generics (Generic) - -import Pact.Core.Command.Types -import Pact.Core.ChainData -import Pact.Core.Evaluate -import Pact.Core.StableEncoding -import Pact.Core.Syntax.ParseTree -import qualified Pact.JSON.Encode as J - +import "aeson" Data.Aeson qualified as Aeson +import "base" Data.Coerce (coerce) +import "base" Data.Function +import "base" Data.Word (Word64) +import "base" GHC.Generics (Generic) +import "bytestring" Data.ByteString.Char8 (ByteString) +import "bytestring" Data.ByteString.Char8 qualified as B +import "bytestring" Data.ByteString.Short qualified as SB +import "deepseq" Control.DeepSeq +import "hashable" Data.Hashable +import "lens" Control.Lens +import "pact" Pact.Parse qualified as Pact4 +import "pact" Pact.Types.Capability qualified as Pact4 +import "pact" Pact.Types.ChainId qualified as Pact4 +import "pact" Pact.Types.ChainMeta qualified as Pact4 +import "pact" Pact.Types.Command qualified as Pact4 +import "pact" Pact.Types.Crypto qualified as Pact4 +import "pact" Pact.Types.Gas qualified as Pact4 +import "pact" Pact.Types.Hash qualified as Pact4 +import "pact" Pact.Types.PactValue qualified as Pact4 +import "pact" Pact.Types.RPC qualified as Pact4 +import "pact" Pact.Types.SPV qualified as Pact4 +import "pact" Pact.Types.Term.Internal (PactId(..)) +import "pact" Pact.Types.Verifier (VerifierName(..)) +import "pact" Pact.Types.Verifier qualified as Pact4 +import "pact-json" Pact.JSON.Encode qualified as J +import "pact-json" Pact.JSON.Legacy.Value qualified as J +import "pact-tng" Pact.Core.Capabilities +import "pact-tng" Pact.Core.ChainData +import "pact-tng" Pact.Core.Command.Crypto +import "pact-tng" Pact.Core.Command.RPC +import "pact-tng" Pact.Core.Command.Types +import "pact-tng" Pact.Core.Evaluate +import "pact-tng" Pact.Core.Gas.Types +import "pact-tng" Pact.Core.Hash +import "pact-tng" Pact.Core.Names +import "pact-tng" Pact.Core.PactValue +import "pact-tng" Pact.Core.SPV +import "pact-tng" Pact.Core.StableEncoding +import "pact-tng" Pact.Core.Syntax.ParseTree +import "pact-tng" Pact.Core.Verifiers +import "pact-tng" Pact.Core.Verifiers qualified as Pact5 +import "text" Data.Text (Text) +import "text" Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Chainweb.Pact.Conversion +import Chainweb.Pact4.Transaction qualified as Pact4 import Chainweb.Utils import Chainweb.Utils.Serialization -import qualified Chainweb.Pact4.Transaction as Pact4 type Transaction = Command (PayloadWithText PublicMeta ParsedCode) @@ -46,6 +75,7 @@ data PayloadWithText meta code = UnsafePayloadWithText , _payloadObj :: !(Payload meta code) } deriving stock (Show, Generic) + deriving stock (Functor) deriving anyclass (NFData) instance Eq (PayloadWithText meta code) where @@ -81,7 +111,122 @@ encodePayload :: PayloadWithText meta code -> ByteString encodePayload = SB.fromShort . _payloadBytes parsePact4Command :: Pact4.UnparsedTransaction -> Either String Transaction -parsePact4Command tx = undefined +parsePact4Command cmd4 = do + let cmd = fromPact4Command cmd4 + parsedCode <- parsePact (decodeUtf8 $ SB.fromShort $ _payloadBytes $ _cmdPayload cmd) + pure $ fmap (parsedCode <$) cmd + +fromPact4Command :: Pact4.Command (Pact4.PayloadWithText Pact4.PublicMeta Text) -> Command (PayloadWithText PublicMeta Text) +fromPact4Command cmd4 = Command + { _cmdPayload = fromPact4PayloadWithText (Pact4._cmdPayload cmd4) + , _cmdSigs = map fromPact4UserSig (Pact4._cmdSigs cmd4) + , _cmdHash = fromPact4Hash (Pact4._cmdHash cmd4) + } + where + fromPact4PayloadWithText :: Pact4.PayloadWithText Pact4.PublicMeta Text -> PayloadWithText PublicMeta Text + fromPact4PayloadWithText payload4 = UnsafePayloadWithText + { _payloadBytes = Pact4.payloadBytes payload4 + , _payloadObj = fromPact4Payload (Pact4.payloadObj payload4) + } + + fromPact4Payload :: Pact4.Payload Pact4.PublicMeta Text -> Payload PublicMeta Text + fromPact4Payload payload4 = Payload + { _pPayload = fromPact4RPC (Pact4._pPayload payload4) + , _pNonce = Pact4._pNonce payload4 + , _pMeta = fromPact4PublicMeta (Pact4._pMeta payload4) + , _pSigners = map fromPact4Signer (Pact4._pSigners payload4) + , _pVerifiers = map fromPact4Verifier <$> Pact4._pVerifiers payload4 + , _pNetworkId = fromPact4NetworkId <$> Pact4._pNetworkId payload4 + } + + fromPact4RPC :: Pact4.PactRPC c -> PactRPC c + fromPact4RPC = \case + Pact4.Exec execMsg -> Exec $ ExecMsg + { _pmCode = Pact4._pmCode execMsg + , _pmData = legacyJsonToPactValue (Pact4._pmData execMsg) + } + Pact4.Continuation contMsg -> Continuation $ ContMsg + { _cmPactId = coerce Pact4._cmPactId contMsg + , _cmStep = Pact4._cmStep contMsg + , _cmRollback = Pact4._cmRollback contMsg + , _cmData = legacyJsonToPactValue (Pact4._cmData contMsg) + , _cmProof = ContProof . Pact4._contProof <$> Pact4._cmProof contMsg + } + + fromPact4PublicMeta :: Pact4.PublicMeta -> PublicMeta + fromPact4PublicMeta pm4 = PublicMeta + { _pmChainId = coerce (Pact4._pmChainId pm4) + , _pmSender = Pact4._pmSender pm4 + , _pmGasLimit = fromPact4GasLimit (Pact4._pmGasLimit pm4) + , _pmGasPrice = fromPact4GasPrice (Pact4._pmGasPrice pm4) + , _pmTTL = fromPact4TTLSeconds (Pact4._pmTTL pm4) + , _pmCreationTime = fromPact4TxCreationTime (Pact4._pmCreationTime pm4) + } + + fromPact4Signer :: Pact4.Signer -> Signer QualifiedName PactValue + fromPact4Signer signer4 = Signer + { _siScheme = Pact4._siScheme signer4 <&> \case { Pact4.ED25519 -> ED25519; Pact4.WebAuthn -> WebAuthn; } + , _siPubKey = Pact4._siPubKey signer4 + , _siAddress = Pact4._siAddress signer4 + , _siCapList = map fromPact4SigCapability (Pact4._siCapList signer4) + } + + fromPact4SigCapability :: Pact4.SigCapability -> CapToken QualifiedName PactValue + fromPact4SigCapability cap4 = CapToken + { _ctName = fromLegacyQualifiedName (Pact4._scName cap4) + , _ctArgs = fromPact4PactValue <$> Pact4._scArgs cap4 + } + + fromPact4Verifier :: Pact4.Verifier Pact4.ParsedVerifierProof -> Verifier Pact5.ParsedVerifierProof + fromPact4Verifier verifier4 = Verifier + { _verifierName = coerce (Pact4._verifierName verifier4) + , _verifierProof = Pact5.ParsedVerifierProof + $ fromPact4PactValue + $ case Pact4._verifierProof verifier4 of { Pact4.ParsedVerifierProof pv -> pv; } + , _verifierCaps = fromPact4SigCapability <$> Pact4._verifierCaps verifier4 + } + + fromPact4NetworkId :: Pact4.NetworkId -> NetworkId + fromPact4NetworkId = NetworkId . Pact4._networkId + + legacyJsonToPactValue :: J.LegacyValue -> PactValue + legacyJsonToPactValue lv = case decodeStable @PactValue (J.encodeStrict lv) of + Just pv -> pv + Nothing -> error "TODO: don't throw an error here, use Either" + + fromPact4PactValue :: Pact4.PactValue -> PactValue + fromPact4PactValue pv4 = case fromLegacyPactValue pv4 of + Right pv -> pv + Left err -> error $ "TODO: don't throw an error here: " ++ show err + + fromPact4UserSig :: Pact4.UserSig -> UserSig + fromPact4UserSig = \case + Pact4.ED25519Sig txt -> ED25519Sig txt + Pact4.WebAuthnSig webAuthnSig4 -> WebAuthnSig $ WebAuthnSignature + { clientDataJSON = Pact4.clientDataJSON webAuthnSig4 + , authenticatorData = Pact4.authenticatorData webAuthnSig4 + , signature = Pact4.signature webAuthnSig4 + } + + fromPact4Hash :: Pact4.PactHash -> Hash + fromPact4Hash (Pact4.TypedHash sbs) = Hash sbs + + fromPact4ParsedInteger :: Pact4.ParsedInteger -> Word64 + fromPact4ParsedInteger (Pact4.ParsedInteger i) + | i < 0 = error "fromPact4ParsedInteger: negative argument" + | otherwise = fromIntegral i + + fromPact4GasLimit :: Pact4.GasLimit -> GasLimit + fromPact4GasLimit (Pact4.GasLimit pi) = GasLimit (Gas (fromPact4ParsedInteger pi)) + + fromPact4GasPrice :: Pact4.GasPrice -> GasPrice + fromPact4GasPrice (Pact4.GasPrice (Pact4.ParsedDecimal d)) = GasPrice d + + fromPact4TTLSeconds :: Pact4.TTLSeconds -> TTLSeconds + fromPact4TTLSeconds (Pact4.TTLSeconds (Pact4.ParsedInteger i)) = TTLSeconds i + + fromPact4TxCreationTime :: Pact4.TxCreationTime -> TxCreationTime + fromPact4TxCreationTime (Pact4.TxCreationTime (Pact4.ParsedInteger pi)) = TxCreationTime pi -- decodePayload -- :: ByteString