Fix conflicts in cabal.project

kadena-io · Dec 18, 2024 · 7d593ee · 7d593ee
2 parents 58f2b87 + 9e19bd6
commit 7d593ee
Show file tree

Hide file tree

Showing 10 changed files with 265 additions and 277 deletions.
diff --git a/cabal.project b/cabal.project
@@ -95,8 +95,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/kadena-io/pact-5.git
-    tag: 4738d8e101069ee8add62a6fb7ada2f4079af89a
-    --sha256: 1sll6rb8w4i18gi0xzbk8c0yp26mv4knrq0cjl8rnn7c0dnmyf4l
+    tag: 52f41d6b48584e8fcbfae745a6e3abe640500885
+    --sha256: 06karzsrih0hjkdipc8s171v4vgk09j5w6fa7zm3rv6qjw6j6jar
 
 source-repository-package
     type: git
@@ -150,30 +150,6 @@ source-repository-package
     tag: 90247042ab3b8662809210af2a78e6dee0f9b4ac
     --sha256: 0dqsrjxm0cm35xcihm49dhwdvmz79vsv4sd5qs2izc4sbnd0d8n6
 
-source-repository-package
-    type: git
-    location: https://gitlab.com/edmundnoble/predicate-transformers
-    tag: 67c77e68ade204f56d91ad5952fe432188b40d23
-    --sha256: 0q7nwl56lgic5andc956zv4zipdv5rxjkalm21cxr75r6grkzfmy
-
-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
 

diff --git a/cabal.project.freeze b/cabal.project.freeze
@@ -308,9 +308,10 @@ constraints: any.Cabal ==3.10.2.0,
              any.pem ==0.2.4,
              any.poly ==0.5.1.0,
              poly +sparse,
-             any.predicate-transformers ==0.15.0.0,
              any.pretty ==1.1.3.6,
              any.pretty-show ==1.10,
+             any.pretty-simple ==4.1.3.0,
+             pretty-simple -buildexample +buildexe,
              any.prettyprinter ==1.7.1,
              prettyprinter -buildreadme +text,
              any.prettyprinter-ansi-terminal ==1.1.3,
@@ -320,11 +321,13 @@ constraints: any.Cabal ==3.10.2.0,
              any.primitive-unlifted ==2.1.0.0,
              any.process ==1.6.18.0,
              any.profunctors ==5.6.2,
+             any.property-matchers ==0.2.0.0,
              any.psqueues ==0.2.8.0,
              any.pvar ==1.0.0.0,
              any.quickcheck-instances ==0.3.32,
              any.ralist ==0.4.0.0,
              any.random ==1.2.1.3,
+             any.recover-rtti ==0.5.0,
              any.recv ==0.1.0,
              any.reducers ==3.12.5,
              any.reflection ==2.1.9,

diff --git a/chainweb.cabal b/chainweb.cabal
@@ -748,13 +748,12 @@ test-suite chainweb-tests
         , pact-tng:pact-request-api
         , pact-tng:test-utils
         , patience >= 0.3
-        , predicate-transformers == 0.15.0.0
+        , property-matchers ^>= 0.2
         , pretty-show
         , quickcheck-instances >= 0.3
         , random >= 1.2
         , resource-pool >= 0.4
         , resourcet >= 1.3
-        , retry >= 0.7
         , rosetta >= 1.0
         , safe-exceptions >= 0.1
         , scheduler >= 1.4

diff --git a/src/Chainweb/Pact5/TransactionExec.hs b/src/Chainweb/Pact5/TransactionExec.hs
@@ -597,8 +597,7 @@ runPayload execMode execFlags db spv specialCaps namespacePolicy gasModel txCtx
           (fmap . fmap) (\_ -> ()) verifiers
           `using` (traverse . traverse) rseq
 
-  res <-
-    (either throwError return =<<) $ liftIO $
+  (either throwError return =<<) $ liftIO $
     case payload ^. pPayload of
       Exec ExecMsg {..} ->
         evalExec (RawCode (_pcCode _pmCode)) execMode
