Update to newer Pact 5

This provides us with a more compatible format for errors in
CommandResults, avoiding some breakage to wallets, in particular
Chainweaver.
Change-Id: Id0000000525b3f854ef3d89b28a22593fcc39612

bench/Chainweb/Utils/Bench.hs

@@ -64,14 +64,6 @@ instance NFData (MempoolBackend a) where
 instance NFData PactQueue where
     rnf !_ = ()
 
-instance (NFData info) => NFData (PactErrorCompat info) where
-    rnf = \case
-        PEPact5Error errorCode -> rnf errorCode
-        PELegacyError legacyError -> rnf legacyError
-
-instance (NFData info) => NFData (PactErrorCode info) where
-    rnf (PactErrorCode a b c) = rnf a `seq` rnf b `seq` rnf c
-
 deriving newtype instance NFData ErrorCode
 
 instance NFData (BoundedText k) where

cabal.project

@@ -101,8 +101,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/kadena-io/pact-5.git
-    tag: c1e4b32e23c38602313f2018e57481b230e948d0
-    --sha256: 1n3n3h9lzw6yzbh4hi2ff05k04zi83nzr3jkhv8h8zr870yizwlq
+    tag: 65918ff881f7a2d44a08bf55ac2a1d3bb59319f9
+    --sha256: 1swp7gkjvsg0hiciczdm3c8j4a5s86d69mjl0wkdynckclgim6xm
 
 source-repository-package
     type: git

src/Chainweb/Pact/PactService.hs

@@ -866,7 +866,8 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do
                         earlyReturn $ Pact5LocalResultLegacy Pact5.CommandResult
                             { _crReqKey = pact5RequestKey
                             , _crTxId = Nothing
-                            , _crResult = Pact5.PactResultErr $ Pact5.PELegacyError $ Pact5.toPrettyLegacyError parseError
+                            , _crResult = Pact5.PactResultErr $
+                                Pact5.pactErrorToOnChainError parseError
                             , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit
                             , _crLogs = Nothing
                             , _crContinuation = Nothing
@@ -913,8 +914,13 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do
                                 earlyReturn $ Pact5LocalResultWithWarns Pact5.CommandResult
                                     { _crReqKey = Pact5.RequestKey (Pact5.Hash $ Pact4.unHash $ Pact4.toUntypedHash $ Pact4._cmdHash cwtx)
                                     , _crTxId = Nothing
-                                    , _crResult = Pact5.PactResultErr $ Pact5.PELegacyError $
-                                        Pact5.LegacyPactError Pact5.LegacyGasError "" [] (prettyPact5GasPurchaseFailure err)
+                                    , _crResult = Pact5.PactResultErr $
+                                        Pact5.PactOnChainError
+                                            -- the only legal error type, once chainweaver is really gone, we
+                                            -- can use a real error type
+                                            (Pact5.ErrorType "EvalError")
+                                            (Pact5.mkBoundedText $ prettyPact5GasPurchaseFailure err)
+                                            (Pact5.LocatedErrorInfo Pact5.TopLevelErrorOrigin Pact5.noInfo)
                                     , _crGas = Pact5.Gas $ fromIntegral $ cmd ^. Pact4.cmdPayload . Pact4.pMeta . Pact4.pmGasLimit
                                     , _crLogs = Nothing
                                     , _crContinuation = Nothing
@@ -928,13 +934,13 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do
                         let commandResult' = hashPact5TxLogs $ set Pact5.crMetaData (Just metadata) commandResult
                         -- TODO: once Pact 5 has warnings, include them here.
                         pure $ Pact5LocalResultWithWarns
-                            (Pact5.PELegacyError . Pact5.toPrettyLegacyError <$> commandResult')
+                            (Pact5.pactErrorToOnChainError <$> commandResult')
                             []
                     _ -> lift $ do
                         -- default is legacy mode: use applyLocal, don't buy gas, don't do any
                         -- metadata checks beyond signature and hash checking
                         cr <- Pact5.pactTransaction Nothing $ \dbEnv -> do
-                            fmap convertPact5Error <$> Pact5.applyLocal _psLogger _psGasLogger dbEnv txCtx spvSupport (view Pact5.payloadObj <$> pact5Cmd)
+                            fmap Pact5.pactErrorToOnChainError <$> Pact5.applyLocal _psLogger _psGasLogger dbEnv txCtx spvSupport (view Pact5.payloadObj <$> pact5Cmd)
                         pure $ Pact5LocalResultLegacy (hashPact5TxLogs cr)
 
     let doLocal = Checkpointer.readFromNthParent (fromIntegral rewindDepth)

src/Chainweb/Pact/RestAPI/Server.hs

@@ -132,10 +132,10 @@ 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 Chainweb.Pact5.Types as Pact5
 import qualified Chainweb.Pact5.Validations as Pact5
 import Data.Coerce
 import qualified Pact.Core.Command.Server as Pact5
-import qualified Pact.Core.Evaluate as Pact5
 import qualified Pact.Core.Errors as Pact5
 import qualified Pact.Core.Hash as Pact5
 import qualified Pact.Core.Gas as Pact5
@@ -614,7 +614,7 @@ internalPoll
     -> PactExecutionService
     -> Maybe ConfirmationDepth
     -> NonEmpty Pact5.RequestKey
-    -> IO (HashMap Pact5.RequestKey (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))))
+    -> IO (HashMap Pact5.RequestKey (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError))
 internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do
     let dbg txt = logFunctionText logger Debug txt
     -- get leaf block header for our chain from current best cut
@@ -639,14 +639,14 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do
 
     lookup
         :: (Pact5.RequestKey, T2 BlockHeight BlockHash)
-        -> IO (Either String (Maybe (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))))
+        -> IO (Either String (Maybe (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)))
     lookup (key, T2 _ ha) = (fmap . fmap . fmap) (key,) $ lookupRequestKey key ha
 
     -- TODO: group by block for performance (not very important right now)
     lookupRequestKey
       :: Pact5.RequestKey
       -> BlockHash
-      -> IO (Either String (Maybe (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))))
+      -> IO (Either String (Maybe (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)))
     lookupRequestKey key bHash = runExceptT $ do
         let pactHash = Pact5.unRequestKey key
         let matchingHash = (== pactHash) . Pact5._cmdHash . fst
