wip: Pact 5 integration

Co-authored-by: Edmund Noble <[email protected]> Co-authored-by: Chessai <[email protected]> Co-authored-by: Jose Cardona <[email protected]>
kadena-io · Sep 20, 2024 · 2a705e1 · 2a705e1
1 parent 23726e1
commit 2a705e1
Show file tree

Hide file tree

Showing 185 changed files with 13,778 additions and 5,775 deletions.
diff --git a/bench/Chainweb/Pact/Backend/Bench.hs b/bench/Chainweb/Pact/Backend/Bench.hs
@@ -53,13 +53,15 @@ import Chainweb.Graph
 import Chainweb.Logger
 import Chainweb.MerkleLogHash
 import Chainweb.Pact.Backend.RelationalCheckpointer
-import Chainweb.Pact.Backend.Types
+
 import Chainweb.Pact.Backend.Utils
 import Chainweb.Pact.Types
 import Chainweb.Test.TestVersions
 import Chainweb.Utils.Bench
 import Chainweb.Utils (sshow)
 import Chainweb.Version
+import qualified Chainweb.Pact4.Backend.ChainwebPactDb as Pact4
+import qualified Pact.Types.Command as Pact
 
 testVer :: ChainwebVersion
 testVer = instantCpmTestVersion petersonChainGraph
@@ -73,10 +75,10 @@ cpRestoreAndSave
   :: (Monoid q)
   => Checkpointer logger
   -> Maybe BlockHeader
-  -> [(BlockHeader, ChainwebPactDbEnv logger -> IO q)]
+  -> [(BlockHeader, PactDbEnv (Pact4.BlockEnv logger) -> IO q)]
   -> IO q
 cpRestoreAndSave cp pc blks = snd <$> _cpRestoreAndSave cp (ParentHeader <$> pc)
-  (traverse Stream.yield [RunnableBlock $ \dbEnv _ -> (,bh) <$> fun (_cpPactDbEnv dbEnv) | (bh, fun) <- blks])
+  (traverse Stream.yield [Pact4RunnableBlock $ \dbEnv _ -> (,bh) <$> fun (Pact4._cpPactDbEnv dbEnv) | (bh, fun) <- blks])
 
 -- | fabricate a `BlockHeader` for a block given its hash and its parent.
 childOf :: Maybe BlockHeader -> BlockHash -> BlockHeader
@@ -442,5 +444,5 @@ cpBenchLookupProcessedTx transactionCount cp = C.env setup' $ \ ~(ut) ->
     pc02 = childOf (Just pc01) hash02
 
     go (NoopNFData _) = do
-        _cpReadFrom (_cpReadCp cp) (Just (ParentHeader pc02)) $ \dbEnv ->
-          _cpLookupProcessedTx dbEnv (V.fromList [Pact.TypedHash "" | _ <- [1..transactionCount]])
+        _cpReadFrom (_cpReadCp cp) (Just (ParentHeader pc02)) Pact4T $ \dbEnv _ ->
+          Pact4._cpLookupProcessedTx dbEnv (V.fromList [Pact.RequestKey (Pact.toUntypedHash $ Pact.TypedHash "") | _ <- [1..transactionCount]])
diff --git a/bench/Chainweb/Pact/Backend/ForkingBench.hs b/bench/Chainweb/Pact/Backend/ForkingBench.hs
@@ -15,6 +15,8 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 
 module Chainweb.Pact.Backend.ForkingBench ( bench ) where
 
@@ -31,6 +33,7 @@ import Data.Aeson hiding (Error)
 import Data.ByteString (ByteString)
 import Data.Char
 import Data.Decimal
+import Data.Either
 import Data.FileEmbed
 import Data.Foldable (toList)
 import Data.IORef
@@ -81,23 +84,22 @@ import Chainweb.BlockHeight (BlockHeight(..))
 import Chainweb.ChainId
 import Chainweb.Graph
 import Chainweb.Logger
-import Chainweb.Mempool.Mempool (BlockFill(..))
+import Chainweb.Mempool.Mempool
 import Chainweb.Miner.Pact
 import Chainweb.Pact.Backend.Compaction qualified as C
-import Chainweb.Pact.Backend.Types
+
 import Chainweb.Pact.Backend.Utils
 import Chainweb.Pact.PactService
 import Chainweb.Pact.Service.BlockValidation
 import Chainweb.Pact.Service.PactQueue