@@ -633,10 +632,6 @@ runPayload execMode execFlags db spv specialCaps namespacePolicy gasModel txCtx
               , _cRollback = _cmRollback
               , _cProof = _cmProof
               }
-
-  chargeGas noInfo (GAConstant (gasToMilliGas $ _erGas res))
-  return res
-
   where
     payload = cmd ^. cmdPayload
     verifiers = payload ^. pVerifiers . _Just

diff --git a/test/unit/Chainweb/Test/Pact5/CutFixture.hs b/test/unit/Chainweb/Test/Pact5/CutFixture.hs
@@ -30,6 +30,7 @@ module Chainweb.Test.Pact5.CutFixture
     , fixtureMempools
     , fixturePactQueues
     , advanceAllChains
+    , advanceAllChains_
     , withTestCutDb
     )
     where
@@ -146,6 +147,13 @@ advanceAllChains v Fixture{..} = do
 
     return (finalCut, onChains perChainCommandResults)
 
+advanceAllChains_
+    :: HasCallStack
+    => ChainwebVersion
+    -> Fixture
+    -> IO ()
+advanceAllChains_ v f = void $ advanceAllChains v f
+
 withTestCutDb :: (Logger logger)
     => logger
     -> ChainwebVersion

diff --git a/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs b/test/unit/Chainweb/Test/Pact5/PactServiceTest.hs
@@ -79,7 +79,8 @@ import Pact.Core.Hash qualified as Pact5
 import Pact.Core.Names
 import Pact.Core.PactValue
 import Pact.Types.Gas qualified as Pact4
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Test.Tasty
 import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)
 import Text.Printf (printf)
@@ -134,8 +135,8 @@ tests baseRdb = testGroup "Pact5 PactServiceTest"
     , testCase "failed txs should go into blocks" (failedTxsShouldGoIntoBlocks baseRdb)
     ]
 
-successfulTx :: Predicatory p => Pred p (CommandResult log err)
-successfulTx = pt _crResult ? match _PactResultOk something
+successfulTx :: P.Prop (CommandResult log err)
+successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 simpleEndToEnd :: RocksDb -> IO ()
 simpleEndToEnd baseRdb = runResourceT $ do
@@ -148,8 +149,8 @@ simpleEndToEnd baseRdb = runResourceT $ do
 
         -- we only care that they succeed; specifics regarding their outputs are in TransactionExecTest
         results &
-            predful ? onChain cid ?
-                predful ? Vector.replicate 2 successfulTx
+            P.propful ? onChain cid ?
+                P.propful ? Vector.replicate 2 successfulTx
 
 newBlockEmpty :: RocksDb -> IO ()
 newBlockEmpty baseRdb = runResourceT $ do
@@ -171,8 +172,8 @@ newBlockEmpty baseRdb = runResourceT $ do
             return $ finalizeBlock nonEmptyBip
 
         results &
-            predful ? onChain cid ?
-                predful ? Vector.replicate 1 successfulTx
+            P.propful ? onChain cid ?
+                P.propful ? Vector.replicate 1 successfulTx
 
 continueBlockSpec :: RocksDb -> IO ()
 continueBlockSpec baseRdb = runResourceT $ do
@@ -194,8 +195,8 @@ continueBlockSpec baseRdb = runResourceT $ do
             return $ finalizeBlock bipAllAtOnce
         -- assert that 3 successful txs are in the block
         allAtOnceResults &
-            predful ? onChain cid ?
-            predful ? Vector.replicate 3 successfulTx
+            P.propful ? onChain cid ?
+            P.propful ? Vector.replicate 3 successfulTx
 
         -- reset back to the empty block for the next phase
         -- next, produce the same block by repeatedly extending a block
@@ -231,7 +232,7 @@ continueBlockSpec baseRdb = runResourceT $ do
             return $ finalizeBlock bipFinal
 
         -- assert that the continued results are equal to doing it all at once
