├── .gitattributes ├── .github ├── ISSUE_TEMPLATE │ ├── bug_report.md │ └── enhancement_request.md ├── pull_request_template.md └── workflows │ ├── applications.yml │ └── nix.yml ├── .gitignore ├── .gitlab-ci.yml ├── .readthedocs.yaml ├── CHANGELOG.md ├── CODEOWNERS ├── LICENSE ├── README.md ├── bench └── PactJson.hs ├── cabal.project ├── cbits └── musl │ ├── __math_divzero.c │ ├── __math_invalid.c │ ├── __math_oflow.c │ ├── __math_uflow.c │ ├── __math_xflow.c │ ├── endian.h │ ├── exp.c │ ├── exp_data.c │ ├── exp_data.h │ ├── libm.h │ ├── log.c │ ├── log_data.c │ ├── log_data.h │ ├── pow.c │ ├── pow_data.c │ ├── pow_data.h │ ├── sqrt.c │ ├── sqrt_data.c │ └── sqrt_data.h ├── collectArtifacts.sh ├── config.yaml ├── dep └── kpkgs │ ├── default.nix │ ├── github.json │ └── thunk.nix ├── docs ├── README.md ├── en │ ├── conf.py │ ├── img │ ├── index.rst │ ├── pact-functions.md │ ├── pact-functions.rst │ ├── pact-properties-api.md │ ├── pact-properties-api.rst │ ├── pact-properties.md │ ├── pact-properties.rst │ ├── pact-reference.md │ ├── pact-reference.rst │ └── pacts.md ├── img │ ├── kadena-logo-100px.png │ ├── kadena-logo-210px.png │ ├── kadena-logo-trans.gif │ └── kadena-logomark-green.png ├── ja │ ├── conf.py │ ├── img │ ├── index.rst │ ├── pact-reference.md │ └── pact-reference.rst ├── ko │ ├── conf.py │ ├── img │ ├── index.rst │ ├── pact-reference.md │ └── pact-reference.rst ├── pandoc.css ├── swagger.json ├── template.html └── work.sh ├── examples ├── accounts │ ├── accounts.pact │ ├── accounts.repl │ └── scripts │ │ ├── 01-system.yaml │ │ ├── 02-accounts.yaml │ │ ├── 03-create.yaml │ │ ├── 04-alice.yaml │ │ ├── 05-bob.yaml │ │ └── run.sh ├── cp │ ├── auth.pact │ ├── cash.pact │ ├── cp.pact │ ├── cp.repl │ ├── orders.pact │ └── scripts │ │ ├── 01-auth.yaml │ │ ├── 02-cash.yaml │ │ ├── 03-orders.yaml │ │ ├── 04-cp.yaml │ │ ├── 05-create.yaml │ │ ├── agent-keyset.yaml │ │ ├── load.cmds │ │ └── trader-keyset.yaml └── verified-accounts │ ├── accounts.pact │ └── accounts.repl ├── executables ├── Bench.hs ├── GasModel.hs └── Repl.hs ├── flake.lock ├── flake.nix ├── gas-model-raw-data.csv ├── gas-prices.csv ├── golden ├── accounts-module-crossChainSendCR │ └── golden ├── accounts-module-crossChainSendCRBackCompat │ └── golden ├── accounts-module-eventCR │ └── golden ├── accounts-module-failureCR │ └── golden ├── accounts-module-successCR │ └── golden ├── accounts-module │ └── golden ├── autocap-module │ └── golden ├── gas-model │ └── golden ├── golden.accounts.repl ├── golden.autocap.repl ├── golden.fqns.repl ├── golden.lams.repl ├── golden.memcheck.repl ├── golden.nks.repl ├── golden.rootnamespace.repl ├── goldenFullyQuals │ └── golden ├── goldenModuleMemCheck │ └── golden ├── goldenNamespacedKeysets │ └── golden ├── goldenRootNamespace │ └── golden ├── lambda-module │ └── golden ├── lcov │ └── golden ├── size-of-pactvalue-guard-keySet │ └── golden ├── size-of-pactvalue-guard-keySetRef │ └── golden ├── size-of-pactvalue-guard-module │ └── golden ├── size-of-pactvalue-guard-pact │ └── golden ├── size-of-pactvalue-guard-user │ └── golden ├── size-of-pactvalue-list │ └── golden ├── size-of-pactvalue-literal-bool │ └── golden ├── size-of-pactvalue-literal-decimal │ └── golden ├── size-of-pactvalue-literal-integer │ └── golden ├── size-of-pactvalue-literal-string │ └── golden ├── size-of-pactvalue-literal-time │ └── golden └── size-of-pactvalue-object-map │ └── golden ├── lib └── unsafe │ └── src │ └── Data │ ├── Foldable │ └── Unsafe.hs │ └── List │ └── Unsafe.hs ├── pact.cabal ├── release.sh ├── src-tool └── Pact │ ├── Analyze.hs │ └── Analyze │ ├── Alloc.hs │ ├── Check.hs │ ├── Errors.hs │ ├── Eval.hs │ ├── Eval │ ├── Core.hs │ ├── Invariant.hs │ ├── Numerical.hs │ ├── Prop.hs │ └── Term.hs │ ├── Feature.hs │ ├── Model.hs │ ├── Model │ ├── Dot.hs │ ├── Graph.hs │ ├── Tags.hs │ └── Text.hs │ ├── PactSFunArray.hs │ ├── Parse.hs │ ├── Parse │ ├── Invariant.hs │ ├── Prop.hs │ └── Types.hs │ ├── Patterns.hs │ ├── PrenexNormalize.hs │ ├── Remote │ └── Server.hs │ ├── Translate.hs │ ├── Types.hs │ ├── Types │ ├── Capability.hs │ ├── Eval.hs │ ├── Languages.hs │ ├── Model.hs │ ├── Numerical.hs │ ├── ObjUtil.hs │ ├── Shared.hs │ └── Types.hs │ └── Util.hs ├── src ├── Crypto │ └── Hash │ │ ├── Blake2Native.hs │ │ ├── HyperlaneNatives.hs │ │ ├── HyperlaneNativesBefore413.hs │ │ ├── Keccak256Native.hs │ │ └── PoseidonNative.hs └── Pact │ ├── Analyze │ └── Remote │ │ └── Types.hs │ ├── ApiReq.hs │ ├── Bench.hs │ ├── Compile.hs │ ├── Coverage.hs │ ├── Coverage │ └── Report.hs │ ├── Crypto │ └── WebAuthn │ │ └── Cose │ │ ├── PublicKey.hs │ │ ├── PublicKeyWithSignAlg.hs │ │ ├── Registry.hs │ │ ├── SignAlg.hs │ │ └── Verify.hs │ ├── Docgen.hs │ ├── Eval.hs │ ├── Gas.hs │ ├── Gas │ ├── Table.hs │ └── Table │ │ └── Format.hs │ ├── GasModel │ ├── GasModel.hs │ ├── GasTests.hs │ ├── Types.hs │ └── Utils.hs │ ├── Interpreter.hs │ ├── Main.hs │ ├── MockDb.hs │ ├── Native.hs │ ├── Native │ ├── Capabilities.hs │ ├── Db.hs │ ├── Decrypt.hs │ ├── Guards.hs │ ├── Internal.hs │ ├── Keysets.hs │ ├── Ops.hs │ ├── Pairing.hs │ ├── Pairing │ │ └── GaloisField.hs │ ├── SPV.hs │ ├── Time.hs │ └── Trans │ │ └── TOps.hs │ ├── Parse.hs │ ├── Persist.hs │ ├── Persist │ ├── MockPersist.hs │ ├── Pure.hs │ └── SQLite.hs │ ├── PersistPactDb.hs │ ├── PersistPactDb │ └── Regression.hs │ ├── Repl.hs │ ├── Repl │ ├── Lib.hs │ └── Types.hs │ ├── ReplTools.hs │ ├── Runtime │ ├── Capabilities.hs │ ├── Typecheck.hs │ └── Utils.hs │ ├── Server │ ├── API.hs │ ├── ApiServer.hs │ ├── History │ │ ├── Persistence.hs │ │ ├── Service.hs │ │ └── Types.hs │ ├── PactService.hs │ └── Server.hs │ ├── Typechecker.hs │ ├── Types │ ├── API.hs │ ├── Advice.hs │ ├── Capability.hs │ ├── ChainId.hs │ ├── ChainMeta.hs │ ├── Codec.hs │ ├── Command.hs │ ├── Continuation.hs │ ├── Crypto.hs │ ├── Exp.hs │ ├── ExpParser.hs │ ├── Gas.hs │ ├── Hash.hs │ ├── Info.hs │ ├── KeySet.hs │ ├── Lang.hs │ ├── Logger.hs │ ├── Names.hs │ ├── Namespace.hs │ ├── Native.hs │ ├── Orphans.hs │ ├── PactError.hs │ ├── PactValue.hs │ ├── PactValue │ │ └── Arbitrary.hs │ ├── Parser.hs │ ├── Persistence.hs │ ├── Pretty.hs │ ├── Principal.hs │ ├── Purity.hs │ ├── RPC.hs │ ├── RowData.hs │ ├── Runtime.hs │ ├── SPV.hs │ ├── SQLite.hs │ ├── Scheme.hs │ ├── Server.hs │ ├── SigData.hs │ ├── SizeOf.hs │ ├── Term.hs │ ├── Term │ │ ├── Arbitrary.hs │ │ └── Internal.hs │ ├── Type.hs │ ├── Typecheck.hs │ ├── Util.hs │ ├── Verifier.hs │ └── Version.hs │ └── Utils │ ├── Servant.hs │ └── StableHashMap.hs ├── templates ├── cont-request-template.yaml └── exec-request-template.yaml ├── tests ├── Analyze │ ├── Eval.hs │ ├── Gen.hs │ ├── TimeGen.hs │ └── Translate.hs ├── AnalyzePropertiesSpec.hs ├── AnalyzeSpec.hs ├── Blake2Spec.hs ├── ClientSpec.hs ├── CoverageSpec.hs ├── DocgenSpec.hs ├── GasModelSpec.hs ├── GoldenSpec.hs ├── HistoryServiceSpec.hs ├── HyperlaneSpec.hs ├── Keccak256Spec.hs ├── KeysetSpec.hs ├── PactCLISpec.hs ├── PactContinuationSpec.hs ├── PactTests.hs ├── PactTestsSpec.hs ├── PairingSpec.hs ├── ParserSpec.hs ├── PersistSpec.hs ├── PoseidonSpec.hs ├── PrincipalSpec.hs ├── RemoteVerifySpec.hs ├── ReplSpec.hs ├── RoundTripSpec.hs ├── SchemeSpec.hs ├── SignatureSpec.hs ├── SizeOfSpec.hs ├── Test │ └── Pact │ │ ├── Native │ │ └── Pairing.hs │ │ ├── Parse.hs │ │ └── Utils │ │ ├── LegacyValue.hs │ │ └── StableHashMap.hs ├── TypecheckSpec.hs ├── Utils.hs ├── Utils │ ├── eth-keys.txt │ └── gen-eth-key.sh ├── ZkSpec.hs ├── add-sig │ ├── key1.yaml │ ├── key2.yaml │ ├── test.yaml │ ├── unsigned.yaml │ └── unsigned2.yaml ├── apireq.yaml ├── bench │ ├── bench │ ├── bench.pact │ └── bench.repl ├── blake2 │ ├── blake2b.c │ └── blake2b.h ├── chainweb-example.yaml ├── cont-scripts │ ├── fail-both-price-down-01-cont-badcaps.yaml │ ├── fail-both-price-up-01-cont.yaml │ ├── fail-cred-finish-01-cont.yaml │ ├── fail-deb-cancel-01-rollback.yaml │ ├── fail-deb-cancel-02-balance.yaml │ ├── fail-deb-finish-01-cont.yaml │ ├── managed-01-pay.yaml │ ├── managed-02-pay-fails.yaml │ ├── pass-both-price-down-01-cont.yaml │ ├── pass-both-price-down-02-cred-balance.yaml │ ├── pass-both-price-down-03-deb-balance.yaml │ ├── pass-cred-cancel-01-reset.yaml │ ├── pass-cred-cancel-02-rollback.yaml │ ├── pass-cred-cancel-03-balance.yaml │ ├── pass-deb-cancel-01-set-time.yaml │ ├── pass-deb-cancel-02-rollback.yaml │ ├── pass-deb-cancel-03-balance.yaml │ ├── setup-01-system.yaml │ ├── setup-02-accounts.yaml │ ├── setup-03-test.yaml │ ├── setup-04-create.yaml │ ├── setup-05-reset.yaml │ ├── setup-06-escrow.yaml │ └── setup-07-balance.yaml ├── cp-auth-keys.json ├── cp-cash-create.pact ├── cp-cash-create2.pact ├── lcov │ ├── lcov.pact │ └── lcov.repl ├── pact │ ├── bad │ │ ├── bad-defcap-explicit-mgr-auto-impl.repl │ │ ├── bad-dupe-def.repl │ │ ├── bad-iface-enforce-ns-user.repl │ │ ├── bad-import-defcap.repl │ │ ├── bad-import-deftable.repl │ │ ├── bad-import-emptylist.pact │ │ ├── bad-import-overlapping-def.pact │ │ ├── bad-import-unimported-reference.repl │ │ ├── bad-import-unknown-definition.pact │ │ ├── bad-import-wrong-hash.repl │ │ ├── bad-modrefs-empty.repl │ │ ├── bad-modrefs.repl │ │ ├── bad-module-enforce-ns-user.repl │ │ ├── bad-modules-disabled.repl │ │ ├── bad-namespace-upgrade.repl │ │ ├── bad-ns-def.repl │ │ ├── bad-pact.repl │ │ ├── bad-parens.repl │ │ ├── bad-repl-native.repl │ │ ├── bad-root-namespace-44.repl │ │ ├── bad-root-namespace-upgrade.repl │ │ ├── bad-root-namespace.repl │ │ └── bad-term-in-list.repl │ ├── base64.repl │ ├── caps.repl │ ├── db.repl │ ├── decrypt.repl │ ├── docs.repl │ ├── errors.repl │ ├── fqns.repl │ ├── fv-shims.repl │ ├── gas.repl │ ├── gov.repl │ ├── hash.repl │ ├── hyperlane.repl │ ├── imports.repl │ ├── json.repl │ ├── keccak256.repl │ ├── keysets.repl │ ├── lambda.repl │ ├── leftpad.repl │ ├── lib.repl │ ├── lists.repl │ ├── meta.repl │ ├── modrefs.repl │ ├── namespaces.repl │ ├── nested-defpacts.repl │ ├── ops.repl │ ├── pairing.repl │ ├── parsing.repl │ ├── poseidon-hash.repl │ ├── principals.repl │ ├── pubdata.repl │ ├── signatures.repl │ ├── simple.repl │ ├── spv.repl │ ├── strings.repl │ ├── strtoint.repl │ ├── tc.repl │ ├── time.repl │ ├── toplevel.repl │ ├── try.repl │ ├── upgrades.repl │ ├── verifier-test.repl │ ├── versions.repl │ ├── webauthn.repl │ ├── yield-rollback.repl │ └── yield.repl ├── sign-scripts │ ├── add-sigs.yaml │ ├── addSigsExpected.yaml │ ├── bare-sig.yaml │ ├── combineSigsExpected.yaml │ ├── key.yaml │ ├── sign-req.yaml │ ├── unsigned-cont.yaml │ └── unsigned-exec.yaml └── test-log │ └── .gitremember └── vendored └── prettyprinter-1.6.0 ├── LICENSE.md └── src └── Data └── Text └── Prettyprint ├── Doc.hs └── Doc ├── Compat.hs ├── Internal.hs ├── Render ├── String.hs ├── Terminal.hs ├── Text.hs └── Util │ ├── Panic.hs │ └── StackMachine.hs └── Symbols └── Ascii.hs /.gitattributes: -------------------------------------------------------------------------------- 1 | *.repl linguist-language=Pact 2 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Pact Bug Report 3 | about: Something specific is going wrong 4 | title: '' 5 | labels: 'status: needs triage, type: bug' 6 | assignees: '' 7 | --- 8 | 9 | ## Issue description 10 | 11 | 14 | 15 | ### Steps to reproduce 16 | 17 | 18 | 19 | ### Expected Behavior 20 | 21 | 22 | 23 | ### Debug Information 24 | 25 | 26 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/enhancement_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Pact Enhancement request 3 | about: I have an idea for how to make Pact better 4 | title: '' 5 | labels: 'status: needs triage, type: enhancement' 6 | assignees: '' 7 | --- 8 | 9 | ## Is your enhancement request related to a problem? Please describe. 10 | 11 | 12 | 13 | ## Describe the solution you'd like 14 | 15 | 16 | 17 | ## Describe alternatives you've considered 18 | 19 | 20 | 21 | ## Additional context 22 | 23 | 24 | -------------------------------------------------------------------------------- /.github/pull_request_template.md: -------------------------------------------------------------------------------- 1 | PR checklist: 2 | 3 | * [ ] Test coverage for the proposed changes 4 | * [ ] PR description contains example output from repl interaction or a snippet from unit test output 5 | * [ ] New builtins have a FV translation 6 | * [ ] Documentation has been (manually) updated at https://docs.kadena.io/pact 7 | * [ ] Any changes that could be relevant to users [have been recorded in the changelog](https://github.com/kadena-io/pact/blob/master/CHANGELOG.md) 8 | * [ ] In case of changes to the Pact trace output (`pact -t`), make sure [pact-lsp](https://github.com/kadena-io/pact-lsp) is in sync. 9 | 10 | Additionally, please justify why you should or should not do the following: 11 | 12 | * [ ] Confirm replay/back compat 13 | * [ ] Benchmark regressions 14 | * [ ] (For Kadena engineers) Run integration-tests against a Chainweb built with this version of Pact 15 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | gas-model-raw-data.csv 2 | gasmodel.sqlite 3 | stack.yaml.lock 4 | .stack-work 5 | /TAGS 6 | /tags 7 | /ctags 8 | /repl.prof 9 | /benchy 10 | .cabal-sandbox 11 | /cabal.sandbox.config 12 | dist 13 | dist-newstyle 14 | docs/en/_build 15 | docs/jp/_build 16 | docs/kr/_build 17 | /web/pact.js 18 | /web/pact.min.js 19 | /web/npm-debug.log 20 | /deleteme.sqllite 21 | log/ 22 | /.pact-history 23 | /result 24 | public 25 | .ghc.environment.* 26 | .dir-locals.el 27 | docs/ko/_build/ 28 | docs/ja/_build/ 29 | *.hie 30 | coverage 31 | .pact-history 32 | */.pact-history 33 | hie.yaml 34 | commands.sqlite 35 | cabal.project.local* 36 | /golden/lcov/actual 37 | .DS_Store 38 | .ghci_history 39 | .direnv/ 40 | .envrc 41 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | stages: 2 | - build 3 | # - deploy 4 | 5 | #pact-macos: 6 | # stage: build 7 | # tags: 8 | # - macos 9 | # script: 10 | # - nix-build 11 | # - nix-build project.nix -A proj.ghc.pact 12 | # - nix-build project.nix -A proj.ghc.pact.doc 13 | # - nix-build project.nix -A proj.ghcjs.pact 14 | # - nix-build project.nix -A proj.ghcjs.pact.doc 15 | # # - ./collectArtifacts.sh macos 16 | # # artifacts: 17 | # # paths: 18 | # # - public-macos/ 19 | 20 | pact-linux: 21 | stage: build 22 | tags: 23 | - linux 24 | script: 25 | - nix-build 26 | - nix-build project.nix -A proj.ghc.pact-do-benchmark 27 | - nix-build project.nix -A proj.ghc.pact.doc 28 | - nix-build project.nix -A proj.ghcjs.pact 29 | - nix-build project.nix -A proj.ghcjs.pact.doc 30 | 31 | # - ./collectArtifacts.sh linux 32 | # artifacts: 33 | # paths: 34 | # - public-linux/ 35 | 36 | # pages: 37 | # stage: deploy 38 | # script: 39 | # - mkdir public 40 | # - mv public-macos public/ 41 | # # - mv public-linux public/ 42 | # artifacts: 43 | # paths: 44 | # - public/ 45 | 46 | # pact-linux-static: 47 | # stage: build 48 | # script: 49 | # - nix-build static.nix --argstr system x86_64-linux 50 | # tags: 51 | # - linux 52 | -------------------------------------------------------------------------------- /.readthedocs.yaml: -------------------------------------------------------------------------------- 1 | # Read the Docs configuration file for Sphinx projects 2 | # See https://docs.readthedocs.io/en/stable/config-file/v2.html for details 3 | 4 | # Required 5 | version: 2 6 | 7 | # Set the OS, Python version and other tools you might need 8 | build: 9 | os: ubuntu-22.04 10 | tools: 11 | python: "3.12" 12 | # You can also specify other tool versions: 13 | # nodejs: "20" 14 | # rust: "1.70" 15 | # golang: "1.20" 16 | 17 | # Build documentation in the "docs/" directory with Sphinx 18 | sphinx: 19 | configuration: docs/en/conf.py 20 | # You can configure Sphinx to use a different builder, for instance use the dirhtml builder for simpler URLs 21 | # builder: "dirhtml" 22 | # Fail on all warnings to avoid broken references 23 | # fail_on_warning: true 24 | 25 | # Optionally build your docs in additional formats such as PDF and ePub 26 | # formats: 27 | # - pdf 28 | # - epub 29 | 30 | # Optional but recommended, declare the Python requirements required 31 | # to build your documentation 32 | # See https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html 33 | # python: 34 | # install: 35 | # - requirements: docs/requirements.txt 36 | -------------------------------------------------------------------------------- /CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @jwiegley @emilypi @jmcardon 2 | /src-ghc/Pact/ApiReq.hs @jwiegley @emilypi @jmcardon 3 | /src-ghc/Pact/Bench.hs @jwiegley @emilypi @jmcardon 4 | /src-ghc/Pact/Coverage.hs @jwiegley @emilypi @jmcardon 5 | /src-ghc/Pact/Coverage/Report.hs @jwiegley @emilypi @jmcardon 6 | /src-ghc/Pact/Interpreter.hs @jwiegley @emilypi @jmcardon 7 | /src/Crypto/Hash/Blake2Native.hs @jwiegley @emilypi @jmcardon 8 | /src/Pact/Compile.hs @jwiegley @emilypi @jmcardon 9 | /src/Pact/Eval.hs @jwiegley @emilypi @jmcardon 10 | /src/Pact/Gas.hs @jwiegley @emilypi @jmcardon 11 | /src/Pact/Native.hs @jwiegley @emilypi @jmcardon 12 | /src/Pact/Native/Capabilities.hs @jwiegley @emilypi @jmcardon 13 | /src/Pact/Native/Db.hs @jwiegley @emilypi @jmcardon 14 | /src/Pact/Native/Ops.hs @jmcardon @jwiegley @emilypi @jmcardon 15 | /src/Pact/Parse.hs @jwiegley @emilypi @jmcardon 16 | /src/Pact/Persist.hs @jwiegley @emilypi @jmcardon 17 | /src/Pact/PersistPactDb.hs @jwiegley @emilypi @jmcardon 18 | /src/Pact/Repl.hs @jwiegley @emilypi @jmcardon 19 | /src/Pact/Repl/Lib.hs @jwiegley @emilypi @jmcardon 20 | /src/Pact/Repl/Types.hs @jwiegley @emilypi @jmcardon 21 | /src/Pact/Runtime/Capabilities.hs @jwiegley @emilypi @jmcardon 22 | /src/Pact/Runtime/Typecheck.hs @jwiegley @emilypi @jmcardon 23 | /src/Pact/Typechecker.hs @jwiegley @emilypi @jmcardon 24 | /src/Pact/Types/API.hs @jwiegley @emilypi @jmcardon 25 | /src/Pact/Types/Advice.hs @jwiegley @emilypi @jmcardon 26 | /src/Pact/Types/Capability.hs @jwiegley @emilypi @jmcardon 27 | /src/Pact/Types/Codec.hs @jwiegley @emilypi @jmcardon 28 | /src/Pact/Types/Command.hs @jwiegley @emilypi @jmcardon 29 | /src/Pact/Types/Continuation.hs @jwiegley @emilypi @jmcardon 30 | /src/Pact/Types/Exp.hs @jwiegley @emilypi @jmcardon 31 | /src/Pact/Types/Hash.hs @jwiegley @emilypi @jmcardon 32 | /src/Pact/Types/Info.hs @jwiegley @emilypi @jmcardon 33 | /src/Pact/Types/KeySet.hs @jwiegley @emilypi @jmcardon 34 | /src/Pact/Types/PactError.hs @jwiegley @emilypi @jmcardon 35 | /src/Pact/Types/PactValue.hs @jwiegley @emilypi @jmcardon 36 | /src/Pact/Types/Parser.hs @jwiegley @emilypi @jmcardon 37 | /src/Pact/Types/Persistence.hs @jwiegley @emilypi @jmcardon 38 | /src/Pact/Types/Purity.hs @jwiegley @emilypi @jmcardon 39 | /src/Pact/Types/RPC.hs @jwiegley @emilypi @jmcardon 40 | /src/Pact/Types/Runtime.hs @jwiegley @emilypi @jmcardon 41 | /src/Pact/Types/Term.hs @jwiegley @emilypi @jmcardon 42 | /src/Pact/Types/Type.hs @jwiegley @emilypi @jmcardon 43 | /src/Pact/Types/Typecheck.hs @jwiegley @emilypi @jmcardon 44 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016-2017, Stuart Popejoy, Will Martino 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | 3. Neither the name of the copyright holder nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 20 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 21 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 22 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 23 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 24 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 25 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 26 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 27 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 28 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | -- -------------------------------------------------------------------------- -- 4 | -- Platform specific locations of external libraries 5 | 6 | if os(darwin) 7 | if arch(aarch64) 8 | package * 9 | extra-include-dirs: 10 | /opt/homebrew/include 11 | /opt/homebrew/opt/openssl/include 12 | extra-lib-dirs: 13 | /opt/homebrew/lib 14 | /opt/homebrew/opt/openssl/lib 15 | else 16 | package * 17 | extra-include-dirs: 18 | /opt/local/include 19 | /usr/local/opt/openssl/include 20 | extra-lib-dirs: 21 | /opt/local/lib 22 | /usr/local/opt/openssl/lib/ 23 | ---------------------------------------------------------------------------------- 24 | 25 | package pact 26 | ghc-options: -Wno-missed-extra-shared-lib 27 | 28 | source-repository-package 29 | type: git 30 | location: https://github.com/kadena-io/pact-json.git 31 | tag: 1d260bfaa48312b54851057885de4c43c420e35f 32 | --sha256: 0fzq4mzaszj5clvixx9mn1x6r4dcrnwvbl2znd0p5mmy5h2jr0hh 33 | 34 | -- temporary upper bounds 35 | constraints: sbv <10 36 | 37 | -- test upper bounds 38 | constraints: hspec-golden <0.2, 39 | 40 | -- These packages are tightly bundled with GHC. The rules ensure that 41 | -- our builds use the version that ships with the GHC version that is 42 | -- used for the build. 43 | -- 44 | allow-newer: *:template-haskell 45 | allow-newer: *:base 46 | allow-newer: *:ghc-prim 47 | 48 | -- Patch merged into master (upcoming verison 10.0). We are currently using 9.2. 49 | -- This fork contains additional fixes for using 9.2 with recent compilers. 50 | source-repository-package 51 | type: git 52 | tag: 1f2d042718fcf9a140398bd3dedac77c207cce27 53 | location: https://github.com/larskuhtz/sbv 54 | --sha256: sha256-Y2ZRU9lkrClYiNc8apwy4uO1TAvJ8JZEPKF73ZuGdlA= 55 | 56 | -- Servant is notoriously forcing outdated upper bounds onto its users. 57 | -- It is usually safe to just ignore those. 58 | -- 59 | allow-newer: servant-server:* 60 | allow-newer: servant-client-core:* 61 | allow-newer: servant-client:* 62 | allow-newer: servant:* 63 | 64 | -- Required by trifecta (e.g. to allow mtl >=2.3) 65 | allow-newer: trifecta:* 66 | 67 | source-repository-package 68 | type: git 69 | location: https://github.com/kadena-io/kadena-ethereum-bridge.git 70 | tag: 3837c4c81f1beaffc1d52375e61576366d49170a 71 | --sha256: 1knhscph2g3saz0pjd1d5a32mr281msapccfrillgd2qk4pj7xjc 72 | 73 | -------------------------------------------------------------------------------- /cbits/musl/__math_divzero.c: -------------------------------------------------------------------------------- 1 | #include "libm.h" 2 | 3 | double __kadena_math_divzero(uint32_t sign) 4 | { 5 | return fp_barrier(sign ? -1.0 : 1.0) / 0.0; 6 | } 7 | -------------------------------------------------------------------------------- /cbits/musl/__math_invalid.c: -------------------------------------------------------------------------------- 1 | #include "libm.h" 2 | 3 | double __kadena_math_invalid(double x) 4 | { 5 | return (x - x) / (x - x); 6 | } 7 | -------------------------------------------------------------------------------- /cbits/musl/__math_oflow.c: -------------------------------------------------------------------------------- 1 | #include "libm.h" 2 | 3 | double __kadena_math_oflow(uint32_t sign) 4 | { 5 | return __kadena_math_xflow(sign, 0x1p769); 6 | } 7 | -------------------------------------------------------------------------------- /cbits/musl/__math_uflow.c: -------------------------------------------------------------------------------- 1 | #include "libm.h" 2 | 3 | double __kadena_math_uflow(uint32_t sign) 4 | { 5 | return __kadena_math_xflow(sign, 0x1p-767); 6 | } 7 | -------------------------------------------------------------------------------- /cbits/musl/__math_xflow.c: -------------------------------------------------------------------------------- 1 | #include "libm.h" 2 | 3 | double __kadena_math_xflow(uint32_t sign, double y) 4 | { 5 | return eval_as_double(fp_barrier(sign ? -y : y) * y); 6 | } 7 | -------------------------------------------------------------------------------- /cbits/musl/endian.h: -------------------------------------------------------------------------------- 1 | #ifndef _ENDIAN_H 2 | #define _ENDIAN_H 3 | 4 | /*#include */ 5 | 6 | #define __NEED_uint16_t 7 | #define __NEED_uint32_t 8 | #define __NEED_uint64_t 9 | 10 | /*#include */ 11 | 12 | #define __PDP_ENDIAN 3412 13 | 14 | #define BIG_ENDIAN __BIG_ENDIAN 15 | #define LITTLE_ENDIAN __LITTLE_ENDIAN 16 | #define PDP_ENDIAN __PDP_ENDIAN 17 | #define BYTE_ORDER __BYTE_ORDER 18 | 19 | static __inline uint16_t __bswap16(uint16_t __x) 20 | { 21 | return __x<<8 | __x>>8; 22 | } 23 | 24 | static __inline uint32_t __bswap32(uint32_t __x) 25 | { 26 | return __x>>24 | __x>>8&0xff00 | __x<<8&0xff0000 | __x<<24; 27 | } 28 | 29 | static __inline uint64_t __bswap64(uint64_t __x) 30 | { 31 | return __bswap32(__x)+0ULL<<32 | __bswap32(__x>>32); 32 | } 33 | 34 | #if __BYTE_ORDER == __LITTLE_ENDIAN 35 | #define htobe16(x) __bswap16(x) 36 | #define be16toh(x) __bswap16(x) 37 | #define htobe32(x) __bswap32(x) 38 | #define be32toh(x) __bswap32(x) 39 | #define htobe64(x) __bswap64(x) 40 | #define be64toh(x) __bswap64(x) 41 | #define htole16(x) (uint16_t)(x) 42 | #define le16toh(x) (uint16_t)(x) 43 | #define htole32(x) (uint32_t)(x) 44 | #define le32toh(x) (uint32_t)(x) 45 | #define htole64(x) (uint64_t)(x) 46 | #define le64toh(x) (uint64_t)(x) 47 | #else 48 | #define htobe16(x) (uint16_t)(x) 49 | #define be16toh(x) (uint16_t)(x) 50 | #define htobe32(x) (uint32_t)(x) 51 | #define be32toh(x) (uint32_t)(x) 52 | #define htobe64(x) (uint64_t)(x) 53 | #define be64toh(x) (uint64_t)(x) 54 | #define htole16(x) __bswap16(x) 55 | #define le16toh(x) __bswap16(x) 56 | #define htole32(x) __bswap32(x) 57 | #define le32toh(x) __bswap32(x) 58 | #define htole64(x) __bswap64(x) 59 | #define le64toh(x) __bswap64(x) 60 | #endif 61 | 62 | #if defined(_GNU_SOURCE) || defined(_BSD_SOURCE) 63 | #if __BYTE_ORDER == __LITTLE_ENDIAN 64 | #define betoh16(x) __bswap16(x) 65 | #define betoh32(x) __bswap32(x) 66 | #define betoh64(x) __bswap64(x) 67 | #define letoh16(x) (uint16_t)(x) 68 | #define letoh32(x) (uint32_t)(x) 69 | #define letoh64(x) (uint64_t)(x) 70 | #else 71 | #define betoh16(x) (uint16_t)(x) 72 | #define betoh32(x) (uint32_t)(x) 73 | #define betoh64(x) (uint64_t)(x) 74 | #define letoh16(x) __bswap16(x) 75 | #define letoh32(x) __bswap32(x) 76 | #define letoh64(x) __bswap64(x) 77 | #endif 78 | #endif 79 | 80 | #endif 81 | -------------------------------------------------------------------------------- /cbits/musl/exp_data.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Arm Limited. 3 | * SPDX-License-Identifier: MIT 4 | */ 5 | #ifndef _EXP_DATA_H 6 | #define _EXP_DATA_H 7 | 8 | /*#include */ 9 | #include 10 | 11 | #define EXP_TABLE_BITS 7 12 | #define EXP_POLY_ORDER 5 13 | #define EXP_USE_TOINT_NARROW 0 14 | #define EXP2_POLY_ORDER 5 15 | extern const struct exp_data { 16 | double invln2N; 17 | double shift; 18 | double negln2hiN; 19 | double negln2loN; 20 | double poly[4]; /* Last four coefficients. */ 21 | double exp2_shift; 22 | double exp2_poly[EXP2_POLY_ORDER]; 23 | uint64_t tab[2*(1 << EXP_TABLE_BITS)]; 24 | } __kadena_exp_data; 25 | 26 | #endif 27 | -------------------------------------------------------------------------------- /cbits/musl/log_data.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Arm Limited. 3 | * SPDX-License-Identifier: MIT 4 | */ 5 | #ifndef _LOG_DATA_H 6 | #define _LOG_DATA_H 7 | 8 | /* #include */ 9 | 10 | #define LOG_TABLE_BITS 7 11 | #define LOG_POLY_ORDER 6 12 | #define LOG_POLY1_ORDER 12 13 | extern const struct log_data { 14 | double ln2hi; 15 | double ln2lo; 16 | double poly[LOG_POLY_ORDER - 1]; /* First coefficient is 1. */ 17 | double poly1[LOG_POLY1_ORDER - 1]; 18 | struct { 19 | double invc, logc; 20 | } tab[1 << LOG_TABLE_BITS]; 21 | #if !__FP_FAST_FMA 22 | struct { 23 | double chi, clo; 24 | } tab2[1 << LOG_TABLE_BITS]; 25 | #endif 26 | } __kadena_log_data; 27 | 28 | #endif 29 | -------------------------------------------------------------------------------- /cbits/musl/pow_data.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Arm Limited. 3 | * SPDX-License-Identifier: MIT 4 | */ 5 | #ifndef _POW_DATA_H 6 | #define _POW_DATA_H 7 | 8 | /*#include */ 9 | 10 | #define POW_LOG_TABLE_BITS 7 11 | #define POW_LOG_POLY_ORDER 8 12 | extern const struct pow_log_data { 13 | double ln2hi; 14 | double ln2lo; 15 | double poly[POW_LOG_POLY_ORDER - 1]; /* First coefficient is 1. */ 16 | /* Note: the pad field is unused, but allows slightly faster indexing. */ 17 | struct { 18 | double invc, pad, logc, logctail; 19 | } tab[1 << POW_LOG_TABLE_BITS]; 20 | } __kadena_pow_log_data; 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /cbits/musl/sqrt_data.c: -------------------------------------------------------------------------------- 1 | #include "sqrt_data.h" 2 | const uint16_t __kadena_rsqrt_tab[128] = { 3 | 0xb451,0xb2f0,0xb196,0xb044,0xaef9,0xadb6,0xac79,0xab43, 4 | 0xaa14,0xa8eb,0xa7c8,0xa6aa,0xa592,0xa480,0xa373,0xa26b, 5 | 0xa168,0xa06a,0x9f70,0x9e7b,0x9d8a,0x9c9d,0x9bb5,0x9ad1, 6 | 0x99f0,0x9913,0x983a,0x9765,0x9693,0x95c4,0x94f8,0x9430, 7 | 0x936b,0x92a9,0x91ea,0x912e,0x9075,0x8fbe,0x8f0a,0x8e59, 8 | 0x8daa,0x8cfe,0x8c54,0x8bac,0x8b07,0x8a64,0x89c4,0x8925, 9 | 0x8889,0x87ee,0x8756,0x86c0,0x862b,0x8599,0x8508,0x8479, 10 | 0x83ec,0x8361,0x82d8,0x8250,0x81c9,0x8145,0x80c2,0x8040, 11 | 0xff02,0xfd0e,0xfb25,0xf947,0xf773,0xf5aa,0xf3ea,0xf234, 12 | 0xf087,0xeee3,0xed47,0xebb3,0xea27,0xe8a3,0xe727,0xe5b2, 13 | 0xe443,0xe2dc,0xe17a,0xe020,0xdecb,0xdd7d,0xdc34,0xdaf1, 14 | 0xd9b3,0xd87b,0xd748,0xd61a,0xd4f1,0xd3cd,0xd2ad,0xd192, 15 | 0xd07b,0xcf69,0xce5b,0xcd51,0xcc4a,0xcb48,0xca4a,0xc94f, 16 | 0xc858,0xc764,0xc674,0xc587,0xc49d,0xc3b7,0xc2d4,0xc1f4, 17 | 0xc116,0xc03c,0xbf65,0xbe90,0xbdbe,0xbcef,0xbc23,0xbb59, 18 | 0xba91,0xb9cc,0xb90a,0xb84a,0xb78c,0xb6d0,0xb617,0xb560, 19 | }; 20 | -------------------------------------------------------------------------------- /cbits/musl/sqrt_data.h: -------------------------------------------------------------------------------- 1 | #ifndef _SQRT_DATA_H 2 | #define _SQRT_DATA_H 3 | 4 | /* #include */ 5 | #include 6 | 7 | /* if x in [1,2): i = (int)(64*x); 8 | if x in [2,4): i = (int)(32*x-64); 9 | __kadena_rsqrt_tab[i]*2^-16 is estimating 1/sqrt(x) with small relative error: 10 | |__kadena_rsqrt_tab[i]*0x1p-16*sqrt(x) - 1| < -0x1.fdp-9 < 2^-8 */ 11 | extern const uint16_t __kadena_rsqrt_tab[128]; 12 | 13 | #endif 14 | -------------------------------------------------------------------------------- /collectArtifacts.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | # Creates artifacts to be captured by GitLab CI 4 | 5 | if [ ! -d result ] ; then nix-build ; fi 6 | if [ ! -d result-doc ] ; then nix-build -A ghc.pact.doc ; fi 7 | 8 | pubdir="public-$1" 9 | binary="pact-$1" 10 | 11 | rm -fr $pubdir 12 | mkdir -p $pubdir 13 | cp -LR result/ghc/pact/share/hpc/vanilla/html $pubdir/code-coverage 14 | mkdir -p $pubdir/docs 15 | cp -LR `find result-doc/share -name html`/* $pubdir/docs 16 | mkdir -p $pubdir/binaries 17 | cp -LR result/ghc/pact/bin/pact $pubdir/binaries/$binary 18 | chmod -R u+w $pubdir 19 | -------------------------------------------------------------------------------- /config.yaml: -------------------------------------------------------------------------------- 1 | # Config file for pact http server. Launch with `pact -s config.yaml` 2 | 3 | # HTTP server port 4 | port: 8080 5 | 6 | # directory for HTTP logs 7 | logDir: log 8 | 9 | # persistence directory 10 | persistDir: log 11 | 12 | # SQLite pragmas for pact back-end 13 | pragmas: [] 14 | 15 | # verbose: provide log output 16 | verbose: True 17 | -------------------------------------------------------------------------------- /dep/kpkgs/default.nix: -------------------------------------------------------------------------------- 1 | # DO NOT HAND-EDIT THIS FILE 2 | import (import ./thunk.nix) -------------------------------------------------------------------------------- /dep/kpkgs/github.json: -------------------------------------------------------------------------------- 1 | { 2 | "owner": "kadena-io", 3 | "repo": "kpkgs", 4 | "branch": "master", 5 | "private": false, 6 | "rev": "905ac27a05db959db3ce27c4f258310746a9f12b", 7 | "sha256": "0mw6zsxkc93pqravvjmjiaq3bhydfabkvh12wbndj2jgv3i4z3qx" 8 | } 9 | -------------------------------------------------------------------------------- /dep/kpkgs/thunk.nix: -------------------------------------------------------------------------------- 1 | # DO NOT HAND-EDIT THIS FILE 2 | let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: 3 | if !fetchSubmodules && !private then builtins.fetchTarball { 4 | url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; 5 | } else (import {}).fetchFromGitHub { 6 | inherit owner repo rev sha256 fetchSubmodules private; 7 | }; 8 | json = builtins.fromJSON (builtins.readFile ./github.json); 9 | in fetch json -------------------------------------------------------------------------------- /docs/en/img: -------------------------------------------------------------------------------- 1 | ../img -------------------------------------------------------------------------------- /docs/en/index.rst: -------------------------------------------------------------------------------- 1 | .. Pact Language Reference documentation master file, created by 2 | sphinx-quickstart on Fri Oct 21 22:13:51 2016. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Pact Language Reference 7 | =================================================== 8 | 9 | Contents: 10 | 11 | .. toctree:: 12 | :maxdepth: 3 13 | 14 | pact-reference 15 | 16 | pact-functions 17 | 18 | pact-properties 19 | 20 | pact-properties-api 21 | -------------------------------------------------------------------------------- /docs/img/kadena-logo-100px.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/pact/d4f03045df6ba5178a76e534d619b6233ad1c659/docs/img/kadena-logo-100px.png -------------------------------------------------------------------------------- /docs/img/kadena-logo-210px.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/pact/d4f03045df6ba5178a76e534d619b6233ad1c659/docs/img/kadena-logo-210px.png -------------------------------------------------------------------------------- /docs/img/kadena-logo-trans.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/pact/d4f03045df6ba5178a76e534d619b6233ad1c659/docs/img/kadena-logo-trans.gif -------------------------------------------------------------------------------- /docs/img/kadena-logomark-green.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/pact/d4f03045df6ba5178a76e534d619b6233ad1c659/docs/img/kadena-logomark-green.png -------------------------------------------------------------------------------- /docs/ja/img: -------------------------------------------------------------------------------- 1 | ../img -------------------------------------------------------------------------------- /docs/ja/index.rst: -------------------------------------------------------------------------------- 1 | .. Pact Language Reference documentation master file, created by 2 | sphinx-quickstart on Fri Oct 21 22:13:51 2016. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Pact スマート コントラクト言語リファレンス 7 | =================================================== 8 | 9 | Contents: 10 | 11 | .. toctree:: 12 | :maxdepth: 3 13 | 14 | pact-reference 15 | -------------------------------------------------------------------------------- /docs/ko/img: -------------------------------------------------------------------------------- 1 | ../img -------------------------------------------------------------------------------- /docs/ko/index.rst: -------------------------------------------------------------------------------- 1 | .. Pact Language Reference documentation master file, created by 2 | sphinx-quickstart on Fri Oct 21 22:13:51 2016. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Pact 스마트 컨트랙트 언어 레퍼런스 7 | =================================================== 8 | 9 | Contents: 10 | 11 | .. toctree:: 12 | :maxdepth: 3 13 | 14 | pact-reference 15 | -------------------------------------------------------------------------------- /docs/pandoc.css: -------------------------------------------------------------------------------- 1 | body { 2 | margin: auto; 3 | padding-right: 10px; 4 | color: black; 5 | font-family: Helvetica,Verdana, sans-serif; 6 | font-size: 100%; 7 | line-height: 140%; 8 | color: #333; 9 | } 10 | pre { 11 | border: 1px dotted gray; 12 | background-color: #ececec; 13 | color: #1111111; 14 | padding: 0.5em; 15 | } 16 | code { 17 | font-family: monospace; 18 | } 19 | h1 a, h2 a, h3 a, h4 a, h5 a { 20 | text-decoration: none; 21 | color: #222222; 22 | } 23 | ul { 24 | padding-left: 15px; 25 | } 26 | h1, h2, h3, h4, h5 { font-family: Futura,Helvetica,Verdana,sans-serif; 27 | font-weight: bold; 28 | color: #222222; } 29 | h1 { 30 | margin-top: 100px; 31 | font-size: 180%; 32 | } 33 | 34 | h2 { 35 | font-size: 110%; 36 | border-bottom: 1px dotted black; 37 | } 38 | 39 | h2.author { 40 | border-bottom:none; 41 | } 42 | 43 | h3 { 44 | font-size: 95%; 45 | } 46 | 47 | h4 { 48 | font-size: 90%; 49 | font-style: italic; 50 | } 51 | 52 | h5 { 53 | font-size: 90%; 54 | font-style: italic; 55 | } 56 | 57 | h1.title { 58 | font-size: 200%; 59 | font-weight: bold; 60 | padding-top: 0.2em; 61 | padding-bottom: 0.2em; 62 | text-align: left; 63 | border: none; 64 | } 65 | 66 | dt code { 67 | font-weight: bold; 68 | } 69 | dd p { 70 | margin-top: 0; 71 | } 72 | 73 | #footer { 74 | padding-top: 1em; 75 | font-size: 70%; 76 | color: gray; 77 | text-align: center; 78 | } 79 | 80 | 81 | .author { 82 | padding-right: 20px; 83 | font-style: italic; 84 | font-size: 80%; 85 | } 86 | 87 | .date { 88 | font-size: 80%; 89 | } 90 | 91 | #content, #header { 92 | margin-left: 10px; 93 | } 94 | 95 | #TOC { 96 | position: relative; 97 | width: auto; 98 | overflow: auto; 99 | height: auto; 100 | margin-left: 10px; 101 | } 102 | 103 | #TOC li { 104 | font-size: 95%; 105 | } 106 | 107 | #tocfrontmatter { 108 | display: none; 109 | } 110 | 111 | #smalllogo { 112 | display: block; 113 | padding-top: 20px; 114 | } 115 | 116 | 117 | @media (min-width: 992px) { 118 | 119 | #smalllogo { 120 | display: none; 121 | } 122 | body { 123 | padding-left: 10px; 124 | } 125 | 126 | #content, #header { 127 | margin-left: 300px; 128 | } 129 | 130 | #TOC { 131 | width: 250px; 132 | position: fixed; 133 | top: 10px; 134 | left: 10px; 135 | position: fixed; 136 | overflow: scroll; 137 | height: 100vh; 138 | margin-left: 10px; 139 | } 140 | #tocfrontmatter { 141 | display: block; 142 | } 143 | 144 | 145 | } 146 | -------------------------------------------------------------------------------- /docs/template.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | $for(author-meta)$ 8 | 9 | $endfor$ 10 | $if(date-meta)$ 11 | 12 | $endif$ 13 | $if(keywords)$ 14 | 15 | $endif$ 16 | $if(title-prefix)$$title-prefix$ – $endif$$pagetitle$ 17 | 18 | $if(quotes)$ 19 | 20 | $endif$ 21 | $if(highlighting-css)$ 22 | 25 | $endif$ 26 | $for(css)$ 27 | 28 | $endfor$ 29 | $if(math)$ 30 | $math$ 31 | $endif$ 32 | $for(header-includes)$ 33 | $header-includes$ 34 | $endfor$ 35 | 36 | 37 | $for(include-before)$ 38 | $include-before$ 39 | $endfor$ 40 |
41 | 42 | $if(title)$ 43 |