-import Chainweb.Pact.Service.Types
 import Chainweb.Pact.Types
 import Chainweb.Pact.Utils (toTxCreationTime)
 import Chainweb.Payload
 import Chainweb.Payload.PayloadStore
 import Chainweb.Payload.PayloadStore.InMemory
 import Chainweb.Test.TestVersions (slowForkingCpmTestVersion)
 import Chainweb.Time
-import Chainweb.Transaction
+import qualified Chainweb.Pact4.Transaction as Pact4
 import Chainweb.Utils
 import Chainweb.Utils.Bench
 import Chainweb.Version
@@ -242,7 +244,7 @@ createBlock validate parent nonce pact = do
      -- assemble block without nonce and timestamp
 
      bip <- throwIfNoHistory =<< newBlock noMiner NewBlockFill parent pact
-     let payload = blockInProgressToPayloadWithOutputs bip
+     let payload = forAnyPactVersion finalizeBlock bip
 
      let creationTime = add second $ view blockCreationTime $ _parentHeader parent
      let bh = newBlockHeader
@@ -383,15 +385,16 @@ withResources rdb trunkLength logLevel compact p f = C.envWithCleanup create des
 testMemPoolAccess :: IORef Int -> MVar (Map Account (NonEmpty (DynKeyPair, [SigCapability]))) -> IO MemPoolAccess
 testMemPoolAccess txsPerBlock accounts = do
   return $ mempty