-        continuedResults & equals allAtOnceResults
+        continuedResults & P.equals allAtOnceResults
 
 -- * test that the NewBlock timeout works properly and doesn't leave any extra state from a timed-out transaction
 newBlockTimeoutSpec :: RocksDb -> IO ()
@@ -276,10 +277,10 @@ newBlockTimeoutSpec baseRdb = runResourceT $ do
                 newBlock noMiner NewBlockFill (ParentHeader ph) pactQueue
             -- Mempool orders by GasPrice. 'buildCwCmd' sets the gas price to the transfer amount.
             -- We hope for 'timeoutTx' to fail, meaning that only 'txTransfer2' is in the block.
-            bip & pt _blockInProgressTransactions ? pt _transactionPairs
-                ? predful ? Vector.fromList
-                    [ pair
-                        (pt _cmdHash ? equals (_cmdHash tx2))
+            bip & P.fun _blockInProgressTransactions ? P.fun _transactionPairs
+                ? P.propful ? Vector.fromList
+                    [ P.pair
+                        (P.fun _cmdHash ? P.equals (_cmdHash tx2))
                         successfulTx
                     ]
             return $ finalizeBlock bip

diff --git a/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs b/test/unit/Chainweb/Test/Pact5/RemotePactTest.hs
@@ -60,8 +60,7 @@ import Chainweb.Test.Pact5.CmdBuilder
 import Chainweb.Test.Pact5.CutFixture qualified as CutFixture
 import Chainweb.Test.Pact5.Utils
 import Chainweb.Test.TestVersions
-import Chainweb.Test.Utils (deadbeef)
-import Chainweb.Test.Utils (testRetryPolicy)
+import Chainweb.Test.Utils (deadbeef, TestPact5CommandResult)
 import Chainweb.Utils
 import Chainweb.Version
 import Chainweb.WebPactExecutionService
@@ -84,7 +83,8 @@ import Pact.Core.Command.Types
 import Pact.Core.Gas.Types
 import Pact.Core.Hash qualified as Pact5
 import Pact.JSON.Encode qualified as J
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Servant.Client
 import Test.Tasty
 import Test.Tasty.HUnit (assertEqual, testCase)
@@ -138,13 +138,13 @@ mkFixture v baseRdb = do
 
 tests :: RocksDb -> TestTree
 tests rdb = testGroup "Pact5 RemotePactTest"
-    [ testCase "pollingBadlistTest" (pollingInvalidTest rdb)
+    [ testCase "pollingInvalidRequestKeyTest" (pollingInvalidRequestKeyTest rdb)
     , testCase "pollingConfirmationDepthTest" (pollingConfirmationDepthTest rdb)
     , testCase "spvTest" (spvTest rdb)
     ]
 
-pollingInvalidTest :: RocksDb -> IO ()
-pollingInvalidTest baseRdb = runResourceT $ do
+pollingInvalidRequestKeyTest :: RocksDb -> IO ()
+pollingInvalidRequestKeyTest baseRdb = runResourceT $ do
     let v = pact5InstantCpmTestVersion singletonChainGraph
     let cid = unsafeChainId 0
     fixture <- mkFixture v baseRdb
@@ -171,7 +171,7 @@ pollingConfirmationDepthTest baseRdb = runResourceT $ do
         pollingWithDepth v cid clientEnv rks (Just (ConfirmationDepth 0)) >>= \response -> do
             assertEqual "there are no command results at depth 0" response HashMap.empty
 
-        _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture)
+        CutFixture.advanceAllChains_ v (fixture ^. cutFixture)
 
         pollingWithDepth v cid clientEnv rks Nothing >>= \response -> do
             assertEqual "results are visible at depth 0" 2 (HashMap.size response)
@@ -180,7 +180,7 @@ pollingConfirmationDepthTest baseRdb = runResourceT $ do
         pollingWithDepth v cid clientEnv rks (Just (ConfirmationDepth 1)) >>= \response -> do
             assertEqual "results are not visible at depth 1" 0 (HashMap.size response)
 
-        _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture)
+        CutFixture.advanceAllChains_ v (fixture ^. cutFixture)
 
         pollingWithDepth v cid clientEnv rks Nothing >>= \response -> do
             assertEqual "results are visible at depth 0" 2 (HashMap.size response)