$title$

44 | $if(subtitle)$ 45 |

$subtitle$

46 | $endif$ 47 | $if(date)$ 48 |

$date$

49 | $endif$ 50 |
51 | $endif$ 52 | $if(toc)$ 53 |
54 |
55 | 56 |

Pact Language Reference

57 | $if(date)$ 58 |

$date$

59 | $endif$ 60 |
61 | $toc$ 62 |
63 | $endif$ 64 |
65 | $body$ 66 |
67 | $for(include-after)$ 68 | $include-after$ 69 | $endfor$ 70 | 71 | 72 | -------------------------------------------------------------------------------- /docs/work.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # --- English Docs --- # 4 | cd en/ 5 | rm -rf _build 6 | 7 | pandoc -s -t rst pact-reference.md -o pact-reference.rst 8 | pandoc -s -t rst pact-functions.md -o pact-functions.rst 9 | pandoc -s -t rst pact-properties.md -o pact-properties.rst 10 | pandoc -s -t rst pact-properties-api.md -o pact-properties-api.rst 11 | 12 | # escape +, - headings 13 | perl -p0777i -e 's/^(\+|\-)\n~/\\\1\n~~/gm' pact-reference.rst 14 | perl -p0777i -e 's/^(\+|\-)\n~/\\\1\n~~/gm' pact-functions.rst 15 | perl -p0777i -e 's/^(\+|\-)\n~/\\\1\n~~/gm' pact-properties-api.rst 16 | 17 | sphinx-build -b html -d _build/doctrees . _build/html 18 | 19 | # --- Japanese Docs --- # 20 | # cd .. 21 | # cd ja/ 22 | # rm -rf _build 23 | 24 | # pandoc -s -t rst pact-reference.md -o pact-reference.rst 25 | # perl -p0777i -e 's/^(\+|\-)\n~/\\\1\n~~/gm' pact-reference.rst 26 | # sphinx-build -b html -d _build/doctrees . _build/html 27 | 28 | # --- Korean Docs --- # 29 | # cd .. 30 | # cd ko/ 31 | # rm -rf _build 32 | 33 | # pandoc -s -t rst pact-reference.md -o pact-reference.rst 34 | # perl -p0777i -e 's/^(\+|\-)\n~/\\\1\n~~/gm' pact-reference.rst 35 | # sphinx-build -b html -d _build/doctrees . _build/html 36 | -------------------------------------------------------------------------------- /examples/accounts/scripts/01-system.yaml: -------------------------------------------------------------------------------- 1 | # Provides mock system module for 'accounts' 2 | code: |- 3 | (define-keyset 'k (read-keyset "accounts-admin-keyset")) 4 | (module system 'k 5 | (defun get-system-time () 6 | (time "2017-10-31T12:00:00Z"))) 7 | (get-system-time) 8 | data: 9 | accounts-admin-keyset: ["ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d"] 10 | keyPairs: 11 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 12 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 13 | nonce: step01 14 | -------------------------------------------------------------------------------- /examples/accounts/scripts/02-accounts.yaml: -------------------------------------------------------------------------------- 1 | # To use, first load mock system module, then load accounts. 2 | # Command line: 3 | # $ pact -a examples/accounts/mock-system.yaml | curl -d @- http://localhost:8080/api/v1/send 4 | # $ pact -a examples/accounts/accounts.yaml | curl -d @- http://localhost:8080/api/v1/send 5 | 6 | 7 | codeFile: ../accounts.pact 8 | data: 9 | accounts-admin-keyset: ["ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d"] 10 | keyPairs: 11 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 12 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 13 | nonce: step02 14 | -------------------------------------------------------------------------------- /examples/accounts/scripts/03-create.yaml: -------------------------------------------------------------------------------- 1 | # Provides mock system module for 'accounts' 2 | 3 | code: |- 4 | (use accounts) 5 | (use system) 6 | (create-account "Alice" (read-keyset "alice-keyset") "USD" (get-system-time)) 7 | (create-account "Bob" (read-keyset "bob-keyset") "USD" (get-system-time)) 8 | (fund-account "Alice" 100.0 (get-system-time)) 9 | (read-all) 10 | data: 11 | alice-keyset: ["7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804"] 12 | bob-keyset: ["ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9"] 13 | keyPairs: 14 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 15 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 16 | nonce: step03 17 | -------------------------------------------------------------------------------- /examples/accounts/scripts/04-alice.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (use accounts) 3 | (transfer "Alice" "Bob" 12.50 (system.get-system-time)) 4 | (read-account-user "Alice") 5 | keyPairs: 6 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 7 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 8 | nonce: step04 9 | -------------------------------------------------------------------------------- /examples/accounts/scripts/05-bob.yaml: -------------------------------------------------------------------------------- 1 | 2 | code: |- 3 | (let ((bob-bal (at 'balance (accounts.read-account-user "Bob")))) 4 | (enforce (= 12.50 bob-bal) "Bob got paid 12.50")) 5 | keyPairs: 6 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 7 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 8 | nonce: step05 9 | -------------------------------------------------------------------------------- /examples/accounts/scripts/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | JSON="Content-Type: application/json" 6 | 7 | 8 | 9 | echo ""; echo "Step 1"; echo "" 10 | pact -a examples/accounts/scripts/01-system.yaml | curl -H "$JSON" -d @- http://localhost:8080/api/v1/send 11 | sleep 1; echo "" 12 | curl -H "$JSON" -d '{"requestKeys":["zaqnRQ0RYzxTccjtYoBvQsDo5K9mxr4TEF-HIYTi5Jo"]}' -X POST http://localhost:8080/api/v1/poll 13 | 14 | echo ""; echo "Step 2"; echo "" 15 | pact -a examples/accounts/scripts/02-accounts.yaml | curl -H "$JSON" -d @- http://localhost:8080/api/v1/send 16 | sleep 1; echo "" 17 | curl -H "$JSON" -d '{"requestKeys":["gx60LXLVcNlSQ4XkJUgqwqdZZ-RyaPymVVpWMspAf-Y"]}' -X POST http://localhost:8080/api/v1/poll 18 | 19 | echo ""; echo "Step 3"; echo "" 20 | pact -a examples/accounts/scripts/03-create.yaml | curl -H "$JSON" -d @- http://localhost:8080/api/v1/send 21 | sleep 1; echo "" 22 | curl -H "$JSON" -d '{"requestKeys":["CgjWWeA3MBmf3GIyop2CPU7ndhPuxnXFtcGm7-STMUo"]}' -X POST http://localhost:8080/api/v1/poll 23 | 24 | echo ""; echo "Step 4"; echo "" 25 | pact -a examples/accounts/scripts/04-alice.yaml | curl -H "$JSON" -d @- http://localhost:8080/api/v1/send 26 | sleep 1; echo "" 27 | curl -H "$JSON" -d '{"requestKeys":["r5L96DVwNKANAedHArQoJc9oxF3hf_EftopCsoaCuuY"]}' -X POST http://localhost:8080/api/v1/poll 28 | 29 | echo ""; echo "Step 5"; echo "" 30 | pact -l -a examples/accounts/scripts/05-bob.yaml | curl -H "$JSON" -d @- http://localhost:8080/api/v1/local 31 | echo "" 32 | -------------------------------------------------------------------------------- /examples/cp/auth.pact: -------------------------------------------------------------------------------- 1 | (define-keyset 'module-admin 2 | (read-keyset "module-admin-keyset")) 3 | (define-keyset 'operate-admin 4 | (read-keyset "module-operate-keyset")) 5 | 6 | (module mpid 'module-admin 7 | 8 | (defschema mpid 9 | keyset:keyset 10 | ) 11 | (deftable mpids:{mpid}) 12 | 13 | 14 | (defun create-mpid (id keyset) 15 | (enforce-keyset 'operate-admin) 16 | (insert mpids id { 17 | "keyset": keyset 18 | }) 19 | ) 20 | 21 | (defun enforce-mpid-auth (id) 22 | "Enforce keyset for market participant ID, and return keyset" 23 | (with-read mpids id { "keyset":= k } 24 | (enforce-keyset k) 25 | k) 26 | ) 27 | 28 | ) 29 | 30 | (create-table mpids) 31 | -------------------------------------------------------------------------------- /examples/cp/cash.pact: -------------------------------------------------------------------------------- 1 | (module cash 'module-admin 2 | 3 | (defschema entry 4 | ccy:string 5 | balance:decimal 6 | change:decimal 7 | date:time 8 | keyset:keyset) 9 | 10 | (deftable cash:{entry}) 11 | 12 | (defun debit (id amount date) 13 | "Debit ID for AMOUNT, checking balance for available funds" 14 | (with-read cash id { "balance":= balance, "keyset" := ks} 15 | (enforce-keyset ks) 16 | (enforce (>= balance amount) "Insufficient funds") 17 | (update cash id { 18 | "balance": (- balance amount), 19 | "change": (- amount), 20 | "date": date 21 | })) 22 | ) 23 | 24 | (defun credit (id amount date) 25 | "Credit ID with AMOUNT" 26 | (with-read cash id { "balance" := balance} 27 | (update cash id { 28 | "balance": (+ balance amount), 29 | "change": amount, 30 | "date": date 31 | }) 32 | ) 33 | ) 34 | 35 | (defun make-payment (payor payee amount date) 36 | "Debit PAYOR and credit PAYEE AMOUNT" 37 | (debit payor amount date) 38 | (credit payee amount date)) 39 | 40 | (defun create-account (id ccy amount date ks) 41 | "Create account ID for CCY and fund with AMOUNT" 42 | (enforce-keyset 'operate-admin) 43 | (insert cash id { 44 | "ccy": ccy, 45 | "balance": amount, 46 | "change": amount, 47 | "date": date, 48 | "keyset": ks }) 49 | ) 50 | 51 | (defun read-account (id) (read cash id)) 52 | 53 | ) 54 | 55 | 56 | (create-table cash) 57 | -------------------------------------------------------------------------------- /examples/cp/orders.pact: -------------------------------------------------------------------------------- 1 | (module orders 'module-admin 2 | 3 | (use mpid) 4 | 5 | (defschema order 6 | cusip:string 7 | buyer:string 8 | seller:string 9 | price:decimal 10 | qty:integer 11 | ccy:string 12 | order-date:time 13 | status:string 14 | modify-date:time) 15 | 16 | (deftable orders:{order}) 17 | 18 | (defconst ORDER_NEW "NEW") 19 | (defconst ORDER_FILLED "FILLED") 20 | (defconst ORDER_CANCELED "CANCELED") 21 | (defconst ORDER_PAID "PAID") 22 | 23 | (defun new-order (order-id cusip buyer seller qty price ccy date) 24 | "Create new order ORDER-ID" 25 | (enforce-mpid-auth buyer) 26 | (insert orders order-id { 27 | "cusip": cusip, 28 | "buyer": buyer, 29 | "seller": seller, 30 | "price": price, 31 | "qty": qty, 32 | "ccy": ccy, 33 | "order-date": date, 34 | "status": ORDER_NEW, 35 | "modify-date": date 36 | })) 37 | 38 | (defun read-order:object{order} (order-id) (read orders order-id)) 39 | 40 | (defun update-order-status (order-id status date) 41 | (enforce (or (= ORDER_NEW status) 42 | (or (= ORDER_FILLED status) 43 | (or (= ORDER_CANCELED status) 44 | (= ORDER_PAID status)))) 45 | "Invalid status") 46 | (update orders order-id 47 | { "status": status , "modify-date": date }) 48 | 49 | ) 50 | 51 | (defun with-order-status:object{order} (order-id status) 52 | "Check that order status is correct, returning details" 53 | (let ((o (read orders order-id))) 54 | (enforce (= (at 'status o) status) 55 | (format "order must be {}" [status])) 56 | o) 57 | ) 58 | 59 | (defun with-order:object{order} (order-id) 60 | "Get order details" 61 | (read orders order-id) 62 | ) 63 | 64 | (defun cancel-order (order-id date) 65 | (with-read orders order-id {"status" := status } 66 | (enforce (= ORDER_NEW status) "only NEW orders can be canceled") 67 | (update-order-status order-id ORDER_CANCELED date)) 68 | ) 69 | 70 | ) 71 | 72 | 73 | (create-table orders) 74 | -------------------------------------------------------------------------------- /examples/cp/scripts/01-auth.yaml: -------------------------------------------------------------------------------- 1 | data: 2 | module-admin-keyset: ["06c9c56daa8a068e1f19f5578cdf1797b047252e1ef0eb4a1809aa3c2226f61e"] 3 | module-operate-keyset: ["acda99515bb9a27e054898e1632626db92a5379d3e62867a60eaba783e017fe0"] 4 | codeFile: auth.pact 5 | keyPairs: 6 | - public: 06c9c56daa8a068e1f19f5578cdf1797b047252e1ef0eb4a1809aa3c2226f61e 7 | secret: 7ce4bae38fccfe33b6344b8c260bffa21df085cf033b3dc99b4781b550e1e922 8 | - public: acda99515bb9a27e054898e1632626db92a5379d3e62867a60eaba783e017fe0 9 | secret: f894d9adb39cdb525ac1707ebedf2a1f401c21f2f2709e4ebafc4af72a18094e 10 | -------------------------------------------------------------------------------- /examples/cp/scripts/02-cash.yaml: -------------------------------------------------------------------------------- 1 | codeFile: cash.pact 2 | keyPairs: 3 | - public: 06c9c56daa8a068e1f19f5578cdf1797b047252e1ef0eb4a1809aa3c2226f61e 4 | secret: 7ce4bae38fccfe33b6344b8c260bffa21df085cf033b3dc99b4781b550e1e922 5 | -------------------------------------------------------------------------------- /examples/cp/scripts/03-orders.yaml: -------------------------------------------------------------------------------- 1 | codeFile: orders.pact 2 | keyPairs: 3 | - public: 06c9c56daa8a068e1f19f5578cdf1797b047252e1ef0eb4a1809aa3c2226f61e 4 | secret: 7ce4bae38fccfe33b6344b8c260bffa21df085cf033b3dc99b4781b550e1e922 5 | -------------------------------------------------------------------------------- /examples/cp/scripts/04-cp.yaml: -------------------------------------------------------------------------------- 1 | codeFile: cp.pact 2 | keyPairs: 3 | - public: 06c9c56daa8a068e1f19f5578cdf1797b047252e1ef0eb4a1809aa3c2226f61e 4 | secret: 7ce4bae38fccfe33b6344b8c260bffa21df085cf033b3dc99b4781b550e1e922 5 | -------------------------------------------------------------------------------- /examples/cp/scripts/05-create.yaml: -------------------------------------------------------------------------------- 1 | data: 2 | "agent-keyset": ["f880a433d6e2a13a32b6169030f56245efdd8c1b8a5027e9ce98a88e886bef27"] 3 | "trader-keyset": ["b4abc21dc4545e4edab0be77945b814ed4e6707e7546bee925a4ed0630caa463"] 4 | code: |- 5 | (let ((t1 (time "2016-09-01T11:00:00Z"))) 6 | (cash.create-account "agent" "USD" 0.0 t1 (read-keyset "agent-keyset")) 7 | (cash.create-account "trader" "USD" 100000.0 t1 (read-keyset "trader-keyset")) 8 | (cp.create-mpid "agent" (read-keyset "agent-keyset")) 9 | (cp.create-mpid "trader" (read-keyset "trader-keyset"))) 10 | keyPairs: 11 | - public: acda99515bb9a27e054898e1632626db92a5379d3e62867a60eaba783e017fe0 12 | secret: f894d9adb39cdb525ac1707ebedf2a1f401c21f2f2709e4ebafc4af72a18094e 13 | -------------------------------------------------------------------------------- /examples/cp/scripts/agent-keyset.yaml: -------------------------------------------------------------------------------- 1 | keyPairs: 2 | - public: f880a433d6e2a13a32b6169030f56245efdd8c1b8a5027e9ce98a88e886bef27 3 | secret: 784fba9e74dfcb3ea27319ff564605cd91ee48ae554cf6bc6f56db58d7df2edd 4 | -------------------------------------------------------------------------------- /examples/cp/scripts/load.cmds: -------------------------------------------------------------------------------- 1 | load demo/cp/01-auth.yaml 2 | load demo/cp/02-cash.yaml 3 | load demo/cp/03-orders.yaml 4 | load demo/cp/04-cp.yaml 5 | load demo/cp/05-create.yaml -------------------------------------------------------------------------------- /examples/cp/scripts/trader-keyset.yaml: -------------------------------------------------------------------------------- 1 | keyPairs: 2 | - public: b4abc21dc4545e4edab0be77945b814ed4e6707e7546bee925a4ed0630caa463 3 | secret: b0c3023e769260a7e29ab8a827483f092fcb2e606894f51c60e6ab32a71ae849 4 | -------------------------------------------------------------------------------- /examples/verified-accounts/accounts.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ["DisablePact44"]) 2 | (env-keys ["accountadmin" "user123" "user456"]) 3 | (env-data { "accounts-admin-keyset": ["accountadmin"] }) 4 | (begin-tx) 5 | (load "accounts.pact") 6 | (commit-tx) 7 | (verify 'accounts) 8 | (use accounts) 9 | (create-account "joel" "USD") 10 | (create-account "brian" "USD") 11 | (fund-account "joel" 50.0) 12 | (fund-account "brian" 50.0) 13 | (transfer "joel" "brian" 1.0) 14 | -------------------------------------------------------------------------------- /executables/Bench.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Pact.Bench as Bench 4 | 5 | main :: IO () 6 | main = Bench.main 7 | -------------------------------------------------------------------------------- /executables/GasModel.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Pact.GasModel.GasModel as GasModel 4 | 5 | main :: IO () 6 | main = GasModel.main 7 | -------------------------------------------------------------------------------- /executables/Repl.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright : (C) 2016 Stuart Popejoy 3 | -- License : BSD-style (see the file LICENSE) 4 | -- 5 | 6 | module Main where 7 | 8 | import qualified Pact.Main as Repl 9 | 10 | main :: IO () 11 | main = Repl.main 12 | -------------------------------------------------------------------------------- /gas-prices.csv: -------------------------------------------------------------------------------- 1 | Purpose: Calculate the gas price of Pact native functions using a data-driven model 2 | Number of cores available for benchmarks: 1 3 | Operating System: Linux/NixOS 4 | More inforamtion on hardware used: AWS t2.xlarge, x86_64, 4 CPU cores, 16GB Memory 5 | "Implementation: For every native function, executes and benchmarks (using Criterion) simple examples of said function." 6 | Number of iterations: Each function's tests are run three times against each backend type and averaged. 7 | Benchmark backend(s): [Sqlite db with `fastNoJournalPragmas`] 8 | "From benchmark to a native function's price: For every backend type, all of the means of the function's benchmark examples are converted into nanoseconds, averaged together, divided by 2500.0, and rounded up to the nearest integer.Only the benchmark averages of the simple function tests are used when calculating the function's price." 9 | , 10 | function,gas price (2500.0 ns) 11 | !=,2 12 | &,1 13 | *,3 14 | +,1 15 | -,1 16 | /,3 17 | <,2 18 | <=,2 19 | =,2 20 | >,2 21 | >=,2 22 | ^,4 23 | abs,1 24 | add-time,3 25 | and,1 26 | and?,1 27 | at,2 28 | base64-decode,1 29 | base64-encode,1 30 | bind,4 31 | ceiling,1 32 | chain-data,1 33 | compose,1 34 | compose-capability,2 35 | constantly,1 36 | contains,2 37 | create-module-guard,1 38 | create-pact-guard,1 39 | create-table,15 40 | create-user-guard,1 41 | days,4 42 | decrypt-cc20p1305,33 43 | define-keyset,20 44 | define-namespace,25 45 | describe-keyset,7 46 | describe-module,10 47 | describe-table,3 48 | diff-time,8 49 | drop,3 50 | enforce,1 51 | enforce-guard,8 52 | enforce-keyset,8 53 | enforce-one,6 54 | enforce-pact-version,0 55 | exp,5 56 | filter,3 57 | floor,1 58 | fold,3 59 | format,4 60 | format-time,4 61 | hash,5 62 | hours,4 63 | identity,2 64 | if,1 65 | insert,21 66 | install-capability,3 67 | int-to-str,1 68 | interface,33 69 | is-charset,1 70 | keylog,11 71 | keys,10 72 | keys-2,1 73 | keys-all,1 74 | keys-any,1 75 | keyset-ref-guard,7 76 | length,1 77 | list-modules,8 78 | ln,6 79 | log,3 80 | make-list,1 81 | map,4 82 | minutes,4 83 | mod,1 84 | module,147 85 | namespace,12 86 | not,1 87 | not?,1 88 | or,1 89 | or?,1 90 | pact-id,0 91 | pact-version,1 92 | parse-time,2 93 | read,10 94 | read-decimal,1 95 | read-integer,1 96 | read-keyset,1 97 | read-msg,27 98 | read-string,1 99 | remove,2 100 | require-capability,1 101 | resume,2 102 | reverse,2 103 | round,1 104 | select,24 105 | shift,1 106 | sort,2 107 | sqrt,6 108 | str-to-int,1 109 | take,3 110 | time,2 111 | try,1 112 | tx-hash,0 113 | txids,10 114 | txlog,3 115 | typeof,2 116 | update,25 117 | use,3 118 | validate-keypair,29 119 | where,2 120 | with-capability,2 121 | with-default-read,14 122 | with-read,13 123 | write,25 124 | xor,1 125 | yield,2 126 | |,1 127 | ~,1 -------------------------------------------------------------------------------- /golden/accounts-module-crossChainSendCR/golden: -------------------------------------------------------------------------------- 1 | {"gas":0,"result":{"status":"success","data":{"a":{"int":3}}},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":"1mwhFumbCoQ2VpOJqEVD0IgAAOmY2RhDuW1PiVD1pGk","events":[{"params":["1","xchain.p",[{"int":3}]],"name":"X_YIELD","module":{"namespace":null,"name":"pact"},"moduleHash":"AHE7loAN5c-ajfetxFoDkmVcixfwr0-tKfKh7mylSvo"}],"metaData":null,"continuation":{"executed":null,"pactId":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","stepHasRollback":false,"step":0,"yield":{"data":{"a":{"int":3}},"source":"","provenance":{"targetChainId":"1","moduleHash":"AHE7loAN5c-ajfetxFoDkmVcixfwr0-tKfKh7mylSvo"}},"continuation":{"args":[{"int":3}],"def":"xchain.p"},"stepCount":2},"txId":null} -------------------------------------------------------------------------------- /golden/accounts-module-crossChainSendCRBackCompat/golden: -------------------------------------------------------------------------------- 1 | {"gas":0,"result":{"status":"success","data":{"a":{"int":3}}},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":"o4k6VwRSTWZnHAXGvzx-Q7yoUDRBtTYU9Uuv6W_6FmI","metaData":null,"continuation":{"executed":null,"pactId":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","stepHasRollback":false,"step":0,"yield":{"data":{"a":{"int":3}},"provenance":{"targetChainId":"1","moduleHash":"AHE7loAN5c-ajfetxFoDkmVcixfwr0-tKfKh7mylSvo"}},"continuation":{"args":[{"int":3}],"def":"xchain.p"},"stepCount":2},"txId":null} -------------------------------------------------------------------------------- /golden/accounts-module-eventCR/golden: -------------------------------------------------------------------------------- 1 | {"gas":0,"result":{"status":"success","data":1},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":"cqZ-6rAE2TTv8ZXj8EbwsR_eUOp_RquGGnt4nnc4ck4","events":[{"params":["Alice",10.1],"name":"CAP","module":{"namespace":null,"name":"events-test"},"moduleHash":"fBdyelQUFqIWDrvMFLe0_WJ6DpEpCsnAhBR2X7nd71U"}],"metaData":null,"continuation":null,"txId":null} -------------------------------------------------------------------------------- /golden/accounts-module-failureCR/golden: -------------------------------------------------------------------------------- 1 | {"gas":0,"result":{"status":"failure","error":{"callStack":["golden/golden.accounts.repl:45:4: (with-read (deftable accounts:(defschema account \"Row type fo... \"a\" ({g: \"rowguard\"} [(native `enforce-guard` Exec...)","golden/golden.accounts.repl:151:21: (USER_GUARD \"a\")","golden/golden.accounts.repl:151:4: (with-capability ((defcap accounts.USER_GUARD: (id:)) \"a\") [(native `with-read` Special form to read row fro...)","golden/golden.accounts.repl:85:6: (debit \"a\" 1.0 true {\"transfer-to\": \"b\"})","golden/golden.accounts.repl:84:4: (with-capability ((defcap accounts.TRANSFER: ())) [((defun accounts.debit: (acct: amount::0:0: (transfer \"a\" \"b\" 1.0 true)"],"type":"TxFailure","message":"with-read: row not found: a","info":"golden/golden.accounts.repl:45:4"}},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":null,"metaData":null,"continuation":null,"txId":null} -------------------------------------------------------------------------------- /golden/accounts-module-successCR/golden: -------------------------------------------------------------------------------- 1 | {"gas":0,"result":{"status":"success","data":1},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":"wsATyGqckuIvlm89hhd2j4t6RMkCrcwJe_oeCYr7Th8","metaData":null,"continuation":null,"txId":null} -------------------------------------------------------------------------------- /golden/golden.autocap.repl: -------------------------------------------------------------------------------- 1 | 2 | (module auto-caps-mod GOV 3 | (defcap GOV () true) 4 | (defcap CAP_A:bool (name:string) 5 | @managed 6 | true) 7 | (defcap CAP_B:bool (name:string times:integer) 8 | @managed times capBMgr 9 | true) 10 | (defun capBMgr:integer (mgd:integer rqd:integer) 11 | (enforce (> mgd 0) "all done") 12 | (- mgd 1)) 13 | (defun doA (name) 14 | (with-capability (CAP_A name) true)) 15 | (defun doB (name times) 16 | (with-capability (CAP_B name times) true))) 17 | -------------------------------------------------------------------------------- /golden/golden.fqns.repl: -------------------------------------------------------------------------------- 1 | (env-gasmodel "table") 2 | (env-gaslimit 150000) 3 | (module fqns GOV 4 | (defcap GOV () true) 5 | 6 | ; Gas lower for const usage post-fork. 7 | (defconst NETWORK_FEE 0.001) 8 | (defconst MIN_FEE (+ NETWORK_FEE 0.1)) 9 | (defconst BANK "bank") 10 | 11 | (defschema account-with-nickname 12 | balance:decimal 13 | nickname:string) 14 | 15 | (defschema account 16 | balance:decimal) 17 | 18 | (defschema obj-table 19 | name:object) 20 | 21 | (deftable accounts:{account}) 22 | (deftable accounts-with-longname:{account}) 23 | (deftable accounts-with-nickname:{account-with-nickname}) 24 | (deftable objs-table:{obj-table}) 25 | 26 | (defun transfer (senderId receiverId amount) 27 | "Send money from sender to receiver, charging a fee" 28 | ;;Read current account information of the sender 29 | (with-read accounts senderId { 30 | "balance":= senderBalance } 31 | ;;Read current account information of the receiver 32 | (with-read accounts receiverId { 33 | "balance":= receiverBalance } 34 | ;;Update account balance of the sender 35 | ;;Charge the sender the fee 36 | (update accounts senderId { 37 | "balance": (- senderBalance (+ amount MIN_FEE)) }) 38 | ;;Update account balance of the receiver 39 | (update accounts receiverId { 40 | "balance": (+ receiverBalance amount) }) 41 | 42 | (with-read accounts BANK {"balance" := bankBalance } 43 | ;;Collect the fee 44 | (update accounts BANK { "balance": (+ bankBalance MIN_FEE) }))))) 45 | 46 | (defun balance (id) 47 | (at "balance" (read accounts id ["balance"])) 48 | ) 49 | 50 | (defpact tester () 51 | (step "dummy step") 52 | (step 53 | (yield { "r": "a" })) 54 | (step 55 | (resume {"r" := res0 } 56 | res0)) 57 | (step 58 | (yield { "g": "b", "y": "b"})) 59 | (step 60 | (resume {"g" := res3 } 61 | res3)) 62 | ) 63 | 64 | (defun lam-test (amount:decimal) 65 | (let ((g (lambda (x:decimal) (+ 3.20 x)))) 66 | (g amount))) 67 | ) 68 | 69 | (env-gas) 70 | -------------------------------------------------------------------------------- /golden/golden.lams.repl: -------------------------------------------------------------------------------- 1 | (module lams-test G 2 | (defcap G () true) 3 | (defun f (amount:decimal) 4 | (let ((g (lambda (x:decimal) (+ 3.20 x)))) 5 | (g amount))) 6 | ) 7 | 8 | (lams-test.f 1.0) 9 | -------------------------------------------------------------------------------- /golden/golden.memcheck.repl: -------------------------------------------------------------------------------- 1 | (env-gasmodel "table") 2 | (env-gaslimit 150000) 3 | (module memcheck GOV 4 | (defcap GOV () true) 5 | 6 | ; Gas lower for const usage post-fork. 7 | (defconst NETWORK_FEE 0.001) 8 | (defconst MIN_FEE (+ NETWORK_FEE 0.1)) 9 | (defconst BANK "bank") 10 | 11 | (defschema account-with-nickname 12 | balance:decimal 13 | nickname:string) 14 | 15 | (defschema account 16 | balance:decimal) 17 | 18 | (defschema obj-table 19 | name:object) 20 | 21 | (deftable accounts:{account}) 22 | (deftable accounts-with-longname:{account}) 23 | (deftable accounts-with-nickname:{account-with-nickname}) 24 | (deftable objs-table:{obj-table}) 25 | 26 | (defun transfer (senderId receiverId amount) 27 | "Send money from sender to receiver, charging a fee" 28 | ;;Read current account information of the sender 29 | (with-read accounts senderId { 30 | "balance":= senderBalance } 31 | ;;Read current account information of the receiver 32 | (with-read accounts receiverId { 33 | "balance":= receiverBalance } 34 | ;;Update account balance of the sender 35 | ;;Charge the sender the fee 36 | (update accounts senderId { 37 | "balance": (- senderBalance (+ amount MIN_FEE)) }) 38 | ;;Update account balance of the receiver 39 | (update accounts receiverId { 40 | "balance": (+ receiverBalance amount) }) 41 | 42 | (with-read accounts BANK {"balance" := bankBalance } 43 | ;;Collect the fee 44 | (update accounts BANK { "balance": (+ bankBalance MIN_FEE) }))))) 45 | 46 | (defun balance (id) 47 | (at "balance" (read accounts id ["balance"])) 48 | ) 49 | 50 | (defpact tester () 51 | (step "dummy step") 52 | (step 53 | (yield { "r": "a" })) 54 | (step 55 | (resume {"r" := res0 } 56 | res0)) 57 | (step 58 | (yield { "g": "b", "y": "b"})) 59 | (step 60 | (resume {"g" := res3 } 61 | res3)) 62 | ) 63 | 64 | (defun lam-test (amount:decimal) 65 | (let ((g (lambda (x:decimal) (+ 3.20 x)))) 66 | (g amount))) 67 | ) 68 | 69 | (env-gas) 70 | -------------------------------------------------------------------------------- /golden/golden.nks.repl: -------------------------------------------------------------------------------- 1 | (env-keys ["key"]) 2 | (env-data {"k": {"keys":["key"], "pred":"keys-all" }}) 3 | 4 | (begin-tx) 5 | (module ezfree G (defcap G () true) (defun ALLOW () true)) 6 | 7 | (define-namespace 'free (create-user-guard (ALLOW)) (create-user-guard (ALLOW))) 8 | (commit-tx) 9 | 10 | (begin-tx) 11 | (namespace 'free) 12 | 13 | (define-keyset "free.k1" (read-keyset 'k)) 14 | 15 | (module nks "free.k1" 16 | (defschema sch col:integer) 17 | (deftable tbl:{sch}) 18 | 19 | (defun insertTbl (a i) 20 | (insert tbl a { 'col: i })) 21 | 22 | (defun updateTbl (a i) 23 | (update tbl a { 'col: i})) 24 | 25 | (defun weirdUpdateTbl (a i) 26 | (update tbl a { 'col: 0}) 27 | (update tbl a { 'col: i})) 28 | 29 | (defun readTbl () 30 | (sort (map (at "col") 31 | (select tbl (constantly true))))) 32 | 33 | (defpact dopact (n) 34 | (step { 'name: n, 'value: 1 }) 35 | (step { 'name: n, 'value: 2 })) 36 | ) 37 | (create-table tbl) 38 | (readTbl) 39 | 40 | (insertTbl "a" 1) 41 | (commit-tx) 42 | 43 | (begin-tx) 44 | (free.nks.readTbl) 45 | (commit-tx) 46 | -------------------------------------------------------------------------------- /golden/golden.rootnamespace.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ['DisablePact44]) 2 | (begin-tx) 3 | (module test-mgd-ns GOV 4 | (defcap GOV () true) 5 | (defun manage (ns guard) true)) 6 | (module nsupgrade G 7 | (defcap G () true) 8 | (defun foo () 1)) 9 | (commit-tx) 10 | 11 | (use test-mgd-ns) 12 | (env-namespace-policy false (manage)) 13 | 14 | (begin-tx) 15 | ; should upgrade post-fork 16 | (env-exec-config []) 17 | (module nsupgrade G 18 | (defcap G () true) 19 | (defun foo () 3)) 20 | (commit-tx) 21 | -------------------------------------------------------------------------------- /golden/goldenRootNamespace/golden: -------------------------------------------------------------------------------- 1 | {"module":{"hash":"BBz9_HXGOUPMWaZ0LYMbnO9cFuVOgduOweP-iu-XKZ8","blessed":[],"interfaces":[],"imports":[],"name":{"namespace":null,"name":"nsupgrade"},"code":"(module nsupgrade G\n (defcap G () true)\n (defun foo () 3))\n","meta":{"model":[],"docs":null},"governance":{"capability":{"defType":"Defcap","defMeta":null,"funType":{"args":[],"return":{"tag":"TypeVar","name":"a","constraint":[]}},"defName":"G","defBody":{"scope":{"list":[{"i":null,"lit":true}],"type":"*","i":null}},"module":{"namespace":null,"name":"nsupgrade"},"meta":{"model":[],"docs":null},"info":null}}},"refMap":{"G":{"ref":{"defType":"Defcap","defMeta":null,"funType":{"args":[],"return":{"tag":"TypeVar","name":"a","constraint":[]}},"defName":"G","defBody":{"scope":{"list":[{"i":null,"lit":true}],"type":"*","i":null}},"module":{"namespace":null,"name":"nsupgrade"},"meta":{"model":[],"docs":null},"info":null}},"foo":{"ref":{"defType":"Defun","defMeta":null,"funType":{"args":[],"return":{"tag":"TypeVar","name":"b","constraint":[]}},"defName":"foo","defBody":{"scope":{"list":[{"i":null,"lit":{"int":3}}],"type":"*","i":null}},"module":{"namespace":null,"name":"nsupgrade"},"meta":{"model":[],"docs":null},"info":null}}}} -------------------------------------------------------------------------------- /golden/lcov/golden: -------------------------------------------------------------------------------- 1 | TN: 2 | SF:tests/lcov/lcov.repl 3 | FNF:0 4 | FNH:0 5 | BRF:0 6 | BRH:0 7 | DA:1,1 8 | DA:17,1 9 | DA:2,1 10 | DA:3,1 11 | DA:20,1 12 | DA:5,2 13 | DA:7,1 14 | DA:10,1 15 | DA:13,1 16 | DA:15,1 17 | LF:10 18 | LH:10 19 | end_of_record 20 | TN: 21 | SF:tests/lcov/lcov.pact 22 | FN:30,covtest.update-val 23 | FN:4,covtest.GOVERNANCE 24 | FN:15,covtest.CAP 25 | FN:37,covtest.increase 26 | FN:20,covtest.create 27 | FNDA:2,covtest.update-val 28 | FNDA:0,covtest.GOVERNANCE 29 | FNDA:2,covtest.CAP 30 | FNDA:1,covtest.increase 31 | FNDA:1,covtest.create 32 | FNF:5 33 | FNH:4 34 | BRF:0 35 | BRH:0 36 | DA:16,2 37 | DA:17,2 38 | DA:2,1 39 | DA:18,2 40 | DA:34,4 41 | DA:35,1 42 | DA:4,0 43 | DA:20,1 44 | DA:37,1 45 | DA:25,1 46 | DA:41,2 47 | DA:42,2 48 | DA:43,0 49 | DA:30,2 50 | DA:15,2 51 | DA:47,1 52 | LF:16 53 | LH:14 54 | end_of_record 55 | -------------------------------------------------------------------------------- /golden/size-of-pactvalue-guard-keySet/golden: -------------------------------------------------------------------------------- 1 | [1128,{"pred":"keys-any","keys":["InpVchx87TQcTQDiRB2BG9MiJCaKnd3qS6bIdkKswzq7KmH0pzxRrbhoDO3jQX1B","KuMlhyIji4sUQijMRdANatpQWpC4TF0LV4D7Qrjd2IWwLltpboPMChRe3Sijv59r","RNGIX97mg8MPfnqQbGk4jOuNEoLGHXBYQkJRj8QRgtRdD5Ty6vVLFZMhZHpjG710","egHsMgpHyqNX6x8scOoICppKck3J1M8GGpqmVPRaJT1PtvFbb2VsXtrpUrUJqpgf","fDmSkQrKq9rhE12LaPsH1Ta6h21nrYM6QzSxfh9kJgY49GGHyBbosRzllfs9HqGy","mbEMjDl1okLePpUjOfsi5uH3QGcNeJ4nnZvPDVu0KnxPzAhGqVc0EfiMFoUXJ2nE"]}] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-guard-keySetRef/golden: -------------------------------------------------------------------------------- 1 | [110,{"keysetref":"Qi_EAu-g3K5amCO"}] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-guard-module/golden: -------------------------------------------------------------------------------- 1 | [256,{"moduleName":{"namespace":null,"name":"lq𩓁zmbOR7Qpj0y"},"name":"O_pJk13늜Ytdg_y4/4_Sm$W"}] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-guard-pact/golden: -------------------------------------------------------------------------------- 1 | [282,{"pactId":"N_6Du37-R8pnsCOIxQABgxt0o0QQhivFo_jh5CE5xTk","name":"O_pJk13늜Ytdg_y4/4_Sm$W"}] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-literal-bool/golden: -------------------------------------------------------------------------------- 1 | [32,true] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-literal-decimal/golden: -------------------------------------------------------------------------------- 1 | [73,9.57e-57] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-literal-integer/golden: -------------------------------------------------------------------------------- 1 | [36,{"int":"76708701818499967"}] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-literal-string/golden: -------------------------------------------------------------------------------- 1 | [100,"Qi_EAu-g3K"] -------------------------------------------------------------------------------- /golden/size-of-pactvalue-literal-time/golden: -------------------------------------------------------------------------------- 1 | [64,{"time":"1188-12-12T03:28:13Z"}] -------------------------------------------------------------------------------- /lib/unsafe/src/Data/Foldable/Unsafe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #if MIN_VERSION_base(4,20,0) 4 | {-# OPTIONS_GHC -Wno-x-partial #-} 5 | #endif 6 | 7 | 8 | -- | 9 | -- Module: Data.Foldable.Unsafe 10 | -- Copyright: Copyright © 2024 Kadena LLC. 11 | -- License: MIT 12 | -- Maintainer: Pact Team 13 | -- Stability: experimental 14 | -- 15 | -- This module provides unsafe versions for all functions in "Data.Foldable" 16 | -- that are either partial or return a 'Maybe' value. 17 | -- 18 | module Data.Foldable.Unsafe 19 | ( 20 | -- * Unsafe versions of partial functions 21 | unsafeMaximum 22 | , unsafeMaximumBy 23 | , unsafeMinimum 24 | , unsafeMinimumBy 25 | 26 | -- * Unsafe versions of functions that return 'Maybe' values 27 | , unsafeFind 28 | ) where 29 | 30 | import Data.Foldable 31 | 32 | import GHC.Stack 33 | 34 | -- -------------------------------------------------------------------------- -- 35 | -- Unsafe versions of partial functions 36 | 37 | unsafeMaximum :: HasCallStack => Foldable t => Ord a => t a -> a 38 | unsafeMaximum = maximum 39 | 40 | unsafeMaximumBy :: HasCallStack => Foldable t => (a -> a -> Ordering) -> t a -> a 41 | unsafeMaximumBy = maximumBy 42 | 43 | unsafeMinimum :: HasCallStack => (Foldable t, Ord a) => t a -> a 44 | unsafeMinimum = minimum 45 | 46 | unsafeMinimumBy :: HasCallStack => Foldable t => (a -> a -> Ordering) -> t a -> a 47 | unsafeMinimumBy = minimumBy 48 | 49 | -- -------------------------------------------------------------------------- -- 50 | -- Unsafe versions of functions that return Maybe 51 | 52 | unsafeFind :: HasCallStack => Foldable t => (a -> Bool) -> t a -> a 53 | unsafeFind a b = case find a b of 54 | Nothing -> error "Data.List.Unsafe.unsafeFind: not found" 55 | Just x -> x 56 | 57 | -------------------------------------------------------------------------------- /lib/unsafe/src/Data/List/Unsafe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #if MIN_VERSION_base(4,20,0) 4 | {-# OPTIONS_GHC -Wno-x-partial #-} 5 | #endif 6 | 7 | -- | 8 | -- Module: Data.List.Unsafe 9 | -- Copyright: Copyright © 2024 Kadena LLC. 10 | -- License: MIT 11 | -- Maintainer: Pact Team 12 | -- Stability: experimental 13 | -- 14 | -- This module provides unsafe versions for all functions in "Data.List" that 15 | -- are either partial or return a 'Maybe' value. 16 | -- 17 | module Data.List.Unsafe 18 | ( 19 | -- * Unsafe versions of partial functions 20 | unsafeHead 21 | , unsafeLast 22 | , unsafeTail 23 | , unsafeInit 24 | , unsafeIndex 25 | , unsafeGenericIndex 26 | 27 | -- * Unsafe versions of functions that return 'Maybe' values 28 | , unsafeUncons 29 | #if MIN_VERSION_base(4,19,0) 30 | , unsafeUnsnoc 31 | #endif 32 | , unsafeLookup 33 | , unsafeElemIndex 34 | , unsafeFindIndex 35 | , unsafeStripPrefix 36 | ) where 37 | 38 | import Data.List 39 | 40 | import GHC.Stack 41 | 42 | -- -------------------------------------------------------------------------- -- 43 | -- Unsafe versions of partial functions 44 | 45 | unsafeHead :: HasCallStack => [a] -> a 46 | unsafeHead = head 47 | 48 | unsafeLast :: HasCallStack => [a] -> a 49 | unsafeLast = last 50 | 51 | unsafeTail :: HasCallStack => [a] -> [a] 52 | unsafeTail = tail 53 | 54 | unsafeInit :: HasCallStack => [a] -> [a] 55 | unsafeInit = init 56 | 57 | unsafeIndex :: HasCallStack => [a] -> Int -> a 58 | unsafeIndex = (!!) 59 | 60 | unsafeGenericIndex :: Integral i => [a] -> i -> a 61 | unsafeGenericIndex = genericIndex 62 | 63 | -- -------------------------------------------------------------------------- -- 64 | -- Unsafe versions of functions that return Maybe 65 | 66 | unsafeUncons :: HasCallStack => [a] -> (a, [a]) 67 | unsafeUncons a = case uncons a of 68 | Nothing -> error "Data.List.Unsafe.unsafeUncons: empty list" 69 | Just x -> x 70 | 71 | #if MIN_VERSION_base(4,19,0) 72 | unsafeUnsnoc :: [a] -> ([a], a) 73 | unsafeUnsnoc a = case unsnoc a of 74 | Nothing -> error "Data.List.Unsafe.unsafeUnsnoc: empty list" 75 | Just x -> x 76 | #endif 77 | 78 | unsafeLookup :: HasCallStack => Eq a => a -> [(a,b)] -> b 79 | unsafeLookup a b = case lookup a b of 80 | Nothing -> error "Data.List.Unsafe.unsafeLookup: not found" 81 | Just x -> x 82 | 83 | unsafeElemIndex :: Eq a => a -> [a] -> Int 84 | unsafeElemIndex a b = case elemIndex a b of 85 | Nothing -> error "Data.List.Unsafe.unsafeElemIndex: not found" 86 | Just x -> x 87 | 88 | unsafeFindIndex :: (a -> Bool) -> [a] -> Int 89 | unsafeFindIndex a b = case findIndex a b of 90 | Nothing -> error "Data.List.Unsafe.unsafeFindIndex: not found" 91 | Just x -> x 92 | 93 | unsafeStripPrefix :: Eq a => [a] -> [a] -> [a] 94 | unsafeStripPrefix a b = case stripPrefix a b of 95 | Nothing -> error "Data.List.Unsafe.unsafeStripPrefix: not found" 96 | Just x -> x 97 | 98 | -------------------------------------------------------------------------------- /src-tool/Pact/Analyze/Eval/Invariant.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | -- | Symbolic evaluation for the schema 'Invariant' language (as opposed to 5 | -- the 'Prop' or 'Term' languages). 6 | module Pact.Analyze.Eval.Invariant where 7 | 8 | import Control.Lens (at, view, (%=), (?~)) 9 | import Control.Monad.Except (MonadError (throwError)) 10 | import Control.Monad.Reader (MonadReader, ReaderT, local) 11 | import Control.Monad.State.Strict (MonadState, 12 | StateT (StateT, runStateT)) 13 | import Data.Map.Strict (Map) 14 | import Data.SBV (Mergeable (symbolicMerge)) 15 | 16 | import Pact.Analyze.Errors 17 | import Pact.Analyze.Eval.Core 18 | import Pact.Analyze.Types 19 | import Pact.Analyze.Types.Eval 20 | import Pact.Analyze.Util 21 | 22 | newtype InvariantCheck a = InvariantCheck 23 | { unInvariantCheck :: StateT SymbolicSuccess 24 | (ReaderT 25 | (Located (Map VarId AVal)) 26 | (Either AnalyzeFailure)) a 27 | } deriving (Functor, Applicative, Monad, MonadError AnalyzeFailure, 28 | MonadReader (Located (Map VarId AVal)), MonadState SymbolicSuccess) 29 | 30 | instance (Mergeable a) => Mergeable (InvariantCheck a) where 31 | symbolicMerge force test left right = InvariantCheck $ StateT $ \s0 -> do 32 | (resL, sL) <- runStateT (unInvariantCheck left) s0 33 | (resR, sR) <- runStateT (unInvariantCheck right) s0 34 | pure ( symbolicMerge force test resL resR 35 | , symbolicMerge force test sL sR 36 | ) 37 | 38 | instance Analyzer InvariantCheck where 39 | type TermOf InvariantCheck = Invariant 40 | eval (CoreInvariant tm) = evalCore tm 41 | throwErrorNoLoc err = do 42 | info <- view location 43 | throwError $ AnalyzeFailure info err 44 | getVar vid = view (located . at vid) 45 | withVar vid val m = local (located . at vid ?~ val) m 46 | markFailure b = id %= (.&& SymbolicSuccess (sNot b)) 47 | emitWarning _ = pure () 48 | withMergeableAnalyzer ty f = withSymVal ty f 49 | -------------------------------------------------------------------------------- /src-tool/Pact/Analyze/Model.hs: -------------------------------------------------------------------------------- 1 | -- | Toplevel module for the construction of symbolic and concrete models, and 2 | -- utilities for rendering concrete models to textual and graphical 3 | -- representations. 4 | module Pact.Analyze.Model 5 | ( module Pact.Analyze.Model.Dot 6 | , module Pact.Analyze.Model.Graph 7 | , module Pact.Analyze.Model.Tags 8 | , module Pact.Analyze.Model.Text 9 | ) where 10 | 11 | import Pact.Analyze.Model.Dot 12 | import Pact.Analyze.Model.Graph 13 | import Pact.Analyze.Model.Tags 14 | import Pact.Analyze.Model.Text 15 | -------------------------------------------------------------------------------- /src-tool/Pact/Analyze/Model/Dot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TupleSections #-} 5 | 6 | -- | Compilation of concrete models to DOT format, for visually displaying the 7 | -- execution graphs that we build for constructing execution traces in a 8 | -- symbolic setting. 9 | module Pact.Analyze.Model.Dot 10 | ( compileDot 11 | , renderDot 12 | ) where 13 | 14 | import qualified Algebra.Graph as Alga 15 | import qualified Algebra.Graph.Export.Dot as Alga 16 | import Algebra.Graph.Export.Dot (Style (..), Attribute ((:=))) 17 | import Control.Lens ((^.)) 18 | import Data.Map.Strict (Map) 19 | import qualified Data.Map.Strict as Map 20 | import Data.Set (Set) 21 | import qualified Data.Set as Set 22 | import Data.Text (Text) 23 | import qualified Data.Text.IO as Text 24 | 25 | import Pact.Types.Util (tShow) 26 | 27 | import qualified Pact.Analyze.Model.Graph as Model 28 | import Pact.Analyze.Types (Concreteness (Concrete), Edge, 29 | Model, Path, Vertex, _pathTag, 30 | modelExecutionGraph, egGraph, 31 | egPathEdges) 32 | 33 | -- | Compile to DOT format 34 | compileDot :: Model 'Concrete -> Text 35 | compileDot m = Alga.export style graph 36 | where 37 | graph :: Alga.Graph Vertex 38 | graph = m ^. modelExecutionGraph.egGraph 39 | 40 | reachableEdges :: Set Edge 41 | reachableEdges = Model.reachableEdges m 42 | 43 | reachable :: Edge -> Bool 44 | reachable = flip Set.member reachableEdges 45 | 46 | edgePaths :: Map Edge Path 47 | edgePaths = Map.fromList $ do 48 | (path, edges) <- Map.toList $ m ^. modelExecutionGraph.egPathEdges 49 | (,path) <$> edges 50 | 51 | style :: Alga.Style Vertex Text 52 | style = (Alga.defaultStyle (tShow . fromEnum)) 53 | { defaultVertexAttributes = 54 | [ "shape" := "circle" 55 | , "style" := "filled" 56 | ] 57 | , edgeAttributes = curry $ \e -> 58 | [ "color" := "blue" 59 | | reachable e 60 | ] ++ 61 | [ "label" := tShow (fromEnum $ _pathTag $ edgePaths Map.! e) 62 | ] 63 | } 64 | 65 | -- | Render to a DOT file 66 | renderDot :: FilePath -> Model 'Concrete -> IO () 67 | renderDot fp m = Text.writeFile fp $ compileDot m 68 | -------------------------------------------------------------------------------- /src-tool/Pact/Analyze/Parse.hs: -------------------------------------------------------------------------------- 1 | -- | Toplevel module for parsers from 'Exp' to 'Prop' and 'Invariant'. 2 | module Pact.Analyze.Parse 3 | ( module Pact.Analyze.Parse.Invariant 4 | , module Pact.Analyze.Parse.Prop 5 | , module Pact.Analyze.Parse.Types 6 | ) where 7 | 8 | import Pact.Analyze.Parse.Invariant 9 | import Pact.Analyze.Parse.Prop 10 | import Pact.Analyze.Parse.Types 11 | -------------------------------------------------------------------------------- /src-tool/Pact/Analyze/Parse/Invariant.hs: -------------------------------------------------------------------------------- 1 | -- | Conversion from 'Exp' to the 'Invariant' language via the 'Prop' language. 2 | module Pact.Analyze.Parse.Invariant (expToInvariant) where 3 | 4 | import Data.HashMap.Strict (HashMap) 5 | import qualified Data.HashMap.Strict as HM 6 | import Data.Map (Map) 7 | import Data.Text (Text) 8 | import Prelude hiding (exp) 9 | 10 | import Pact.Types.Lang hiding (KeySet, KeySetName, SchemaVar, 11 | TableName, Type) 12 | 13 | import Pact.Analyze.Parse.Prop (expToProp) 14 | import Pact.Analyze.Types 15 | 16 | expToInvariant 17 | :: VarId 18 | -- ^ ID to start issuing from 19 | -> Map Text VarId 20 | -- ^ Environment mapping names to var IDs 21 | -> Map VarId EType 22 | -- ^ Environment mapping var IDs to their types 23 | -> HashMap Text EProp 24 | -- ^ Environment mapping names to constants 25 | -> SingTy a 26 | -- ^ The expected type of the invariant 27 | -> Exp Info 28 | -- ^ Exp to convert 29 | -> Either String (Invariant a) 30 | expToInvariant genStart nameEnv tyEnv consts ty body = 31 | propToInvariant =<< 32 | expToProp (TableMap mempty) genStart nameEnv tyEnv consts HM.empty ty body -------------------------------------------------------------------------------- /src/Crypto/Hash/Keccak256Native.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE ImportQualifiedPost #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TypeApplications #-} 9 | 10 | -- | Implementation of the `keccak256` pact native. 11 | module Crypto.Hash.Keccak256Native (Keccak256Error(..), keccak256) where 12 | 13 | import Control.Exception (Exception(..), SomeException(..), try) 14 | import Control.Monad (forM_) 15 | import Control.Monad.Catch (throwM) 16 | import Data.ByteString.Short qualified as BSS 17 | import Data.Hash.Class.Mutable (initialize, finalize, updateByteString) 18 | import Data.Hash.Internal.OpenSSL (OpenSslException(..)) 19 | import Data.Hash.Keccak (Keccak256(..)) 20 | import Data.Text (Text) 21 | import Data.Text.Encoding qualified as Text 22 | import Data.Vector (Vector) 23 | import Pact.Types.Util (encodeBase64UrlUnpadded, decodeBase64UrlUnpadded) 24 | import System.IO.Unsafe (unsafePerformIO) 25 | 26 | data Keccak256Error 27 | = Keccak256OpenSslException String 28 | | Keccak256Base64Exception String 29 | | Keccak256OtherException !SomeException 30 | deriving stock (Show) 31 | deriving anyclass (Exception) 32 | 33 | keccak256 :: Vector Text -> Either Keccak256Error Text 34 | keccak256 strings = unsafePerformIO $ do 35 | e <- try @SomeException @_ $ do 36 | ctx <- initialize @Keccak256 37 | forM_ strings $ \string -> do 38 | case decodeBase64UrlUnpadded (Text.encodeUtf8 string) of 39 | Left b64Err -> do 40 | throwM (Keccak256Base64Exception b64Err) 41 | Right bytes -> do 42 | updateByteString @Keccak256 ctx bytes 43 | Keccak256 hash <- finalize ctx 44 | pure (BSS.fromShort hash) 45 | case e of 46 | Left err 47 | | Just (OpenSslException msg) <- fromException err -> pure (Left (Keccak256OpenSslException msg)) 48 | | Just (exc :: Keccak256Error) <- fromException err -> pure (Left exc) 49 | | otherwise -> pure (Left (Keccak256OtherException err)) 50 | Right hash -> pure (Right (Text.decodeUtf8 (encodeBase64UrlUnpadded hash))) 51 | {-# noinline keccak256 #-} 52 | -------------------------------------------------------------------------------- /src/Pact/Analyze/Remote/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | 8 | -- | Types for remote verification of pact programs. 9 | -- 10 | module Pact.Analyze.Remote.Types 11 | ( Request(..) 12 | , Response(..) 13 | , responseLines 14 | , ClientError(..) 15 | ) where 16 | 17 | import Control.Lens (makeLenses) 18 | 19 | import qualified Data.Aeson as A 20 | import qualified Data.Text as T 21 | 22 | import GHC.Generics 23 | 24 | import qualified Pact.JSON.Encode as J 25 | import Pact.Types.PactError 26 | import Pact.Types.Term (ModuleDef, ModuleName, Name) 27 | 28 | import Test.QuickCheck 29 | 30 | data Request 31 | = Request [ModuleDef Name] ModuleName -- ^ verify one of the modules, by name 32 | deriving (Eq, Show, Generic) 33 | 34 | instance A.FromJSON Request where 35 | parseJSON = A.withObject "Request" $ \o -> 36 | Request <$> o A..: "modules" 37 | <*> o A..: "verify" 38 | 39 | instance J.Encode Request where 40 | build (Request mods modName) = J.object 41 | [ "verify" J..= modName 42 | , "modules" J..= J.Array mods 43 | ] 44 | {-# INLINE build #-} 45 | 46 | instance Arbitrary Request where 47 | arbitrary = Request <$> scale (min 10) arbitrary <*> arbitrary 48 | 49 | newtype Response 50 | = Response 51 | { _responseLines :: [RenderedOutput] 52 | -- ^ Repl interactive output 53 | } 54 | deriving (Eq, Show, Generic) 55 | deriving newtype (Arbitrary) 56 | 57 | instance A.FromJSON Response where 58 | parseJSON = A.withObject "Response" $ \o -> 59 | Response <$> o A..: "output" 60 | 61 | instance J.Encode Response where 62 | build o = J.object 63 | [ "output" J..= J.Array (_responseLines o) 64 | ] 65 | 66 | newtype ClientError 67 | = ClientError String 68 | deriving (Show, Eq) 69 | deriving newtype (Arbitrary) 70 | 71 | instance A.FromJSON ClientError where 72 | parseJSON = A.withObject "ClientError" $ \o -> 73 | ClientError <$> o A..: "error" 74 | 75 | instance J.Encode ClientError where 76 | build (ClientError err) = J.object 77 | ["error" J..= J.text (T.pack err) 78 | ] 79 | 80 | makeLenses ''Response 81 | -------------------------------------------------------------------------------- /src/Pact/MockDb.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Pact.MockDb where 4 | 5 | import Pact.Types.Runtime 6 | import Data.Aeson 7 | import Data.String 8 | import Data.Default 9 | import Pact.Interpreter 10 | 11 | rc :: a -> Method e a 12 | rc = const . return 13 | 14 | newtype MockRead = 15 | MockRead (forall k v . (IsString k,FromJSON v) => 16 | Domain k v -> k -> Method () (Maybe v)) 17 | instance Default MockRead where def = MockRead (\_t _k -> rc Nothing) 18 | 19 | newtype MockKeys = 20 | MockKeys (forall k v . (IsString k,AsString k) => Domain k v -> Method () [k]) 21 | instance Default MockKeys where def = MockKeys (\_t -> rc []) 22 | 23 | newtype MockTxIds = 24 | MockTxIds (TableName -> TxId -> Method () [TxId]) 25 | instance Default MockTxIds where def = MockTxIds (\_t _i -> rc []) 26 | 27 | newtype MockGetUserTableInfo = 28 | MockGetUserTableInfo (TableName -> Method () ModuleName) 29 | instance Default MockGetUserTableInfo where def = MockGetUserTableInfo (\_t -> rc "") 30 | 31 | newtype MockCommitTx = 32 | MockCommitTx (Method () [TxLogJson]) 33 | instance Default MockCommitTx where def = MockCommitTx (rc []) 34 | 35 | newtype MockGetTxLog = 36 | MockGetTxLog (forall k v . (IsString k,FromJSON v) => 37 | Domain k v -> TxId -> Method () [TxLog v]) 38 | instance Default MockGetTxLog where def = MockGetTxLog (\_t _i -> rc []) 39 | 40 | data MockDb = MockDb { 41 | mockRead :: MockRead, 42 | mockKeys :: MockKeys, 43 | mockTxIds :: MockTxIds, 44 | mockGetUserTableInfo :: MockGetUserTableInfo, 45 | mockCommitTx :: MockCommitTx, 46 | mockGetTxLog :: MockGetTxLog 47 | } 48 | instance Default MockDb where def = MockDb def def def def def def 49 | 50 | pactdb :: MockDb -> PactDb () 51 | pactdb (MockDb (MockRead r) (MockKeys ks) (MockTxIds tids) (MockGetUserTableInfo uti) 52 | (MockCommitTx c) (MockGetTxLog gt)) = PactDb { 53 | _readRow = r 54 | , 55 | _writeRow = \_wt _t _k _v -> rc () 56 | , 57 | _keys = ks 58 | , 59 | _txids = tids 60 | , 61 | _createUserTable = \_t _m -> rc () 62 | , 63 | _getUserTableInfo = uti 64 | , 65 | _beginTx = \_t -> rc Nothing 66 | , 67 | _commitTx = c 68 | , 69 | _rollbackTx = rc () 70 | , 71 | _getTxLog = gt 72 | 73 | } 74 | 75 | 76 | mkMockEnv :: MockDb -> IO (PactDbEnv ()) 77 | mkMockEnv m = mkPactDbEnv (pactdb m) () 78 | -------------------------------------------------------------------------------- /src/Pact/Native/Pairing/GaloisField.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | -- | 8 | -- Module: Pact.Native.Pairing.GaloisField 9 | -- Copyright: Copyright © 2023 Kadena LLC. 10 | -- License: MIT 11 | -- Maintainer: Lars Kuhtz 12 | -- Stability: experimental 13 | -- 14 | module Pact.Native.Pairing.GaloisField 15 | ( GaloisField(..) 16 | , Fq(..) 17 | ) where 18 | 19 | import Data.Euclidean (Euclidean, GcdDomain) 20 | import Data.Semiring (Semiring, Ring) 21 | import Data.Field (Field) 22 | import qualified Data.Euclidean as E 23 | import Data.Mod 24 | import GHC.Natural(naturalToInteger) 25 | 26 | import Control.DeepSeq (NFData) 27 | import Numeric.Natural(Natural) 28 | 29 | ----------------------------------------------------- 30 | -- Galois fields and field extensions 31 | ------------------------------------------------------ 32 | class (Field k, Fractional k, Ord k, Show k) => GaloisField k where 33 | -- | The characteristic of the field 34 | characteristic :: k -> Natural 35 | 36 | -- | The degree of the finite field 37 | degree :: k -> Word 38 | 39 | frobenius :: k -> k 40 | 41 | -- | order of a field p^k 42 | order :: k -> Natural 43 | order k = characteristic k ^ degree k 44 | {-# INLINABLE order #-} 45 | 46 | type Q = 21888242871839275222246405745257275088696311157297823662689037894645226208583 47 | 48 | newtype Fq = Fq (Mod Q) 49 | deriving 50 | ( Eq 51 | , Show 52 | , Ord 53 | , Num 54 | , Fractional 55 | , Euclidean 56 | , Field 57 | , GcdDomain 58 | , Ring 59 | , Semiring 60 | , Bounded 61 | , Enum 62 | , NFData 63 | ) 64 | 65 | instance Real Fq where 66 | toRational = fromIntegral 67 | 68 | instance Integral Fq where 69 | quotRem = E.quotRem 70 | toInteger (Fq m) = naturalToInteger (unMod m) 71 | 72 | instance GaloisField Fq where 73 | characteristic _ = 21888242871839275222246405745257275088696311157297823662689037894645226208583 74 | 75 | degree _ = 1 76 | 77 | frobenius = id 78 | 79 | -------------------------------------------------------------------------------- /src/Pact/Native/SPV.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- | 4 | -- Module : Pact.Native.SPV 5 | -- Copyright : (C) 2019 Stuart Popejoy 6 | -- License : BSD-style (see the file LICENSE) 7 | -- Maintainer : Stuart Popejoy 8 | -- 9 | -- Builtins for working with SPV proofs. 10 | -- 11 | 12 | module Pact.Native.SPV 13 | ( spvDefs 14 | ) where 15 | 16 | import Control.Lens (view) 17 | 18 | import Data.Default 19 | 20 | import Pact.Native.Internal 21 | import Pact.Types.SPV 22 | import Pact.Types.Pretty 23 | import Pact.Types.Runtime 24 | 25 | 26 | spvDefs :: NativeModule 27 | spvDefs = 28 | ("SPV", 29 | [ verifySPV 30 | ]) 31 | 32 | verifySPV :: NativeDef 33 | verifySPV = 34 | defRNative "verify-spv" verifySPV' 35 | (funType (tTyObject (mkTyVar' "out")) 36 | [("type", tTyString), 37 | ("payload", tTyObject (mkTyVar' "in"))]) 38 | [LitExample "(verify-spv \"TXOUT\" (read-msg \"proof\"))"] 39 | "Performs a platform-specific spv proof of type TYPE on PAYLOAD. \ 40 | \The format of the PAYLOAD object depends on TYPE, as does the \ 41 | \format of the return object. Platforms such as Chainweb will \ 42 | \document the specific payload types and return values." 43 | where 44 | verifySPV' i [TLitString proofType, TObject o _] = do 45 | view eeSPVSupport >>= \(SPVSupport f _) -> liftIO (f proofType o) >>= \r -> case r of 46 | Left err -> evalError' i $ "SPV verify failed: " <> pretty err 47 | Right o' -> return $ TObject o' def 48 | verifySPV' i as = argsError i as 49 | -------------------------------------------------------------------------------- /src/Pact/Native/Trans/TOps.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Pact.Native.Trans.TOps 3 | -- Copyright : (C) 2022 John Wiegley 4 | -- License : BSD-style (see the file LICENSE) 5 | -- Maintainer : John Wiegley 6 | -- 7 | -- Operators and math built-ins. 8 | -- 9 | 10 | module Pact.Native.Trans.TOps 11 | ( trans_pow 12 | , trans_exp 13 | , trans_log 14 | , trans_ln 15 | , trans_sqrt 16 | ) where 17 | 18 | foreign import ccall unsafe "musl_pow" 19 | musl_pow :: Double -> Double -> Double 20 | 21 | foreign import ccall unsafe "musl_exp" 22 | musl_exp :: Double -> Double 23 | 24 | foreign import ccall unsafe "musl_log" 25 | musl_log :: Double -> Double 26 | 27 | foreign import ccall unsafe "musl_sqrt" 28 | musl_sqrt :: Double -> Double 29 | 30 | trans_pow :: Double -> Double -> Double 31 | trans_pow = musl_pow 32 | 33 | trans_exp :: Double -> Double 34 | trans_exp = musl_exp 35 | 36 | trans_log :: Double -> Double -> Double 37 | trans_log b x = musl_log x / musl_log b 38 | 39 | trans_ln :: Double -> Double 40 | trans_ln = musl_log 41 | 42 | trans_sqrt :: Double -> Double 43 | trans_sqrt = musl_sqrt 44 | -------------------------------------------------------------------------------- /src/Pact/Persist/MockPersist.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | module Pact.Persist.MockPersist where 3 | 4 | import Data.Aeson (FromJSON) 5 | import Pact.Persist 6 | import Data.Default 7 | import Pact.PersistPactDb 8 | import Pact.Interpreter 9 | import Pact.Types.Logger 10 | 11 | rcp :: a -> Persist e a 12 | rcp a s = return (s,a) 13 | 14 | newtype MockQueryKeys = 15 | MockQueryKeys (forall k . PactDbKey k => Table k -> Maybe (KeyQuery k) -> Persist () [k]) 16 | instance Default MockQueryKeys where def = MockQueryKeys (\_t _q -> rcp []) 17 | 18 | newtype MockQuery = 19 | MockQuery (forall k v . (PactDbKey k, FromJSON v) => Table k -> Maybe (KeyQuery k) -> Persist () [(k,v)]) 20 | instance Default MockQuery where def = MockQuery (\_t _q -> rcp []) 21 | 22 | newtype MockReadValue = 23 | MockReadValue (forall k v . (PactDbKey k, FromJSON v) => Table k -> k -> Persist () (Maybe v)) 24 | instance Default MockReadValue where def = MockReadValue (\_t _k -> rcp Nothing) 25 | 26 | data MockPersist = MockPersist { 27 | mockQueryKeys :: MockQueryKeys 28 | ,mockQuery :: MockQuery 29 | ,mockReadValue :: MockReadValue 30 | } 31 | instance Default MockPersist where def = MockPersist def def def 32 | 33 | persister :: MockPersist -> Persister () 34 | persister (MockPersist (MockQueryKeys qk) (MockQuery q) (MockReadValue rv)) = Persister { 35 | createTable = \_t -> rcp () 36 | , 37 | beginTx = \_t -> rcp () 38 | , 39 | commitTx = rcp () 40 | , 41 | rollbackTx = rcp () 42 | , 43 | queryKeys = qk 44 | , 45 | query = q 46 | , 47 | readValue = rv 48 | , 49 | writeValue = \_t _wt _k _v -> rcp () 50 | , 51 | refreshConn = rcp () 52 | } 53 | 54 | 55 | mkMockPersistEnv :: Loggers -> MockPersist -> IO (PactDbEnv (DbEnv ())) 56 | mkMockPersistEnv l mp = mkPactDbEnv pactdb (initDbEnv l (persister mp) ()) 57 | -------------------------------------------------------------------------------- /src/Pact/Server/History/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module Pact.Server.History.Types 6 | ( HistoryEnv(..), historyChannel, inboundPactChannel, debugPrint, dbPath, replayFromDisk 7 | , HistoryState(..), registeredListeners, persistence 8 | , PersistenceSystem(..) 9 | , HistoryService 10 | , DbEnv(..) 11 | ) where 12 | 13 | import Control.Lens hiding (Index) 14 | 15 | import Control.Monad.Trans.RWS.Strict 16 | import Control.Concurrent.MVar 17 | 18 | import Data.ByteString (ByteString) 19 | import Data.HashMap.Strict (HashMap) 20 | 21 | import Database.SQLite3.Direct 22 | 23 | import Pact.Types.Command 24 | import Pact.Types.Server 25 | import Pact.Types.Hash 26 | 27 | data HistoryEnv = HistoryEnv 28 | { _historyChannel :: !HistoryChannel 29 | , _inboundPactChannel :: !InboundPactChan 30 | , _debugPrint :: !(String -> IO ()) 31 | , _dbPath :: !(Maybe FilePath) 32 | , _replayFromDisk :: !ReplayFromDisk 33 | } 34 | makeLenses ''HistoryEnv 35 | 36 | data DbEnv = DbEnv 37 | { _conn :: !Database 38 | , _insertStatement :: !Statement 39 | , _qryExistingStmt :: !Statement 40 | , _qryCompletedStmt :: !Statement 41 | , _qrySelectAllCmds :: !Statement 42 | } 43 | 44 | data PersistenceSystem = 45 | InMemory 46 | { inMemResults :: !(HashMap RequestKey (Command ByteString, Maybe (CommandResult Hash)))} | 47 | OnDisk 48 | { incompleteRequestKeys :: !(HashMap RequestKey (Command ByteString)) 49 | , dbConn :: !DbEnv} 50 | 51 | data HistoryState = HistoryState 52 | { _registeredListeners :: !(HashMap RequestKey [MVar ListenerResult]) 53 | , _persistence :: !PersistenceSystem 54 | } 55 | makeLenses ''HistoryState 56 | 57 | type HistoryService = RWST HistoryEnv () HistoryState IO 58 | -------------------------------------------------------------------------------- /src/Pact/Types/ChainId.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | -- | 6 | -- Module : Pact.Types.ChainId 7 | -- Copyright : (C) 2019 Stuart Popejoy, Emily Pillmore 8 | -- License : BSD-style (see the file LICENSE) 9 | -- Maintainer : Stuart Popejoy , 10 | -- Emily Pillmore 11 | -- 12 | -- Chain and Network Identifiers 13 | -- 14 | module Pact.Types.ChainId 15 | ( -- * Chain Id 16 | ChainId(..) 17 | , chainId 18 | 19 | -- * Network Id 20 | , NetworkId(..) 21 | , networkId 22 | ) where 23 | 24 | import GHC.Generics 25 | 26 | import Control.DeepSeq 27 | import Control.Lens 28 | 29 | import Data.Aeson (FromJSON) 30 | import Data.Serialize (Serialize) 31 | import Data.String (IsString) 32 | import Data.Text 33 | import Test.QuickCheck (Arbitrary(..)) 34 | 35 | import Servant.API (ToHttpApiData(..)) 36 | 37 | import Pact.Types.Pretty 38 | import Pact.Types.SizeOf 39 | import Pact.Types.Term (ToTerm(..)) 40 | import Pact.Types.Util (genBareText,AsString(..)) 41 | 42 | import qualified Pact.JSON.Encode as J 43 | 44 | -- | Expresses unique platform-specific chain identifier. 45 | -- 46 | newtype ChainId = ChainId { _chainId :: Text } 47 | deriving stock (Eq, Generic) 48 | deriving newtype 49 | ( Show, Pretty, IsString 50 | , FromJSON 51 | , Serialize, ToTerm, NFData 52 | , SizeOf, AsString, J.Encode 53 | ) 54 | 55 | instance Arbitrary ChainId where 56 | arbitrary = ChainId <$> genBareText 57 | 58 | instance Wrapped ChainId 59 | 60 | instance ToHttpApiData ChainId where 61 | toUrlPiece = _chainId 62 | 63 | -- | Lens into the text value of a 'ChainId' 64 | -- 65 | chainId :: Lens' ChainId Text 66 | chainId = lens _chainId (\t b -> t { _chainId = b }) 67 | 68 | -- | Network Ids are blockchain-specific network identifiers 69 | -- 70 | newtype NetworkId = NetworkId { _networkId :: Text } 71 | deriving stock (Eq, Generic) 72 | deriving newtype 73 | ( Show, Pretty, IsString 74 | , FromJSON, J.Encode 75 | , Serialize, ToTerm, NFData 76 | ) 77 | 78 | instance Wrapped NetworkId 79 | 80 | instance Arbitrary NetworkId where 81 | arbitrary = NetworkId <$> genBareText 82 | 83 | -- | Lens into the value of 'NetworkId' 84 | -- 85 | networkId :: Lens' NetworkId Text 86 | networkId = lens _networkId (\t b -> t { _networkId = b }) 87 | -------------------------------------------------------------------------------- /src/Pact/Types/Lang.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Pact.Types.Lang 3 | -- Copyright : (C) 2016 Stuart Popejoy 4 | -- License : BSD-style (see the file LICENSE) 5 | -- Maintainer : Stuart Popejoy 6 | -- 7 | -- Export of types related to Info, Type, Literal, Exp, Term. 8 | -- 9 | 10 | module Pact.Types.Lang 11 | ( module Pact.Types.ChainId 12 | , module Pact.Types.Continuation 13 | , module Pact.Types.Exp 14 | , module Pact.Types.Hash 15 | , module Pact.Types.Info 16 | , module Pact.Types.Util 17 | , module Pact.Types.Term 18 | , module Pact.Types.Type 19 | ) where 20 | 21 | import Pact.Types.ChainId 22 | import Pact.Types.Continuation 23 | import Pact.Types.Exp 24 | import Pact.Types.Hash 25 | import Pact.Types.Info 26 | import Pact.Types.Util 27 | import Pact.Types.Term 28 | import Pact.Types.Type 29 | -------------------------------------------------------------------------------- /src/Pact/Types/Namespace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | module Pact.Types.Namespace 7 | ( Namespace(..), nsName, nsUser, nsAdmin 8 | , NamespacePolicy(..) 9 | , permissiveNamespacePolicy 10 | ) where 11 | 12 | import Control.DeepSeq 13 | import Control.Lens hiding ((.=)) 14 | 15 | import Data.Aeson 16 | 17 | 18 | import Pact.Types.Names 19 | import Pact.Types.Term 20 | import Pact.Types.Term.Arbitrary () 21 | import Pact.Types.Pretty 22 | import Pact.Types.SizeOf 23 | import Pact.Types.Util 24 | 25 | import qualified Pact.JSON.Encode as J 26 | 27 | import GHC.Generics 28 | 29 | import Test.QuickCheck 30 | 31 | -- -------------------------------------------------------------------------- -- 32 | -- Namespace 33 | 34 | data Namespace a = Namespace 35 | { _nsName :: !NamespaceName 36 | , _nsUser :: !(Guard a) 37 | , _nsAdmin :: !(Guard a) 38 | } deriving (Eq, Show, Generic) 39 | makeLenses ''Namespace 40 | 41 | instance (Arbitrary a) => Arbitrary (Namespace a) where 42 | arbitrary = Namespace <$> arbitrary <*> arbitrary <*> arbitrary 43 | 44 | instance Pretty (Namespace a) where 45 | pretty Namespace{..} = "(namespace " <> prettyString (asString' _nsName) <> ")" 46 | 47 | instance (SizeOf n) => SizeOf (Namespace n) where 48 | sizeOf ver (Namespace name ug ag) = 49 | (constructorCost 3) + (sizeOf ver name) + (sizeOf ver ug) + (sizeOf ver ag) 50 | 51 | instance J.Encode a => J.Encode (Namespace a) where 52 | build o = J.object 53 | [ "admin" J..= _nsAdmin o 54 | , "user" J..= _nsUser o 55 | , "name" J..= _nsName o 56 | ] 57 | {-# INLINABLE build #-} 58 | 59 | instance FromJSON a => FromJSON (Namespace a) where parseJSON = lensyParseJSON 3 60 | 61 | instance (NFData a) => NFData (Namespace a) 62 | 63 | -- | Governance of namespace use. Policy dictates: 64 | -- 1. Whether a namespace can be created. 65 | -- 2. Whether the default namespace can be used. 66 | data NamespacePolicy 67 | = SimpleNamespacePolicy !(Maybe (Namespace (Term Name)) -> Bool) 68 | -- ^ if namespace is Nothing/root, govern usage; otherwise govern creation. 69 | | SmartNamespacePolicy !Bool !QualifiedName 70 | -- ^ Bool governs root usage, Name governs ns creation. 71 | -- Def is (defun xxx:bool (ns:string ns-admin:guard)) 72 | 73 | permissiveNamespacePolicy :: NamespacePolicy 74 | permissiveNamespacePolicy = SimpleNamespacePolicy $ const True 75 | -------------------------------------------------------------------------------- /src/Pact/Types/Native.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Pact.Types.Native where 4 | 5 | import Pact.Types.Util 6 | import Pact.Types.Runtime 7 | import Pact.Compile (Reserved(RWithCapability)) 8 | import qualified Data.Map.Strict as M 9 | import Control.Arrow 10 | 11 | data SpecialForm = 12 | WithRead | 13 | WithDefaultRead | 14 | Bind | 15 | Select | 16 | Where | 17 | WithCapability | 18 | YieldSF | 19 | Resume 20 | deriving (Eq,Enum,Ord,Bounded) 21 | 22 | instance AsString SpecialForm where 23 | asString WithRead = "with-read" 24 | asString WithDefaultRead = "with-default-read" 25 | asString Bind = "bind" 26 | asString Select = "select" 27 | asString Where = "where" 28 | asString WithCapability = asString RWithCapability 29 | asString YieldSF = "yield" 30 | asString Resume = "resume" 31 | 32 | instance Show SpecialForm where show = show . asString 33 | 34 | specialForm :: SpecialForm -> NativeDefName 35 | specialForm = NativeDefName . asString 36 | 37 | sfLookup :: M.Map NativeDefName SpecialForm 38 | sfLookup = M.fromList $ map (specialForm &&& id) [minBound .. maxBound] 39 | 40 | isSpecialForm :: NativeDefName -> Maybe SpecialForm 41 | isSpecialForm = (`M.lookup` sfLookup) 42 | 43 | 44 | -- | Native function with un-reduced arguments that computes gas. 45 | -- Operation cost implemented in definition. 46 | type NativeFun e = FunApp -> [Term Ref] -> Eval e (Term Name) 47 | 48 | -- | Native function with reduced arguments, initial gas pre-compute that computes final gas. 49 | type GasRNativeFun e = FunApp -> [Term Name] -> Eval e (Term Name) 50 | 51 | -- | Native function with reduced arguments, final gas pre-computed. 52 | -- Operations with fixed cost. 53 | type RNativeFun e = FunApp -> [Term Name] -> Eval e (Term Name) 54 | 55 | type NativeDef = (NativeDefName,Term Name) 56 | type NativeModule = (ModuleName,[NativeDef]) 57 | -------------------------------------------------------------------------------- /src/Pact/Types/SPV.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | -- | 6 | -- Module : Pact.Types.SPV 7 | -- Copyright : (C) 2019 Stuart Popejoy, Emily Pillmore 8 | -- License : BSD-style (see the file LICENSE) 9 | -- Maintainer : Stuart Popejoy , 10 | -- Emily Pillmore 11 | -- 12 | -- SPV Support data and types 13 | -- 14 | module Pact.Types.SPV 15 | ( -- * Types 16 | ContProof(..) 17 | , SPVSupport(..) 18 | -- * Support 19 | , noSPVSupport 20 | -- * Optics 21 | , spvSupport 22 | , spvVerifyContinuation 23 | ) where 24 | 25 | import Control.DeepSeq (NFData) 26 | import Control.Lens 27 | 28 | import Data.Aeson hiding (Object) 29 | import Data.ByteString 30 | import Data.Text 31 | import Data.Text.Encoding 32 | 33 | import GHC.Generics hiding (to) 34 | 35 | import Test.QuickCheck 36 | 37 | import Pact.Types.Continuation (PactExec) 38 | import Pact.Types.Pretty (Pretty(..), prettyString) 39 | import Pact.Types.Term (Object, Name) 40 | 41 | import qualified Pact.JSON.Encode as J 42 | 43 | newtype ContProof = ContProof { _contProof :: ByteString } 44 | deriving (Eq, Ord, Show, Generic) 45 | 46 | instance Wrapped ContProof 47 | 48 | instance NFData ContProof 49 | 50 | instance J.Encode ContProof where 51 | build (ContProof bs) = J.build $ decodeUtf8 bs 52 | {-# INLINE build #-} 53 | 54 | instance FromJSON ContProof where 55 | parseJSON = withText "ByteString" (return . ContProof . encodeUtf8) 56 | instance Pretty ContProof where 57 | pretty = prettyString . show 58 | 59 | instance Arbitrary ContProof where 60 | arbitrary = ContProof . encodeUtf8 <$> arbitrary 61 | 62 | -- | Backend for SPV support 63 | data SPVSupport = SPVSupport 64 | { _spvSupport :: !(Text -> (Object Name) -> IO (Either Text (Object Name))) 65 | -- ^ Attempt to verify an SPV proof of a given type, 66 | -- given a payload object. On success, returns the 67 | -- specific data represented by the proof. 68 | , _spvVerifyContinuation :: !(ContProof -> IO (Either Text PactExec)) 69 | -- ^ Attempt to verify an SPV proof of a continuation given 70 | -- a continuation payload object bytestring. On success, returns 71 | -- the 'PactExec' associated with the proof. 72 | } 73 | makeLenses ''SPVSupport 74 | 75 | noSPVSupport :: SPVSupport 76 | noSPVSupport = SPVSupport spv vcon 77 | where 78 | spv = \_ _ -> return $ Left "SPV verification not supported" 79 | vcon = \_ -> return $ Left "Cross-chain continuations not supported" 80 | -------------------------------------------------------------------------------- /src/Pact/Types/Scheme.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE TypeFamilies, GADTs, DataKinds #-} 8 | 9 | 10 | module Pact.Types.Scheme 11 | ( PPKScheme(..) 12 | , defPPKScheme 13 | , SPPKScheme(..) 14 | ) where 15 | 16 | import GHC.Generics 17 | import Control.DeepSeq 18 | import Data.Kind (Type) 19 | import Data.Serialize 20 | import qualified Data.Text as T 21 | import Data.Aeson 22 | import Test.QuickCheck 23 | 24 | import Pact.Types.Pretty (Pretty(pretty)) 25 | import Pact.Types.Util (ParseText(..)) 26 | 27 | import qualified Pact.JSON.Encode as J 28 | 29 | 30 | --------- PPKSCHEME DATA TYPE --------- 31 | 32 | data PPKScheme = ED25519 | WebAuthn 33 | deriving (Show, Eq, Ord, Generic, Bounded, Enum) 34 | 35 | instance NFData PPKScheme 36 | instance Serialize PPKScheme 37 | 38 | instance ToJSON PPKScheme where 39 | toJSON ED25519 = "ED25519" 40 | toJSON WebAuthn = "WebAuthn" 41 | 42 | 43 | toEncoding ED25519 = toEncoding @T.Text "ED25519" 44 | toEncoding WebAuthn = toEncoding @T.Text "WebAuthn" 45 | {-# INLINE toJSON #-} 46 | {-# INLINE toEncoding #-} 47 | 48 | instance Pretty PPKScheme where 49 | pretty = \case 50 | ED25519 -> "ed25519" 51 | WebAuthn -> "webauthn" 52 | 53 | instance FromJSON PPKScheme where 54 | parseJSON = withText "PPKScheme" parseText 55 | {-# INLINE parseJSON #-} 56 | 57 | instance ParseText PPKScheme where 58 | parseText s = case s of 59 | "ED25519" -> return ED25519 60 | "WebAuthn" -> return WebAuthn 61 | _ -> fail $ "Unsupported PPKScheme: " ++ show s 62 | {-# INLINE parseText #-} 63 | 64 | instance Arbitrary PPKScheme where 65 | arbitrary = elements [ minBound .. maxBound ] 66 | 67 | instance J.Encode PPKScheme where 68 | build ED25519 = J.text "ED25519" 69 | build WebAuthn = J.text "WebAuthn" 70 | {-# INLINE build #-} 71 | 72 | 73 | defPPKScheme :: PPKScheme 74 | defPPKScheme = ED25519 75 | 76 | 77 | -- Run-time witness to PPKScheme kind. 78 | 79 | data SPPKScheme :: PPKScheme -> Type where 80 | SED25519 :: SPPKScheme 'ED25519 81 | SWebAuthn :: SPPKScheme 'WebAuthn 82 | instance Show (SPPKScheme a) where 83 | show SED25519 = show ED25519 84 | show SWebAuthn = show WebAuthn 85 | -------------------------------------------------------------------------------- /src/Pact/Types/Verifier.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE StandaloneDeriving #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE DeriveFunctor #-} 7 | {-# LANGUAGE DeriveFoldable #-} 8 | {-# LANGUAGE DeriveTraversable #-} 9 | {-# LANGUAGE TemplateHaskell #-} 10 | 11 | module Pact.Types.Verifier 12 | ( VerifierName(..) 13 | , Verifier(..) 14 | , verifierName 15 | , verifierProof 16 | , verifierCaps 17 | , ParsedVerifierProof(..) 18 | ) where 19 | 20 | import Control.DeepSeq 21 | import Control.Lens 22 | import Data.Aeson 23 | import Data.Text 24 | import GHC.Generics 25 | import Test.QuickCheck(Arbitrary(..), scale) 26 | 27 | import qualified Pact.JSON.Encode as J 28 | 29 | import Pact.Types.Orphans() 30 | import Pact.Types.PactValue 31 | import Pact.Types.Capability 32 | 33 | newtype VerifierName = VerifierName Text 34 | deriving newtype (J.Encode, Arbitrary, NFData, Eq, Show, Ord, FromJSON) 35 | deriving stock Generic 36 | 37 | data Verifier prf = Verifier 38 | { _verifierName :: VerifierName 39 | , _verifierProof :: prf 40 | , _verifierCaps :: [UserCapability] 41 | } 42 | deriving (Eq, Show, Generic, Ord, Functor, Foldable, Traversable) 43 | 44 | makeLenses ''Verifier 45 | 46 | instance NFData a => NFData (Verifier a) 47 | instance Arbitrary a => Arbitrary (Verifier a) where 48 | arbitrary = 49 | Verifier <$> 50 | (VerifierName . pack <$> arbitrary) <*> 51 | arbitrary <*> 52 | scale (min 10) arbitrary 53 | instance J.Encode a => J.Encode (Verifier a) where 54 | build va = J.object 55 | [ "name" J..= _verifierName va 56 | , "proof" J..= _verifierProof va 57 | , "clist" J..= J.Array (_verifierCaps va) 58 | ] 59 | instance FromJSON a => FromJSON (Verifier a) where 60 | parseJSON = withObject "Verifier" $ \o -> do 61 | name <- o .: "name" 62 | proof <- o .: "proof" 63 | caps <- o .: "clist" 64 | return $ Verifier name proof caps 65 | 66 | newtype ParsedVerifierProof = ParsedVerifierProof PactValue 67 | deriving newtype (NFData, Eq, Show, Ord, FromJSON) 68 | deriving stock Generic 69 | 70 | instance J.Encode ParsedVerifierProof where 71 | build (ParsedVerifierProof as) = J.build as 72 | 73 | instance Arbitrary ParsedVerifierProof where 74 | arbitrary = ParsedVerifierProof <$> arbitrary 75 | -------------------------------------------------------------------------------- /src/Pact/Types/Version.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- | 3 | -- Module : Pact.Types.Version 4 | -- Copyright : (C) 2017 Stuart Popejoy 5 | -- License : BSD-style (see the file LICENSE) 6 | -- Maintainer : Stuart Popejoy 7 | -- 8 | -- Use CPP to retrieve cabal library version. 9 | -- 10 | module Pact.Types.Version (pactVersion) where 11 | 12 | import Data.Text (Text, pack) 13 | 14 | pactVersion :: Text 15 | pactVersion = pack VERSION_pact 16 | -------------------------------------------------------------------------------- /src/Pact/Utils/Servant.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE StandaloneDeriving #-} 10 | {-# LANGUAGE TypeApplications #-} 11 | 12 | -- | 13 | -- Module: Pact.Utils.Servant 14 | -- Copyright: Copyright © 2023 Kadena LLC. 15 | -- License: MIT 16 | -- Maintainer: Lars Kuhtz 17 | -- Stability: experimental 18 | -- 19 | module Pact.Utils.Servant 20 | ( PactJson(..) 21 | ) where 22 | 23 | import Data.Aeson 24 | import Data.Proxy 25 | 26 | import qualified Pact.JSON.Encode as J 27 | 28 | import Servant.API.ContentTypes 29 | import Servant.API.UVerb 30 | 31 | newtype PactJson = PactJson JSON 32 | deriving newtype (Accept) 33 | 34 | instance {-# OVERLAPPABLE #-} J.Encode a => MimeRender PactJson a where 35 | mimeRender _ = J.encode 36 | 37 | instance {-# OVERLAPPING #-} MimeRender PactJson a => MimeRender PactJson (WithStatus _status a) where 38 | mimeRender contentTypeProxy (WithStatus a) = mimeRender contentTypeProxy a 39 | 40 | instance FromJSON a => MimeUnrender PactJson a where 41 | mimeUnrender _ = mimeUnrender @JSON @a Proxy 42 | 43 | -------------------------------------------------------------------------------- /templates/cont-request-template.yaml: -------------------------------------------------------------------------------- 1 | # Public chain continuation request template 2 | 3 | pactTxHash: 4 | step: 5 | rollback: 6 | proof: 7 | data: 8 | dataFile: 9 | keyPairs: 10 | [ public: 11 | secret: 12 | caps: [] 13 | ] 14 | networkId: 15 | publicMeta: 16 | chainId: 17 | sender: 18 | gasLimit: 19 | gasPrice: 20 | ttl: 21 | creationTime: 22 | nonce: 23 | type: cont -------------------------------------------------------------------------------- /templates/exec-request-template.yaml: -------------------------------------------------------------------------------- 1 | # Public chain exec request template 2 | 3 | code: 4 | codeFile: 5 | data: 6 | dataFile: 7 | networkId: 8 | publicMeta: 9 | chainId: 10 | sender: 11 | gasLimit: 12 | gasPrice: 13 | ttl: 14 | creationTime: 15 | keyPairs: 16 | [ public: 17 | secret: 18 | caps: [] 19 | ] 20 | nonce: 21 | type: exec -------------------------------------------------------------------------------- /tests/CoverageSpec.hs: -------------------------------------------------------------------------------- 1 | module CoverageSpec (spec) where 2 | 3 | 4 | import Control.Lens 5 | import Control.Monad 6 | import Data.IORef 7 | import qualified Data.Text as T 8 | 9 | import Test.Hspec 10 | import Test.Hspec.Golden 11 | 12 | import Pact.Coverage 13 | import Pact.Coverage.Report 14 | import Pact.Repl 15 | import Pact.Repl.Types 16 | import Pact.Types.Runtime 17 | 18 | spec :: Spec 19 | spec = do 20 | testCover 21 | 22 | 23 | testCover :: Spec 24 | testCover = do 25 | before rpt $ 26 | it "matches golden coverage" $ \a -> 27 | Golden 28 | { output = T.unpack (showReport a) 29 | , encodePretty = id 30 | , writeToFile = writeFile 31 | , readFromFile = readFile 32 | , testName = "lcov" 33 | , directory = "golden" 34 | , failFirstTime = False 35 | } 36 | where 37 | rpt = do 38 | let fn = "tests/lcov/lcov.repl" 39 | (ref,adv) <- mkCoverageAdvice 40 | s <- initReplState (Script False fn) Nothing 41 | void $! execScriptState' fn s (set (rEnv . eeAdvice) adv) 42 | readIORef ref 43 | -------------------------------------------------------------------------------- /tests/DocgenSpec.hs: -------------------------------------------------------------------------------- 1 | module DocgenSpec where 2 | 3 | import qualified Pact.Docgen as Docgen 4 | import Test.Hspec 5 | 6 | spec :: Spec 7 | spec = it "runs Docgen.main" Docgen.main 8 | -------------------------------------------------------------------------------- /tests/KeysetSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module KeysetSpec (spec) where 3 | 4 | import Test.Hspec 5 | 6 | import Data.Aeson 7 | 8 | import Pact.Types.Runtime 9 | 10 | 11 | spec :: Spec 12 | spec = describe "fromJSON" testFromJSON 13 | 14 | testFromJSON :: Spec 15 | testFromJSON = do 16 | let ks = mkKeySet ["a","b"] "keys-all" 17 | it "full read from JSON" $ 18 | eitherDecode "{ \"keys\": [\"a\",\"b\"], \"pred\": \"keys-all\" }" `shouldBe` Right ks 19 | it "object no pred" $ 20 | eitherDecode "{ \"keys\": [\"a\",\"b\"]}" `shouldBe` Right ks 21 | it "just list" $ 22 | eitherDecode "[\"a\",\"b\"]" `shouldBe` Right ks 23 | -------------------------------------------------------------------------------- /tests/PactCLISpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | module PactCLISpec(spec) where 4 | 5 | import Test.Hspec 6 | 7 | import qualified Data.Aeson as A 8 | import qualified Data.ByteString as BS 9 | import qualified Data.ByteString.Lazy as BSL 10 | import Data.Either(isRight) 11 | import qualified Data.Yaml as Y 12 | import Data.Text(Text) 13 | import System.FilePath 14 | 15 | import Pact.ApiReq 16 | import Pact.Types.Command 17 | import Pact.Types.API(SubmitBatch) 18 | import Pact.Types.SigData(SigData) 19 | 20 | spec :: Spec 21 | spec = do 22 | partialSigTests 23 | 24 | -- note, generated with `pact -g` 25 | key1, key2 :: FilePath 26 | key1 = "tests" "add-sig" "key1.yaml" 27 | key2 = "tests" "add-sig" "key2.yaml" 28 | 29 | unsignedFile :: FilePath 30 | unsignedFile = "tests" "add-sig" "unsigned.yaml" 31 | 32 | unsignedFile2 :: FilePath 33 | unsignedFile2 = "tests" "add-sig" "unsigned2.yaml" 34 | 35 | partialSigTests :: Spec 36 | partialSigTests = 37 | describe "partial sigs" $ do 38 | it "validates and combines two partial sigs" $ do 39 | unsigned <- BS.readFile unsignedFile 40 | sig1 <- Y.decodeEither' <$> addSigsReq [key1] True unsigned 41 | sig2 <- Y.decodeEither' <$> addSigsReq [key2] True unsigned 42 | sig1 `shouldSatisfy` isRight 43 | sig2 `shouldSatisfy` isRight 44 | let sig1' = either (error "impossible") id sig1 45 | sig2' = either (error "impossible") id sig2 46 | -- Works normally for local 47 | command <- A.eitherDecode @(Command Text) . BSL.fromStrict <$> combineSigDatas [sig1', sig2'] True 48 | command `shouldSatisfy` isRight 49 | -- Works as submitBatch 50 | commandBatch <- A.eitherDecode @SubmitBatch . BSL.fromStrict <$> combineSigDatas [sig1', sig2'] False 51 | commandBatch `shouldSatisfy` isRight 52 | it "validates when command portion is missing as well:" $ do 53 | unsigned <- BS.readFile unsignedFile2 54 | sig1 <- Y.decodeEither' @(SigData Text) <$> addSigsReq [key1] True unsigned 55 | sig2 <- Y.decodeEither' @(SigData Text) <$> addSigsReq [key2] True unsigned 56 | sig1 `shouldSatisfy` isRight 57 | sig2 `shouldSatisfy` isRight 58 | it "does not validate on missing signatures" $ do 59 | unsigned <- BS.readFile unsignedFile 60 | sig1 <- Y.decodeEither' <$> addSigsReq [key1] True unsigned 61 | sig1 `shouldSatisfy` isRight 62 | let sig1' = either (error "impossible") id sig1 63 | -- Works normally for local 64 | combineSigDatas [sig1'] True `shouldThrow` anyException 65 | -------------------------------------------------------------------------------- /tests/PactTests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | import Test.Hspec 4 | 5 | import qualified Blake2Spec 6 | import qualified KeysetSpec 7 | import qualified RoundTripSpec 8 | import qualified PrincipalSpec 9 | import qualified Test.Pact.Utils.LegacyValue 10 | import qualified Test.Pact.Utils.StableHashMap 11 | import qualified SizeOfSpec 12 | import qualified Test.Pact.Native.Pairing 13 | 14 | import qualified PactTestsSpec 15 | import qualified ParserSpec 16 | import qualified SchemeSpec 17 | import qualified SignatureSpec 18 | import qualified Test.Pact.Parse 19 | 20 | #ifdef BUILD_TOOL 21 | import qualified AnalyzePropertiesSpec 22 | import qualified AnalyzeSpec 23 | import qualified ClientSpec 24 | import qualified DocgenSpec 25 | import qualified GasModelSpec 26 | import qualified GoldenSpec 27 | import qualified HistoryServiceSpec 28 | import qualified HyperlaneSpec 29 | import qualified Keccak256Spec 30 | import qualified PactContinuationSpec 31 | import qualified PersistSpec 32 | import qualified RemoteVerifySpec 33 | import qualified TypecheckSpec 34 | import qualified PactCLISpec 35 | import qualified ZkSpec 36 | import qualified ReplSpec 37 | import qualified PoseidonSpec 38 | import qualified CoverageSpec 39 | #endif 40 | 41 | main :: IO () 42 | main = hspec $ parallel $ do 43 | 44 | describe "Blake2Spec" Blake2Spec.spec 45 | describe "KeysetSpec" KeysetSpec.spec 46 | describe "RoundTripSpec" RoundTripSpec.spec 47 | describe "PrincipalSpec" PrincipalSpec.spec 48 | describe "Test.Pact.Utils.LegacyValue" Test.Pact.Utils.LegacyValue.spec 49 | describe "Test.Pact.Utils.StableHashMap" Test.Pact.Utils.StableHashMap.spec 50 | describe "SizeOfSpec" SizeOfSpec.spec 51 | describe "Test.Pact.Native.Pairing" Test.Pact.Native.Pairing.spec 52 | describe "PactTestsSpec" PactTestsSpec.spec 53 | describe "ParserSpec" ParserSpec.spec 54 | describe "SignatureSpec" SignatureSpec.spec 55 | describe "SchemeSpec" SchemeSpec.spec 56 | describe "Test.Pact.Parse" Test.Pact.Parse.spec 57 | 58 | #ifdef BUILD_TOOL 59 | 60 | describe "AnalyzePropertiesSpec" AnalyzePropertiesSpec.spec 61 | describe "AnalyzeSpec" AnalyzeSpec.spec 62 | describe "ClientSpec" ClientSpec.spec 63 | describe "DocgenSpec" DocgenSpec.spec 64 | describe "GasModelSpec" GasModelSpec.spec 65 | describe "GoldenSpec" GoldenSpec.spec 66 | describe "HistoryServiceSpec" HistoryServiceSpec.spec 67 | describe "HyperlaneSpec" HyperlaneSpec.spec 68 | describe "Keccak256Spec" Keccak256Spec.spec 69 | describe "PactContinuationSpec" PactContinuationSpec.spec 70 | describe "PersistSpec" PersistSpec.spec 71 | describe "RemoteVerifySpec" RemoteVerifySpec.spec 72 | describe "TypecheckSpec" TypecheckSpec.spec 73 | describe "PactCLISpec" PactCLISpec.spec 74 | describe "ZkSpec" ZkSpec.spec 75 | describe "ReplSpec" ReplSpec.spec 76 | describe "PoseidonSpec" PoseidonSpec.spec 77 | describe "CoverageSpec" CoverageSpec.spec 78 | 79 | #endif 80 | -------------------------------------------------------------------------------- /tests/PairingSpec.hs: -------------------------------------------------------------------------------- 1 | module PairingSpec where 2 | 3 | -------------------------------------------------------------------------------- /tests/PersistSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module PersistSpec (spec) where 4 | 5 | import Test.Hspec 6 | import Pact.PersistPactDb.Regression 7 | import qualified Pact.Persist.SQLite as SQLite 8 | import System.Directory 9 | import Control.Monad 10 | import Pact.Types.Logger 11 | import Control.Concurrent 12 | 13 | spec :: Spec 14 | spec = do 15 | it "regress Pure" (void $ regressPure neverLog) 16 | describe "regress SQLite" regressSQLite 17 | 18 | 19 | regressSQLite :: Spec 20 | regressSQLite = it "SQLite successfully closes" $ do 21 | let f = "deleteme.sqllite" 22 | db <- do 23 | doesFileExist f >>= \b -> when b (removeFile f) 24 | sl <- SQLite.initSQLite (SQLite.SQLiteConfig "deleteme.sqllite" []) neverLog 25 | mv <- runRegression (initDbEnv neverLog SQLite.persister sl) 26 | _db <$> readMVar mv 27 | SQLite.closeSQLite db `shouldReturn` Right () 28 | removeFile f 29 | -------------------------------------------------------------------------------- /tests/PoseidonSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeOperators #-} 2 | {-# LANGUAGE DataKinds #-} 3 | 4 | module PoseidonSpec (spec) where 5 | 6 | import Test.Hspec 7 | import Crypto.Hash.PoseidonNative 8 | 9 | spec :: Spec 10 | spec = describe "poseidon" $ do 11 | describe "poseidon-hash" $ do 12 | it "computes the poseidon hash for two integers" $ do 13 | poseidon [1] `shouldBe` 18586133768512220936620570745912940619677854269274689475585506675881198879027 14 | poseidon [1, 2] `shouldBe` 7853200120776062878684798364095072458815029376092732009249414926327459813530 15 | poseidon [1, 2, 3] `shouldBe` 6542985608222806190361240322586112750744169038454362455181422643027100751666 16 | poseidon [1, 2, 3, 4] `shouldBe` 18821383157269793795438455681495246036402687001665670618754263018637548127333 17 | poseidon [1, 2, 3, 4, 5] `shouldBe` 6183221330272524995739186171720101788151706631170188140075976616310159254464 18 | poseidon [1, 2, 3, 4, 5, 6] `shouldBe` 20400040500897583745843009878988256314335038853985262692600694741116813247201 19 | poseidon [1, 2, 3, 4, 5, 6, 7] `shouldBe` 12748163991115452309045839028154629052133952896122405799815156419278439301912 20 | poseidon [1, 2, 3, 4, 5, 6, 7, 8] `shouldBe` 18604317144381847857886385684060986177838410221561136253933256952257712543953 -------------------------------------------------------------------------------- /tests/ReplSpec.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module ReplSpec where 5 | 6 | import Test.Hspec 7 | 8 | import Data.ByteString (ByteString) 9 | -- import Control.Monad.IO.Class 10 | import qualified Data.ByteString as BS 11 | import System.Posix.Pty (spawnWithPty, writePty, readPty, closePty) 12 | import System.Process (terminateProcess) 13 | import Control.Monad (void) 14 | 15 | spec :: Spec 16 | spec = describe "ReplSpec" $ do 17 | return () 18 | -- TODO: Find out why these tests fail intermittently on github runners. 19 | -- it "should not print literal via `Show` (regression #1101)" $ do 20 | -- let src = "(print 1)" 21 | -- out <- liftIO (runInteractive src) 22 | -- out `shouldSatisfy` containsNoTermInfo 23 | 24 | -- it "should not print `ErrInfo` via `Show` (regression #1164)" $ do 25 | -- let src = "(module m g (defcap g () true) (defcap OFFERED (pid:string) true) \ 26 | -- \ (defpact sale () (step (= (create-capability-guard (OFFERED (pact-id)))\ 27 | -- \ (create-capability-guard (OFFERED pact-id)))))))" 28 | -- out <- liftIO (runInteractive src) 29 | -- out `shouldSatisfy`containsNoErrInfo 30 | -- it "should inform about shimmed hash function" $ do 31 | -- let src = "(module m g (defcap g () true) (defun test: string (x: integer) \ 32 | -- \ @model [(property (not (= result \"\")))] \ 33 | -- \ (hash x))) \ 34 | -- \ (verify 'm)" 35 | -- out <- liftIO (runInteractive src) 36 | -- out `shouldSatisfy` containsShimmedInfo 37 | 38 | -- | Execute 'src' inside a pseudo-terminal running the pact repl and returns the repl output. 39 | runInteractive :: ByteString -> IO ByteString 40 | runInteractive src = do 41 | (pty, ph) <- spawnWithPty Nothing True "cabal" ["run", "pact"] (100,100) 42 | -- Read until we reach the first pact prompt to ensure 43 | -- the repl is ready. 44 | void $ seekPactPrompt pty mempty 45 | writePty pty (src <> "\n") 46 | out <- seekPactPrompt pty mempty 47 | terminateProcess ph 48 | closePty pty 49 | pure out 50 | where 51 | -- We recursively collect output using 'readPty' (line-based reading), 52 | -- until we encounter the pact prompt. 53 | seekPactPrompt pty o = do 54 | content <- readPty pty 55 | if "pact>" `BS.isInfixOf` content 56 | then pure o 57 | else seekPactPrompt pty (o <> content) 58 | 59 | -- | Check if 's' did not use the show instance of 'ErrInfo' 60 | containsNoErrInfo :: ByteString -> Bool 61 | containsNoErrInfo s = not ("_errDeltas" `BS.isInfixOf` s) 62 | 63 | -- | Check if 's' did not use the show instance of 'TLiteral' 64 | containsNoTermInfo :: ByteString -> Bool 65 | containsNoTermInfo s = not ("_tLiteral" `BS.isInfixOf` s) 66 | 67 | -- | Check if 's' did contain 'Shimmed' 68 | containsShimmedInfo :: ByteString -> Bool 69 | containsShimmedInfo s = "Shimmed" `BS.isInfixOf` s 70 | -------------------------------------------------------------------------------- /tests/SignatureSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module SignatureSpec (spec) where 6 | 7 | import Test.Hspec 8 | 9 | import Control.Error.Util (failWith, hoistEither) 10 | import Control.Monad (forM_, void) 11 | import Control.Monad.Trans.Except 12 | import Data.Bifunctor (first) 13 | import Data.Default (def) 14 | import qualified Data.HashMap.Strict as HM 15 | 16 | import Pact.Repl 17 | import Pact.Repl.Types 18 | import Pact.Types.Exp 19 | import Pact.Types.Runtime 20 | import qualified Pact.Utils.StableHashMap as SHM 21 | 22 | spec :: Spec 23 | spec = compareModelSpec 24 | 25 | compareModelSpec :: Spec 26 | compareModelSpec = describe "Module models" $ do 27 | it "should find all exps defined in interface in corresponding module" $ do 28 | (r,s) <- execScript' Quiet "tests/pact/signatures.repl" 29 | eres <- runExceptT $ do 30 | void $ hoistEither r 31 | (rs,_) <- ExceptT . fmap (first show) $ replGetModules s 32 | md <- failWith "Map lookup failed" $ HM.lookup (ModuleName "model-test1-impl" Nothing) rs 33 | ifd <- failWith "Map lookup failed" $ HM.lookup (ModuleName "model-test1" Nothing) rs 34 | pure (md, ifd) 35 | case eres of 36 | Left e -> expectationFailure $ "script loading + lookups: " <> e 37 | Right (md, ifd) -> do 38 | let mModels = case _mdModule md of 39 | MDModule m -> _mModel $ _mMeta m 40 | _ -> def 41 | iModels = case _mdModule ifd of 42 | MDInterface i -> _mModel $ _interfaceMeta i 43 | _ -> def 44 | mfunModels = aggregateFunctionModels md 45 | ifunModels = aggregateFunctionModels ifd 46 | forM_ iModels $ \e -> 47 | (e,mModels) `shouldSatisfy` (\_ -> any (expEquality e) mModels) 48 | forM_ ifunModels $ \e -> 49 | (e,mfunModels) `shouldSatisfy` (\_ -> any (expEquality e) mfunModels) 50 | 51 | aggregateFunctionModels :: ModuleData Ref -> [Exp Info] 52 | aggregateFunctionModels ModuleData{..} = 53 | foldMap (extractExp . snd) $ SHM.toList _mdRefMap 54 | where 55 | extractExp (Ref (TDef (Def _ _ _ _ _ Meta{_mModel=m} _ _) _)) = m 56 | extractExp _ = [] 57 | 58 | -- Because models will necessarily have conflicting Info values 59 | -- we need to define a new form of equality which forgets 60 | -- 'Info', and only compares relevant terms. 61 | expEquality :: Exp Info -> Exp Info -> Bool 62 | expEquality e1 e2 = ((def :: Info) <$ e1) == ((def :: Info) <$ e2) 63 | -------------------------------------------------------------------------------- /tests/SizeOfSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | module SizeOfSpec(spec) where 4 | 5 | import Test.Hspec 6 | import GHC.Generics(Generic) 7 | 8 | import Pact.Types.SizeOf 9 | 10 | -- Testing whether derived instance for empty constructors is 1 word 11 | data A = A1 | A2 deriving (Eq, Show, Generic) 12 | data B = B1 Int | B2 Int Bool | B3 Int Bool A deriving (Eq, Show, Generic) 13 | data C a = C a deriving (Eq, Show, Generic) 14 | 15 | instance SizeOf A 16 | instance SizeOf B 17 | instance SizeOf a => SizeOf (C a) 18 | 19 | newtype D = D Int 20 | deriving (Eq, Show, Generic) 21 | 22 | instance SizeOf D 23 | 24 | newtype F = F Int 25 | deriving (Eq, Show, SizeOf) 26 | 27 | sizeOfGenericsTest :: SizeOfVersion -> Spec 28 | sizeOfGenericsTest szVer = do 29 | describe ("SizeOf " <> show szVer <> " generics conform to specification") $ do 30 | it "Costs only one word for shared data types" $ do 31 | sizeOf szVer A1 `shouldBe` wordSize 32 | sizeOf szVer A2 `shouldBe` wordSize 33 | it "Costs the constructor size + 1 word per field" $ do 34 | sizeOf szVer (B1 0) `shouldBe` (sizeOf szVer (0::Int) + constructorCost 1) 35 | sizeOf szVer (B2 0 True) `shouldBe` (sizeOf szVer (0::Int) + sizeOf szVer True + constructorCost 2) 36 | let b3Cost = sizeOf szVer (0::Int) + sizeOf szVer True + sizeOf szVer A1 + constructorCost 3 37 | sizeOf szVer (B3 0 True A1) `shouldBe` b3Cost 38 | it "Works with parametrically defined instances" $ do 39 | sizeOf szVer (C (B1 0)) `shouldBe` (sizeOf szVer (B1 0) + constructorCost 1) 40 | it "Prices newtype instance with standalone deriving like constructor" $ do 41 | let k = 1 42 | sizeOf szVer (D k) `shouldBe` (sizeOf szVer k + constructorCost 1) 43 | it "Prices newtype instance with GND like a newtype" $ do 44 | let k = 1 45 | sizeOf SizeOfV0 (F k) `shouldBe` sizeOf szVer k 46 | 47 | sizeOfV1ForkTest :: Spec 48 | sizeOfV1ForkTest = describe "SizeOfV1 Changes" $ do 49 | it "Costs integers differently post-fork" $ do 50 | let i = (1120381203120310237810238701283710287440918750182730812730817238127328 :: Integer) 51 | sizeOf SizeOfV0 i `shouldSatisfy` (< sizeOf SizeOfV1 i) 52 | -- Exact amounts here function as a regression. 53 | sizeOf SizeOfV0 i `shouldBe` 14 54 | sizeOf SizeOfV1 i `shouldBe` 28 55 | -- Regression on old behavior 56 | sizeOf SizeOfV0 (-i) `shouldBe` 0 57 | -- New behavior for sizeOf testing abs 58 | sizeOf SizeOfV1 (-i) `shouldBe` sizeOf SizeOfV1 i 59 | 60 | 61 | spec :: Spec 62 | spec = do 63 | sizeOfGenericsTest SizeOfV0 64 | sizeOfGenericsTest SizeOfV1 65 | sizeOfV1ForkTest 66 | -------------------------------------------------------------------------------- /tests/Utils/eth-keys.txt: -------------------------------------------------------------------------------- 1 | Private Key, Public Key, Address 2 | 6dc206256e48dc3ce545e05135b469b8c4dc44493785ff69f38eb702aa065af4, 8281c43fe803b508e2f3fdae7aa2c22db9c337e62806658c5fa67b137a5f82bafc74ea853feddf85c89d61c31f191f7e398a3b793004a7a7380ac72e2861ed33, db8304f325524279d9a34706932a6a07ebfc5c97 3 | cf1dfadbf15bf750a3541d3ce39d9b65311061405855bd81c0137651ca9ba983, c640e94730fb7b7fce01b11086645741fcb5174d1c634888b9d146613730243a171833259cd7dab9b3435421dcb2816d3efa55033ff0899de6cc8b1e0b20e56c, 9f491e44a3f87df60d6cb0eefd5a9083ae6c3f32 4 | f71ee6126edd0693127fb05e16c9b9e85c55d86a83f21626e018f2f709e8b969, 0e72033edfce78e0b74d07bb275312179af22ae38feaccecfbdd8728f816e5c938aed5015098af1dd0a135681118410f95f9036b2f16ff51a1bf3d6d23faa82b, 1dc3794f3079b380e26b26a5835c04b9497d0908 5 | 8c56d5133fdc454c2d6eaab1abf50aef6298f4b17d8ed8ae3b6eb3b5993c36f7, 558c704562332c798b1858f3a3e443dcf630d072e348a4466195c72a107b88cb588b49a70c36c41f4e2488b21b8f376f464b02074bea1f68ddb3c325465cf5a3, bc6314c12b78a21d2fd6a8eec8e78936ce9a86e1 6 | 43ada94cababd585ca7a320609ec43695b5c1b97c66ef3ab133a7ef7b934a24d, ef082370011f8c0f6ac2b5ab965b84f7141a1057ce55b9cc815f8d339b7b8168713e4a4b51982307f827199bbd9d6c94be3f93def86601c74772a52ca9631251, 612ac19e1ac0e5feb47737560930adeba57baf3f 7 | 1aa7383fba7ca9ad06eeb5362dfcfeca63b9fca6b69e98a5653c4213b272f9d1, 3ff4aa2504039f415b9e1a4f745da396a26f60c9370d5ef2f0c0778852f5e3b9d05780ea52bc0448714516c0315d0907f22419439613d0087d76e580c39b4a7a, 24f3ae0fc699ff2287365684a50cdaa8e69996dd 8 | -------------------------------------------------------------------------------- /tests/Utils/gen-eth-key.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Source: "Complete example" section, https://kobl.one/blog/create-full-ethereum-keypair-and-address/ 4 | 5 | rm Key pub priv geth address 6 | 7 | # Generate the private and public keys 8 | openssl ecparam -name secp256k1 -genkey -noout | openssl ec -text -noout > Key && 9 | 10 | # Extract the public key and remove the EC prefix 0x04 11 | cat Key | grep pub -A 5 | tail -n +2 | tr -d '\n[:space:]:' | sed 's/^04//' > pub && 12 | 13 | # Extract the private key and remove the leading zero byte 14 | cat Key | grep priv -A 3 | tail -n +2 | tr -d '\n[:space:]:' | sed 's/^00//' > priv && 15 | 16 | # Import the private key to geth and get address 17 | yes '' | geth account import priv > geth && 18 | 19 | cat geth | grep "Address" | sed 's/^Address: {//' | sed 's/.$//' > address && 20 | 21 | # Add public key, private key, and address to text file 22 | pubV=`cat pub` 23 | privV=`cat priv` 24 | addrV=`cat address` 25 | echo "$privV, $pubV, $addrV" >> ./tests/Utils/eth-keys.txt && 26 | echo "Added the following keys \n \ 27 | priv: $privV \n \ 28 | pub: $pubV \n \ 29 | addr: $addrV \n" 30 | 31 | rm Key pub priv geth address 32 | -------------------------------------------------------------------------------- /tests/add-sig/key1.yaml: -------------------------------------------------------------------------------- 1 | public: 87a4f2f179662829da6816b901ec1402b4baa30ce9d96048345aff9b346de6b7 2 | secret: 0a61e065af30ce14d36e683b5394fdbf4573347a72fa44e6fcb6b42e20c64db1 3 | -------------------------------------------------------------------------------- /tests/add-sig/key2.yaml: -------------------------------------------------------------------------------- 1 | public: 1ba4d22bdcf499a8e27667b56e45222260a93806066ca5f82e79ef2f38cf8c0b 2 | secret: 31f2554f16ca907073739a2441fcca4d2a54c6f773f61628c262f0f24ff776cb 3 | -------------------------------------------------------------------------------- /tests/add-sig/test.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (+ 1 1) 3 | publicMeta: 4 | chainId: "0" 5 | sender: jose 6 | gasLimit: 5000 7 | gasPrice: 0.00000001 8 | ttl: 28800 9 | networkId: "testnet04" 10 | signers: 11 | - public: 87a4f2f179662829da6816b901ec1402b4baa30ce9d96048345aff9b346de6b7 12 | - public: 1ba4d22bdcf499a8e27667b56e45222260a93806066ca5f82e79ef2f38cf8c0b 13 | caps: 14 | - name: coin.GAS 15 | args: [] 16 | type: exec 17 | -------------------------------------------------------------------------------- /tests/add-sig/unsigned.yaml: -------------------------------------------------------------------------------- 1 | hash: tTg1a9B8jWRM3KrAq2ITSZtL5yq1wQj30SpugHiLqiE 2 | sigs: 3 | 1ba4d22bdcf499a8e27667b56e45222260a93806066ca5f82e79ef2f38cf8c0b: null 4 | 87a4f2f179662829da6816b901ec1402b4baa30ce9d96048345aff9b346de6b7: null 5 | cmd: '{"networkId":"testnet04","payload":{"exec":{"data":null,"code":"(+ 1 1)"}},"signers":[{"pubKey":"87a4f2f179662829da6816b901ec1402b4baa30ce9d96048345aff9b346de6b7"},{"pubKey":"1ba4d22bdcf499a8e27667b56e45222260a93806066ca5f82e79ef2f38cf8c0b","clist":[{"args":[],"name":"coin.GAS"}]}],"meta":{"creationTime":1648585041,"ttl":28800,"gasLimit":5000,"chainId":"0","gasPrice":1.0e-8,"sender":"jose"},"nonce":"2022-03-29 20:17:21.296857 UTC"}' 6 | 7 | -------------------------------------------------------------------------------- /tests/add-sig/unsigned2.yaml: -------------------------------------------------------------------------------- 1 | hash: tTg1a9B8jWRM3KrAq2ITSZtL5yq1wQj30SpugHiLqiE 2 | sigs: 3 | 1ba4d22bdcf499a8e27667b56e45222260a93806066ca5f82e79ef2f38cf8c0b: null 4 | 87a4f2f179662829da6816b901ec1402b4baa30ce9d96048345aff9b346de6b7: null 5 | cmd: null 6 | 7 | -------------------------------------------------------------------------------- /tests/apireq.yaml: -------------------------------------------------------------------------------- 1 | code: "(+ 1 2)" 2 | data: 3 | name: Stuart 4 | language: Pact 5 | keyPairs: 6 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 7 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 8 | -------------------------------------------------------------------------------- /tests/bench/bench: -------------------------------------------------------------------------------- 1 | (load "bench.repl") 2 | (bench (bench.bench)) 3 | -------------------------------------------------------------------------------- /tests/bench/bench.repl: -------------------------------------------------------------------------------- 1 | (env-data 2 | { "keyset": { "keys": ["benchadmin"], "pred": ">" } 3 | , "acct": ["0c99d911059580819c6f39ca5c203364a20dbf0a02b0b415f8ce7b48ba3a5bad"] 4 | } 5 | ) 6 | (begin-tx) 7 | (load "bench.pact") 8 | (commit-tx) 9 | (use bench) 10 | (env-keys ["0c99d911059580819c6f39ca5c203364a20dbf0a02b0b415f8ce7b48ba3a5bad"]) 11 | (expect "bench success" "Write succeeded" 12 | (bench)) 13 | (env-sigs 14 | [{"key": "0c99d911059580819c6f39ca5c203364a20dbf0a02b0b415f8ce7b48ba3a5bad" 15 | ,"caps":[(MTRANSFER "Acct1" "Acct2" 1.0)]}]) 16 | (test-capability (MTRANSFER "Acct1" "Acct2" 1.0)) 17 | (expect "mbench success" "Write succeeded" 18 | (mbench)) 19 | -------------------------------------------------------------------------------- /tests/blake2/blake2b.h: -------------------------------------------------------------------------------- 1 | // blake2b.h 2 | // BLAKE2b Hashing Context and API Prototypes 3 | 4 | #ifndef BLAKE2B_H 5 | #define BLAKE2B_H 6 | 7 | #include 8 | #include 9 | 10 | // state context 11 | typedef struct { 12 | uint8_t b[128]; // input buffer 13 | uint64_t h[8]; // chained state 14 | uint64_t t[2]; // total number of bytes 15 | size_t c; // pointer for b[] 16 | size_t outlen; // digest size 17 | } blake2b_ctx; 18 | 19 | // Initialize the hashing context "ctx" with optional key "key". 20 | // 1 <= outlen <= 64 gives the digest size in bytes. 21 | // Secret key (also <= 64 bytes) is optional (keylen = 0). 22 | int blake2b_init(blake2b_ctx *ctx, size_t outlen, 23 | const void *key, size_t keylen); // secret key 24 | 25 | // Add "inlen" bytes from "in" into the hash. 26 | void blake2b_update(blake2b_ctx *ctx, // context 27 | const void *in, size_t inlen); // data to be hashed 28 | 29 | // Generate the message digest (size given in init). 30 | // Result placed in "out". 31 | void blake2b_final(blake2b_ctx *ctx, void *out); 32 | 33 | // All-in-one convenience function. 34 | int blake2b(void *out, size_t outlen, // return buffer for digest 35 | const void *key, size_t keylen, // optional secret key 36 | const void *in, size_t inlen); // data to be hashed 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /tests/chainweb-example.yaml: -------------------------------------------------------------------------------- 1 | code: (+ 1 2) 2 | publicMeta: 3 | chainId : "0" 4 | sender: "sender00" 5 | gasLimit: 1000 6 | gasPrice: 0.01 7 | ttl: 0 8 | creationTime: 0 9 | keyPairs: 10 | - public: 368820f80c324bbc7c2b0610688a7da43e39f91d118732671cd9c7500ff43cca 11 | secret: 251a920c403ae8c8f65f59142316af3c82b631fba46ddea92ee8c95035bd2898 12 | -------------------------------------------------------------------------------- /tests/cont-scripts/fail-both-price-down-01-cont-badcaps.yaml: -------------------------------------------------------------------------------- 1 | # Both debtor and creditor can finish together if price remains the same 2 | # or negotiated down BUT bad caps ruin the day. 3 | type: "cont" 4 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 5 | step: 1 6 | rollback: False 7 | data: {final-price: 1.75} 8 | keyPairs: 9 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 10 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 11 | caps: 12 | - name: accounts.ADMIN 13 | args: [] 14 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 15 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 16 | nonce: fail-both-price-down-01-cont-badcaps 17 | -------------------------------------------------------------------------------- /tests/cont-scripts/fail-both-price-up-01-cont.yaml: -------------------------------------------------------------------------------- 1 | # Both debtor and creditor can finish together, but cannot negotiate price up 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 1 5 | rollback: False 6 | data: {final-price: 12.0} 7 | publicMeta: 8 | chainId: "Testnet00/0" 9 | sender: "Sender0" 10 | gasLimit: 0 11 | gasPrice: 0 12 | ttl: 0 13 | creationTime: 0 14 | keyPairs: 15 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 16 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 17 | scheme: ED25519 18 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 19 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 20 | nonce: both-price-up-step01 21 | -------------------------------------------------------------------------------- /tests/cont-scripts/fail-cred-finish-01-cont.yaml: -------------------------------------------------------------------------------- 1 | # Creditor (Bob) cannot finish alone 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 1 5 | rollback: False 6 | keyPairs: 7 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 8 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 9 | nonce: cred-finish-step01 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/fail-deb-cancel-01-rollback.yaml: -------------------------------------------------------------------------------- 1 | # Debtor (Alice) cannot cancel pre-timeout 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 0 5 | rollback: True 6 | keyPairs: 7 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 8 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 9 | nonce: fail-deb-cancel-step01 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/fail-deb-cancel-02-balance.yaml: -------------------------------------------------------------------------------- 1 | # Money should still be escrowed, despite debtor's attempt to cancel 2 | code: (test.get-balance "Alice") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: fail-deb-cancel-step02 -------------------------------------------------------------------------------- /tests/cont-scripts/fail-deb-finish-01-cont.yaml: -------------------------------------------------------------------------------- 1 | # Debtor (Alice) cannot finish alone 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 1 5 | rollback: False 6 | keyPairs: 7 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 8 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 9 | nonce: deb-finish-step01 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/managed-01-pay.yaml: -------------------------------------------------------------------------------- 1 | # Exercises PAY capability 2 | 3 | code: |- 4 | (accounts.pay "Alice" "Bob" 0.9 (time "2016-07-22T11:26:35Z")) 5 | keyPairs: 6 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 7 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 8 | caps: 9 | - name: accounts.PAY 10 | args: ["Alice","Bob",1.0] 11 | nonce: managed-01-pay 12 | -------------------------------------------------------------------------------- /tests/cont-scripts/managed-02-pay-fails.yaml: -------------------------------------------------------------------------------- 1 | # Exercises PAY capability, fails because amount too high on second pmt 2 | 3 | code: |- 4 | (accounts.pay "Alice" "Bob" 0.9 (time "2016-07-22T11:26:35Z")) 5 | (accounts.pay "Alice" "Bob" 0.2 (time "2016-07-22T11:26:35Z")) 6 | keyPairs: 7 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 8 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 9 | caps: 10 | - name: accounts.PAY 11 | args: ["Alice","Bob",1.0] 12 | nonce: managed-02-pay-fails 13 | -------------------------------------------------------------------------------- /tests/cont-scripts/pass-both-price-down-01-cont.yaml: -------------------------------------------------------------------------------- 1 | # Both debtor and creditor can finish together if price remains the same 2 | # or negotiated down. 3 | type: "cont" 4 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 5 | step: 1 6 | rollback: False 7 | data: {final-price: 1.75} 8 | keyPairs: 9 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 10 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 11 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 12 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 13 | nonce: both-price-down-step01 14 | -------------------------------------------------------------------------------- /tests/cont-scripts/pass-both-price-down-02-cred-balance.yaml: -------------------------------------------------------------------------------- 1 | # Get creditor balance after escrow finishes 2 | code: (test.get-balance "Bob") 3 | keyPairs: 4 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 5 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 6 | nonce: both-price-down-step02 -------------------------------------------------------------------------------- /tests/cont-scripts/pass-both-price-down-03-deb-balance.yaml: -------------------------------------------------------------------------------- 1 | # Get debtor balance after escrow finishes 2 | code: (test.get-balance "Alice") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: both-price-down-step03 -------------------------------------------------------------------------------- /tests/cont-scripts/pass-cred-cancel-01-reset.yaml: -------------------------------------------------------------------------------- 1 | # Alice resets time 2 | code: |- 3 | (test.reset-time) 4 | keyPairs: 5 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 6 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 7 | nonce: pass-cred-cancel-step01 8 | -------------------------------------------------------------------------------- /tests/cont-scripts/pass-cred-cancel-02-rollback.yaml: -------------------------------------------------------------------------------- 1 | # Creditor (Bob) can cancel anytime 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 0 5 | rollback: True 6 | keyPairs: 7 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 8 | secret: 756f0d270d3ed42594529817e89ffa311b4bd5359d76cbcbb135fb178071faaa 9 | nonce: pass-cred-cancel-step02 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/pass-cred-cancel-03-balance.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (test.get-balance "Alice") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: pass-cred-cancel-step03 -------------------------------------------------------------------------------- /tests/cont-scripts/pass-deb-cancel-01-set-time.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (system.set-system-time test.TIMEOUT) 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: pass-deb-cancel-step01 -------------------------------------------------------------------------------- /tests/cont-scripts/pass-deb-cancel-02-rollback.yaml: -------------------------------------------------------------------------------- 1 | # Debtor (Alice) can cancel after timeout 2 | type: "cont" 3 | pactTxHash: "L2N2SgjdQAHNEu6WY82VAa4LyxmqfrAuaR6sB41DUMQ" 4 | step: 0 5 | rollback: True 6 | keyPairs: 7 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 8 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 9 | nonce: pass-deb-cancel-step02 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/pass-deb-cancel-03-balance.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (test.get-balance "Alice") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: pass-deb-cancel-step03 -------------------------------------------------------------------------------- /tests/cont-scripts/setup-01-system.yaml: -------------------------------------------------------------------------------- 1 | # Provides mock system module for 'accounts' 2 | code: |- 3 | (define-keyset 'k (read-keyset "accounts-admin-keyset")) 4 | (module system 'k 5 | (defschema sysdata curtime:time) 6 | (deftable systbl:{sysdata}) 7 | (defconst KEY "sys") 8 | (defun set-system-time (curtime) (write systbl KEY { 'curtime: curtime })) 9 | (defun get-system-time () (at 'curtime (read systbl KEY))) 10 | ) 11 | (create-table systbl) 12 | "system module loaded" 13 | data: 14 | accounts-admin-keyset: ["ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d"] 15 | keyPairs: 16 | - address: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 17 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 18 | scheme: ED25519 19 | nonce: setup-step01 20 | -------------------------------------------------------------------------------- /tests/cont-scripts/setup-02-accounts.yaml: -------------------------------------------------------------------------------- 1 | # To use, first load mock system module, then load accounts. 2 | # Command line: 3 | # $ pact -a examples/accounts/mock-system.yaml | curl -d @- http://localhost:8080/api/v1/send 4 | # $ pact -a examples/accounts/accounts.yaml | curl -d @- http://localhost:8080/api/v1/send 5 | 6 | codeFile: ../../examples/accounts/accounts.pact 7 | data: 8 | accounts-admin-keyset: ["ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d"] 9 | keyPairs: 10 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 11 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 12 | nonce: setup-step02 13 | -------------------------------------------------------------------------------- /tests/cont-scripts/setup-03-test.yaml: -------------------------------------------------------------------------------- 1 | # Provides mock module for running two-party-escrow tests 2 | code: |- 3 | (module test 'k 4 | (defconst TIMEOUT (time "2017-01-01T13:00:00Z")) 5 | (defun run-escrow (deb cred) (accounts.two-party-escrow deb cred 2.00 TIMEOUT)) 6 | (defun reset-time () (system.set-system-time (time "2017-01-01T12:00:00Z"))) 7 | (defun get-balance (acct) (at "balance" (accounts.read-account-user acct))) 8 | ) 9 | "test module loaded" 10 | data: 11 | accounts-admin-keyset: ["ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d"] 12 | keyPairs: 13 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 14 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 15 | nonce: setup-step03 16 | -------------------------------------------------------------------------------- /tests/cont-scripts/setup-04-create.yaml: -------------------------------------------------------------------------------- 1 | # Creates accounts and funds Alice's account 2 | #(format "Alice has ${} and Bob has ${}." [(test.get-balance "Alice") (test.get-balance "Bob")]))) 3 | code: |- 4 | (use accounts) 5 | (use system) 6 | (create-account "Alice" (read-keyset "alice-keyset") "USD" (time "2016-07-22T11:26:35Z")) 7 | (create-account "Bob" (read-keyset "bob-keyset") "USD" (time "2016-07-22T11:26:35Z")) 8 | (fund-account "Alice" 100.0 (time "2016-07-22T11:26:35Z")) 9 | (read-all) 10 | data: 11 | alice-keyset: ["7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804"] 12 | bob-keyset: ["ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9"] 13 | keyPairs: 14 | - public: ba54b224d1924dd98403f5c751abdd10de6cd81b0121800bf7bdbdcfaec7388d 15 | secret: 8693e641ae2bbe9ea802c736f42027b03f86afe63cae315e7169c9c496c17332 16 | nonce: setup-step04 17 | -------------------------------------------------------------------------------- /tests/cont-scripts/setup-05-reset.yaml: -------------------------------------------------------------------------------- 1 | # Alice resets time 2 | code: |- 3 | (test.reset-time) 4 | keyPairs: 5 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 6 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 7 | nonce: setup-step05 -------------------------------------------------------------------------------- /tests/cont-scripts/setup-06-escrow.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (test.run-escrow "Alice" "Bob") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | caps: 7 | - name: accounts.USER_GUARD 8 | args: ["Alice"] 9 | nonce: setup-step06 10 | -------------------------------------------------------------------------------- /tests/cont-scripts/setup-07-balance.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (test.get-balance "Alice") 3 | keyPairs: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 6 | nonce: setup-step07 7 | -------------------------------------------------------------------------------- /tests/cp-auth-keys.json: -------------------------------------------------------------------------------- 1 | { "module-admin-keyset": 2 | { "keys": ["e6f65edd34986745f1d3a4a3f9706ad35a0049005d63117578a800701c9ef8cc"], 3 | "pred": "keys-all" } } 4 | -------------------------------------------------------------------------------- /tests/cp-cash-create.pact: -------------------------------------------------------------------------------- 1 | (cash.create-account "stu" "USD" 1000.0 (time "2016-09-01T11:00:00Z")) 2 | -------------------------------------------------------------------------------- /tests/cp-cash-create2.pact: -------------------------------------------------------------------------------- 1 | (cash.create-account "will" "USD" 1010.0 (time "2016-09-01T11:00:00Z")) 2 | -------------------------------------------------------------------------------- /tests/lcov/lcov.pact: -------------------------------------------------------------------------------- 1 | 2 | (module covtest GOVERNANCE 3 | 4 | (defcap GOVERNANCE:bool () true) 5 | 6 | (defconst CONST:decimal 1.0) 7 | 8 | (defschema sch 9 | guard:guard 10 | val:decimal 11 | ) 12 | 13 | (deftable tbl:{sch}) 14 | 15 | (defcap CAP:bool (k:string) 16 | (enforce-guard 17 | (at 'guard 18 | (read tbl k)))) 19 | 20 | (defun create:string 21 | ( k:string 22 | g:guard 23 | val:decimal 24 | ) 25 | (insert tbl k 26 | { 'guard: g 27 | , 'val: val 28 | })) 29 | 30 | (defun update-val:string 31 | ( k:string 32 | val:decimal 33 | ) 34 | (with-capability (CAP k) 35 | (update tbl k { 'val: val }))) 36 | 37 | (defun increase:string 38 | ( k:string 39 | d:decimal 40 | ) 41 | (let ((curr (at 'val (read tbl k)))) 42 | (enforce (> d curr) "must increase") 43 | (update-val k d)) ;; deliberately skipping this 44 | ) 45 | ) 46 | 47 | (create-table tbl) 48 | -------------------------------------------------------------------------------- /tests/lcov/lcov.repl: -------------------------------------------------------------------------------- 1 | (load "lcov.pact") 2 | (typecheck 'covtest) 3 | (env-data { 'k: ["key"] }) 4 | 5 | (create 'a (read-keyset 'k) CONST) 6 | 7 | (expect-failure 8 | "update guard" 9 | "Keyset failure" 10 | (update-val 'a 2.0) 11 | ) 12 | 13 | (env-keys ['key]) 14 | 15 | (update-val 'a 2.0) 16 | 17 | (expect-failure 18 | "must increase" 19 | "must increase" 20 | (increase 'a 1.0)) 21 | 22 | ;; skip success test 23 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-defcap-explicit-mgr-auto-impl.repl: -------------------------------------------------------------------------------- 1 | (interface I 2 | (defcap CAP:bool (a:string b:integer) 3 | @managed b mgr) 4 | (defun mgr:integer (a:integer b:integer))) 5 | 6 | (module M G 7 | (defcap G () true) 8 | (implements I) 9 | ;; auto @managed 10 | (defcap CAP:bool (a:string b:integer) @managed 11 | true) 12 | (defun mgr:integer (a:integer b:integer) 1) 13 | ) 14 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-dupe-def.repl: -------------------------------------------------------------------------------- 1 | (module bad-dupe-def G 2 | (defcap G () true) 3 | (defschema a a:string) 4 | (defun a () true) 5 | ) 6 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-iface-enforce-ns-user.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-data { 'user: ["user"], 'admin: ["admin"] }) 3 | (define-namespace 'ns-user-behavior (read-keyset 'user) (read-keyset 'admin)) 4 | (commit-tx) 5 | 6 | (begin-tx) 7 | (env-data { 'user: ["user"], 'admin: ["admin"] }) 8 | (env-keys []) 9 | (env-exec-config []) 10 | (expect-failure 11 | "ensure user keyset does not pass" 12 | (enforce-keyset (read-keyset 'user))) 13 | 14 | (expect-that 15 | "entering ns does not enforce user guard" 16 | (constantly true) 17 | (namespace 'ns-user-behavior)) 18 | 19 | ;; interface install should FAIL 20 | (interface user-iface-fail 21 | (defun f ()) 22 | ) 23 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-defcap.repl: -------------------------------------------------------------------------------- 1 | ;; Bad import - capabilities are non-importable 2 | (module f F 3 | (defcap F () true) 4 | (defun f () true) 5 | ) 6 | 7 | (module g G 8 | (use f [F]) 9 | (defcap G () true) 10 | (defun g () (f)) 11 | ) 12 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-deftable.repl: -------------------------------------------------------------------------------- 1 | ;; Bad Import - tables are non-importable 2 | (module f F 3 | 4 | (defschema s 5 | a:string) 6 | 7 | (deftable t:{s}) 8 | 9 | (defcap F () true) 10 | (defun f () true) 11 | ) 12 | 13 | (module g G 14 | (use f [t]) 15 | (defcap G () true) 16 | (defun g () (f)) 17 | ) 18 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-emptylist.pact: -------------------------------------------------------------------------------- 1 | ;; Bad import - empty import lists should fail if no module hash 2 | ;; is supplied. 3 | (module f F 4 | (defcap F () true) 5 | (defun f () true) 6 | ) 7 | 8 | (module g G 9 | (use f []) 10 | (defcap G () true) 11 | (defun g () (f)) 12 | ) 13 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-overlapping-def.pact: -------------------------------------------------------------------------------- 1 | ;; Bad import - name overlap between definitions and imports 2 | (module f F 3 | (defcap F () true) 4 | (defun f () true) 5 | ) 6 | 7 | (module g G 8 | (use f [f]) 9 | (defcap G () true) 10 | (defun f () true) 11 | ) 12 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-unimported-reference.repl: -------------------------------------------------------------------------------- 1 | ;; Bad import - cannot reference unimported member of module defined 2 | ;; in previous tx. 3 | (begin-tx) 4 | 5 | (module f F 6 | (defcap F () true) 7 | (defun f () true) 8 | (defun g () true) 9 | ) 10 | 11 | (commit-tx) 12 | (begin-tx) 13 | 14 | (module g G 15 | (use f [g]) 16 | (defcap G () true) 17 | (defun g () (f)) 18 | ) 19 | 20 | (g.g) 21 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-unknown-definition.pact: -------------------------------------------------------------------------------- 1 | ;; Bad Import - cannot import undefined member 2 | (module f F 3 | (defcap F () true) 4 | (defun f () true) 5 | ) 6 | 7 | (module g G 8 | (use f [g]) 9 | (defcap G () true) 10 | (defun g () (f)) 11 | ) 12 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-import-wrong-hash.repl: -------------------------------------------------------------------------------- 1 | ;; Bad import - empty import lists should fail if no module hash 2 | ;; is supplied. 3 | (begin-tx) 4 | (module m G 5 | (defcap G () true) 6 | (defun f () true) 7 | ) 8 | (commit-tx) 9 | (begin-tx) 10 | (module n H 11 | ;; only last letter changed 12 | ;; actual hash: S_uhfqHsatDTMeUQhDNwXOHMpio2hX2Jcd-S5YDiNNk 13 | (use m "S_uhfqHsatDTMeUQhDNwXOHMpio2hX2Jcd-S5YDiNNg" 14 | []) 15 | 16 | (defcap H () true) 17 | (defun g () true) 18 | ) 19 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-modrefs-empty.repl: -------------------------------------------------------------------------------- 1 | (module bad-modrefs G 2 | (defcap G () true) 3 | (defun modref-types 4 | ( ref:module{} ) 5 | "test modref with empty list" 6 | 1) 7 | ) 8 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-modrefs.repl: -------------------------------------------------------------------------------- 1 | (module bad-modrefs G 2 | (defcap G () true) 3 | (defun modref-types 4 | ( ref:module{foo.bar.baz} ) 5 | "test modref with bad interface name" 6 | 1) 7 | ) 8 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-module-enforce-ns-user.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-data { 'user: ["user"], 'admin: ["admin"] }) 3 | (define-namespace 'ns-user-behavior (read-keyset 'user) (read-keyset 'admin)) 4 | (commit-tx) 5 | 6 | (begin-tx) 7 | (env-data { 'user: ["user"], 'admin: ["admin"] }) 8 | (env-keys []) 9 | (env-exec-config []) 10 | (expect-failure 11 | "ensure user keyset does not pass" 12 | (enforce-keyset (read-keyset 'user))) 13 | 14 | (expect-that 15 | "entering ns does not enforce user guard" 16 | (constantly true) 17 | (namespace 'ns-user-behavior)) 18 | 19 | 20 | ;; initial module install should FAIL 21 | (module user-module-fail G 22 | (defcap G () false) 23 | (defun f () 2)) 24 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-modules-disabled.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ["DisableModuleInstall"]) 2 | (module M G 3 | (defcap G () true) 4 | (defun foo () true)) 5 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-namespace-upgrade.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-data { "k": ["k"]}) 3 | (env-keys ["k"]) 4 | (define-namespace 'ns (read-keyset 'k) (read-keyset 'k)) 5 | (namespace 'ns) 6 | (module foo AUTONOMOUS 7 | (defcap AUTONOMOUS () (enforce false 'autonomous))) 8 | (commit-tx) 9 | 10 | (begin-tx) 11 | (namespace 'ns) 12 | ;; following should fail, as ns.foo is non-upgradeable 13 | (module foo AUTONOMOUS 14 | (defcap AUTONOMOUS () (enforce true "wheee"))) 15 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-ns-def.repl: -------------------------------------------------------------------------------- 1 | (env-data { "k" : ["k"] }) 2 | (env-keys ["k"]) 3 | (define-namespace "1-namespace" (read-keyset "k") (read-keyset "k")) 4 | (namespace "1-namespace") 5 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-pact.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ["DisablePact44"]) 2 | (define-keyset 'k (sig-keyset)) 3 | (module parensfordays 'k 4 | (defpact foo () 5 | (step "foo") 6 | (step-with-rollback "foo" "bar"))) ; rollbacks not allowed on the last step 7 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-parens.repl: -------------------------------------------------------------------------------- 1 | 2 | (define-keyset 'k (sig-keyset)) 3 | (module parensfordays 'k 4 | (defun foo () 1)))))) 5 | 6 | 1 7 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-repl-native.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (module bad-repl-native G 3 | (defcap G () true) 4 | (defun f () (env-sigs [{'key: "bob",'caps: []}]))) 5 | (commit-tx) 6 | (bad-repl-native.f) 7 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-root-namespace-44.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (module test-mgd-ns GOV 3 | (defcap GOV () true) 4 | (defun manage (ns guard) true)) 5 | (commit-tx) 6 | (use test-mgd-ns) 7 | (env-namespace-policy false (manage)) 8 | 9 | ;; root install should fail, legacy 10 | 11 | (env-exec-config ['DisablePact44]) 12 | (module my-bad-root G 13 | (defcap G () true) 14 | (defun foo () 1)) 15 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-root-namespace-upgrade.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (module test-mgd-ns GOV 3 | (defcap GOV () true) 4 | (defun manage (ns guard) true)) 5 | (commit-tx) 6 | (use test-mgd-ns) 7 | (env-namespace-policy true (manage)) 8 | 9 | ;; root install success 10 | 11 | (module my-bad-root G 12 | (defcap G () true) 13 | (defun foo () 1)) 14 | 15 | ;; root upgrade legacy failure 16 | 17 | (env-namespace-policy false (manage)) 18 | (env-exec-config ['DisablePact44]) 19 | 20 | (module my-bad-root G 21 | (defcap G () true) 22 | (defun foo () 1)) 23 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-root-namespace.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (module test-mgd-ns GOV 3 | (defcap GOV () true) 4 | (defun manage (ns guard) true)) 5 | (commit-tx) 6 | (use test-mgd-ns) 7 | (env-namespace-policy false (manage)) 8 | 9 | ;; root install should fail 10 | 11 | (module my-bad-root G 12 | (defcap G () true) 13 | (defun foo () 1)) 14 | -------------------------------------------------------------------------------- /tests/pact/bad/bad-term-in-list.repl: -------------------------------------------------------------------------------- 1 | [(module m g (defcap g () 1))] 2 | -------------------------------------------------------------------------------- /tests/pact/base64.repl: -------------------------------------------------------------------------------- 1 | ; round trip 2 | 3 | (env-exec-config ["DisablePact49"]) 4 | 5 | (expect 6 | "Base64 decode sanity check" 7 | "hello world!" 8 | (base64-decode "aGVsbG8gd29ybGQh")) 9 | 10 | (expect 11 | "Base64 encode sanity check" 12 | "aGVsbG8gd29ybGQh" 13 | (base64-encode "hello world!")) 14 | 15 | (expect 16 | "Base64 encoding round trips" 17 | "hello world!" 18 | (base64-decode (base64-encode "hello world!"))) 19 | 20 | (expect 21 | "Base64 decoding round trips" 22 | "aGVsbG8gd29ybGQh" 23 | (base64-encode (base64-decode "aGVsbG8gd29ybGQh"))) 24 | 25 | (expect-failure 26 | "base64 decoding fails on non base64-encoded input" 27 | "Could not decode string: Base64URL decode failed: invalid padding near offset 16" 28 | (base64-decode "aGVsbG8gd29ybGQh%")) 29 | 30 | (expect-failure 31 | "base64 decoding fails on garbage input 1" 32 | "Could not decode string: Base64URL decode failed: invalid unicode" 33 | (base64-decode "aaa")) 34 | 35 | (expect-failure 36 | "base64 decoding fails on garbage input 2" 37 | "Could not decode string: Base64URL decode failed: invalid unicode" 38 | (base64-decode "asdflk")) 39 | 40 | (expect-failure 41 | "base64 decoding fails on garbage input 3" 42 | "Could not decode string: Base64URL decode failed: invalid base64 encoding near offset 0" 43 | (base64-decode "!@#$%&")) 44 | 45 | (expect-failure 46 | "base64 decoding fails on garbage input 4" 47 | "Could not decode string: Base64URL decode failed: invalid base64 encoding near offset 0" 48 | (base64-decode "\x0237")) 49 | 50 | (expect-failure 51 | "base64 decoding fails on garbage input 5" 52 | "Could not decode string: Base64URL decode failed: invalid base64 encoding near offset 0" 53 | (base64-decode "+\x0000")) 54 | 55 | (expect 56 | "base64 decoding succeeds on non-canonical encodings" 57 | "d" 58 | (base64-decode "ZE==")) 59 | 60 | (env-exec-config []) 61 | 62 | (expect-failure 63 | "base64 decoding fails on non-canonical encodings" 64 | "Could not base64-decode string" 65 | (base64-decode "ZE==")) 66 | -------------------------------------------------------------------------------- /tests/pact/decrypt.repl: -------------------------------------------------------------------------------- 1 | (expect 2 | "RFC7748 alice keypair validates" 3 | true 4 | (validate-keypair 5 | "8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a" 6 | "77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a")) 7 | 8 | (expect 9 | "RFC7748 bob keypair validates" 10 | true 11 | (validate-keypair 12 | "de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f" 13 | "5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb")) 14 | 15 | (expect-failure 16 | "bad keypair fails" 17 | (validate-keypair 18 | "a236ee764da1bde16f3452df78ed0d46d94c0763042330a8341511cfe537da62" 19 | "92702bbc9026d489f0ecefe266d694b9ad321965f3345758d1f937fba8817184")) 20 | 21 | (expect 22 | "decryption test succeeds with base64url of 'message'" 23 | "bWVzc2FnZQ" 24 | (let 25 | ((nonce "AAAAAAECAwQFBgcI") 26 | (aad "YWFk") 27 | (mac "FYP6lG7xq7aExvoaHIH8Jg") 28 | (ciphertext "Zi1REj5-iA") 29 | (pubkey "8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a") 30 | (seckey "5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb") 31 | ) 32 | (decrypt-cc20p1305 ciphertext nonce aad mac pubkey seckey))) 33 | -------------------------------------------------------------------------------- /tests/pact/docs.repl: -------------------------------------------------------------------------------- 1 | ;; Test whether function details and native docs are output 2 | ;; in repl at toplevel. 3 | 4 | (begin-tx) 5 | 6 | (module tester g 7 | (defcap g () true) 8 | (defun f (a) a)) 9 | 10 | (commit-tx) 11 | 12 | ;; Test for undesired behavior in Pact <4.7 13 | (begin-tx) 14 | 15 | ; disable in-repl restrictions 16 | (env-exec-config ['DisablePact47]) 17 | 18 | (expect 19 | "Calling tester.f applied to a function results in function details" 20 | "(defun tester.f: (a:))" 21 | (tester.f tester.f)) 22 | 23 | (expect 24 | "Calling tester.f at toplevel results in function details" 25 | "(defun tester.f: (a:))" 26 | tester.f) 27 | 28 | (expect-failure 29 | "Natives in tester.f result in typecheck error" 30 | "Invalid type in value location" 31 | (tester.f +)) 32 | 33 | (commit-tx) 34 | 35 | ;; Test for failure in the above tests for Pact 4.7 36 | (begin-tx) 37 | 38 | (env-exec-config []) 39 | (env-simulate-onchain false) 40 | 41 | (expect-failure 42 | "Calling tester.f applied to a function results in function details" 43 | "Cannot display function details in non-repl context" 44 | (tester.f tester.f)) 45 | 46 | (expect 47 | "Calling tester.f at toplevel results in function details" 48 | "(defun tester.f: (a:))" 49 | tester.f) 50 | 51 | (expect-failure 52 | "Natives in tester.f result in typecheck error" 53 | "Invalid type in value location" 54 | (tester.f +)) 55 | 56 | (commit-tx) 57 | 58 | ;; Test in non-repl context 59 | (begin-tx) 60 | (env-simulate-onchain true) 61 | 62 | (expect-failure 63 | "Calling tester.f applied to a function results in function details" 64 | "Cannot display function details in non-repl context" 65 | (tester.f tester.f)) 66 | 67 | (expect-failure 68 | "Calling tester.f at toplevel results in function details" 69 | "Cannot display function details in non-repl context" 70 | tester.f) 71 | 72 | (expect-failure 73 | "Natives in tester.f result in typecheck error" 74 | "Invalid type in value location" 75 | (tester.f +)) 76 | -------------------------------------------------------------------------------- /tests/pact/fv-shims.repl: -------------------------------------------------------------------------------- 1 | (define-namespace 'test (sig-keyset) (sig-keyset)) 2 | (namespace 'test) 3 | 4 | (interface iface 5 | (defun op:integer ())) 6 | 7 | (interface iface2 8 | (defpact good:string ())) 9 | 10 | (module impl g 11 | (implements iface) 12 | (defcap g () true) 13 | (defun op:integer () 1)) 14 | 15 | (module testmod g 16 | 17 | @model 18 | [ 19 | ;; need at least some property to kick off fv 20 | (property (= 1 1)) 21 | ] 22 | 23 | (defcap g () true) 24 | 25 | (defschema sch 26 | i:integer 27 | ;; exercise modref type coercion in schemas 28 | m:module{iface}) 29 | 30 | (deftable tbl:{sch}) 31 | 32 | (defschema test-schema 33 | "test schema" 34 | guard:string) 35 | 36 | (deftable test-table:{test-schema}) 37 | 38 | (defcap CAP () @event true) 39 | 40 | (defun alist:[integer] () [ 1 2 ]) 41 | 42 | ;; make sure verification works for 43 | ;; module references 44 | (defpact nested-modref-pact-1:string (m1:module{iface2}) 45 | (step 46 | (+ (m1::good) "-nested") 47 | ) 48 | (step 49 | (+ (continue (m1::good)) "-nested") 50 | ) 51 | (step 52 | (+ (continue (m1::good)) "-nested") 53 | ) 54 | ) 55 | 56 | ;; test principal create/validate for 57 | ;; coverage 58 | (defun both-guard (ks1 ks2) 59 | (enforce-keyset ks1) 60 | (enforce-keyset ks2)) 61 | 62 | (defun create-principal-test () 63 | (insert test-table "user" 64 | { "guard": 65 | (create-principal 66 | (create-user-guard 67 | (both-guard 68 | (read-keyset 'ks1) 69 | (read-keyset 'ks2) 70 | ))) 71 | })) 72 | 73 | (defun validate-principal-test () 74 | (validate-principal 75 | (create-user-guard 76 | (both-guard 77 | (read-keyset 'ks1) 78 | (read-keyset 'ks2))) 79 | (create-principal 80 | (create-user-guard 81 | (both-guard 82 | (read-keyset 'ks1) 83 | (read-keyset 'ks2)))) 84 | )) 85 | 86 | 87 | (defun fun (m:module{iface}) 88 | @doc "Exercise FV shims and coercions. Modref arg coerced to string." 89 | ;; dynamic ref 90 | (m::op) 91 | ;; unsupported natives 92 | (keys tbl) 93 | (is-charset CHARSET_ASCII "abc") 94 | (install-capability (CAP)) 95 | (emit-event (CAP)) 96 | (concat ["a" "b"]) 97 | (format "dynamic list {}" (alist)) 98 | (enumerate 1 10) 99 | (enumerate 1 10 2) 100 | (tx-hash) 101 | (str-to-list "abc") 102 | (int-to-str 16 65535) 103 | (distinct [1 2 2 3]) 104 | (diff-time 105 | (time "2021-01-01T00:00:00Z") 106 | (time "2021-01-01T00:00:00Z")) 107 | ) 108 | 109 | ) 110 | 111 | (env-dynref iface impl) 112 | (verify "test.testmod") 113 | -------------------------------------------------------------------------------- /tests/pact/gov.repl: -------------------------------------------------------------------------------- 1 | 2 | (begin-tx) 3 | 4 | (module govtest count-votes 5 | "Demonstrate programmable governance showing votes for upgrade transaction hashes" 6 | (defschema vote 7 | vote-hash:string) 8 | (deftable votes:{vote}) 9 | 10 | (defun vote-for-hash (user hsh) 11 | (write votes user { "vote-hash": hsh })) 12 | 13 | (defcap count-votes () 14 | (let* ((h (tx-hash)) 15 | (tally (fold (do-count h) { "for": 0, "against": 0 } (keys votes)))) 16 | (enforce (> (at 'for tally) (at 'against tally)) (format "vote result: {}, {}" [h tally])))) 17 | 18 | (defun do-count (hsh tally u) 19 | (bind tally { "for" := f, "against" := a } 20 | (with-read votes u { 'vote-hash := v } 21 | (if (= v hsh) 22 | { "for": (+ 1 f), "against": a } 23 | { "for": f, "against": (+ 1 a) }))))) 24 | 25 | (create-table votes) 26 | 27 | (commit-tx) 28 | 29 | (begin-tx) 30 | (use govtest) 31 | 32 | (vote-for-hash "alice" (hash "tx1")) 33 | (vote-for-hash "bob" (hash "tx2")) 34 | (vote-for-hash "charlie" (hash "tx3")) 35 | (vote-for-hash "dinesh" (hash "tx2")) 36 | (vote-for-hash "erica" (hash "tx2")) 37 | 38 | (commit-tx) 39 | 40 | (begin-tx) 41 | (use govtest) 42 | 43 | ;; direct read will attempt to grant admin 44 | (env-hash (hash "tx1")) 45 | (expect-failure "admin grant fails for tx1" (read votes "bob")) 46 | 47 | (env-hash (hash "tx3")) 48 | (expect-failure "admin grant fails for tx3" (read votes "bob")) 49 | 50 | (env-hash (hash "tx2")) 51 | 52 | (expect "admin grant succeeds for tx2" { "vote-hash": (hash "tx2") } (read votes "bob")) 53 | 54 | ;; prove that admin is granted for rest of tx by resetting tx-hash to non-winning value 55 | 56 | (env-hash (hash "tx1")) 57 | 58 | (expect "admin grant doesn't need re-acquire" 59 | { "vote-hash": (hash "tx2") } 60 | (read votes "bob")) 61 | (commit-tx) 62 | 63 | (begin-tx) 64 | (use govtest) 65 | (env-hash (hash "tx1")) 66 | (expect-failure "admin grant fails on new tx for tx1" (read votes "bob")) 67 | (commit-tx) 68 | 69 | 70 | (begin-tx) 71 | (define-namespace 'user (sig-keyset) (sig-keyset)) 72 | (namespace 'user) 73 | (module ns-gov GOV 74 | (defcap GOV () (enforce false "autonomous-ns-gov")) 75 | (defschema s x:string) 76 | (deftable t:{s})) 77 | (create-table t) 78 | (commit-tx) 79 | 80 | (expect-failure 81 | "gov not granted after install" 82 | "autonomous-ns-gov" 83 | (write user.ns-gov.t "a" { 's: "x" })) 84 | 85 | (begin-tx) 86 | (namespace 'user) 87 | (env-exec-config ["PreserveNsModuleInstallBug"]) 88 | (module ns-gov-bug GOV 89 | (defcap GOV () (enforce false "autonomous-ns-gov-bug")) 90 | (defschema s x:string) 91 | (deftable t:{s})) 92 | (expect-failure 93 | "ns gov bug preserved" 94 | "autonomous-ns-gov-bug" 95 | (create-table t)) 96 | (commit-tx) 97 | -------------------------------------------------------------------------------- /tests/pact/hash.repl: -------------------------------------------------------------------------------- 1 | (expect "repl starts with empty hash" (hash "") (tx-hash)) 2 | (env-hash (hash "hello")) 3 | (expect "hash roundtrip" (hash "hello") (tx-hash)) 4 | 5 | (begin-tx) 6 | (env-exec-config ["DisablePact49"]) 7 | (interface iface 8 | (defun f:bool (a:module{iface})) 9 | ) 10 | 11 | (module my-mod G 12 | (defcap G() true) 13 | 14 | (defschema hashes h:string) 15 | (deftable hashes-table:{hashes}) 16 | (implements iface) 17 | 18 | (defun get-hash (k:string) 19 | (at "h" (read hashes-table k))) 20 | 21 | (defun f:bool (a:module{iface}) true) 22 | 23 | (defun insert-hash (k:string h:string) 24 | (write hashes-table k {"h":h}) 25 | (concat ["added hash ", h, " to table"]) 26 | ) 27 | ) 28 | 29 | (create-table hashes-table) 30 | 31 | ; pre fork module hashing 32 | (insert-hash "a" (hash my-mod)) 33 | (insert-hash "b" (hash my-mod)) 34 | (insert-hash "c" (hash [my-mod, {'a:my-mod}, (create-user-guard (f my-mod))])) 35 | (insert-hash "d" (hash [my-mod, {'a:my-mod}, (create-user-guard (f my-mod))])) 36 | (let* 37 | ( (h1 (get-hash "a")) 38 | (h2 (get-hash "b")) 39 | (h3 (get-hash "c")) 40 | (h4 (get-hash "d")) 41 | ) 42 | (enforce (= h1 "orgMn9G2BN4Mvq4IX7XbF016YdAhoLLtEIpUPglM3-c") "h1 does not match expected value") 43 | (enforce (= h2 "A7RKCqSxlJMPSoZshF2Rviny30yVUXK6CDnjfwKc-dU") "h2 does not match expected value") 44 | (enforce (= h3 "2Hic2Iy60yTYtCn1Ih6J7X359KAjPjdOkyEUGbR9pa8") "h3 does not match expected value") 45 | (enforce (= h4 "ltxrif1Y_w9qg2pM-V93lMjU15HIA48WBqp3RzlZ0cU") "h4 does not match expected value") 46 | (expect-failure "hashes do not match pre-fork - simple case" (enforce (= h1 h2) "boom")) 47 | (expect-failure "hashes do not match pre-fork - recursive case" (enforce (= h3 h4) "boom")) 48 | ) 49 | 50 | 51 | (env-exec-config []) 52 | ; post fork module hashing 53 | (insert-hash "a" (hash my-mod)) 54 | (insert-hash "b" (hash my-mod)) 55 | (insert-hash "c" (hash [my-mod, {'a:my-mod}, (create-user-guard (f my-mod))])) 56 | (insert-hash "d" (hash [my-mod, {'a:my-mod}, (create-user-guard (f my-mod))])) 57 | 58 | (let* 59 | ( (h1 (get-hash "a")) 60 | (h2 (get-hash "b")) 61 | (h3 (get-hash "c")) 62 | (h4 (get-hash "d")) 63 | ) 64 | (enforce (= h1 "vediBPdnKkzahPDZY2UF_hkS8i7pIXqwsCj925gLng8") "h1 does not match expected value") 65 | (enforce (= h3 "_c98nMfdnxKUdjoE7EQR9RUHfqJDJjlljL2JGGwUqiA") "h3 does not match expected value") 66 | (expect "hashes match post-fork - simple case" true (enforce (= h1 h2) "boom")) 67 | (expect "hashes match post-fork - recursive case" true (enforce (= h1 h2) "boom")) 68 | ) 69 | (commit-tx) 70 | -------------------------------------------------------------------------------- /tests/pact/imports.repl: -------------------------------------------------------------------------------- 1 | ;; Positive unit tests for use/import-based forms 2 | (begin-tx) 3 | (module m G 4 | (defcap G () true) 5 | (defun f () true) 6 | ) 7 | (commit-tx) 8 | (begin-tx) 9 | ;; Show that empty imports work when hashes are 10 | ;; supplied. For a negative test, see: ./bad/bad-import-emptylist.pact 11 | (module n H 12 | (use m "S_uhfqHsatDTMeUQhDNwXOHMpio2hX2Jcd-S5YDiNNk" 13 | []) 14 | 15 | (defcap H () true) 16 | (defun g () true) 17 | ) 18 | 19 | (module o I 20 | (use m [f]) 21 | 22 | (defcap I () true) 23 | (defun h () true) 24 | ) 25 | 26 | (module p J 27 | (use m "S_uhfqHsatDTMeUQhDNwXOHMpio2hX2Jcd-S5YDiNNk" 28 | [f]) 29 | 30 | (defcap J () true) 31 | (defun i () true) 32 | ) 33 | (commit-tx) 34 | 35 | (begin-tx) 36 | (interface iface 37 | 38 | (defschema p 39 | flag:bool 40 | other-field:string) 41 | 42 | (defconst pushin:object{p} {'flag:true, 'other-field:"future"}) 43 | ) 44 | (commit-tx) 45 | (begin-tx) 46 | 47 | (module m g 48 | 49 | (use iface) 50 | (defcap g () true) 51 | 52 | (defun get-pushin:object{p} () pushin) 53 | (defconst obj2:object{p} {'flag:false, 'other-field:"yt"}) 54 | ) 55 | 56 | (commit-tx) 57 | ;; Explicit imports 58 | (begin-tx) 59 | (module m g 60 | 61 | (use iface [p]) 62 | (defcap g () true) 63 | 64 | (defconst obj2:object{p} {'flag:false, 'other-field:"yt"}) 65 | ) 66 | 67 | (commit-tx) 68 | -------------------------------------------------------------------------------- /tests/pact/json.repl: -------------------------------------------------------------------------------- 1 | (env-data 2 | "{ \"intn\": 1, \ 3 | \ \"ints\": \"1\", \ 4 | \ \"nintn\": -1, \ 5 | \ \"nints\": \"-1\", \ 6 | \ \"dec\": 1.0, \ 7 | \ \"ndec\": -1.0, \ 8 | \ \"bool\": true, \ 9 | \ \"str\": \"hello\", \ 10 | \ \"obj\": { \"list\": [ { \"a\": true }, {\"b\": \"hello\" } ] }, \ 11 | \ \"list\": [1,2,3] \ 12 | \ }") 13 | (expect "read-integer with number value" 1 (read-integer "intn")) 14 | (expect "read-integer with string value" 1 (read-integer "ints")) 15 | (expect "read-integer with neg number value" -1 (read-integer "nints")) 16 | (expect "read-integer with neg string value" -1 (read-integer "nintn")) 17 | (expect "read-decimal with number value" 1.0 (read-decimal "dec")) 18 | (expect "read-decimal with neg number value" -1.0 (read-decimal "ndec")) 19 | (expect "read-string with string value" "hello" (read-string "str")) 20 | (expect "read-msg for object" { "list": [ { "a": true } {"b": "hello" } ] } (read-msg "obj")) 21 | (expect "read-msg for list" [1.0 2.0 3.0] (read-msg "list")) 22 | (expect "read-msg for bool" true (read-msg "bool")) 23 | (expect "read-msg for string" "hello" (read-msg "str")) 24 | (expect "read-msg for decimal" 1.0 (read-msg "intn")) 25 | (expect "read-msg for neg decimal" -1.0 (read-msg "nintn")) 26 | (env-data { "foo": true }) 27 | (expect "read-msg with no args" { "foo": true } (read-msg)) 28 | -------------------------------------------------------------------------------- /tests/pact/keccak256.repl: -------------------------------------------------------------------------------- 1 | (expect "computes the correct hash" 2 | "xdJGAYb3IzySfn2y3McDwOUAtlPKgic7e_rYBF2FpHA" 3 | (hash-keccak256 []) 4 | ) 5 | 6 | (expect "computes the correct hash" 7 | "xdJGAYb3IzySfn2y3McDwOUAtlPKgic7e_rYBF2FpHA" 8 | (hash-keccak256 [""]) 9 | ) 10 | 11 | (expect "computes the correct hash" 12 | "DsjZ0g3fCnsCUelBpyYbVXUH_2KHtQQ2Ko8XNMWpEBI" 13 | (hash-keccak256 ["IP9FQ2ml0FuBp489sFgZ_qmwjCOE91ywq2qhFd1pDaMTGHShyo9witFRnqlSweJJy1QNGWOSx56HdVQk_ufIkICMViciNZ7qUuihL7u5ad15YdK6UgN0k3VaX6BPDVChqibJtEFIwNO5TRxKWaMayhWui9RKy3gz2OkcS4b6MTWkIzh7gVG0Ez7SP21xh7UOwiBK2QGtdNOW5EJ04OyvquF7O5CF4iJgs1ylOxXMUqu6dYr2eY-9BOzuztZI869P2z3tdVeppc-3OCYSqKjz9FlH0aKc4pByko7Bk8ol1RBxvV4ZhOz0AvMG6nYvDyUoL1KW2Zdli-P5g2lv-m0JXGNptNr3nppdMTYikSj462PBK56fp4r_ej6eGaYgIkk80Tbe-7W7e6G5OPNn_S9j61ynbAsP8hueNsPwcjDPPDB05dpYcECnaXXX459ElKzlSG_L84CrdVjE_ollYzW4Lk24ZZUJ6rRqGWExJuWUBCcy3UxBH0GqjN6sccD7QKlObaVYwF53thgoBvJtmv3z2gDGlBkiLIGGpu-tYAtBDmzi8qeX5J3B8TUxmAH6bzlrBvl14qGQoCPkdLYY5w"]) 14 | ) 15 | 16 | (expect "computes the correct hash over chunked input" 17 | "DsjZ0g3fCnsCUelBpyYbVXUH_2KHtQQ2Ko8XNMWpEBI" 18 | (hash-keccak256 ["IP9FQ2ml0FuBp489sFgZ_qmwjCOE91ywq2qhFd1pDaM", "Exh0ocqPcIrRUZ6pUsHiSctUDRljkseeh3VUJP7nyJA", "gIxWJyI1nupS6KEvu7lp3Xlh0rpSA3STdVpfoE8NUKE", "qibJtEFIwNO5TRxKWaMayhWui9RKy3gz2OkcS4b6MTU", "pCM4e4FRtBM-0j9tcYe1DsIgStkBrXTTluRCdODsr6o", "4Xs7kIXiImCzXKU7FcxSq7p1ivZ5j70E7O7O1kjzr08", "2z3tdVeppc-3OCYSqKjz9FlH0aKc4pByko7Bk8ol1RA", "cb1eGYTs9ALzBup2Lw8lKC9SltmXZYvj-YNpb_ptCVw", "Y2m02veeml0xNiKRKPjrY8Ernp-niv96Pp4ZpiAiSTw", "0Tbe-7W7e6G5OPNn_S9j61ynbAsP8hueNsPwcjDPPDA", "dOXaWHBAp2l11-OfRJSs5Uhvy_OAq3VYxP6JZWM1uC4", "TbhllQnqtGoZYTEm5ZQEJzLdTEEfQaqM3qxxwPtAqU4", "baVYwF53thgoBvJtmv3z2gDGlBkiLIGGpu-tYAtBDmw", "4vKnl-SdwfE1MZgB-m85awb5deKhkKAj5HS2GOc"]) 19 | ) 20 | 21 | (expect "computes the correct hash" 22 | "DqM-LjT1ckQGQCRMfx9fBGl86XE5vacqZVjYZjwCs4g" 23 | (hash-keccak256 ["T73FllCNJKKgAQ4UCYC4CfucbVXsdRJYkd2YXTdmW9gPm-tqUCB1iKvzzu6Md82KWtSKngqgdO04hzg2JJbS-yyHVDuzNJ6mSZfOPntCTqktEi9X27CFWoAwWEN_4Ir7DItecXm5BEu_TYGnFjsxOeMIiLU2sPlX7_macWL0ylqnVqSpgt-tvzHvJVCDxLXGwbmaEH19Ov_9uJFHwsxMmiZD9Hjl4tOTrqN7THy0tel9rc8WtrUKrg87VJ7OR3Rtts5vZ91EBs1OdVldUQPRP536eTcpJNMo-N0fy-taji6L9Mdt4I4_xGqgIfmJxJMpx6ysWmiFVte8vLKl1L5p0yhOnEDsSDjuhZISDOIKC2NeytqoT9VpBQn1T3fjWkF8WEZIvJg5uXTge_qwA46QKV0LE5AlMKgw0cK91T8fnJ-u1Dyk7tCo3XYbx-292iiih8YM1Cr1-cdY5cclAjHAmlglY2ia_GXit5p6K2ggBmd1LpEBdG8DGE4jmeTtiDXLjprpDilq8iCuI0JZ_gvQvMYPekpf8_cMXtTenIxRmhDpYvZzyCxek1F4aoo7_VcAMYV71Mh_T8ox7U1Q4U8hB9oCy1BYcAt06iQai0HXhGFljxsrkL_YSkwsnWVDhhqzxWRRdX3PubpgMzSI290C1gG0Gq4xfKdHTrbm3Q"]) 24 | ) 25 | 26 | (expect-failure "fails on non-base64 inputs" 27 | (hash-keccak256 ["alibaba"]) 28 | ) 29 | 30 | (expect-failure "fails if any inputs are not base64-encoded" 31 | (hash-keccak256 ["Zm9v", "fooey"]) 32 | ) 33 | -------------------------------------------------------------------------------- /tests/pact/lambda.repl: -------------------------------------------------------------------------------- 1 | 2 | (module lam-test g (defcap g () true) 3 | (defun add2 (x:integer) (+ x 2)) 4 | (defun gt2 (x:integer) (> x 2)) 5 | ) 6 | 7 | (expect "lambdas in let* behave as expected" 8 | 8 9 | (let* 10 | ((f (lambda (x:integer) (+ x 2))) 11 | (g (lambda (x:integer) (+ (f x) 2))) 12 | (h (lambda (x:integer) (+ (g x) 2))) 13 | ) 14 | (h 2) 15 | ) 16 | ) 17 | 18 | (expect "nested lambdas in let reference as expected" 19 | 8 20 | (let 21 | ((f (lambda (x:integer) (+ x 2)))) 22 | (let 23 | ((g (lambda (x:integer) (+ (f x) 2)))) 24 | (let ((h (lambda (x:integer) (+ (g x) 2)))) 25 | (h 2)))) 26 | ) 27 | 28 | (expect "nested lambdas in let reference as expected v2" 29 | 8 30 | (let 31 | ((f (lambda (x:integer) (+ x 2)))) 32 | (let 33 | ((g (lambda (x:integer) (+ x 2)))) 34 | (let ((h (lambda (x:integer) (+ x 2)))) 35 | (h (g (f 2)))))) 36 | ) 37 | 38 | (expect "lambdas function within natives: map" 39 | [1, 4, 9, 16, 25] 40 | (let 41 | ((squarelam (lambda(x) (* x x)))) 42 | (map (squarelam) [1, 2, 3, 4, 5])) 43 | ) 44 | 45 | (expect "defuns function within natives: map" 46 | [3, 4, 5, 6, 7] 47 | (map (add2) [1, 2, 3, 4, 5]) 48 | ) 49 | 50 | (expect "lambdas function within natives: filter" 51 | [4, 5] 52 | (let 53 | ((gt3 (lambda(x) (> x 3)))) 54 | (filter (gt3) [1, 2, 3, 4, 5])) 55 | ) 56 | 57 | (expect "defuns function within natives: filter" 58 | [3, 4, 5] 59 | (filter (gt2) [1, 2, 3, 4, 5]) 60 | ) 61 | 62 | (expect "inline lambdas function within natives: map" 63 | [1, 4, 9, 16, 25] 64 | (map (lambda(x) (* x x)) [1, 2, 3, 4, 5]) 65 | ) 66 | 67 | (expect "inline lambdas function within natives: filter" 68 | [4, 5] 69 | (filter (lambda(x) (> x 3)) [1, 2, 3, 4, 5]) 70 | ) 71 | 72 | (expect "inline lambdas function within natives: fold" 73 | 6 74 | (fold (lambda (x y) (+ x y)) 0 [1, 2, 3]) 75 | ) 76 | 77 | (expect "inline lambdas function within natives: compose" 78 | 2 79 | (compose (lambda (x) (+ x 1)) (lambda (x) (+ x 1)) 0) 80 | ) 81 | 82 | (expect "inline lambdas function within natives: and?" 83 | true 84 | (and? (lambda (x) (< x 20)) (lambda (x) (<= x 15)) 15) 85 | ) 86 | 87 | (expect "inline lambdas function within natives: or?" 88 | true 89 | (or? (lambda (x) (> x 20)) (lambda (x) (<= x 15)) 15) 90 | ) 91 | 92 | (expect "inline lambdas function within natives: not?" 93 | false 94 | (not? (lambda (x) (> x 20)) 22) 95 | ) 96 | -------------------------------------------------------------------------------- /tests/pact/leftpad.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-exec-config ["DisablePact44"]) 3 | (define-keyset 'k (sig-keyset)) 4 | 5 | (module leftpad 'k 6 | (defconst VERSION 1) 7 | (defun left-pad (s i) 8 | (+ (fold (+) "" (make-list i " ")) s))) 9 | 10 | (module impure 'k 11 | (defconst VERSION 1) 12 | (deftable foo) 13 | (defun ins (k v) (insert foo k v))) 14 | 15 | (create-table foo) 16 | 17 | (commit-tx) 18 | 19 | (begin-tx) 20 | 21 | (use leftpad) 22 | (use impure) 23 | 24 | (module dep 'k 25 | (defun dep-leftpad () (left-pad "hello" 3)) 26 | (defun dep-impure (k v) (ins k { "value": v }))) 27 | 28 | (commit-tx) 29 | 30 | (begin-tx) 31 | 32 | (expect "leftpad works" " hello" (dep.dep-leftpad)) 33 | (dep.dep-impure "a" 1) 34 | (expect "impure works" { "value": 1 } (read impure.foo "a")) 35 | 36 | (rollback-tx) 37 | 38 | (begin-tx) 39 | 40 | (module leftpad 'k 41 | (defconst VERSION 2) 42 | (defun left-pad (s i) 43 | (+ (fold (+) "" (make-list i " ")) s))) 44 | 45 | (module impure 'k 46 | (defconst VERSION 2) 47 | (deftable foo) 48 | (defun ins (k v) (insert foo k v))) 49 | 50 | (commit-tx) 51 | 52 | (begin-tx) 53 | 54 | (expect "leftpad works after update" " hello" (dep.dep-leftpad)) 55 | (expect-failure "impure fails after update" (dep.dep-impure "b" 1)) 56 | 57 | (rollback-tx) 58 | 59 | (begin-tx) 60 | 61 | (use dep) 62 | 63 | (module impure 'k 64 | (defconst VERSION 3) 65 | (bless "74d20rfD3baZiITTChOUbIb8tlHGjMVMGRHuTFBuKAk") 66 | (deftable foo) 67 | (defun ins (k v) (insert foo k v))) 68 | 69 | (commit-tx) 70 | 71 | (dep.dep-impure "b" 1) 72 | (expect "impure works with blessed hash" { "value": 1 } (read impure.foo "b")) 73 | -------------------------------------------------------------------------------- /tests/pact/lib.repl: -------------------------------------------------------------------------------- 1 | ;; lib.repl: test REPL-only functions 2 | 3 | 4 | (expect "env-hash" "Set tx hash to YQo" (env-hash "YQo")) 5 | 6 | ;; TODO use expect-that for above tests 7 | (expect-that "expect-that test" (< 2) (+ 1 2)) 8 | 9 | (expect 10 | (format "{}" ["expect: computed docstring"]) 1 1) 11 | (expect-that 12 | (format "{}" ["expect-that: computed docstring"]) (= 1) 1) 13 | (expect-failure 14 | (format "{}" ["expect-failure: computed docstring"]) 15 | (enforce false "unforced error")) 16 | 17 | 18 | ;; test with-applied-env and multiple env updates, 19 | ;; plus that env reverts 20 | (env-data { 'h: ["h"] }) 21 | (env-keys ["h"]) 22 | (let ((x 0)) 23 | (env-data { 'k: ["k"] }) 24 | (env-keys ["k"]) 25 | (with-applied-env 26 | [(expect 27 | "applied env has data and keys" 28 | true (enforce-keyset (read-keyset 'k))) 29 | (expect-failure 30 | "outside env gone" 31 | (read-keyset 'h)) 32 | ])) 33 | (expect 34 | "old env restored" 35 | true (enforce-keyset (read-keyset 'h))) 36 | (expect-failure 37 | "applied env gone" 38 | (read-keyset 'k)) 39 | 40 | 41 | ;; run pacts non-toplevel 42 | (env-enable-repl-natives true) 43 | (module f g 44 | (defcap g () true) 45 | (defpact p () 46 | (step 1) 47 | (step 2)) 48 | (defun go () 49 | (p) 50 | (continue-pact 1))) 51 | (expect "non-toplevel pact continuation succeeds" 2 (go)) 52 | -------------------------------------------------------------------------------- /tests/pact/lists.repl: -------------------------------------------------------------------------------- 1 | ; make-list tests 2 | (expect 3 | "make-list: Non-positive lengths return empty lists" 4 | true 5 | (fold 6 | (and) 7 | true 8 | (map (= []) (list (make-list -1 true) (make-list 0 true) (make-list -100 true))))) 9 | 10 | (expect 11 | "make-list: Simple sanity test" 12 | ["hello" "hello" "hello" "hello" "hello"] 13 | (make-list 5 "hello")) 14 | 15 | ; enumerate tests 16 | 17 | (expect 18 | "enumerate: Enumerate numbers from 0 to 10." 19 | [0 1 2 3 4 5 6 7 8 9 10] 20 | (enumerate 0 10)) 21 | 22 | (expect 23 | "enumerate: Increment greater than 1" 24 | [0 2 4 6 8 10] 25 | (enumerate 0 10 2)) 26 | 27 | (expect 28 | "enumerate: Increment less than -1" 29 | (reverse (enumerate 0 10 2)) 30 | (enumerate 10 0 -2)) 31 | 32 | (expect 33 | "enumerate: When FROM is greater than TO and no icrement is given." 34 | (reverse (enumerate 0 10)) 35 | (enumerate 10 0)) 36 | 37 | (expect 38 | "enumerate: Return empty list when given an INC of zero." 39 | [] 40 | (enumerate 0 10 0)) 41 | 42 | (expect 43 | "enumerate: Return FROM when FROM equals TO." 44 | [10] 45 | (enumerate 10 10)) 46 | 47 | (expect-failure 48 | "enumerate: bad increment (-1)" 49 | "enumerate: increment diverges below from interval bounds." 50 | (enumerate 0 10 -1)) 51 | 52 | (expect-failure 53 | "enumerate: bad decrement (1)" 54 | "enumerate: increment diverges above from interval bounds." 55 | (enumerate 10 0 1)) 56 | 57 | (expect 58 | "enumerate: bad increment (11)" 59 | [0] 60 | (enumerate 0 10 11)) 61 | 62 | (expect 63 | "enumerate: bad increment (-11)" 64 | [10] 65 | (enumerate 10 0 -11)) 66 | 67 | ; distinct tests 68 | 69 | (expect 70 | "distinct: remove duplicates" 71 | [1 2 3] 72 | (distinct [1 1 2 2 3 3])) 73 | 74 | (expect 75 | "distinct: preserve original order" 76 | [3 1 2] 77 | (distinct [3 1 3 2 2 1 3])) 78 | 79 | (expect 80 | "distinct: work on empty list" 81 | [] 82 | (distinct [])) 83 | 84 | (expect 85 | "zip combines properly" 86 | [5 7 9] 87 | (zip (+) [1 2 3] [4 5 6])) 88 | 89 | (expect 90 | "zip combines properly left shortest" 91 | [5 7] 92 | (zip (+) [1 2] [4 5 6])) 93 | 94 | (expect 95 | "zip combines properly right shortest" 96 | [5 7] 97 | (zip (+) [1 2 3] [4 5])) 98 | 99 | (expect 100 | "zip with empty list left" 101 | [] 102 | (zip (+) [] [4 5 6])) 103 | 104 | 105 | (expect 106 | "zip with empty list right" 107 | [] 108 | (zip (+) [1 2 3] [])) 109 | 110 | (expect 111 | "zip functions with inline lambda" 112 | [5 7 9] 113 | (zip (lambda (x:integer y:integer) (+ x y)) [1 2 3] [4 5 6])) 114 | -------------------------------------------------------------------------------- /tests/pact/meta.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ["DisablePact44"]) 2 | (define-keyset 'k (sig-keyset)) 3 | 4 | (module mod 'k 5 | @doc "this defines mod" 6 | @model [(property (do (crazy stuff)))] 7 | 8 | (defun foo () 9 | @doc "foo the town" 10 | 1) 11 | 12 | (defun foobar () 13 | "docstrings work without @doc" 14 | 2) 15 | 16 | (defun docmodel () 17 | @doc "stuff" 18 | @model [(property stuff)] 19 | 3) 20 | 21 | (defun modeldoc () 22 | @model [(property stuff)] 23 | @doc "stuff" 24 | 4) 25 | 26 | (defconst BAR 1 @doc "barring disbelief") 27 | 28 | (defconst BAZ 2 "docstrings work without @doc") 29 | 30 | (defschema schema 31 | @doc "a schema" @model [(property stuff)]) 32 | 33 | (defschema schema2 34 | "a schema") 35 | 36 | (deftable tbl @doc "a table") 37 | (deftable tbl2 "a table") 38 | ) 39 | -------------------------------------------------------------------------------- /tests/pact/parsing.repl: -------------------------------------------------------------------------------- 1 | ;; parsing.repl: success means forms in this file parsed successfully. 2 | ;; errors have to be handled via "bad" scripts in tests/pact/bad 3 | 4 | ;; semicolon in expr 5 | ;; =========== 6 | (+ 1 2 7 | ; 8 | ) 9 | 10 | ;; in-module productions 11 | ;; note this is parsed, compiled, and loaded, so not just parsing 12 | ;; =========== 13 | (interface quux (defun f ())) 14 | 15 | (define-namespace 'bar (sig-keyset) (sig-keyset)) 16 | 17 | (namespace 'bar) 18 | 19 | (interface baz (defun f ())) 20 | 21 | (module mod-parse-test G 22 | "test in-module parsing" 23 | (defcap G () true) 24 | 25 | (defun defun-with-semicolon () 26 | "parses with semicolon" 27 | 1 28 | ; 29 | ;; 30 | ) 31 | 32 | (defun modref-types 33 | ( ref:module{bar.baz, quux} ) 34 | "test module ref parsing" 35 | 1) 36 | 37 | (defun test-cond (a) 38 | (cond ((< a 10) "a") 39 | ((< a 20) "b") 40 | ((< a 30) "c") 41 | "d")) 42 | ) 43 | 44 | 45 | 46 | 47 | ;; semicolon in expr again 48 | (+ 1 49 | ; This is fine 50 | 2 51 | ) 52 | 53 | 54 | (expect 55 | "list equivalence with commas or without" 56 | [1 "2" true (+ 3 4)] 57 | [1, "2", true, (+ 3 4)]) 58 | 59 | (expect 60 | "cond folds ifs correctly" 61 | "acbd" 62 | (fold (+) "" [(test-cond 1) (test-cond 21) (test-cond 11) (test-cond 31)])) 63 | -------------------------------------------------------------------------------- /tests/pact/pubdata.repl: -------------------------------------------------------------------------------- 1 | ;; Chain public metadata should initialize with defaults 2 | (expect "chain data chain id initializes with \"\"" "" (at "chain-id" (chain-data))) 3 | (expect "chain data block height initializes with 0" 0 (at "block-height" (chain-data))) 4 | (expect "chain data block time id initializes with time value" (time "1970-01-01T00:00:00Z") (at "block-time" (chain-data))) 5 | (expect "chain data sender initializes with \"\"" "" (at "sender" (chain-data))) 6 | (expect "chain data gas limit initializes with 0" 0 (at "gas-limit" (chain-data))) 7 | (expect "chain data gas price initializes with 0.0" 0.0 (at "gas-price" (chain-data))) 8 | 9 | ;; Chain public metadata should reflect updates 10 | (env-chain-data { "chain-id": "Testnet00/2", "block-height": 20 }) 11 | (expect "chain data chain id reflects updated value" "Testnet00/2" (at "chain-id" (chain-data))) 12 | (expect "chain data block height reflects updated value" 20 (at "block-height" (chain-data))) 13 | 14 | ;; show that updates are granular 15 | (env-chain-data { "sender": "squawk" }) 16 | (expect "chain data sender reflects updated value" "squawk" (at "sender" (chain-data))) 17 | 18 | ;; show that updates are cumulative 19 | (expect "chain data chain id reflects updated value" "Testnet00/2" (at "chain-id" (chain-data))) 20 | (expect "chain data block height reflects updated value" 20 (at "block-height" (chain-data))) 21 | 22 | ;; Show failure on improper keys 23 | (expect-failure "chain data should fail to update when wrong key is specified" (env-chain-data { "foo": 8 })) 24 | 25 | ;; Show failure on wrongly-typed keys 26 | (expect-failure "chain data should fail for wrongly-typed keys" (env-chain-data { "chain-id": 0.0 })) 27 | 28 | ;; Show failure on duplicate keys 29 | (expect-failure "chain data should not accept duplicate updates" (env-chain-data { "chain-id": "Testnet00/1", "chain-id:": "Testnet00/2" })) 30 | 31 | ;; test time 32 | (expect "time update succeeds" 33 | "Updated public metadata" 34 | (env-chain-data 35 | { "block-time": (time "2019-01-01T00:00:00Z") })) 36 | (expect "time value correct" 37 | (time "2019-01-01T00:00:00Z") 38 | (at "block-time" (chain-data))) 39 | -------------------------------------------------------------------------------- /tests/pact/simple.repl: -------------------------------------------------------------------------------- 1 | ;; used in Pact.PersistPactDb.Regression 2 | (module simple GOV 3 | (defcap GOV () true) 4 | (defun f (a) a)) 5 | -------------------------------------------------------------------------------- /tests/pact/spv.repl: -------------------------------------------------------------------------------- 1 | (mock-spv "TXOUT" { "baz": "quux" } { "foo": "bar" }) 2 | (expect-failure "fail on unmocked type" (verify-spv "BLAH" { "baz": "quux" })) 3 | (expect-failure "fail on unmocked payload" (verify-spv "TXOUT" { "here": "gone" })) 4 | (expect "succeed with mock" { "foo": "bar" } (verify-spv "TXOUT" { "baz": "quux" })) 5 | -------------------------------------------------------------------------------- /tests/pact/strings.repl: -------------------------------------------------------------------------------- 1 | ;; strings.repl : tests for ops on strings 2 | 3 | "===== str-to-list" 4 | (expect "str-to-list on str returns a list of single char strings" 5 | ["a" "b" "c"] (str-to-list "abc")) 6 | (expect "str-to-list on empty string" [] (str-to-list "")) 7 | (expect-failure "str-to-list fails on list" "Invalid arguments" (str-to-list [])) 8 | 9 | "===== concat" 10 | (expect "concat works on empty list" "" (concat [])) 11 | (expect "concat works on list of str" "abc" (concat ["a" "b" "c"])) 12 | (expect "concat works on list of multi char strings" "aabbcc" (concat ["aa" "bb" "cc"])) 13 | (expect "concat works singleton list" "abc" (concat ["abc"])) 14 | (expect-failure "concat fails when not all elems are strings" "concat: expecting list of strings" (concat ["a" "b" 2])) 15 | (expect-failure "concat fails on non list" "Invalid arguments" (concat "hello")) 16 | -------------------------------------------------------------------------------- /tests/pact/strtoint.repl: -------------------------------------------------------------------------------- 1 | (expect "str-to-int decimal identity - no base" (str-to-int "12345") 12345) 2 | (expect "str-to-int hex identity" (str-to-int 16 "12345abcdef") 1251004370415) 3 | (expect "str-to-int binary identity" (str-to-int 2 "101010111100110111101111000100100011010001010110") 188900967593046) 4 | (expect "str-to-int roundtrip" (str-to-int 16 "12345abcdef") (str-to-int "1251004370415")) 5 | (expect "str-to-int roundtrip" (str-to-int 2 "101010111100110111101111000100100011010001010110") (str-to-int "188900967593046")) 6 | (expect "str-to-int roundtrip" (str-to-int 10 "12345") (str-to-int "12345")) 7 | (expect-failure "str-to-int base == 1" "Base value must be" (str-to-int 1 "12345")) 8 | (expect-failure "str-to-int base < 1" (str-to-int -1 "12345")) 9 | (expect-failure "str-to-int base > 16" (str-to-int 17 "12345")) 10 | (expect-failure "str-to-int empty string" (str-to-int "")) 11 | (expect-failure "str-to-int char out of range with base" (str-to-int 8 "8")) 12 | (expect-failure "str-to-int char out of range without base" (str-to-int "a")) 13 | 14 | (expect "str-to-int 64" 43981 (str-to-int 64 "q80")) 15 | 16 | (expect "int-to-str 2" "101010111100110111101111000100100011010001010110" 17 | (int-to-str 2 188900967593046)) 18 | (expect "int-to-str 10" "12345" (int-to-str 10 12345)) 19 | (expect "int-to-str 16" "12345abcdef" (int-to-str 16 1251004370415)) 20 | (expect "int-to-str 64" "q80" (int-to-str 64 43981)) 21 | (expect-failure "int-to-str 17" (int-to-str 17 3245342)) 22 | -------------------------------------------------------------------------------- /tests/pact/toplevel.repl: -------------------------------------------------------------------------------- 1 | 2 | ;; 3 | ;; toplevel.repl: test that toplevel-only builtins 4 | ;; fail in module context but work in non-module context. 5 | ;; MAINTENANCE NOTE: for every built-in created using "setTopLevelOnly", 6 | ;; please add both "success" and "failure" cases below. 7 | ;; 8 | 9 | (begin-tx) 10 | 11 | ;; ease restrictions requiring namespaced keysets 12 | (env-exec-config ["DisablePact44"]) 13 | ;; define-keyset success case 14 | (define-keyset 'k (sig-keyset)) 15 | 16 | (module toplevel 'k 17 | (deftable atable) 18 | (deftable atable-bad) 19 | 20 | (defun bad-create-table (tbl) (create-table tbl)) 21 | (defun bad-describe-table (tbl) (describe-table tbl)) 22 | (defun bad-describe-keyset (k) (describe-keyset k)) 23 | (defun bad-describe-module (m) (describe-module m)) 24 | (defun bad-define-keyset (n k) (define-keyset n k)) 25 | (defun bad-pact-version () (pact-version)) 26 | (defun bad-list-modules () (list-modules)) 27 | (defun bad-enforce-pact-version (v) (enforce-pact-version v)) 28 | ) 29 | 30 | ;; Success cases 31 | 32 | (create-table atable) 33 | (commit-tx) 34 | (describe-table toplevel.atable) 35 | (describe-keyset 'k) 36 | (describe-module "toplevel") 37 | (pact-version) 38 | (list-modules) 39 | (enforce-pact-version (pact-version)) 40 | (use toplevel) 41 | 42 | ;; failure cases 43 | 44 | (expect-failure "bad-create-table" (bad-create-table atable-bad)) 45 | (expect-failure "bad-describe-table" (bad-describe-table atable)) 46 | (expect-failure "bad-describe-keyset" (bad-describe-keyset 'k)) 47 | (expect-failure "bad-describe-module" (bad-describe-module "toplevel")) 48 | (expect-failure "bad-define-keyset" (bad-define-keyset 'j (sig-keyset))) 49 | (expect-failure "bad-pact-version" (bad-pact-version)) 50 | (expect-failure "bad-list-modules" (bad-list-modules)) 51 | (expect-failure "bad-enforce-pact-version" (bad-enforce-pact-version (pact-version))) 52 | 53 | (env-enable-repl-natives true) 54 | (module repl-natives 'k 55 | (defun f () (env-sigs [{'key: "bob",'caps: []}]))) 56 | (expect 57 | "env-sigs in module" 58 | "Setting transaction signatures/caps" 59 | (f)) 60 | 61 | (env-data { 'b: "hello"}) 62 | (expect 63 | "with-applied-env: env-data takes immediate, scoped effect" 64 | 3 65 | (let ((a 1)) 66 | (env-data { 'b: 2 }) ;; normally would not be in effect until next top-level 67 | (with-applied-env 68 | (+ a (read-integer 'b))))) 69 | 70 | (expect 71 | "old env unchanged" 72 | "hello" 73 | (read-msg 'b)) 74 | 75 | ; Pact 4.11 list-modules moved to local only 76 | (env-exec-config ["DisablePact411", "DisableHistoryInTransactionalMode"]) 77 | (expect "list-modules is isn't local-only after pact 4.11" ["repl-natives" "toplevel"] (list-modules)) 78 | 79 | 80 | (env-exec-config ["DisableHistoryInTransactionalMode"]) 81 | (expect-failure "list-modules is local-only after pact 4.11" (list-modules)) 82 | -------------------------------------------------------------------------------- /tests/pact/upgrades.repl: -------------------------------------------------------------------------------- 1 | (module schema-mod g (defcap g () 2) (defschema s a:integer b:string)) 2 | 3 | (interface schema-ref-iface (defun foo:object{schema-mod.s} (o:object{schema-mod.s}))) 4 | 5 | ;; upgrade schema module with identical schema 6 | (module schema-mod g (defcap g () 1) (defschema s a:integer b:string)) 7 | 8 | ;; implement iface defined with pre-upgraded schema to exercise module unification holds across upgrade 9 | (module n g (defcap g () 1) (implements schema-ref-iface) (defun foo:object{schema-mod.s} (o:object{schema-mod.s}) o)) 10 | 11 | 12 | -------------------------------------------------------------------------------- /tests/pact/verifier-test.repl: -------------------------------------------------------------------------------- 1 | (module m GOV 2 | (defcap GOV () true) 3 | 4 | (defcap GOOD () 5 | (enforce-verifier 'HYPERLANE) 6 | ) 7 | 8 | (defcap BAD () 9 | (enforce-verifier 'HYPERLANE) 10 | ) 11 | 12 | (defcap OUTERGOOD () 13 | (enforce-verifier 'HYPERLANE) 14 | (compose-capability (GOOD)) 15 | ) 16 | 17 | (defun outergood-mgr:integer (a:integer b:integer) (print a) (+ a b)) 18 | 19 | (defcap OUTERGOOD-MANAGED (param:integer) 20 | ; @managed param outergood-mgr 21 | ; (enforce-verifier 'HYPERLANE) 22 | ; (compose-capability (GOOD)) 23 | (compose-capability (INNERGOOD-MANAGED param)) 24 | ) 25 | 26 | (defcap INNERGOOD-MANAGED (param:integer) 27 | @managed param outergood-mgr 28 | (enforce-verifier 'HYPERLANE) 29 | (compose-capability (GOOD)) 30 | ) 31 | 32 | (defun good () 33 | (with-capability (GOOD) 1) 34 | ) 35 | 36 | (defun outergood-managed () 37 | (with-capability (OUTERGOOD-MANAGED 1) 38 | 1 39 | ) 40 | ) 41 | 42 | (defun outergood () 43 | (with-capability (OUTERGOOD) 1) 44 | ) 45 | 46 | (defun bad () 47 | (with-capability (GOOD) 48 | (with-capability (BAD) 1) 49 | ) 50 | ) 51 | 52 | (defun enforce-outside-cap () 53 | (with-capability (GOOD) 54 | (enforce-verifier "HYPERLANE") 55 | ) 56 | ) 57 | ) 58 | 59 | 60 | (env-verifiers [{"name":"HYPERLANE", "caps":[(OUTERGOOD)]}]) 61 | 62 | (expect "outergood succeeds" (outergood) 1) 63 | (expect-failure "bad acquisition fails: not in scope" (bad)) 64 | (expect-failure "good acquisition fails: not in scope" (good)) 65 | 66 | (env-verifiers [{"name":"HYPERLANE", "caps":[(GOOD)]}]) 67 | 68 | (expect-failure "enforce-outside-cap fails: cannot use enforce-verifier outside of cap evaluation" (enforce-outside-cap)) 69 | (expect-failure "outergood acquisition fails: not in scope" (outergood)) 70 | (expect "good succeeds" (good) 1) 71 | (expect-failure "bad acquisition fails: not in scope" (bad)) 72 | 73 | (env-sigs [{"key":"jose", "caps":[(INNERGOOD-MANAGED 0)]}]) 74 | (env-verifiers [{"name":"HYPERLANE", "caps":[(OUTERGOOD-MANAGED 1)]}]) 75 | (expect "outergood-managed succeeds" (outergood-managed) 1) 76 | -------------------------------------------------------------------------------- /tests/pact/versions.repl: -------------------------------------------------------------------------------- 1 | 2 | 3 | (expect 4 | "pact version bounds work for current pact version" 5 | true 6 | (enforce-pact-version "3.0.0" "6.0.0")) 7 | 8 | (expect 9 | "enforce-pact-version works for current pact version" 10 | true 11 | (enforce-pact-version (pact-version))) 12 | 13 | (expect-failure 14 | "pact version bounds fail for current version if wrong bounds" 15 | (enforce-pact-version "6.0.0" "100.0.0")) 16 | 17 | ;; regression #1327 18 | (expect 19 | "enforce-pact-version succeeds for current version if lower bound set" 20 | true 21 | (enforce-pact-version "1.0.0")) 22 | 23 | (expect 24 | "enforce-pact-version succeeds (double digit regression)" 25 | true 26 | (enforce-pact-version "3.0000.0" "88.420.0")) 27 | -------------------------------------------------------------------------------- /tests/pact/webauthn.repl: -------------------------------------------------------------------------------- 1 | (env-exec-config ["EnforceKeyFormats", "DisablePact410"]) 2 | 3 | (env-data {"k":["WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf"]}) 4 | (env-sigs [{"key":"WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf", "caps":[]}]) 5 | 6 | (expect-failure "Enforcing a keyset with prefixed webauthn fails" (read-keyset "k")) 7 | 8 | (env-exec-config ["EnforceKeyFormats"]) 9 | (expect "Enforcing a keyset with prefixed webauthn works" true (enforce-keyset (read-keyset "k"))) 10 | 11 | (env-data {"k":["a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf"]}) 12 | (expect-failure "Reading an unprefixed key fails key format enforcement" (read-keyset "k")) 13 | -------------------------------------------------------------------------------- /tests/pact/yield-rollback.repl: -------------------------------------------------------------------------------- 1 | (begin-tx) 2 | (env-exec-config ["DisablePact44"]) 3 | (define-keyset 'k (sig-keyset)) 4 | 5 | (module yield-rollback 'k 6 | 7 | (defpact cross-chain (n:string) 8 | 9 | "Show that a mix of rollbacks with yield/resume pairs \ 10 | \is fine, as long as rollbacks do not occur in the \ 11 | \same step as a yield." 12 | 13 | (step-with-rollback 14 | (let ((nn (+ n "[1]-"))) 15 | (yield { "n" : nn }) 16 | nn) 17 | "rollback-1") 18 | 19 | (step 20 | (resume { "n" := nn } 21 | (let ((nnn (+ nn "[2]-"))) 22 | (yield { "n" : nnn } "1") 23 | nnn))) 24 | 25 | (step 26 | (resume { "n" := nnn } 27 | (+ nnn "[3]-end"))) 28 | ) 29 | 30 | ) 31 | 32 | (module yield-rollback-failure 'k 33 | 34 | (defpact cross-chain-failure (n:string) 35 | 36 | "Show that steps with rollbacks and yield in the \ 37 | \same step fails at runtime, and fails tc." 38 | 39 | (step-with-rollback 40 | (let ((nn (+ n "[1]-"))) 41 | (yield { "n" : nn }) 42 | nn) 43 | "rollback-1") 44 | 45 | (step-with-rollback 46 | (resume { "n" := nn } 47 | (let ((nnn (+ nn "[2]-"))) 48 | (yield { "n" : nnn } "1") 49 | nnn)) 50 | "rollback-2") 51 | 52 | (step 53 | (resume { "n" := nnn } 54 | (+ nnn "[3]-end"))) 55 | ) 56 | ) 57 | 58 | (commit-tx) 59 | 60 | ;;; begin tests for yield-rollback 61 | 62 | (use yield-rollback) 63 | 64 | ;; set chain id to something sane 65 | (env-chain-data { "chain-id": "0" }) 66 | (env-hash (hash "emily-pact-id")) 67 | 68 | ;; expect successful output which primes the yiel 69 | (expect "step 0 executes" "start-[1]-" (cross-chain "start-")) 70 | 71 | (env-chain-data { "chain-id" : "1" }) 72 | (expect "step 1 executes on chain 1" "start-[1]-[2]-" (continue-pact 1)) 73 | (expect "step 2 executes" "start-[1]-[2]-[3]-end" (continue-pact 2)) 74 | 75 | ;;; begin tests for yield-rollback-failure 76 | 77 | (pact-state true) 78 | 79 | (use yield-rollback-failure) 80 | 81 | ;; set chain id to something sane 82 | (env-chain-data { "chain-id": "0" }) 83 | (env-hash (hash "emily-pact-id")) 84 | 85 | ;; expect successful output which primes the yiel 86 | (expect "step 0 executes" "start-[1]-" (cross-chain-failure "start-")) 87 | 88 | (env-chain-data { "chain-id" : "1" }) 89 | (expect-failure "step 1 fails to execute on chain 1 due to rollback" (continue-pact 1)) 90 | (expect-failure 91 | "typechecking fails for defpacts with rollbacks and yield in the same step" 92 | (typecheck 'yield-rollback-failure)) 93 | -------------------------------------------------------------------------------- /tests/sign-scripts/add-sigs.yaml: -------------------------------------------------------------------------------- 1 | hash: i1S2rUgEyfBl393oWEwts3DzuyCvraemXA9A1Bno6sg 2 | sigs: 3 | 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804: null 4 | cmd: '{"networkId":null,"payload":{"exec":{"data":null,"code":"(test.run-escrow \"Alice\" \"Bob\")"}},"signers":[{"pubKey":"7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804","clist":[{"args":["Alice"],"name":"accounts.USER_GUARD"}]}],"meta":{"creationTime":0,"ttl":0,"gasLimit":0,"chainId":"","gasPrice":0,"sender":""},"nonce":"just-sign-exec"}' 5 | -------------------------------------------------------------------------------- /tests/sign-scripts/addSigsExpected.yaml: -------------------------------------------------------------------------------- 1 | {"cmds":[{"hash":"i1S2rUgEyfBl393oWEwts3DzuyCvraemXA9A1Bno6sg","sigs":[{"sig":"c72ac57ac1f03cd264b4e0db1ef681894e42b02b5ddcb115ee2f776ba8048c2afd15a4c1e46b20248bb015ba395689a90ac93b5193173f3af6e495b4ce09ce03"}],"cmd":"{\"networkId\":null,\"payload\":{\"exec\":{\"data\":null,\"code\":\"(test.run-escrow \\\"Alice\\\" \\\"Bob\\\")\"}},\"signers\":[{\"pubKey\":\"7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804\",\"clist\":[{\"args\":[\"Alice\"],\"name\":\"accounts.USER_GUARD\"}]}],\"meta\":{\"creationTime\":0,\"ttl\":0,\"gasLimit\":0,\"chainId\":\"\",\"gasPrice\":0,\"sender\":\"\"},\"nonce\":\"just-sign-exec\"}"}]} 2 | -------------------------------------------------------------------------------- /tests/sign-scripts/bare-sig.yaml: -------------------------------------------------------------------------------- 1 | hash: i1S2rUgEyfBl393oWEwts3DzuyCvraemXA9A1Bno6sg 2 | sigs: 3 | 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804: c72ac57ac1f03cd264b4e0db1ef681894e42b02b5ddcb115ee2f776ba8048c2afd15a4c1e46b20248bb015ba395689a90ac93b5193173f3af6e495b4ce09ce03 4 | 5 | -------------------------------------------------------------------------------- /tests/sign-scripts/combineSigsExpected.yaml: -------------------------------------------------------------------------------- 1 | {"cmds":[{"hash":"i1S2rUgEyfBl393oWEwts3DzuyCvraemXA9A1Bno6sg","sigs":[{"sig":"c72ac57ac1f03cd264b4e0db1ef681894e42b02b5ddcb115ee2f776ba8048c2afd15a4c1e46b20248bb015ba395689a90ac93b5193173f3af6e495b4ce09ce03"}],"cmd":"{\"networkId\":null,\"payload\":{\"exec\":{\"data\":null,\"code\":\"(test.run-escrow \\\"Alice\\\" \\\"Bob\\\")\"}},\"signers\":[{\"pubKey\":\"7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804\",\"clist\":[{\"args\":[\"Alice\"],\"name\":\"accounts.USER_GUARD\"}]}],\"meta\":{\"creationTime\":0,\"ttl\":0,\"gasLimit\":0,\"chainId\":\"\",\"gasPrice\":0,\"sender\":\"\"},\"nonce\":\"just-sign-exec\"}"}]} 2 | -------------------------------------------------------------------------------- /tests/sign-scripts/key.yaml: -------------------------------------------------------------------------------- 1 | public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 2 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 3 | -------------------------------------------------------------------------------- /tests/sign-scripts/sign-req.yaml: -------------------------------------------------------------------------------- 1 | keyPairs: 2 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 3 | secret: 2e8c91521479537221576a7c3c80c46d0fa3fc663804117f0c7011366dec35de 4 | hash: i1S2rUgEyfBl393oWEwts3DzuyCvraemXA9A1Bno6sg 5 | -------------------------------------------------------------------------------- /tests/sign-scripts/unsigned-cont.yaml: -------------------------------------------------------------------------------- 1 | type: "cont" 2 | pactTxHash: "TNgO7o8nSZILVCfJPcg5IjHADy-XKvQ7o5RfAieJvwY" 3 | step: 1 4 | rollback: False 5 | signers: 6 | - public: ac69d9856821f11b8e6ca5cdd84a98ec3086493fd6407e74ea9038407ec9eba9 7 | nonce: just-sign-cont 8 | -------------------------------------------------------------------------------- /tests/sign-scripts/unsigned-exec.yaml: -------------------------------------------------------------------------------- 1 | code: |- 2 | (test.run-escrow "Alice" "Bob") 3 | signers: 4 | - public: 7d0c9ba189927df85c8c54f8b5c8acd76c1d27e923abbf25a957afdf25550804 5 | caps: 6 | - name: accounts.USER_GUARD 7 | args: ["Alice"] 8 | nonce: just-sign-exec 9 | -------------------------------------------------------------------------------- /tests/test-log/.gitremember: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Hardcoding-1992/pact/d4f03045df6ba5178a76e534d619b6233ad1c659/tests/test-log/.gitremember -------------------------------------------------------------------------------- /vendored/prettyprinter-1.6.0/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. All 2 | rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | - Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | - Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | This software is provided by the copyright holders "as is" and any express or 15 | implied warranties, including, but not limited to, the implied warranties of 16 | merchantability and fitness for a particular purpose are disclaimed. In no event 17 | shall the copyright holders be liable for any direct, indirect, incidental, 18 | special, exemplary, or consequential damages (including, but not limited to, 19 | procurement of substitute goods or services; loss of use, data, or profits; or 20 | business interruption) however caused and on any theory of liability, whether in 21 | contract, strict liability, or tort (including negligence or otherwise) arising 22 | in any way out of the use of this software, even if advised of the possibility 23 | of such damage. 24 | -------------------------------------------------------------------------------- /vendored/prettyprinter-1.6.0/src/Data/Text/Prettyprint/Doc/Compat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | -- | 8 | -- Module: Data.Text.Prettyprint.Doc.Compat 9 | -- Copyright: Copyright © 2023 Kadena LLC. 10 | -- License: MIT 11 | -- Maintainer: Lars Kuhtz 12 | -- Stability: experimental 13 | -- 14 | -- Translate between Doc values of the internal (vendored) prettyprinter 15 | -- implementation and of recent versions (>=1.7) of prettyprinter package on 16 | -- Hackage. 17 | -- 18 | module Data.Text.Prettyprint.Doc.Compat 19 | ( docToInternal 20 | , docFromInternal 21 | ) where 22 | 23 | import "prettyprinter" Prettyprinter.Internal qualified as PP 24 | import Data.Text.Prettyprint.Doc.Internal 25 | 26 | pageWidthFromInternal :: PageWidth -> PP.PageWidth 27 | pageWidthFromInternal (AvailablePerLine a b) = PP.AvailablePerLine a b 28 | pageWidthFromInternal Unbounded = PP.Unbounded 29 | 30 | pageWidthToInternal :: PP.PageWidth -> PageWidth 31 | pageWidthToInternal (PP.AvailablePerLine a b) = AvailablePerLine a b 32 | pageWidthToInternal PP.Unbounded = Unbounded 33 | 34 | docFromInternal :: Doc a -> PP.Doc a 35 | docFromInternal Fail = PP.Fail 36 | docFromInternal Empty = PP.Empty 37 | docFromInternal (Char a) = PP.Char a 38 | docFromInternal (Text a b) = PP.Text a b 39 | docFromInternal Line = PP.Line 40 | docFromInternal (FlatAlt a b) = PP.FlatAlt (docFromInternal a) (docFromInternal b) 41 | docFromInternal (Cat a b) = PP.Cat (docFromInternal a) (docFromInternal b) 42 | docFromInternal (Nest a b) = PP.Nest a (docFromInternal b) 43 | docFromInternal (Union a b) = PP.Union (docFromInternal a) (docFromInternal b) 44 | docFromInternal (Column a) = PP.Column $ docFromInternal <$> a 45 | docFromInternal (WithPageWidth a) = PP.WithPageWidth (docFromInternal <$> a . pageWidthToInternal) 46 | docFromInternal (Nesting a) = PP.Nesting (docFromInternal <$> a) 47 | docFromInternal (Annotated a b) = PP.Annotated a (docFromInternal b) 48 | 49 | docToInternal :: PP.Doc a -> Doc a 50 | docToInternal PP.Fail = Fail 51 | docToInternal PP.Empty = Empty 52 | docToInternal (PP.Char a) = Char a 53 | docToInternal (PP.Text a b) = Text a b 54 | docToInternal PP.Line = Line 55 | docToInternal (PP.FlatAlt a b) = FlatAlt (docToInternal a) (docToInternal b) 56 | docToInternal (PP.Cat a b) = Cat (docToInternal a) (docToInternal b) 57 | docToInternal (PP.Nest a b) = Nest a (docToInternal b) 58 | docToInternal (PP.Union a b) = Union (docToInternal a) (docToInternal b) 59 | docToInternal (PP.Column a) = Column (docToInternal <$> a) 60 | docToInternal (PP.WithPageWidth a) = WithPageWidth (docToInternal <$> a . pageWidthFromInternal) 61 | docToInternal (PP.Nesting a) = Nesting (docToInternal <$> a) 62 | docToInternal (PP.Annotated a b) = Annotated a (docToInternal b) 63 | -------------------------------------------------------------------------------- /vendored/prettyprinter-1.6.0/src/Data/Text/Prettyprint/Doc/Render/String.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.String ( 2 | renderString, 3 | renderShowS, 4 | ) where 5 | 6 | import Data.Text.Prettyprint.Doc.Internal (SimpleDocStream, renderShowS) 7 | 8 | -- | Render a 'SimpleDocStream' to a 'String'. 9 | renderString :: SimpleDocStream ann -> String 10 | renderString s = renderShowS s "" 11 | -------------------------------------------------------------------------------- /vendored/prettyprinter-1.6.0/src/Data/Text/Prettyprint/Doc/Render/Util/Panic.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Util.Panic ( 2 | panicUncaughtFail, 3 | panicUnpairedPop, 4 | panicSimpleDocTreeConversionFailed, 5 | panicInputNotFullyConsumed, 6 | panicPeekedEmpty, 7 | panicPoppedEmpty, 8 | ) where 9 | 10 | -- | Raise a hard 'error' if there is a 'Data.Text.Prettyprint.Doc.SFail' in a 11 | -- 'Data.Text.Prettyprint.Doc.SimpleDocStream'. 12 | panicUncaughtFail :: void 13 | panicUncaughtFail = error ("»SFail« must not appear in a rendered »SimpleDocStream«. This is a bug in the layout algorithm! " ++ report) 14 | 15 | -- | Raise a hard 'error' when an annotation terminator is encountered in an 16 | -- unannotated region. 17 | panicUnpairedPop :: void 18 | panicUnpairedPop = error ("An unpaired style terminator was encountered. This is a bug in the layout algorithm! " ++ report) 19 | 20 | -- | Raise a hard generic 'error' when the 21 | -- 'Data.Text.Prettyprint.Doc.SimpleDocStream' to 22 | -- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' conversion fails. 23 | panicSimpleDocTreeConversionFailed :: void 24 | panicSimpleDocTreeConversionFailed = error ("Conversion from SimpleDocStream to SimpleDocTree failed! " ++ report) 25 | 26 | -- | Raise a hard 'error' when the »to 27 | -- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree'« parser finishes 28 | -- without consuming the full input. 29 | panicInputNotFullyConsumed :: void 30 | panicInputNotFullyConsumed = error ("Conversion from SimpleDocStream to SimpleDocTree left unconsumed input! " ++ report) 31 | 32 | report :: String 33 | report = "Please report this as a bug" 34 | 35 | panicPeekedEmpty, panicPoppedEmpty :: void 36 | (panicPeekedEmpty, panicPoppedEmpty) = (mkErr "Peeked", mkErr "Popped") 37 | where 38 | mkErr x = error (x ++ " an empty style stack! Please report this as a bug.") 39 | --------------------------------------------------------------------------------