-    { mpaGetBlock = \bf validate bh hash header -> do
+    { mpaGetBlock = \bf validate bh hash bct -> do
         if _bfCount bf /= 0 then pure mempty else do
-          testBlock <- getTestBlock accounts (_bct $ view blockCreationTime header) validate bh hash
+          testBlock <- getTestBlock accounts (_bct bct) validate bh hash
           pure testBlock
     }
   where
 
     setTime time pb = pb { _pmCreationTime = toTxCreationTime time }
 
+    getTestBlock :: _ -> _ -> MempoolPreBlockCheck Pact4.UnparsedTransaction to -> _ -> _ -> IO (V.Vector to)
     getTestBlock mVarAccounts txOrigTime validate bHeight hash
         | bHeight == 1 = do
             meta <- setTime txOrigTime <$> makeMeta cid
@@ -402,10 +405,10 @@ testMemPoolAccess txsPerBlock accounts = do
                   modifyMVar' mVarAccounts
                     (const $ M.fromList $ zip as kss)
 
-                  vs <- validate bHeight hash (V.fromList $ toList r)
+                  vs <- validate bHeight hash (V.fromList $ toList $ Pact4.unparseTransaction <$> r)
                   -- TODO: something better should go here
-                  unless (and vs) $ throwM $ userError $ "at blockheight 1: tx validation failed " <> sshow vs
-                  return $! V.fromList $ toList r
+                  unless (all isRight vs) $ throwM $ userError $ "at blockheight 1: tx validation failed " <> sshow r
+                  return $! V.fromList [v | Right v <- toList vs]
 
         | otherwise = do
           withMVar mVarAccounts $ \accs -> do
@@ -419,7 +422,9 @@ testMemPoolAccess txsPerBlock accounts = do
                 case eCmd of
                   Left e -> throwM $ userError e
                   Right tx -> return tx
-            return $! txs
+            vs <- validate bHeight hash (V.fromList $ toList $ Pact4.unparseTransaction <$> txs)
+            unless (all isRight vs) $ throwM $ userError $ "tx validation failed " <> sshow txs
+            return $! V.fromList [v | Right v <- toList vs]
 
     mkTransferCaps :: ReceiverName -> Amount -> (Account, NonEmpty (DynKeyPair, [SigCapability])) -> (Account, NonEmpty (DynKeyPair, [SigCapability]))
     mkTransferCaps (ReceiverName (Account r)) (Amount m) (s@(Account ss),ks) = (s, (caps <$) <$> ks)
@@ -509,10 +514,10 @@ safeCapitalize :: String -> String
 safeCapitalize = maybe [] (uncurry (:) . bimap toUpper (Prelude.map toLower)) . Data.List.uncons
 
 
--- TODO: Use the new `assertCommand` function.
-validateCommand :: Command Text -> Either String ChainwebTransaction
+-- TODO: Use the new `assertPact4Command` function.
+validateCommand :: Command Text -> Either String Pact4.Transaction
 validateCommand cmdText = case verifyCommand cmdBS of
-    ProcSucc cmd -> Right (mkPayloadWithTextOld <$> cmd)
+    ProcSucc cmd -> Right (Pact4.mkPayloadWithTextOld <$> cmd)
     ProcFail err -> Left err
   where
     cmdBS :: Command ByteString

diff --git a/cabal.project b/cabal.project
@@ -52,6 +52,11 @@ package pact
     -- avoid conflict with cryptonite during linking
     flags: +cryptonite-ed25519 -build-tool
 
+package pact-tng
+    ghc-options: -Wwarn
+    -- avoid conflict with cryptonite during linking
+    flags: +cryptonite-ed25519 -build-tool
+
 package rocksdb-haskell-kadena
     ghc-options: -Wwarn -optc-w -optcxx-w
 
@@ -75,8 +80,14 @@ package yet-another-logger
 source-repository-package
     type: git
     location: https://github.com/kadena-io/pact.git
-    tag: f5980d1594122a65872980bf92d7295c32997116
-    --sha256: 1vwv8qrg2fpxalk3mdnj2zwzjynldvdsdmz2jzq5jyrcykfqafy2
+    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: fb544f8c553078f071e3bf2225a94f7dbd28e6dc
+    --sha256: 16k2j2nlc8crwqr5018h8f0mavp99gprc2nq74c4bxq373c59dsa
 
 source-repository-package
     type: git
@@ -103,10 +114,16 @@ source-repository-package
     --sha256: 19pjy06xrx2siggzybcmly0qaq4ds3yzxcsvqwgs4qh9kkzh0kqh
 
 source-repository-package
-  type: git
-  location: https://github.com/kadena-io/kadena-ethereum-bridge.git
-  tag: 3837c4c81f1beaffc1d52375e61576366d49170a
-  --sha256: 1knhscph2g3saz0pjd1d5a32mr281msapccfrillgd2qk4pj7xjc
+    type: git
+    location: https://github.com/kadena-io/kadena-ethereum-bridge.git
+    tag: 8df1cff7f279750490fea8ff580294f3e5a3fcaf
+    --sha256: sha256-HyWTEtw/dKQduXl5avRckS0oNc9Z5yxeUxvX09wDkDY=
+
+source-repository-package
+    type: git
+    location: https://github.com/edmundnoble/hs-hashes.git
+    tag: 9665a5d82c9bf890ded0346f58e6bde9843a9320
+    --sha256: sha256-6zK5nPiGGy7EIDj8l9nBQxcBkZlzUiz3/LYKhGemhdg=
 
 source-repository-package
     type: git
@@ -133,9 +150,27 @@ source-repository-package
 -- Required for non-canonical decode in base64-bytestring (remove after 2.20 fork)
 source-repository-package
     type: git
-    location: https://github.com/emilypi/base64-bytestring-kadena
-    tag: 174af3523616c8fe01449da5ccbb9f16df097ac3
-    --sha256: sha256-kVFIy+Aj3TNJpsM1Cs/5uGmzeWwHKYWjjCQ+L1/XOj8=
+    location: https://github.com/kadena-io/base64-bytestring-kadena
+    tag: 90247042ab3b8662809210af2a78e6dee0f9b4ac
+    --sha256: sha256-xqIGml2asB+FxqVpsvVO59fdOGyJVBhZL6MyULvMGjc=
+
+source-repository-package
+    type: git
+    location: https://github.com/chessai/patience
+    tag: 2f67d546ea6608fc6ebe5f2f6976503cbf340442
+    --sha256: 0x137akvbh4kr3qagksw74xdj2xz5vjnx1fbr41bb54a0lkcb8mm
+
+source-repository-package
+    type: git
+    location: https://github.com/andrewthad/chronos
+    tag: b199bf6df1453af95832c2d2f9f0ef48c3622caa
+    --sha256: 056awkmdmkqdd5g3m8a1ibg2vp02kbppmidkfh4aildb1brq970a
+
+source-repository-package
+    type: git
+    location: https://gitlab.com/edmundnoble/predicate-transformers
+    tag: 67c77e68ade204f56d91ad5952fe432188b40d23
+    --sha256: 0q7nwl56lgic5andc956zv4zipdv5rxjkalm21cxr75r6grkzfmy
 
 -- -------------------------------------------------------------------------- --
 -- Relaxed Bounds
@@ -203,5 +238,4 @@ allow-newer: webauthn:these
 allow-newer: webauthn:time
 allow-newer: webauthn:aeson
 
--- Hashable 1.4.5 changes the hashing of bytestring, which causes some issues.
-constraints: hashable < 1.4.5
+allow-newer: lrucaching:base-compat