@@ -191,7 +191,7 @@ pollingConfirmationDepthTest baseRdb = runResourceT $ do
         pollingWithDepth v cid clientEnv rks (Just (ConfirmationDepth 2)) >>= \response -> do
             assertEqual "results are not visible at depth 2" 0 (HashMap.size response)
 
-        _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture)
+        CutFixture.advanceAllChains_ v (fixture ^. cutFixture)
 
         pollingWithDepth v cid clientEnv rks Nothing >>= \response -> do
             assertEqual "results are visible at depth 0" 2 (HashMap.size response)
@@ -267,21 +267,20 @@ spvTest baseRdb = runResourceT $ do
         _ <- CutFixture.advanceAllChains v (fixture ^. cutFixture)
         recvCr <- fmap (HashMap.! recvReqKey) $ polling v targetChain clientEnv (NE.singleton recvReqKey)
         recvCr
-            & allTrue
-                [ pt _crResult ? match _PactResultOk something
-                , pt _crEvents ? predful
-                    [ something
-                    , allTrue
-                        [ pt _peName ? equals "TRANSFER_XCHAIN_RECD"
-                        , pt _peArgs ? traceFailShow ? equals
+            & P.allTrue
+                [ P.fun _crResult ? P.match _PactResultOk P.succeed
+                , P.fun _crEvents ? P.propful
+                    [ P.succeed
+                    , P.allTrue
+                        [ P.fun _peName ? P.equals "TRANSFER_XCHAIN_RECD"
+                        , P.fun _peArgs ? P.equals
                             [PString "", PString "sender01", PDecimal 1.0, PString (chainIdToText srcChain)]
                         ]
-                    , pt _peName ? equals "X_RESUME"
-                    , something
+                    , P.fun _peName ? P.equals "X_RESUME"
+                    , P.succeed
                     ]
                 ]
 
-
         pure ()
 
     pure ()
@@ -410,11 +409,9 @@ trivialTx cid n = defaultCmd
     , _cbGasLimit = GasLimit (Gas 1_000)
     }
 
-_successfulTx :: Predicatory p => Pred p (CommandResult log err)
-_successfulTx = pt _crResult ? match _PactResultOk something
+_successfulTx :: P.Prop (CommandResult log err)
+_successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 pactDeadBeef :: RequestKey
 pactDeadBeef = case deadbeef of
     TransactionHash bytes -> RequestKey (Pact5.Hash bytes)
-
-type TestPact5CommandResult = CommandResult Pact5.Hash (PactErrorCompat (LocatedErrorInfo Info))
diff --git a/test/unit/Chainweb/Test/Pact5/SPVTest.hs b/test/unit/Chainweb/Test/Pact5/SPVTest.hs
@@ -157,7 +157,8 @@ import Pact.Core.Serialise
 import Pact.Core.StableEncoding (encodeStable)
 import Pact.Core.Verifiers
 import Pact.Types.Gas qualified as Pact4
-import PredicateTransformers as PT
+import PropertyMatchers ((?))
+import PropertyMatchers qualified as P
 import Streaming.Prelude qualified as Stream
 import System.LogLevel
 import System.LogLevel (LogLevel (..))
@@ -252,8 +253,8 @@ tests baseRdb = testGroup "Pact5 SPVTest"
     [ --testCase "simple end to end" (simpleEndToEnd baseRdb)
     ]
 
-successfulTx :: Predicatory p => Pred p (CommandResult log err)
-successfulTx = pt _crResult ? match _PactResultOk something
+successfulTx :: P.Prop (CommandResult log err)
+successfulTx = P.fun _crResult ? P.match _PactResultOk P.succeed
 
 cid = unsafeChainId 0
 v = pact5InstantCpmTestVersion singletonChainGraph