@@ -678,19 +678,23 @@ internalPoll logger pdb bhdb mempool pactEx confDepth requestKeys0 = do
           (\decodeErr -> "Transaction failed to decode: " <> decodeErr)
         return (tx', out)
 
-    checkBadList :: Vector Pact5.RequestKey -> IO (Vector (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))))
+    checkBadList :: Vector Pact5.RequestKey -> IO (Vector (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError))
     checkBadList rkeys = do
         let !hashes = V.map pact5RequestKeyToTransactionHash rkeys
         out <- mempoolCheckBadList mempool hashes
         let bad = V.map (Pact5.RequestKey . Pact5.Hash . unTransactionHash . fst) $
                   V.filter snd $ V.zip hashes out
         return $! V.map hashIsOnBadList bad
 
-    hashIsOnBadList :: Pact5.RequestKey -> (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))
+    hashIsOnBadList :: Pact5.RequestKey -> (Pact5.RequestKey, Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)
     hashIsOnBadList rk =
         let res = Pact5.PactResultErr err
-            err = Pact5.PELegacyError $
-              Pact5.LegacyPactError Pact5.LegacyTxFailure "" [] "Transaction is badlisted because it previously failed to validate."
+            err = Pact5.PactOnChainError
+              -- the only legal error type, once chainweaver is really gone, we
+              -- can use a real error type
+              (Pact5.ErrorType "EvalError")
+              (Pact5.mkBoundedText "Transaction is badlisted because it previously failed to validate.")
+              (Pact5.LocatedErrorInfo Pact5.TopLevelErrorOrigin Pact5.noInfo)
             !cr = Pact5.CommandResult rk Nothing res (mempty :: Pact5.Gas) Nothing Nothing Nothing []
         in (rk, cr)
 

