From 09df3d18138742c3abb1971f96759da16a11e8ba Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 20 Jun 2023 08:38:20 -0700 Subject: [PATCH 1/8] Add John and Emily as codeowners to all files (#1241) --- CODEOWNERS | 84 +++++++++++++++++++++++++++--------------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index 3307338be..721605964 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -1,43 +1,43 @@ * @jwiegley @emilypi -/src-ghc/Pact/ApiReq.hs @sirlensalot -/src-ghc/Pact/Bench.hs @sirlensalot -/src-ghc/Pact/Coverage.hs @sirlensalot -/src-ghc/Pact/Coverage/Report.hs @sirlensalot -/src-ghc/Pact/Interpreter.hs @sirlensalot -/src/Crypto/Hash/Blake2Native.hs @sirlensalot -/src/Pact/Compile.hs @sirlensalot -/src/Pact/Eval.hs @sirlensalot -/src/Pact/Gas.hs @sirlensalot -/src/Pact/Native.hs @sirlensalot -/src/Pact/Native/Capabilities.hs @sirlensalot -/src/Pact/Native/Db.hs @sirlensalot -/src/Pact/Native/Ops.hs @jmcardon -/src/Pact/Parse.hs @sirlensalot -/src/Pact/Persist.hs @sirlensalot -/src/Pact/PersistPactDb.hs @sirlensalot -/src/Pact/Repl.hs @sirlensalot -/src/Pact/Repl/Lib.hs @sirlensalot -/src/Pact/Repl/Types.hs @sirlensalot -/src/Pact/Runtime/Capabilities.hs @sirlensalot -/src/Pact/Runtime/Typecheck.hs @sirlensalot -/src/Pact/Typechecker.hs @sirlensalot -/src/Pact/Types/API.hs @sirlensalot -/src/Pact/Types/Advice.hs @sirlensalot -/src/Pact/Types/Capability.hs @sirlensalot -/src/Pact/Types/Codec.hs @sirlensalot -/src/Pact/Types/Command.hs @sirlensalot -/src/Pact/Types/Continuation.hs @sirlensalot -/src/Pact/Types/Exp.hs @sirlensalot -/src/Pact/Types/Hash.hs @sirlensalot -/src/Pact/Types/Info.hs @sirlensalot -/src/Pact/Types/KeySet.hs @sirlensalot -/src/Pact/Types/PactError.hs @sirlensalot -/src/Pact/Types/PactValue.hs @sirlensalot -/src/Pact/Types/Parser.hs @sirlensalot -/src/Pact/Types/Persistence.hs @sirlensalot -/src/Pact/Types/Purity.hs @sirlensalot -/src/Pact/Types/RPC.hs @sirlensalot -/src/Pact/Types/Runtime.hs @sirlensalot -/src/Pact/Types/Term.hs @sirlensalot -/src/Pact/Types/Type.hs @sirlensalot -/src/Pact/Types/Typecheck.hs @sirlensalot \ No newline at end of file +/src-ghc/Pact/ApiReq.hs @sirlensalot @jwiegley @emilypi +/src-ghc/Pact/Bench.hs @sirlensalot @jwiegley @emilypi +/src-ghc/Pact/Coverage.hs @sirlensalot @jwiegley @emilypi +/src-ghc/Pact/Coverage/Report.hs @sirlensalot @jwiegley @emilypi +/src-ghc/Pact/Interpreter.hs @sirlensalot @jwiegley @emilypi +/src/Crypto/Hash/Blake2Native.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Compile.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Eval.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Gas.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Native.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Native/Capabilities.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Native/Db.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Native/Ops.hs @jmcardon @jwiegley @emilypi +/src/Pact/Parse.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Persist.hs @sirlensalot @jwiegley @emilypi +/src/Pact/PersistPactDb.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Repl.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Repl/Lib.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Repl/Types.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Runtime/Capabilities.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Runtime/Typecheck.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Typechecker.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/API.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Advice.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Capability.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Codec.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Command.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Continuation.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Exp.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Hash.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Info.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/KeySet.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/PactError.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/PactValue.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Parser.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Persistence.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Purity.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/RPC.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Runtime.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Term.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Type.hs @sirlensalot @jwiegley @emilypi +/src/Pact/Types/Typecheck.hs @sirlensalot @jwiegley @emilypi \ No newline at end of file From 3d5d793a7822b0b5e9f352f3ae2f2c6137dcfc09 Mon Sep 17 00:00:00 2001 From: rsoeldner Date: Thu, 22 Jun 2023 03:32:27 +0200 Subject: [PATCH 2/8] Add parsing of `and?` and `or?` for properties (#1243) * Add parsing of `and?` and `or?` for properties * add additional test cases --- src-tool/Pact/Analyze/Parse/Prop.hs | 6 +++++ tests/AnalyzeSpec.hs | 35 +++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/src-tool/Pact/Analyze/Parse/Prop.hs b/src-tool/Pact/Analyze/Parse/Prop.hs index 6449d8eb4..c94ddfe41 100644 --- a/src-tool/Pact/Analyze/Parse/Prop.hs +++ b/src-tool/Pact/Analyze/Parse/Prop.hs @@ -517,6 +517,12 @@ inferPreProp preProp = case preProp of _ -> throwErrorIn preProp $ pretty op' <> " applied to wrong number of arguments" + PreApp s [PreApp a p1, PreApp b p2 , c] | s == SOrQ -> + inferPreProp (PreApp SLogicalDisjunction [PreApp a (p1 ++ [c]), PreApp b (p2 ++ [c])]) + + PreApp s [PreApp a p1, PreApp b p2 , c] | s == SAndQ -> + inferPreProp (PreApp SLogicalConjunction [PreApp a (p1 ++ [c]), PreApp b (p2 ++ [c])]) + PreApp s [a, b] | s == SLogicalImplication -> do propNotA <- PNot <$> checkPreProp SBool a Some SBool . POr propNotA <$> checkPreProp SBool b diff --git a/tests/AnalyzeSpec.hs b/tests/AnalyzeSpec.hs index bc1998866..5025a63d4 100644 --- a/tests/AnalyzeSpec.hs +++ b/tests/AnalyzeSpec.hs @@ -4594,3 +4594,38 @@ spec = describe "analyze" $ do , "block-time" := block-time } (* block-height x))) |] + + describe "Properties involving `or?` and `and?` are handled" $ do + expectVerified [text| + (defun test() + @model [ (property (or? (> 1) (> 2) 1))] + true) + |] + expectFalsified [text| + (defun test() + @model [ (property (or? (> 1) (> 2) 3))] + true) + |] + expectVerified [text| + (defun test() + @model [ (property (and? (> 1) (> 2) 0))] + true) + |] + expectFalsified [text| + (defun test() + @model [ (property (and? (> 1) (> 2) 3))] + true) + |] + + expectVerified [text| + (defun test(x: integer y: integer z: integer) + @model [ (property (or? (> x) (> y) z))] + (enforce (or? (> x) (> y) z) "") + true) + |] + expectVerified [text| + (defun test(x: integer y: integer z: integer) + @model [ (property (and? (> x) (> y) z))] + (enforce (and? (> x) (> y) z) "") + true) + |] From e10a20f496c04fac53e9a980fbbffe4ad64cba30 Mon Sep 17 00:00:00 2001 From: rsoeldner Date: Fri, 23 Jun 2023 20:58:53 +0200 Subject: [PATCH 3/8] fix docs for `env-sigs` (#1230) --- docs/en/pact-functions.md | 2 +- docs/en/pact-functions.rst | 2 +- docs/en/pact-reference.md | 4 ++-- docs/en/pact-reference.rst | 4 ++-- src/Pact/Repl/Lib.hs | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index b81765e68..9e2293a83 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -2022,7 +2022,7 @@ pact> (env-hash (hash "hello")) *keys* `[string]` *→* `string` -DEPRECATED in favor of 'set-sigs'. Set transaction signer KEYS. See 'env-sigs' for setting keys with associated capabilities. +DEPRECATED in favor of 'env-sigs'. Set transaction signer KEYS. See 'env-sigs' for setting keys with associated capabilities. ```lisp pact> (env-keys ["my-key" "admin-key"]) "Setting transaction keys" diff --git a/docs/en/pact-functions.rst b/docs/en/pact-functions.rst index 621e24a09..c4288a725 100644 --- a/docs/en/pact-functions.rst +++ b/docs/en/pact-functions.rst @@ -2319,7 +2319,7 @@ env-keys *keys* ``[string]`` *→* ``string`` -DEPRECATED in favor of ‘set-sigs’. Set transaction signer KEYS. See +DEPRECATED in favor of ‘env-sigs’. Set transaction signer KEYS. See ‘env-sigs’ for setting keys with associated capabilities. .. code:: lisp diff --git a/docs/en/pact-reference.md b/docs/en/pact-reference.md index fcc86918c..3f8ea851d 100644 --- a/docs/en/pact-reference.md +++ b/docs/en/pact-reference.md @@ -923,10 +923,10 @@ new `env-sigs` REPL function as follows: ... ) -(set-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) +(env-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) (accounts.pay "alice" "bob" 10.0) ;; works as the cap match the signature caps -(set-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) +(env-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) (expect-failure "payment to bob will no longer be able to enforce alice's keyset" (accounts.pay "alice" "bob" 10.0)) ``` diff --git a/docs/en/pact-reference.rst b/docs/en/pact-reference.rst index c357ca858..2ae0c65c2 100644 --- a/docs/en/pact-reference.rst +++ b/docs/en/pact-reference.rst @@ -1189,10 +1189,10 @@ as follows: ... ) - (set-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) + (env-sigs [{'key: "alice", 'caps: ["(accounts.PAY \"alice\" \"bob\" 10.0)"]}]) (accounts.pay "alice" "bob" 10.0) ;; works as the cap match the signature caps - (set-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) + (env-sigs [('key: "alice", 'caps: ["(accounts.PAY \"alice\" "\carol\" 10.0)"]}]) (expect-failure "payment to bob will no longer be able to enforce alice's keyset" (accounts.pay "alice" "bob" 10.0)) diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index 4243f1db9..e7ba1f2d4 100644 --- a/src/Pact/Repl/Lib.hs +++ b/src/Pact/Repl/Lib.hs @@ -120,7 +120,7 @@ replDefs = ("Repl", "Transform PUBLIC-KEY into an address (i.e. a Pact Runtime Public Key) depending on its SCHEME." ,defZRNative "env-keys" setsigs (funType tTyString [("keys",TyList tTyString)]) ["(env-keys [\"my-key\" \"admin-key\"])"] - ("DEPRECATED in favor of 'set-sigs'. Set transaction signer KEYS. "<> + ("DEPRECATED in favor of 'env-sigs'. Set transaction signer KEYS. "<> "See 'env-sigs' for setting keys with associated capabilities.") ,defZNative "env-sigs" setsigs' (funType tTyString [("sigs",TyList (tTyObject TyAny))]) [LitExample $ "(env-sigs [{'key: \"my-key\", 'caps: [(accounts.USER_GUARD \"my-account\")]}, " <> From b1ffb7c0c42ab45574e270aa141bac967a30c292 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Fri, 23 Jun 2023 14:34:12 -0700 Subject: [PATCH 4/8] add benchmarks for user-function application (#1219) * add benchmarks for user-function application * add benchmarks for user-function application --- src-ghc/Pact/Bench.hs | 38 ++++++++++++++++++++++++++++++++++++++ tests/bench/bench.pact | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 73 insertions(+) diff --git a/src-ghc/Pact/Bench.hs b/src-ghc/Pact/Bench.hs index d6ca8168d..a622b747c 100644 --- a/src-ghc/Pact/Bench.hs +++ b/src-ghc/Pact/Bench.hs @@ -327,6 +327,21 @@ main = do let tt = evalReplEval def replS (mapM eval timeTest) void $! eitherDie "timeTest failed" . fmapL show =<< tt + wrap10Cmd <- parseCode "(bench.wrap10 100)" + wrap10MonoCmd <- parseCode "(bench.wrap10_integer 100)" + + arityCmd0 <- parseCode "(bench.arity_tc_0)" + arityCmd1 <- parseCode "(bench.arity_tc_1 1)" + arityCmd10 <- parseCode "(bench.arity_tc_10 1 1 1 1 1 1 1 1 1 1)" + arityCmd40 <- parseCode "(bench.arity_tc_40 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)" + + aritySmallObj <- parseCode "(bench.arity_small_obj {\"a\": 1})" + arityMediumObj <- parseCode "(bench.arity_medium_obj {\"a\":1, \"b\":true, \"c\":1, \"d\":{\"a\":1}, \"e\":1, \"f\":true, \"g\":1, \"h\":{\"a\":1} })" + arityLargeObj <- parseCode "(bench.arity_large_obj {\"a\":1, \"b\":true, \"c\":1, \"d\":{\"a\":1}, \"e\":1, \"f\":true, \"g\":1, \"h\":{\"a\":1}, \"i\":1, \"j\":true, \"k\":1, \"l\":{\"a\":1}, \"m\":1, \"n\":true, \"o\":1, \"p\":{\"a\":1} })" + + accumCmd0 <- parseCode "(bench.accum (enumerate 1 0))" + accumCmd1 <- parseCode "(bench.accum (enumerate 1 1))" + accumCmd100 <- parseCode "(bench.accum (enumerate 1 100))" let cleanupSqlite = do c <- readMVar $ pdPactDbVar sqliteDb @@ -384,4 +399,27 @@ main = do , benchNFIO "round4" $ runPactExec def "round4" [] Null Nothing pureDb round4 ] , benchNFIO "time" $ fmap fst <$> evalReplEval def replS (mapM eval timeTest) + , bgroup "defun" + [ bgroup "return-type-tc" + [ benchNFIO "wrap10" $ runPactExec def "wrap10" [] Null Nothing pureDb wrap10Cmd + , benchNFIO "wrap10_mono" $ runPactExec def "wrap10_mono" [] Null Nothing pureDb wrap10MonoCmd + , benchNFIO "accum100" $ runPactExec def "accum100" [] Null Nothing pureDb accumCmd100 + ] + , bgroup "arity" + [ benchNFIO "00-args" $ runPactExec def "00-args" [] Null Nothing pureDb arityCmd0 + , benchNFIO "01-args" $ runPactExec def "01-args" [] Null Nothing pureDb arityCmd1 + , benchNFIO "10-args" $ runPactExec def "10-args" [] Null Nothing pureDb arityCmd10 + , benchNFIO "40-args" $ runPactExec def "40-args" [] Null Nothing pureDb arityCmd40 + ] + , bgroup "object-size" + [ benchNFIO "small-obj" $ runPactExec def "small-obj" [] Null Nothing pureDb aritySmallObj + , benchNFIO "medium-obj" $ runPactExec def "medium-obj" [] Null Nothing pureDb arityMediumObj + , benchNFIO "large-obj" $ runPactExec def "large-obj" [] Null Nothing pureDb arityLargeObj + ] + , bgroup "list-tc" + [ benchNFIO "000-items" $ runPactExec def "000-items" [] Null Nothing pureDb accumCmd0 + , benchNFIO "001-items" $ runPactExec def "001-items" [] Null Nothing pureDb accumCmd1 + , benchNFIO "100-items" $ runPactExec def "100-items" [] Null Nothing pureDb accumCmd100 + ] + ] ] diff --git a/tests/bench/bench.pact b/tests/bench/bench.pact index 8ffacd3c2..f25ff0084 100644 --- a/tests/bench/bench.pact +++ b/tests/bench/bench.pact @@ -89,14 +89,49 @@ (defun wrap10 (a) (id (id (id (id (id (id (id (id (id (id a))))))))))) + (defun wrap10_integer:integer (a:integer) (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer (id_integer a))))))))))) + (defun rep10 (a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a) (id a)) (defun withr () (with-read bench-accounts "Acct1" { "balance":= b } b)) + (defun accum:integer (xs) (fold (+) 0 xs)) + (defun fst (a b) a) (defun snd (a b) b) (defun id (a) a) + (defun id_integer:integer (a:integer) a) + + (defun arity_tc_0:integer + () 1) + + (defun arity_tc_1:integer + (a:integer) 1) + + (defun arity_tc_10:integer + (a:integer b:integer c:integer d:integer e:integer f:integer g:integer h:integer i:integer j:integer) 1) + + (defun arity_tc_40:integer + (a1:integer b1:integer c1:integer d1:integer e1:integer f1:integer g1:integer h1:integer i1:integer j1:integer a2:integer b2:integer c2:integer d2:integer e2:integer f2:integer g2:integer h2:integer i2:integer j2:integer a3:integer b3:integer c3:integer d3:integer e3:integer f3:integer g3:integer h3:integer i3:integer j3:integer a4:integer b4:integer c4:integer d4:integer e4:integer f4:integer g4:integer h4:integer i4:integer j4:integer) 1) + + + (defschema small_object + a:integer) + (defun arity_small_obj:integer (arg:object{small_object}) 1) + + (defschema medium_object + a:integer b:bool c:integer d:object{small_object} + e:integer f:bool g:integer h:object{small_object} + ) + (defun arity_medium_obj:integer (arg:object{medium_object}) 1) + (defschema large_object + a:integer b:bool c:integer d:object{small_object} + e:integer f:bool g:integer h:object{small_object} + i:integer j:bool k:integer l:object{small_object} + m:integer n:bool o:integer p:object{small_object} + ) + (defun arity_large_obj:integer (arg:object{large_object}) 1) ) (create-table bench-accounts) From e67bde85a55345bd9cfd20f1378da9c4cd092da9 Mon Sep 17 00:00:00 2001 From: Jose C Date: Sun, 25 Jun 2023 11:58:35 -0400 Subject: [PATCH 5/8] add jose as codeowner (#1244) Co-authored-by: jmcardon --- CODEOWNERS | 86 +++++++++++++++++++++++++++--------------------------- 1 file changed, 43 insertions(+), 43 deletions(-) diff --git a/CODEOWNERS b/CODEOWNERS index 721605964..579c49c29 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -1,43 +1,43 @@ -* @jwiegley @emilypi -/src-ghc/Pact/ApiReq.hs @sirlensalot @jwiegley @emilypi -/src-ghc/Pact/Bench.hs @sirlensalot @jwiegley @emilypi -/src-ghc/Pact/Coverage.hs @sirlensalot @jwiegley @emilypi -/src-ghc/Pact/Coverage/Report.hs @sirlensalot @jwiegley @emilypi -/src-ghc/Pact/Interpreter.hs @sirlensalot @jwiegley @emilypi -/src/Crypto/Hash/Blake2Native.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Compile.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Eval.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Gas.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Native.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Native/Capabilities.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Native/Db.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Native/Ops.hs @jmcardon @jwiegley @emilypi -/src/Pact/Parse.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Persist.hs @sirlensalot @jwiegley @emilypi -/src/Pact/PersistPactDb.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Repl.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Repl/Lib.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Repl/Types.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Runtime/Capabilities.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Runtime/Typecheck.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Typechecker.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/API.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Advice.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Capability.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Codec.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Command.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Continuation.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Exp.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Hash.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Info.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/KeySet.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/PactError.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/PactValue.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Parser.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Persistence.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Purity.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/RPC.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Runtime.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Term.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Type.hs @sirlensalot @jwiegley @emilypi -/src/Pact/Types/Typecheck.hs @sirlensalot @jwiegley @emilypi \ No newline at end of file +* @jwiegley @emilypi @jmcardon +/src-ghc/Pact/ApiReq.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Bench.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Coverage.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Coverage/Report.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src-ghc/Pact/Interpreter.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Crypto/Hash/Blake2Native.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Compile.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Eval.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Gas.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Capabilities.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Db.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Native/Ops.hs @jmcardon @jwiegley @emilypi @jmcardon +/src/Pact/Parse.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Persist.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/PersistPactDb.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl/Lib.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Repl/Types.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Runtime/Capabilities.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Runtime/Typecheck.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Typechecker.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/API.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Advice.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Capability.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Codec.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Command.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Continuation.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Exp.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Hash.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Info.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/KeySet.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/PactError.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/PactValue.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Parser.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Persistence.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Purity.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/RPC.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Runtime.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Term.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Type.hs @sirlensalot @jwiegley @emilypi @jmcardon +/src/Pact/Types/Typecheck.hs @sirlensalot @jwiegley @emilypi @jmcardon From 640e39d59d2d2c6146e33b28999d6bfeacf91d3d Mon Sep 17 00:00:00 2001 From: rsoeldner Date: Tue, 27 Jun 2023 22:45:10 +0200 Subject: [PATCH 6/8] Fix name resolution within module redeploy (#1235) * wip * add tests * add DisablePact48 flag * Factor out BareName resolve * address review comments * simplification * Fix incorrect module name * Use lens * Correct spelling * Add old behavior test case * add additional test * fix resolving of names without a namespace * add additional tests * add even more tests * cleanup * add missing tests * rephrase tests * fix spelling Signed-off-by: Robert Soeldner * address comments * add missing test redepl --------- Signed-off-by: Robert Soeldner --- docs/en/pact-functions.md | 2 +- src/Pact/Eval.hs | 53 ++++++++++++++++------- src/Pact/Types/Runtime.hs | 2 + tests/pact/fqns.repl | 91 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 131 insertions(+), 17 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index 9e2293a83..67fa0da0c 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -1928,7 +1928,7 @@ Retreive any accumulated events and optionally clear event state. Object returne *→* `[string]` -Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"] +Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"] ```lisp pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config) ["DisableHistoryInTransactionalMode"] diff --git a/src/Pact/Eval.hs b/src/Pact/Eval.hs index 2f60bfcdc..400868908 100644 --- a/src/Pact/Eval.hs +++ b/src/Pact/Eval.hs @@ -89,6 +89,7 @@ import Pact.Types.Purity import Pact.Types.Runtime import Pact.Types.SizeOf import Pact.Types.Namespace +import Control.Applicative (liftA2) evalBeginTx :: Info -> Eval e (Maybe TxId) @@ -320,6 +321,11 @@ eval' (TModule _tm@(MDModule m) bod i) = capMName <- ifExecutionFlagSet' FlagPreserveNsModuleInstallBug (_mName m) (_mName mangledM) void $ acquireModuleAdminCapability capMName $ return () + + unlessExecutionFlagSet FlagDisablePact48 $ do + evalRefs.rsLoadedModules %= HM.delete (_mName mangledM) + evalRefs.rsQualifiedDeps %= HM.filterWithKey (\k _ -> _fqModule k /= _mName mangledM) + -- build/install module from defs (g,govM) <- loadModule mangledM bod i g0 szVer <- getSizeOfVersion @@ -737,27 +743,42 @@ fullyQualifyDefs info mdef defs = do checkAddDep = \case Direct (TVar (FQName fq) _) -> modify' (Set.insert (_fqModule fq)) _ -> pure () - -- | traverse to find deps and form graph - traverseGraph allDefs memo = fmap stronglyConnCompR $ forM (HM.toList allDefs) $ \(defName,defTerm) -> do - let defName' = FullyQualifiedName defName (_mName mdef) (moduleHash mdef) - defTerm' <- forM defTerm $ \(f :: Name) -> do + + resolveBareName memo f@(BareName fn _) = case HM.lookup fn defs of + Just _ -> do + let name' = FullyQualifiedName fn (_mName mdef) (moduleHash mdef) + return (Left name') -- decl found + Nothing -> lift (resolveBareModRef info f fn memo (MDModule mdef)) >>= \case + Just mr -> return (Right mr) -- mod ref found + Nothing -> resolveError f + + resolveError f = lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) + + resolveName flagPact48Disabled memo = \case + (QName (QualifiedName (ModuleName mn mNs) fn i)) + | not flagPact48Disabled + && mn == _mnName (_mName mdef) + && isNsMatch -> resolveBareName memo (BareName fn i) + where + isNsMatch = fromMaybe True (liftA2 (==) modNs mNs) + modNs = _mnNamespace (_mName mdef) + f -> do dm <- lift (resolveRefFQN f f) -- lookup ref, don't try modules for barenames case (dm, f) of (Just t, _) -> checkAddDep t *> return (Right t) -- ref found - -- for barenames, check decls and finally modules - (Nothing, Name (BareName fn _)) -> - case HM.lookup fn allDefs of - Just _ -> do - let name' = FullyQualifiedName fn (_mName mdef) (moduleHash mdef) - return (Left name') -- decl found - Nothing -> lift (resolveBareModRef info f fn memo (MDModule mdef)) >>= \r -> case r of - Just mr -> return (Right mr) -- mod ref found - Nothing -> - lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) - -- for qualified names, simply fail - (Nothing, _) -> lift (evalError' f $ "Cannot resolve " <> dquotes (pretty f)) + -- for barenames, check decls and finally modules + (Nothing, Name bn@BareName{}) -> resolveBareName memo bn + -- for qualified names, simply fail + (Nothing, _) -> resolveError f + + -- | traverse to find deps and form graph + traverseGraph allDefs memo = fmap stronglyConnCompR $ forM (HM.toList allDefs) $ \(defName,defTerm) -> do + let defName' = FullyQualifiedName defName (_mName mdef) (moduleHash mdef) + disablePact48 <- lift (isExecutionFlagSet FlagDisablePact48) + defTerm' <- forM defTerm $ \(f :: Name) -> resolveName disablePact48 memo f return (defTerm', defName', mapMaybe (either Just (const Nothing)) $ toList defTerm') + moduleHash = _mhHash . _mHash diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs index 31b8321f8..f95a3151b 100644 --- a/src/Pact/Types/Runtime.hs +++ b/src/Pact/Types/Runtime.hs @@ -189,6 +189,8 @@ data ExecutionFlag | FlagDisablePact47 -- | Disable runtime return type checking. | FlagDisableRuntimeReturnTypeChecking + -- | Disable Pact 4.8 Features + | FlagDisablePact48 deriving (Eq,Ord,Show,Enum,Bounded) -- | Flag string representation diff --git a/tests/pact/fqns.repl b/tests/pact/fqns.repl index 4234f61c1..015e9c646 100644 --- a/tests/pact/fqns.repl +++ b/tests/pact/fqns.repl @@ -77,3 +77,94 @@ (expect "selects correct test" (modB.get-test) "hello") (commit-tx) + +;; +;; Module redeploy name resolution +;; + +; In the following tests, we define a module `test-mod-redeploy-ref`, and then +; redeploy the same module with the change to one capability: `test`. +; In the old version, the `test` capability fails, in the new one it passes. + +(begin-tx) +; First, demonstrate the behavior prior to pact-4.8. +(env-exec-config ["DisablePact48"]) + +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + + (defcap test () + (enforce false "boom")) + + (defun f () + (with-capability (test) + 1)) + ) +; Before pact-4.8, the updated capability will be ignored, and calls to a function +; requiring that capability will fail. +(expect-failure "Demonstrate defcap resolution." (f)) + +(commit-tx) + +; The following module redeployment changed the capability `test` to pass. +(begin-tx) +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + (defcap test () + true) + + (defun f () + (with-capability (free.test-mod-redeploy-ref.test) + 1)) + + (defun f1 () + (with-capability (test-mod-redeploy-ref.test) + 1)) + + ) +; Before pact-4.8, the capability update (passing `test`) was ignored as the +; full-qualified reference referenced the previously deployed version of the module. +(expect-failure "Reproduce upgrade resolution bug with fully-qualified reference." (f)) +(expect-failure "Reproduce upgrade resolution bug with non-namespace-qualified reference." (f1)) +(commit-tx) + + +;; Check Pact48 behaviour + +(begin-tx) +(namespace 'free) +(module test-mod-redeploy-ref g + (defcap g () true) + + (defcap test () + (enforce false "boom")) + + (defun f () + (with-capability (test) + 1)) + ) +(commit-tx) + +(begin-tx) +(namespace 'free) +(env-exec-config []) ; reset + +(module test-mod-redeploy-ref g + (defcap g () true) + (defcap test () + true) + (defun f () + (with-capability (free.test-mod-redeploy-ref.test) + 1)) + + (defun f1 () + (with-capability (test-mod-redeploy-ref.test) + 1)) + ) +; These tests show that f now references the updated version of the capability. +(expect "Demonstrate correct resolution with fully-qualified reference." 1 (f)) +(expect "Demonstrate correct resolution with non-namespace-qualified reference." 1 (f1)) + +(commit-tx) From 97b0f789364ca65abdeb79b2e9c7e942c8373e13 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Tue, 11 Jul 2023 09:23:29 -0700 Subject: [PATCH 7/8] replace cryptonite by crypton (#1240) --- pact.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pact.cabal b/pact.cabal index 71525de04..854bfb895 100644 --- a/pact.cabal +++ b/pact.cabal @@ -28,7 +28,7 @@ extra-source-files: cbits/musl/sqrt_data.h flag cryptonite-ed25519 - description: use cryptonite instead of ed25519-donna + description: use crypton instead of ed25519-donna default: True manual: True @@ -228,7 +228,7 @@ library Pact.Types.SQLite build-depends: , criterion >=1.1.4 - , cryptonite + , crypton , direct-sqlite >=2.3.27 , memory , safe-exceptions >=0.1.5.0 From 266d4a35a14b20bc3f8a3fdf0e993f117da30485 Mon Sep 17 00:00:00 2001 From: Jose C Date: Thu, 13 Jul 2023 16:54:21 -0400 Subject: [PATCH 8/8] remove unnecessary traversals of enrichdynamic (#1248) Co-authored-by: jmcardon --- src/Pact/Compile.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Pact/Compile.hs b/src/Pact/Compile.hs index b64e4eeef..d183eb540 100644 --- a/src/Pact/Compile.hs +++ b/src/Pact/Compile.hs @@ -585,7 +585,8 @@ abstractBody :: Compile (Term Name) -> [Arg (Term Name)] -> Compile (Scope Int T abstractBody term args = abstractBody' args =<< bodyForm term abstractBody' :: [Arg (Term Name)] -> Term Name -> Compile (Scope Int Term Name) -abstractBody' args body = traverse enrichDynamic $ abstract (`elemIndex` bNames) body +abstractBody' args body = + (if M.null modRefArgs then pure else traverse enrichDynamic) $ abstract (`elemIndex` bNames) body where bNames = map arg2Name args