src/Chainweb/Pact/Types.hs

@@ -860,11 +860,11 @@ _Pact4LocalResultLegacy = prism' Pact4LocalResultLegacy $ \case
   _ -> Nothing
 
 pattern Pact5LocalResultLegacy
-  :: Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))
+  :: Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError
   -> LocalResult
 pattern Pact5LocalResultLegacy cr <- ConvertLocalResultLegacy cr where
   Pact5LocalResultLegacy cr = ConvertLocalResultLegacy cr
-_Pact5LocalResultLegacy :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)))
+_Pact5LocalResultLegacy :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError)
 _Pact5LocalResultLegacy = prism' Pact5LocalResultLegacy $ \case
   Pact5LocalResultLegacy cr -> Just cr
   _ -> Nothing
@@ -885,12 +885,12 @@ _Pact4LocalResultWithWarns = prism' (uncurry Pact4LocalResultWithWarns) $ \case
   _ -> Nothing
 
 pattern Pact5LocalResultWithWarns
-  :: Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info))
+  :: Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError
   -> [Text]
   -> LocalResult
 pattern Pact5LocalResultWithWarns cr warns <- ConvertLocalResultWithWarns cr warns where
   Pact5LocalResultWithWarns cr warns = ConvertLocalResultWithWarns cr warns
-_Pact5LocalResultWithWarns :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)), [Text])
+_Pact5LocalResultWithWarns :: Prism' LocalResult (Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError, [Text])
 _Pact5LocalResultWithWarns = prism' (uncurry Pact5LocalResultWithWarns) $ \case
   Pact5LocalResultWithWarns cr warns -> Just (cr, warns)
   _ -> Nothing
@@ -1244,12 +1244,11 @@ pact5CommandToBytes tx = Transaction
 -- be stored on-chain.
 pact5CommandResultToBytes :: Pact5.CommandResult Pact5.Hash (Pact5.PactError Pact5.Info) -> ByteString
 pact5CommandResultToBytes cr =
-    J.encodeStrict (fmap convertPact5Error cr)
+    J.encodeStrict (fmap Pact5.pactErrorToOnChainError cr)
 
-convertPact5Error :: Pact5.PactError Pact5.Info -> Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.Info)
+convertPact5Error :: Pact5.PactError Pact5.Info -> Pact5.PactOnChainError
 convertPact5Error err =
-  Pact5.PEPact5Error $
-      Pact5.pactErrorToLocatedErrorCode err
+  Pact5.pactErrorToOnChainError err
 
 hashPact5TxLogs :: Pact5.CommandResult [Pact5.TxLog ByteString] err -> Pact5.CommandResult Pact5.Hash err
 hashPact5TxLogs cr = cr & over (Pact5.crLogs . _Just)

test/lib/Chainweb/Test/Utils.hs

@@ -253,7 +253,6 @@ import Data.Semigroup
 import qualified Pact.Core.Command.Types as Pact5
 import qualified Data.Aeson as Aeson
 import qualified Pact.Core.Errors as Pact5
-import qualified Pact.Core.Info as Pact5
 import qualified Pact.Types.Command as Pact4
 import qualified Pact.Core.Hash as Pact5
 import qualified Pact.Types.Hash as Pact4
@@ -1186,7 +1185,7 @@ independentSequentialTestGroup tn tts =
 unsafeHeadOf :: HasCallStack => Getting (Endo a) s a -> s -> a
 unsafeHeadOf l s = s ^?! l
 
-type TestPact5CommandResult = Pact5.CommandResult Pact5.Hash (Pact5.PactErrorCompat (Pact5.LocatedErrorInfo Pact5.LineInfo))
+type TestPact5CommandResult = Pact5.CommandResult Pact5.Hash Pact5.PactOnChainError
 
 toPact4RequestKey :: Pact5.RequestKey -> Pact4.RequestKey
 toPact4RequestKey = \case

test/unit/Chainweb/Test/Pact5/HyperlanePluginTests.hs

@@ -140,8 +140,8 @@ hyperlaneValidatorAnnouncementTest baseRdb step = runResourceT $ do
         poll fx v chain0 [cmdToRequestKey useBadSignature]
             >>= P.list
                 [ P.match _Just ? P.checkAll
-                    [ P.fun _crResult ? P.match (_PactResultErr  . _PEPact5Error) ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                    [ P.fun _crResult ? P.match _PactResultErr ? P.checkAll
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Failed to recover the address from the signature"
                         ]
                     , P.fun _crGas ? P.equals (Gas 100000)
@@ -191,8 +191,8 @@ hyperlaneValidatorAnnouncementTest baseRdb step = runResourceT $ do
         poll fx v chain0 [cmdToRequestKey useWrongSigner]
             >>= P.list
                 [ P.match _Just ? P.checkAll
-                    [ P.fun _crResult ? P.match (_PactResultErr  . _PEPact5Error) ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                    [ P.fun _crResult ? P.match _PactResultErr ? P.checkAll
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Incorrect signer. Expected: PLiteral (LString {_lString = \"0x6c414e7a15088023e28af44ad0e1d593671e4b15\"}) but got PLiteral (LString {_lString = \"0x5c414e7a15088023e28af44ad0e1d593671e4b15\"})"
                         ]
                     , P.fun _crGas ? P.equals (Gas 100000)
@@ -357,9 +357,8 @@ checkVerifierNotInTx fx pluginName = do
         [ P.match _Just
             ? P.fun _crResult
             ? P.match _PactResultErr
-            ? P.match _PEPact5Error
             ? P.checkAll
-                [ P.fun _peCode ? P.equals (ErrorCode 1133596488237056)
+                [ P.fun _peType ? P.equals (ErrorType "TxFailure")
                 , P.fun _peMsg ? P.fun _boundedText ? P.equals
                     ("Verifier " <> pluginName <> " failed with the message: not in transaction")
                 ]
@@ -451,9 +450,9 @@ hyperlaneVerifyThresholdZeroError baseRdb step = runResourceT $ do
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Threshold should be greater than 0"
                         ]
                 , P.fun _crGas ? P.equals (Gas 20000)
@@ -476,9 +475,9 @@ hyperlaneVerifyWrongSignersFailure baseRdb step = runResourceT $ do
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Verification failed"
                         ]
                 , P.fun _crGas ? P.equals (Gas 20000)
@@ -503,9 +502,9 @@ hyperlaneVerifyNotEnoughRecoveredSignaturesFailure baseRdb step = runResourceT $
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "The number of signatures can't be less than threshold"
                         ]
                 , P.fun _crGas ? P.equals (Gas 20000)
@@ -533,9 +532,9 @@ hyperlaneVerifyNotEnoughCapabilitySignaturesFailure baseRdb step = runResourceT
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Verification failed"
                         ]
                 , P.fun _crGas ? P.equals (Gas 40000)
@@ -562,9 +561,9 @@ hyperlaneVerifyMerkleIncorrectProofFailure baseRdb step = runResourceT $ do
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Verification failed"
                         ]
                 , P.fun _crGas ? P.equals (Gas 20000)
@@ -594,9 +593,9 @@ hyperlaneVerifyFailureNotEnoughSignaturesToPassThreshold baseRdb step = runResou
             [ P.match _Just
             ? P.checkAll
                 [ P.fun _crResult
-                    ? P.match (_PactResultErr . _PEPact5Error)
+                    ? P.match _PactResultErr
                     ? P.checkAll
-                        [ P.fun _peCode ? P.equals (ErrorCode 1407374883553280)
+                        [ P.fun _peType ? P.equals (ErrorType "EvalError")
                         , P.fun _peMsg ? P.equals "Verification failed"
                         ]
                 , P.fun _crGas ? P.equals (Gas 40000)