From 5bae354268fb49f40ff1d002376b8923bc58dace Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 9 Mar 2022 19:32:13 +0100 Subject: [PATCH 1/7] apropos-tx setup --- {bench => agora-bench}/Main.hs | 0 {test => agora-test}/Spec.hs | 11 +- agora-test/Spec/Int.hs | 88 ++++ agora.cabal | 13 +- {src => agora}/Agora/AuthorityToken.hs | 0 {src => agora}/Agora/SafeMoney.hs | 0 {src => agora}/Agora/SafeMoney/QQ.hs | 0 {src => agora}/Agora/Stake.hs | 0 {src => agora}/Agora/Treasury.hs | 0 {src => agora}/Agora/Utils.hs | 0 {src => agora}/Agora/Utils/Value.hs | 0 {src => agora}/Agora/Voting.hs | 0 {src => agora}/PPrelude.hs | 0 {src => agora}/Plutarch/Api/V1/These.hs | 0 {src => agora}/Plutarch/These.hs | 0 flake.lock | 616 ++++++++++++++++++++++-- flake.nix | 21 +- 17 files changed, 695 insertions(+), 54 deletions(-) rename {bench => agora-bench}/Main.hs (100%) rename {test => agora-test}/Spec.hs (68%) create mode 100644 agora-test/Spec/Int.hs rename {src => agora}/Agora/AuthorityToken.hs (100%) rename {src => agora}/Agora/SafeMoney.hs (100%) rename {src => agora}/Agora/SafeMoney/QQ.hs (100%) rename {src => agora}/Agora/Stake.hs (100%) rename {src => agora}/Agora/Treasury.hs (100%) rename {src => agora}/Agora/Utils.hs (100%) rename {src => agora}/Agora/Utils/Value.hs (100%) rename {src => agora}/Agora/Voting.hs (100%) rename {src => agora}/PPrelude.hs (100%) rename {src => agora}/Plutarch/Api/V1/These.hs (100%) rename {src => agora}/Plutarch/These.hs (100%) diff --git a/bench/Main.hs b/agora-bench/Main.hs similarity index 100% rename from bench/Main.hs rename to agora-bench/Main.hs diff --git a/test/Spec.hs b/agora-test/Spec.hs similarity index 68% rename from test/Spec.hs rename to agora-test/Spec.hs index 9cfc14c..606e9ca 100644 --- a/test/Spec.hs +++ b/agora-test/Spec.hs @@ -8,6 +8,15 @@ import Test.Tasty (defaultMain, testGroup) -------------------------------------------------------------------------------- +import Spec.Int + main :: IO () main = - defaultMain $ testGroup "Suites" [] + defaultMain $ + testGroup + "apropos-tx" + [ testGroup + "Int" + [ intPlutarchTests + ] + ] diff --git a/agora-test/Spec/Int.hs b/agora-test/Spec/Int.hs new file mode 100644 index 0000000..8063784 --- /dev/null +++ b/agora-test/Spec/Int.hs @@ -0,0 +1,88 @@ +module Spec.Int (HasLogicalModel (..), IntProp (..), intGenTests, intPureTests, intPlutarchTests) where + +import Apropos +import Apropos.Script +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (fromGroup) + +import Plutarch (compile) + +data IntProp + = IsNegative + | IsPositive + | IsZero + | IsLarge + | IsSmall + | IsMaxBound + | IsMinBound + deriving stock (Eq, Ord, Enum, Show, Bounded) + +instance Enumerable IntProp where + enumerated = [minBound .. maxBound] + +instance LogicalModel IntProp where + logic = + ExactlyOne [Var IsNegative, Var IsPositive, Var IsZero] + :&&: ExactlyOne [Var IsLarge, Var IsSmall] + :&&: (Var IsZero :->: Var IsSmall) + :&&: (Var IsMaxBound :->: (Var IsLarge :&&: Var IsPositive)) + :&&: (Var IsMinBound :->: (Var IsLarge :&&: Var IsNegative)) + +instance HasLogicalModel IntProp Int where + satisfiesProperty IsNegative i = i < 0 + satisfiesProperty IsPositive i = i > 0 + satisfiesProperty IsMaxBound i = i == maxBound + satisfiesProperty IsMinBound i = i == minBound + satisfiesProperty IsZero i = i == 0 + satisfiesProperty IsLarge i = i > 10 || i < -10 + satisfiesProperty IsSmall i = i <= 10 && i >= -10 + +instance HasParameterisedGenerator IntProp Int where + parameterisedGenerator s = do + i <- + if IsZero `elem` s + then pure 0 + else + if IsSmall `elem` s + then int (linear 1 10) + else + if IsMaxBound `elem` s + then pure maxBound + else int (linear 11 (maxBound - 1)) + if IsNegative `elem` s + then + if IsMinBound `elem` s + then pure minBound + else pure (-i) + else pure i + +intGenTests :: TestTree +intGenTests = + testGroup "intGenTests" $ + fromGroup + <$> [ runGeneratorTestsWhere (Apropos :: Int :+ IntProp) "Int Generator" Yes + ] + +instance HasPureRunner IntProp Int where + expect _ = Var IsSmall :&&: Var IsNegative + script _ i = i < 0 && i >= -10 + +intPureTests :: TestTree +intPureTests = + testGroup "intPureTests" $ + fromGroup + <$> [ runPureTestsWhere (Apropos :: Int :+ IntProp) "AcceptsSmallNegativeInts" Yes + ] + +instance HasScriptRunner IntProp Int where + expect _ = Var IsSmall :&&: Var IsNegative + script _ i = + let ii = fromIntegral i :: Integer + in compile (pif ((fromInteger ii #< (0 :: Term s PInteger)) #&& ((fromInteger (-10) :: Term s PInteger) #<= fromInteger ii)) (pcon PUnit) perror) + +intPlutarchTests :: TestTree +intPlutarchTests = + testGroup "intPlutarchTests" $ + fromGroup + <$> [ runScriptTestsWhere (Apropos :: Int :+ IntProp) "AcceptsSmallNegativeInts" Yes + ] diff --git a/agora.cabal b/agora.cabal index 3d8cdf0..440ac37 100644 --- a/agora.cabal +++ b/agora.cabal @@ -110,7 +110,8 @@ common test-deps , QuickCheck , quickcheck-instances , tasty - , tasty-quickcheck + , tasty-hedgehog + , apropos-tx library import: lang, deps @@ -128,7 +129,7 @@ library Plutarch.Api.V1.These Plutarch.These - hs-source-dirs: src + hs-source-dirs: agora library pprelude build-depends: @@ -136,18 +137,20 @@ library pprelude , plutarch exposed-modules: PPrelude - hs-source-dirs: src + hs-source-dirs: agora default-language: Haskell2010 test-suite agora-test import: lang, deps, test-deps type: exitcode-stdio-1.0 main-is: Spec.hs - hs-source-dirs: test + hs-source-dirs: agora-test + other-modules: + Spec.Int benchmark agora-bench import: lang, deps - hs-source-dirs: bench + hs-source-dirs: agora-bench main-is: Main.hs type: exitcode-stdio-1.0 build-depends: diff --git a/src/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs similarity index 100% rename from src/Agora/AuthorityToken.hs rename to agora/Agora/AuthorityToken.hs diff --git a/src/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs similarity index 100% rename from src/Agora/SafeMoney.hs rename to agora/Agora/SafeMoney.hs diff --git a/src/Agora/SafeMoney/QQ.hs b/agora/Agora/SafeMoney/QQ.hs similarity index 100% rename from src/Agora/SafeMoney/QQ.hs rename to agora/Agora/SafeMoney/QQ.hs diff --git a/src/Agora/Stake.hs b/agora/Agora/Stake.hs similarity index 100% rename from src/Agora/Stake.hs rename to agora/Agora/Stake.hs diff --git a/src/Agora/Treasury.hs b/agora/Agora/Treasury.hs similarity index 100% rename from src/Agora/Treasury.hs rename to agora/Agora/Treasury.hs diff --git a/src/Agora/Utils.hs b/agora/Agora/Utils.hs similarity index 100% rename from src/Agora/Utils.hs rename to agora/Agora/Utils.hs diff --git a/src/Agora/Utils/Value.hs b/agora/Agora/Utils/Value.hs similarity index 100% rename from src/Agora/Utils/Value.hs rename to agora/Agora/Utils/Value.hs diff --git a/src/Agora/Voting.hs b/agora/Agora/Voting.hs similarity index 100% rename from src/Agora/Voting.hs rename to agora/Agora/Voting.hs diff --git a/src/PPrelude.hs b/agora/PPrelude.hs similarity index 100% rename from src/PPrelude.hs rename to agora/PPrelude.hs diff --git a/src/Plutarch/Api/V1/These.hs b/agora/Plutarch/Api/V1/These.hs similarity index 100% rename from src/Plutarch/Api/V1/These.hs rename to agora/Plutarch/Api/V1/These.hs diff --git a/src/Plutarch/These.hs b/agora/Plutarch/These.hs similarity index 100% rename from src/Plutarch/These.hs rename to agora/Plutarch/These.hs diff --git a/flake.lock b/flake.lock index f5ab6be..879db67 100644 --- a/flake.lock +++ b/flake.lock @@ -16,6 +16,22 @@ "type": "github" } }, + "HTTP_2": { + "flake": false, + "locked": { + "lastModified": 1451647621, + "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", + "owner": "phadej", + "repo": "HTTP", + "rev": "9bc0996d412fef1787449d841277ef663ad9a915", + "type": "github" + }, + "original": { + "owner": "phadej", + "repo": "HTTP", + "type": "github" + } + }, "Shrinker": { "flake": false, "locked": { @@ -49,6 +65,33 @@ "type": "github" } }, + "apropos-tx": { + "inputs": { + "flake-compat": "flake-compat", + "flake-compat-ci": "flake-compat-ci", + "haskell-nix": "haskell-nix", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-unstable" + ], + "plutus": "plutus" + }, + "locked": { + "lastModified": 1646436508, + "narHash": "sha256-4QevdgeSSHfOyJEqdiNx6SovGpLZv1vw9i6r0XbpQ3U=", + "owner": "mlabs-haskell", + "repo": "apropos-tx", + "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "type": "github" + }, + "original": { + "owner": "mlabs-haskell", + "repo": "apropos-tx", + "rev": "5b74ba897a6f02718c163bf588a08c5e3e9de204", + "type": "github" + } + }, "autodocodec": { "flake": false, "locked": { @@ -83,6 +126,23 @@ "type": "github" } }, + "cabal-32_2": { + "flake": false, + "locked": { + "lastModified": 1603716527, + "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "owner": "haskell", + "repo": "cabal", + "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.2", + "repo": "cabal", + "type": "github" + } + }, "cabal-34": { "flake": false, "locked": { @@ -100,6 +160,23 @@ "type": "github" } }, + "cabal-34_2": { + "flake": false, + "locked": { + "lastModified": 1622475795, + "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "owner": "haskell", + "repo": "cabal", + "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.4", + "repo": "cabal", + "type": "github" + } + }, "cabal-36": { "flake": false, "locked": { @@ -183,6 +260,22 @@ "type": "github" } }, + "cardano-repo-tool_2": { + "flake": false, + "locked": { + "lastModified": 1624584417, + "narHash": "sha256-YSepT97PagR/1jTYV/Yer8a2GjFe9+tTwaTCHxuK50M=", + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "rev": "30e826ed8f00e3e154453b122a6f3d779b2f73ec", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-repo-tool", + "type": "github" + } + }, "cardano-shell": { "flake": false, "locked": { @@ -199,6 +292,22 @@ "type": "github" } }, + "cardano-shell_2": { + "flake": false, + "locked": { + "lastModified": 1608537748, + "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", + "owner": "input-output-hk", + "repo": "cardano-shell", + "rev": "9392c75087cb9a3d453998f4230930dea3a95725", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "cardano-shell", + "type": "github" + } + }, "cryptonite": { "flake": false, "locked": { @@ -247,24 +356,55 @@ "type": "github" } }, + "flake-compat-ci_2": { + "locked": { + "lastModified": 1641672839, + "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-compat-ci", + "type": "github" + } + }, "flake-compat_2": { "flake": false, "locked": { - "lastModified": 1606424373, - "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", "owner": "edolstra", "repo": "flake-compat", - "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", "type": "github" }, "original": { "owner": "edolstra", - "ref": "master", "repo": "flake-compat", "type": "github" } }, "flake-compat_3": { + "flake": false, + "locked": { + "lastModified": 1606424373, + "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "type": "github" + }, + "original": { + "owner": "edolstra", + "ref": "master", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_4": { "flake": false, "locked": { "lastModified": 1606424373, @@ -295,6 +435,21 @@ "type": "github" } }, + "flake-utils_2": { + "locked": { + "lastModified": 1623875721, + "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, "flat": { "flake": false, "locked": { @@ -346,6 +501,23 @@ "type": "github" } }, + "ghc-8.6.5-iohk_2": { + "flake": false, + "locked": { + "lastModified": 1600920045, + "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", + "owner": "input-output-hk", + "repo": "ghc", + "rev": "95713a6ecce4551240da7c96b6176f980af75cae", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "release/8.6.5-iohk", + "repo": "ghc", + "type": "github" + } + }, "gitignore-nix": { "flake": false, "locked": { @@ -362,14 +534,30 @@ "type": "github" } }, + "gitignore-nix_2": { + "flake": false, + "locked": { + "lastModified": 1611672876, + "narHash": "sha256-qHu3uZ/o9jBHiA3MEKHJ06k7w4heOhA+4HCSIvflRxo=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "211907489e9f198594c0eb0ca9256a1949c9d412", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "gitignore.nix", + "type": "github" + } + }, "hackage": { "flake": false, "locked": { - "lastModified": 1642554756, - "narHash": "sha256-1+SN+z80HgKYshlCf8dRxwRojQzuwwsQ5uq14N/JP1Y=", + "lastModified": 1639357972, + "narHash": "sha256-NvVn00YOYZMqDUSiBbghJk/rm/nJItBEUJulWRGTgvk=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "f9d5e67ca90926b244c0ad68815371d37582a149", + "rev": "54adf6e47e20831d9c49a2b62e12f7f218fd7752", "type": "github" }, "original": { @@ -394,7 +582,56 @@ "type": "github" } }, + "hackage-nix_2": { + "flake": false, + "locked": { + "lastModified": 1637291070, + "narHash": "sha256-hTX2Xo36i9MR6PNwA/89C8daKjxmx5ZS5lwR2Cbp8Yo=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "6ea4ad5f4a5e2303cd64974329ba90ccc410a012", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, + "hackage_2": { + "flake": false, + "locked": { + "lastModified": 1642554756, + "narHash": "sha256-1+SN+z80HgKYshlCf8dRxwRojQzuwwsQ5uq14N/JP1Y=", + "owner": "input-output-hk", + "repo": "hackage.nix", + "rev": "f9d5e67ca90926b244c0ad68815371d37582a149", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "hackage.nix", + "type": "github" + } + }, "haskell-language-server": { + "flake": false, + "locked": { + "lastModified": 1638136578, + "narHash": "sha256-Reo9BQ12O+OX7tuRfaDPZPBpJW4jnxZetm63BxYncoM=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "745ef26f406dbdd5e4a538585f8519af9f1ccb09", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "1.5.1", + "repo": "haskell-language-server", + "type": "github" + } + }, + "haskell-language-server_2": { "flake": false, "locked": { "lastModified": 1642772345, @@ -410,7 +647,7 @@ "type": "github" } }, - "haskell-language-server_2": { + "haskell-language-server_3": { "flake": false, "locked": { "lastModified": 1638136578, @@ -432,7 +669,6 @@ "HTTP": "HTTP", "cabal-32": "cabal-32", "cabal-34": "cabal-34", - "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-utils": "flake-utils", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", @@ -440,28 +676,27 @@ "hpc-coveralls": "hpc-coveralls", "nix-tools": "nix-tools", "nixpkgs": [ - "plutarch", + "apropos-tx", "haskell-nix", - "nixpkgs-2111" + "nixpkgs-2105" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", - "nixpkgs-2111": "nixpkgs-2111_2", + "nixpkgs-2111": "nixpkgs-2111", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", "stackage": "stackage" }, "locked": { - "lastModified": 1642811877, - "narHash": "sha256-7YbbFF4ISWMcs5hHDfH7GkCSccvwEwhvKZ5D74Cuajo=", - "owner": "L-as", + "lastModified": 1639371915, + "narHash": "sha256-i5kW3hPptzXwzkpI2FAkfdDA/9QEDl/9mrwwoeBxDJg=", + "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "ac825b91c202947ec59b1a477003564cc018fcec", + "rev": "e95a1f0dacbc64603c31d11e36e4ba1af8f0eb43", "type": "github" }, "original": { - "owner": "L-as", - "ref": "master", + "owner": "input-output-hk", "repo": "haskell.nix", "type": "github" } @@ -482,13 +717,68 @@ "type": "github" } }, + "haskell-nix_3": { + "inputs": { + "HTTP": "HTTP_2", + "cabal-32": "cabal-32_2", + "cabal-34": "cabal-34_2", + "cabal-36": "cabal-36", + "cardano-shell": "cardano-shell_2", + "flake-utils": "flake-utils_2", + "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", + "hackage": "hackage_2", + "hpc-coveralls": "hpc-coveralls_2", + "nix-tools": "nix-tools_2", + "nixpkgs": [ + "plutarch", + "haskell-nix", + "nixpkgs-2111" + ], + "nixpkgs-2003": "nixpkgs-2003_2", + "nixpkgs-2105": "nixpkgs-2105_2", + "nixpkgs-2111": "nixpkgs-2111_3", + "nixpkgs-unstable": "nixpkgs-unstable_2", + "old-ghc-nix": "old-ghc-nix_2", + "stackage": "stackage_2" + }, + "locked": { + "lastModified": 1642811877, + "narHash": "sha256-7YbbFF4ISWMcs5hHDfH7GkCSccvwEwhvKZ5D74Cuajo=", + "owner": "L-as", + "repo": "haskell.nix", + "rev": "ac825b91c202947ec59b1a477003564cc018fcec", + "type": "github" + }, + "original": { + "owner": "L-as", + "ref": "master", + "repo": "haskell.nix", + "type": "github" + } + }, + "haskell-nix_4": { + "flake": false, + "locked": { + "lastModified": 1629380841, + "narHash": "sha256-gWOWCfX7IgVSvMMYN6rBGK6EA0pk6pmYguXzMvGte+Q=", + "owner": "input-output-hk", + "repo": "haskell.nix", + "rev": "7215f083b37741446aa325b20c8ba9f9f76015eb", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "haskell.nix", + "type": "github" + } + }, "hercules-ci-agent": { "inputs": { - "flake-compat": "flake-compat_3", + "flake-compat": "flake-compat_4", "nix-darwin": "nix-darwin", "nixos-20_09": "nixos-20_09", "nixos-unstable": "nixos-unstable", - "pre-commit-hooks-nix": "pre-commit-hooks-nix" + "pre-commit-hooks-nix": "pre-commit-hooks-nix_2" }, "locked": { "lastModified": 1642766877, @@ -507,9 +797,9 @@ }, "hercules-ci-effects": { "inputs": { - "flake-compat": "flake-compat_2", + "flake-compat": "flake-compat_3", "hercules-ci-agent": "hercules-ci-agent", - "nixpkgs": "nixpkgs_2", + "nixpkgs": "nixpkgs_3", "nixpkgs-nixops": "nixpkgs-nixops" }, "locked": { @@ -542,6 +832,22 @@ "type": "github" } }, + "hpc-coveralls_2": { + "flake": false, + "locked": { + "lastModified": 1607498076, + "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", + "type": "github" + }, + "original": { + "owner": "sevanspowell", + "repo": "hpc-coveralls", + "type": "github" + } + }, "hs-memory": { "flake": false, "locked": { @@ -575,9 +881,25 @@ "type": "github" } }, + "iohk-nix_2": { + "flake": false, + "locked": { + "lastModified": 1626953580, + "narHash": "sha256-iEI9aTOaZMGsjWzcrctrC0usmiagwKT2v1LSDe9/tMU=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "cbd497f5844249ef8fe617166337d59f2a6ebe90", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, "nix-darwin": { "inputs": { - "nixpkgs": "nixpkgs" + "nixpkgs": "nixpkgs_2" }, "locked": { "lastModified": 1622060422, @@ -609,6 +931,22 @@ "type": "github" } }, + "nix-tools_2": { + "flake": false, + "locked": { + "lastModified": 1636018067, + "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "nix-tools", + "type": "github" + } + }, "nixos-20_09": { "locked": { "lastModified": 1623585158, @@ -642,17 +980,20 @@ } }, "nixpkgs": { + "flake": false, "locked": { - "lastModified": 1602411953, - "narHash": "sha256-gbupmxRpoQZqL5NBQCJN2GI5G7XDEHHHYKhVwEj5+Ps=", - "owner": "LnL7", + "lastModified": 1628785280, + "narHash": "sha256-2B5eMrEr6O8ff2aQNeVxTB+9WrGE80OB4+oM6T7fOcc=", + "owner": "NixOS", "repo": "nixpkgs", - "rev": "f780534ea2d0c12e62607ff254b6b45f46653f7a", + "rev": "6525bbc06a39f26750ad8ee0d40000ddfdc24acb", "type": "github" }, "original": { - "id": "nixpkgs", - "type": "indirect" + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" } }, "nixpkgs-2003": { @@ -671,7 +1012,39 @@ "type": "github" } }, + "nixpkgs-2003_2": { + "locked": { + "lastModified": 1620055814, + "narHash": "sha256-8LEHoYSJiL901bTMVatq+rf8y7QtWuZhwwpKE2fyaRY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "1db42b7fe3878f3f5f7a4f2dc210772fd080e205", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-20.03-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, "nixpkgs-2105": { + "locked": { + "lastModified": 1639202042, + "narHash": "sha256-xEMgCsIcDUQ0kw9xvqU0wObns580kpdcr1ACz83+gHs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "499ca2a9f6463ce119e40361f4329afa921a1d13", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.05-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2105_2": { "locked": { "lastModified": 1640283157, "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", @@ -688,6 +1061,22 @@ } }, "nixpkgs-2111": { + "locked": { + "lastModified": 1639213685, + "narHash": "sha256-Evuobw7o9uVjAZuwz06Al0fOWZ5JMKOktgXR0XgWBtg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "453bcb8380fd1777348245b3c44ce2a2b93b2e2d", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-21.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-2111_2": { "locked": { "lastModified": 1644793108, "narHash": "sha256-MN/ElRTuE7pWuf99Hr1pbAxA3ApDLYuK6hIsA5sagjc=", @@ -703,7 +1092,7 @@ "type": "github" } }, - "nixpkgs-2111_2": { + "nixpkgs-2111_3": { "locked": { "lastModified": 1640283207, "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", @@ -736,6 +1125,22 @@ } }, "nixpkgs-unstable": { + "locked": { + "lastModified": 1639239143, + "narHash": "sha256-9fFMUs6m3/4ZMflSqRgO4iEkBtFBnDyLWa3AB2tOvfs=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "e6df26a654b7fdd59a068c57001eab5736b1363c", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-unstable_2": { "locked": { "lastModified": 1641285291, "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", @@ -752,6 +1157,20 @@ } }, "nixpkgs_2": { + "locked": { + "lastModified": 1602411953, + "narHash": "sha256-gbupmxRpoQZqL5NBQCJN2GI5G7XDEHHHYKhVwEj5+Ps=", + "owner": "LnL7", + "repo": "nixpkgs", + "rev": "f780534ea2d0c12e62607ff254b6b45f46653f7a", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_3": { "locked": { "lastModified": 1633463774, "narHash": "sha256-y3GjapcRzd42NgebQ4sx5GFJ53dYqNdF3UQu7/t6mUg=", @@ -767,7 +1186,7 @@ "type": "github" } }, - "nixpkgs_3": { + "nixpkgs_4": { "flake": false, "locked": { "lastModified": 1628785280, @@ -801,6 +1220,23 @@ "type": "github" } }, + "old-ghc-nix_2": { + "flake": false, + "locked": { + "lastModified": 1631092763, + "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", + "owner": "angerman", + "repo": "old-ghc-nix", + "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", + "type": "github" + }, + "original": { + "owner": "angerman", + "ref": "master", + "repo": "old-ghc-nix", + "type": "github" + } + }, "plutarch": { "inputs": { "Shrinker": "Shrinker", @@ -810,12 +1246,12 @@ "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", "cryptonite": "cryptonite", - "flake-compat": "flake-compat", - "flake-compat-ci": "flake-compat-ci", + "flake-compat": "flake-compat_2", + "flake-compat-ci": "flake-compat-ci_2", "flat": "flat", "foundation": "foundation", - "haskell-language-server": "haskell-language-server", - "haskell-nix": "haskell-nix", + "haskell-language-server": "haskell-language-server_2", + "haskell-nix": "haskell-nix_3", "hercules-ci-effects": "hercules-ci-effects", "hs-memory": "hs-memory", "nixpkgs": [ @@ -823,7 +1259,7 @@ "haskell-nix", "nixpkgs-unstable" ], - "plutus": "plutus", + "plutus": "plutus_2", "protolude": "protolude", "safe-coloured-text": "safe-coloured-text", "sized-functors": "sized-functors", @@ -850,14 +1286,41 @@ "cardano-repo-tool": "cardano-repo-tool", "gitignore-nix": "gitignore-nix", "hackage-nix": "hackage-nix", - "haskell-language-server": "haskell-language-server_2", + "haskell-language-server": "haskell-language-server", "haskell-nix": "haskell-nix_2", "iohk-nix": "iohk-nix", - "nixpkgs": "nixpkgs_3", - "pre-commit-hooks-nix": "pre-commit-hooks-nix_2", + "nixpkgs": "nixpkgs", + "pre-commit-hooks-nix": "pre-commit-hooks-nix", "sphinxcontrib-haddock": "sphinxcontrib-haddock", "stackage-nix": "stackage-nix" }, + "locked": { + "lastModified": 1639153959, + "narHash": "sha256-tz8wEV5oO2yu2WFl3+wAPHedJJUP/NMFYgfcsbcyji4=", + "owner": "input-output-hk", + "repo": "plutus", + "rev": "da4f85cdd2a3a261ce540e8dc51d2a3c5fa89ed2", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "plutus", + "type": "github" + } + }, + "plutus_2": { + "inputs": { + "cardano-repo-tool": "cardano-repo-tool_2", + "gitignore-nix": "gitignore-nix_2", + "hackage-nix": "hackage-nix_2", + "haskell-language-server": "haskell-language-server_3", + "haskell-nix": "haskell-nix_4", + "iohk-nix": "iohk-nix_2", + "nixpkgs": "nixpkgs_4", + "pre-commit-hooks-nix": "pre-commit-hooks-nix_3", + "sphinxcontrib-haddock": "sphinxcontrib-haddock_2", + "stackage-nix": "stackage-nix_2" + }, "locked": { "lastModified": 1642004499, "narHash": "sha256-LMAMixBJRYZ5wgINjp4rb8hifEGkXptX8Z5e2Ip8HeM=", @@ -874,6 +1337,22 @@ } }, "pre-commit-hooks-nix": { + "flake": false, + "locked": { + "lastModified": 1624971177, + "narHash": "sha256-Amf/nBj1E77RmbSSmV+hg6YOpR+rddCbbVgo5C7BS0I=", + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "rev": "397f0713d007250a2c7a745e555fa16c5dc8cadb", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "type": "github" + } + }, + "pre-commit-hooks-nix_2": { "flake": false, "locked": { "lastModified": 1622650193, @@ -889,7 +1368,7 @@ "type": "github" } }, - "pre-commit-hooks-nix_2": { + "pre-commit-hooks-nix_3": { "flake": false, "locked": { "lastModified": 1624971177, @@ -924,6 +1403,7 @@ }, "root": { "inputs": { + "apropos-tx": "apropos-tx", "haskell-nix": [ "plutarch", "haskell-nix" @@ -932,7 +1412,7 @@ "plutarch", "nixpkgs" ], - "nixpkgs-2111": "nixpkgs-2111", + "nixpkgs-2111": "nixpkgs-2111_2", "plutarch": "plutarch" } }, @@ -986,14 +1466,30 @@ "type": "github" } }, + "sphinxcontrib-haddock_2": { + "flake": false, + "locked": { + "lastModified": 1594136664, + "narHash": "sha256-O9YT3iCUBHP3CEF88VDLLCO2HSP3HqkNA2q2939RnVY=", + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "rev": "f3956b3256962b2d27d5a4e96edb7951acf5de34", + "type": "github" + }, + "original": { + "owner": "michaelpj", + "repo": "sphinxcontrib-haddock", + "type": "github" + } + }, "stackage": { "flake": false, "locked": { - "lastModified": 1642468901, - "narHash": "sha256-+Hu4m9i8v8Moey/C8fy8juyxB729JdsXz02cK8nJXLk=", + "lastModified": 1639185224, + "narHash": "sha256-ZBL0Lvqq8/Iwl8F5sT2N9J8+HTh0OY+09LkkUVtuUtY=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "7544f8fd16bb92b7cf90cb51cb4ddc43173526de", + "rev": "14819f5c85a92e5fb6e322cc809c803fa6419bd4", "type": "github" }, "original": { @@ -1018,6 +1514,38 @@ "type": "github" } }, + "stackage-nix_2": { + "flake": false, + "locked": { + "lastModified": 1597712578, + "narHash": "sha256-c/pcfZ6w5Yp//7oC0hErOGVVphBLc5vc4IZlWKZ/t6E=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "e32c8b06d56954865725514ce0d98d5d1867e43a", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, + "stackage_2": { + "flake": false, + "locked": { + "lastModified": 1642468901, + "narHash": "sha256-+Hu4m9i8v8Moey/C8fy8juyxB729JdsXz02cK8nJXLk=", + "owner": "input-output-hk", + "repo": "stackage.nix", + "rev": "7544f8fd16bb92b7cf90cb51cb4ddc43173526de", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "stackage.nix", + "type": "github" + } + }, "sydtest": { "flake": false, "locked": { diff --git a/flake.nix b/flake.nix index ca4ede1..cf967f3 100644 --- a/flake.nix +++ b/flake.nix @@ -4,6 +4,12 @@ inputs.nixpkgs.follows = "plutarch/nixpkgs"; inputs.haskell-nix.follows = "plutarch/haskell-nix"; + # https://github.com/mlabs-haskell/apropos-tx/pull/28 + inputs.apropos-tx.url = + "github:mlabs-haskell/apropos-tx?rev=5b74ba897a6f02718c163bf588a08c5e3e9de204"; + inputs.apropos-tx.inputs.nixpkgs.follows = + "plutarch/haskell-nix/nixpkgs-unstable"; + # temporary fix for nix versions that have the transitive follows bug # see https://github.com/NixOS/nix/issues/6013 inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; @@ -40,10 +46,16 @@ src = ./.; compiler-nix-name = ghcVersion; inherit (plutarch) cabalProjectLocal; - extraSources = plutarch.extraSources ++ [{ - src = inputs.plutarch; - subdirs = [ "." "plutarch-benchmark" ]; - }]; + extraSources = plutarch.extraSources ++ [ + { + src = inputs.plutarch; + subdirs = [ "." "plutarch-benchmark" ]; + } + { + src = inputs.apropos-tx; + subdirs = [ "." ]; + } + ]; modules = [ (plutarch.haskellModule system) ]; shell = { withHoogle = true; @@ -69,6 +81,7 @@ ps.plutarch ps.plutarch-benchmark ps.tasty-quickcheck + ps.apropos-tx ]; }; }; From 8b98324ceecc680f1c6f8031d3cee5f405a7008e Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 9 Mar 2022 22:00:02 +0100 Subject: [PATCH 2/7] WIP simple sample test for Stake policy --- agora-test/Spec.hs | 13 ++- agora-test/Spec/Sample/Stake.hs | 97 ++++++++++++++++ agora-test/Spec/Stake.hs | 39 +++++++ agora.cabal | 6 + agora/Agora/SafeMoney.hs | 5 + agora/Agora/Stake.hs | 28 ++++- flake.lock | 198 ++++++++++++-------------------- flake.nix | 1 - hie.yaml | 6 +- 9 files changed, 256 insertions(+), 137 deletions(-) create mode 100644 agora-test/Spec/Sample/Stake.hs create mode 100644 agora-test/Spec/Stake.hs diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 606e9ca..37def06 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -9,14 +9,21 @@ import Test.Tasty (defaultMain, testGroup) -------------------------------------------------------------------------------- import Spec.Int +import Spec.Stake qualified as Stake main :: IO () main = defaultMain $ testGroup - "apropos-tx" + "test suite" [ testGroup - "Int" - [ intPlutarchTests + "sample-tests" + Stake.tests + , testGroup + "apropos-tx" + [ testGroup + "Int" + [ intPlutarchTests + ] ] ] diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs new file mode 100644 index 0000000..9f86cbd --- /dev/null +++ b/agora-test/Spec/Sample/Stake.hs @@ -0,0 +1,97 @@ +{- | +Module : Spec.Sample.Stake +Maintainer : emi@haskell.fyi +Description: Sample based testing for Stake utxos + +This module tests primarily the happy path for Stake creation +-} +module Spec.Sample.Stake ( + stake, + policy, + policySymbol, + stakeCreation, + validatorHashTN, +) where + +-------------------------------------------------------------------------------- + +import Plutarch.Api.V1 ( + mintingPolicySymbol, + mkMintingPolicy, + mkValidator, + validatorHash, + ) +import Plutus.V1.Ledger.Ada (adaValueOf) +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (ScriptCredential), + CurrencySymbol, + Datum (Datum), + DatumHash (DatumHash), + MintingPolicy (..), + PubKeyHash, + ScriptContext (..), + ScriptPurpose (..), + ToData (toBuiltinData), + TxInfo (..), + TxOut (txOutAddress, txOutDatumHash, txOutValue), + ValidatorHash (ValidatorHash), + ) +import Plutus.V1.Ledger.Contexts (TxOut (TxOut)) +import Plutus.V1.Ledger.Interval qualified as Interval +import Plutus.V1.Ledger.Scripts (Validator) +import Plutus.V1.Ledger.Value (TokenName (TokenName)) +import Plutus.V1.Ledger.Value qualified as Value + +-------------------------------------------------------------------------------- + +import Agora.SafeMoney +import Agora.Stake + +-------------------------------------------------------------------------------- + +stake :: Stake LQ +stake = Stake + +policy :: MintingPolicy +policy = mkMintingPolicy (stakePolicy stake) + +policySymbol :: CurrencySymbol +policySymbol = mintingPolicySymbol policy + +signer :: PubKeyHash +signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" + +validator :: Validator +validator = mkValidator (stakeValidator stake) + +validatorHashTN :: TokenName +validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh + +stakeCreation :: ScriptContext +stakeCreation = + let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST + datum :: Datum + datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = [] + , txInfoOutputs = + [ TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + , txOutValue = st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242 + , txOutDatumHash = Just (DatumHash "") + } + ] + , txInfoFee = adaValueOf 2 + , txInfoMint = st + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer] + , txInfoData = [("", datum)] + , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + } + , scriptContextPurpose = Minting policySymbol + } diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs new file mode 100644 index 0000000..fc52396 --- /dev/null +++ b/agora-test/Spec/Stake.hs @@ -0,0 +1,39 @@ +module Spec.Stake (tests) where + +-------------------------------------------------------------------------------- + +import Prelude + +-------------------------------------------------------------------------------- + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertFailure, testCase) + +-------------------------------------------------------------------------------- + +import Plutarch (compile) +import Plutarch.Evaluate (evaluateScript) +import Plutus.V1.Ledger.Scripts (Script) + +-------------------------------------------------------------------------------- + +import Agora.Stake (stakePolicy) + +-------------------------------------------------------------------------------- + +import Plutarch.Builtin (pforgetData) +import Spec.Sample.Stake qualified as Stake + +-------------------------------------------------------------------------------- +tests :: [TestTree] +tests = + [ testGroup "policy" $ + [ scriptTest "minting" (compile $ stakePolicy Stake.stake # pforgetData (pconstantData ()) # pconstant Stake.stakeCreation) + ] + ] + +scriptTest :: String -> Script -> TestTree +scriptTest name script = testCase name $ do + case evaluateScript script of + Left e -> assertFailure (show e) + Right _v -> pure () diff --git a/agora.cabal b/agora.cabal index 440ac37..e915b25 100644 --- a/agora.cabal +++ b/agora.cabal @@ -111,6 +111,7 @@ common test-deps , quickcheck-instances , tasty , tasty-hedgehog + , tasty-hunit , apropos-tx library @@ -147,6 +148,11 @@ test-suite agora-test hs-source-dirs: agora-test other-modules: Spec.Int + Spec.Sample.Stake + Spec.Stake + + build-depends: + , agora benchmark agora-bench import: lang, deps diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs index f361e22..d40d99d 100644 --- a/agora/Agora/SafeMoney.hs +++ b/agora/Agora/SafeMoney.hs @@ -9,6 +9,7 @@ module Agora.SafeMoney ( -- * Types MoneyClass, PDiscrete, + Discrete, -- * Utility functions paddDiscrete, @@ -60,6 +61,10 @@ newtype PDiscrete (mc :: MoneyClass) (s :: S) = PDiscrete (Term s PInteger) deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype (PDiscrete mc) PInteger) +newtype Discrete (mc :: MoneyClass) + = Discrete Integer + deriving stock (Show) + -- | Add two `PDiscrete` values of the same `MoneyClass`. paddDiscrete :: Term s (PDiscrete mc :--> PDiscrete mc :--> PDiscrete mc) paddDiscrete = phoistAcyclic $ diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index cc87ae8..df8ffc4 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + {- | Module : Agora.Stake Maintainer : emi@haskell.fyi @@ -8,6 +10,7 @@ Vote-lockable stake UTXOs holding GT. module Agora.Stake ( PStakeDatum (..), PStakeAction (..), + StakeDatum (..), Stake (..), stakePolicy, stakeValidator, @@ -25,12 +28,18 @@ import Prelude -------------------------------------------------------------------------------- +import Plutus.V1.Ledger.Api (PubKeyHash) +import PlutusTx qualified + +-------------------------------------------------------------------------------- + import Plutarch (popaque) import Plutarch.Api.V1 ( PCredential (PPubKeyCredential, PScriptCredential), PMintingPolicy, PPubKeyHash, PScriptPurpose (PMinting, PSpending), + PTokenName, PValidator, mintingPolicySymbol, mkMintingPolicy, @@ -92,6 +101,15 @@ newtype PStakeDatum (gt :: MoneyClass) (s :: S) = PStakeDatum (PlutusType, PIsData, PDataFields) via (PIsDataReprInstances (PStakeDatum gt)) +-- | Haskell-level datum for Stake scripts. +data StakeDatum = StakeDatum + { stakedAmount :: Integer + , owner :: PubKeyHash + } + deriving stock (Show, GHC.Generic) + +PlutusTx.makeIsDataIndexed ''StakeDatum [('StakeDatum, 0)] + -------------------------------------------------------------------------------- {- What this Policy does @@ -162,12 +180,16 @@ stakePolicy _stake = PScriptCredential validatorHash' -> P.do validatorHash <- pletFields @'["_0"] validatorHash' stakeDatum <- pletFields @'["owner", "stakedAmount"] stakeDatum' + + -- TODO: figure out why this is required :/ (specifically, why `validatorHash._0` is `PData`) + tn <- plet (pfromData (punsafeCoerce validatorHash._0 :: Term _ (PAsData PTokenName))) + let stValue = psingletonValue # ownSymbol -- This coerce is safe because the structure -- of PValidatorHash is the same as PTokenName. - # punsafeCoerce validatorHash._0 + # tn # 1 let expectedValue = paddValue @@ -180,8 +202,8 @@ stakePolicy _stake = -- TODO: Needs to be >=, rather than == let valueCorrect = pdata value #== pdata expectedValue - ownerSignsTransaction #&& valueCorrect - + ptraceIfFalse "ownerSignsTransaction" ownerSignsTransaction + #&& ptraceIfFalse "valueCorrect" valueCorrect popaque (pconstant ()) pif (0 #< mintedST) minting burning diff --git a/flake.lock b/flake.lock index 879db67..dfcb32a 100644 --- a/flake.lock +++ b/flake.lock @@ -92,31 +92,14 @@ "type": "github" } }, - "autodocodec": { - "flake": false, - "locked": { - "lastModified": 1644358110, - "narHash": "sha256-X1TNZlmO2qDFk3OL4Z1v/gzvd3ouoACAiMweutsYek4=", - "owner": "srid", - "repo": "autodocodec", - "rev": "42b42a7407f33c6c74fa4e8c84906aebfed28daf", - "type": "github" - }, - "original": { - "owner": "srid", - "ref": "ghc921", - "repo": "autodocodec", - "type": "github" - } - }, "cabal-32": { "flake": false, "locked": { "lastModified": 1603716527, - "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", "owner": "haskell", "repo": "cabal", - "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", "type": "github" }, "original": { @@ -146,11 +129,11 @@ "cabal-34": { "flake": false, "locked": { - "lastModified": 1622475795, - "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", "owner": "haskell", "repo": "cabal", - "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", "type": "github" }, "original": { @@ -178,6 +161,23 @@ } }, "cabal-36": { + "flake": false, + "locked": { + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", + "owner": "haskell", + "repo": "cabal", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "3.6", + "repo": "cabal", + "type": "github" + } + }, + "cabal-36_2": { "flake": false, "locked": { "lastModified": 1640163203, @@ -422,11 +422,11 @@ }, "flake-utils": { "locked": { - "lastModified": 1623875721, - "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", "owner": "numtide", "repo": "flake-utils", - "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", "type": "github" }, "original": { @@ -553,11 +553,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1639357972, - "narHash": "sha256-NvVn00YOYZMqDUSiBbghJk/rm/nJItBEUJulWRGTgvk=", + "lastModified": 1646270198, + "narHash": "sha256-SakG546Zr9RuNPs5mhtT7CYPpvEDMGrWisWK/VpCvr0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "54adf6e47e20831d9c49a2b62e12f7f218fd7752", + "rev": "4cf90b36955597d0151940eabfb1b61a8ec42256", "type": "github" }, "original": { @@ -569,11 +569,11 @@ "hackage-nix": { "flake": false, "locked": { - "lastModified": 1637291070, - "narHash": "sha256-hTX2Xo36i9MR6PNwA/89C8daKjxmx5ZS5lwR2Cbp8Yo=", + "lastModified": 1644369434, + "narHash": "sha256-WqU6f1OhSM0UHXFW8Mhhvhz0tcij+NQVtmb6sW4RiFw=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6ea4ad5f4a5e2303cd64974329ba90ccc410a012", + "rev": "644a0d702abf84cdec62f4e620ff1034000e6146", "type": "github" }, "original": { @@ -617,16 +617,16 @@ "haskell-language-server": { "flake": false, "locked": { - "lastModified": 1638136578, - "narHash": "sha256-Reo9BQ12O+OX7tuRfaDPZPBpJW4jnxZetm63BxYncoM=", + "lastModified": 1643835246, + "narHash": "sha256-5LQHcQmi3mUGRgJu+X/m3jeM3kdkYjLD+KwgnxBlbeU=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "745ef26f406dbdd5e4a538585f8519af9f1ccb09", + "rev": "024ddc8b3904f8b8e8fe67ba6b9ebd8a4bd7ce76", "type": "github" }, "original": { "owner": "haskell", - "ref": "1.5.1", + "ref": "1.6.1.1", "repo": "haskell-language-server", "type": "github" } @@ -669,6 +669,7 @@ "HTTP": "HTTP", "cabal-32": "cabal-32", "cabal-34": "cabal-34", + "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-utils": "flake-utils", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", @@ -688,11 +689,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1639371915, - "narHash": "sha256-i5kW3hPptzXwzkpI2FAkfdDA/9QEDl/9mrwwoeBxDJg=", + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "e95a1f0dacbc64603c31d11e36e4ba1af8f0eb43", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", "type": "github" }, "original": { @@ -704,11 +705,11 @@ "haskell-nix_2": { "flake": false, "locked": { - "lastModified": 1629380841, - "narHash": "sha256-gWOWCfX7IgVSvMMYN6rBGK6EA0pk6pmYguXzMvGte+Q=", + "lastModified": 1646278384, + "narHash": "sha256-Gv1Ws3vAojjvjATcsvwAOTuOhzpxwt6tBci7EBaXxU4=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "7215f083b37741446aa325b20c8ba9f9f76015eb", + "rev": "7e06e14ae1b894445254fe41288bfa7dd4ccbc6f", "type": "github" }, "original": { @@ -722,7 +723,7 @@ "HTTP": "HTTP_2", "cabal-32": "cabal-32_2", "cabal-34": "cabal-34_2", - "cabal-36": "cabal-36", + "cabal-36": "cabal-36_2", "cardano-shell": "cardano-shell_2", "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk_2", @@ -730,8 +731,6 @@ "hpc-coveralls": "hpc-coveralls_2", "nix-tools": "nix-tools_2", "nixpkgs": [ - "plutarch", - "haskell-nix", "nixpkgs-2111" ], "nixpkgs-2003": "nixpkgs-2003_2", @@ -918,11 +917,11 @@ "nix-tools": { "flake": false, "locked": { - "lastModified": 1636018067, - "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", + "lastModified": 1644395812, + "narHash": "sha256-BVFk/BEsTLq5MMZvdy3ZYHKfaS3dHrsKh4+tb5t5b58=", "owner": "input-output-hk", "repo": "nix-tools", - "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "rev": "d847c63b99bbec78bf83be2a61dc9f09b8a9ccc1", "type": "github" }, "original": { @@ -982,11 +981,11 @@ "nixpkgs": { "flake": false, "locked": { - "lastModified": 1628785280, - "narHash": "sha256-2B5eMrEr6O8ff2aQNeVxTB+9WrGE80OB4+oM6T7fOcc=", + "lastModified": 1645493675, + "narHash": "sha256-9xundbZQbhFodsQRh6QMN1GeSXfo3y/5NL0CZcJULz0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "6525bbc06a39f26750ad8ee0d40000ddfdc24acb", + "rev": "74b10859829153d5c5d50f7c77b86763759e8654", "type": "github" }, "original": { @@ -1030,11 +1029,11 @@ }, "nixpkgs-2105": { "locked": { - "lastModified": 1639202042, - "narHash": "sha256-xEMgCsIcDUQ0kw9xvqU0wObns580kpdcr1ACz83+gHs=", + "lastModified": 1642244250, + "narHash": "sha256-vWpUEqQdVP4srj+/YLJRTN9vjpTs4je0cdWKXPbDItc=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "499ca2a9f6463ce119e40361f4329afa921a1d13", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", "type": "github" }, "original": { @@ -1062,11 +1061,11 @@ }, "nixpkgs-2111": { "locked": { - "lastModified": 1639213685, - "narHash": "sha256-Evuobw7o9uVjAZuwz06Al0fOWZ5JMKOktgXR0XgWBtg=", + "lastModified": 1644510859, + "narHash": "sha256-xjpVvL5ecbyi0vxtVl/Fh9bwGlMbw3S06zE5nUzFB8A=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "453bcb8380fd1777348245b3c44ce2a2b93b2e2d", + "rev": "0d1d5d7e3679fec9d07f2eb804d9f9fdb98378d3", "type": "github" }, "original": { @@ -1078,11 +1077,11 @@ }, "nixpkgs-2111_2": { "locked": { - "lastModified": 1644793108, - "narHash": "sha256-MN/ElRTuE7pWuf99Hr1pbAxA3ApDLYuK6hIsA5sagjc=", + "lastModified": 1646416052, + "narHash": "sha256-bfV62gYQGYjb/Gvw6MdMuEvWCcC838mI1Dzi1efjqTA=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "b61bf7a96aa6ddd3c425fa1db8c45acfdd82e36b", + "rev": "c78fc23f108b9a3bea9bf8693d2943ee0269c804", "type": "github" }, "original": { @@ -1126,11 +1125,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1639239143, - "narHash": "sha256-9fFMUs6m3/4ZMflSqRgO4iEkBtFBnDyLWa3AB2tOvfs=", + "lastModified": 1644486793, + "narHash": "sha256-EeijR4guVHgVv+JpOX3cQO+1XdrkJfGmiJ9XVsVU530=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e6df26a654b7fdd59a068c57001eab5736b1363c", + "rev": "1882c6b7368fd284ad01b0a5b5601ef136321292", "type": "github" }, "original": { @@ -1241,7 +1240,6 @@ "inputs": { "Shrinker": "Shrinker", "Win32-network": "Win32-network", - "autodocodec": "autodocodec", "cardano-base": "cardano-base", "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", @@ -1261,18 +1259,15 @@ ], "plutus": "plutus_2", "protolude": "protolude", - "safe-coloured-text": "safe-coloured-text", "sized-functors": "sized-functors", - "sydtest": "sydtest", - "th-extras": "th-extras", - "validity": "validity" + "th-extras": "th-extras" }, "locked": { - "lastModified": 1645200363, - "narHash": "sha256-k/ecf2uasWwBV+zq3daJVGY3xnsYkLe3zmT+k+iZ++A=", + "lastModified": 1646730784, + "narHash": "sha256-pVvSa4fBoKXCdCu/NGduoKhr1/gGESCmj/Tr9Y5l9B4=", "owner": "Plutonomicon", "repo": "plutarch", - "rev": "473424c89b4457e58e009e65d411ace1efc3ea9e", + "rev": "aecc2050eb63ff0041576473aa3193070fe91314", "type": "github" }, "original": { @@ -1295,11 +1290,11 @@ "stackage-nix": "stackage-nix" }, "locked": { - "lastModified": 1639153959, - "narHash": "sha256-tz8wEV5oO2yu2WFl3+wAPHedJJUP/NMFYgfcsbcyji4=", + "lastModified": 1646401716, + "narHash": "sha256-Xh4m6NVgxhtJZPW+/TH0KncginXLORO6EAN/ulitlrw=", "owner": "input-output-hk", "repo": "plutus", - "rev": "da4f85cdd2a3a261ce540e8dc51d2a3c5fa89ed2", + "rev": "73e4bbfc32ea233ba679d3f558a95adf8513a9d7", "type": "github" }, "original": { @@ -1416,23 +1411,6 @@ "plutarch": "plutarch" } }, - "safe-coloured-text": { - "flake": false, - "locked": { - "lastModified": 1644357337, - "narHash": "sha256-sXSKw8m6O9K/H2BBiYqO5e4sJIo+9UP+UvEukRn28d8=", - "owner": "srid", - "repo": "safe-coloured-text", - "rev": "034f3612525568b422e0c62b52417d77b7cf31c2", - "type": "github" - }, - "original": { - "owner": "srid", - "ref": "ghc921", - "repo": "safe-coloured-text", - "type": "github" - } - }, "sized-functors": { "flake": false, "locked": { @@ -1485,11 +1463,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1639185224, - "narHash": "sha256-ZBL0Lvqq8/Iwl8F5sT2N9J8+HTh0OY+09LkkUVtuUtY=", + "lastModified": 1646270328, + "narHash": "sha256-WFzBTbZW9zKnZtHLBLGui9F1tBDKX7ixBtaQOG5SK/M=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "14819f5c85a92e5fb6e322cc809c803fa6419bd4", + "rev": "b3171527569b52b3924d8e70e0aed753d3f55cc4", "type": "github" }, "original": { @@ -1546,23 +1524,6 @@ "type": "github" } }, - "sydtest": { - "flake": false, - "locked": { - "lastModified": 1644358460, - "narHash": "sha256-1ZxTLL5YVxktyHqfMywwsNGx5nxNMPXnq33QI6BcvUI=", - "owner": "srid", - "repo": "sydtest", - "rev": "5b572105c30f79c5e20637c6af4eedf39e0ac85a", - "type": "github" - }, - "original": { - "owner": "srid", - "ref": "ghc921", - "repo": "sydtest", - "type": "github" - } - }, "th-extras": { "flake": false, "locked": { @@ -1579,23 +1540,6 @@ "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", "type": "github" } - }, - "validity": { - "flake": false, - "locked": { - "lastModified": 1644358698, - "narHash": "sha256-dpMIu08qXMzy8Kilk/2VWpuwIsfqFtpg/3mkwt5pdjA=", - "owner": "srid", - "repo": "validity", - "rev": "f7982549b95d0ab727950dc876ca06b1862135ba", - "type": "github" - }, - "original": { - "owner": "srid", - "ref": "ghc921", - "repo": "validity", - "type": "github" - } } }, "root": "root", diff --git a/flake.nix b/flake.nix index cf967f3..992dcfd 100644 --- a/flake.nix +++ b/flake.nix @@ -80,7 +80,6 @@ additional = ps: [ ps.plutarch ps.plutarch-benchmark - ps.tasty-quickcheck ps.apropos-tx ]; }; diff --git a/hie.yaml b/hie.yaml index bea0b14..e1be10a 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1,8 +1,8 @@ cradle: cabal: - - path: "./src" + - path: "./agora-src" component: "lib:agora" - - path: "./bench" + - path: "./agora-bench" component: "benchmark:agora-bench" - - path: "./test" + - path: "./agora-test" component: "test:agora-test" From 7003c4556ef0fbd75cd9161c795f9ca7e37625f2 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Fri, 11 Mar 2022 18:05:30 +0100 Subject: [PATCH 3/7] bump plutarch to staging rev --- agora-bench/Main.hs | 30 +------ agora-test/Spec/Sample/Stake.hs | 3 +- agora-test/Spec/Stake.hs | 8 +- agora.cabal | 1 - agora/Agora/Stake.hs | 4 +- flake.lock | 140 ++++++++++++++++++++++++-------- flake.nix | 8 +- 7 files changed, 120 insertions(+), 74 deletions(-) diff --git a/agora-bench/Main.hs b/agora-bench/Main.hs index 150f528..62046f7 100644 --- a/agora-bench/Main.hs +++ b/agora-bench/Main.hs @@ -4,39 +4,11 @@ import Prelude -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Value qualified as Value - -------------------------------------------------------------------------------- -import Plutarch.Benchmark - -------------------------------------------------------------------------------- -import Agora.AuthorityToken ( - AuthorityToken (AuthorityToken), - authorityTokenPolicy, - ) -import Agora.SafeMoney (LQ) -import Agora.Stake ( - Stake (Stake), - stakePolicy, - stakeValidator, - ) - -------------------------------------------------------------------------------- main :: IO () -main = do - benchMain benchmarks - -benchmarks :: [NamedBenchmark] -benchmarks = - benchGroup - "full_scripts" - [ bench "authorityTokenPolicy" $ authorityTokenPolicy authorityToken - , bench "stakePolicy" $ stakePolicy (Stake @LQ) - , bench "stakeValidator" $ stakeValidator (Stake @LQ) - ] - -authorityToken :: AuthorityToken -authorityToken = AuthorityToken (Value.assetClass "" "") +main = pure () diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index 9f86cbd..55897c8 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -21,7 +21,6 @@ import Plutarch.Api.V1 ( mkValidator, validatorHash, ) -import Plutus.V1.Ledger.Ada (adaValueOf) import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -84,7 +83,7 @@ stakeCreation = , txOutDatumHash = Just (DatumHash "") } ] - , txInfoFee = adaValueOf 2 + , txInfoFee = Value.singleton "" "" 2 , txInfoMint = st , txInfoDCert = [] , txInfoWdrl = [] diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index fc52396..486252e 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -12,7 +12,7 @@ import Test.Tasty.HUnit (assertFailure, testCase) -------------------------------------------------------------------------------- import Plutarch (compile) -import Plutarch.Evaluate (evaluateScript) +import Plutarch.Evaluate (evalScript) import Plutus.V1.Ledger.Scripts (Script) -------------------------------------------------------------------------------- @@ -34,6 +34,8 @@ tests = scriptTest :: String -> Script -> TestTree scriptTest name script = testCase name $ do - case evaluateScript script of - Left e -> assertFailure (show e) + let (res, _budget, traces) = evalScript script + case res of + Left e -> do + assertFailure (show e <> " Traces: " <> show traces) Right _v -> pure () diff --git a/agora.cabal b/agora.cabal index f586351..7dad5f8 100644 --- a/agora.cabal +++ b/agora.cabal @@ -162,4 +162,3 @@ benchmark agora-bench type: exitcode-stdio-1.0 build-depends: , agora - , plutarch-benchmark diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index df8ffc4..44199a6 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -202,8 +202,8 @@ stakePolicy _stake = -- TODO: Needs to be >=, rather than == let valueCorrect = pdata value #== pdata expectedValue - ptraceIfFalse "ownerSignsTransaction" ownerSignsTransaction - #&& ptraceIfFalse "valueCorrect" valueCorrect + ownerSignsTransaction + #&& valueCorrect popaque (pconstant ()) pif (0 #< mintedST) minting burning diff --git a/flake.lock b/flake.lock index dfcb32a..713ed75 100644 --- a/flake.lock +++ b/flake.lock @@ -48,23 +48,6 @@ "type": "github" } }, - "Win32-network": { - "flake": false, - "locked": { - "lastModified": 1636063162, - "narHash": "sha256-uvYEWalN62ETpH45/O7lNHo4rAIaJtYpLWdIcAkq3dA=", - "owner": "input-output-hk", - "repo": "Win32-network", - "rev": "2d1a01c7cbb9f68a1aefe2934aad6c70644ebfea", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "Win32-network", - "rev": "2d1a01c7cbb9f68a1aefe2934aad6c70644ebfea", - "type": "github" - } - }, "apropos-tx": { "inputs": { "flake-compat": "flake-compat", @@ -92,6 +75,23 @@ "type": "github" } }, + "autodocodec": { + "flake": false, + "locked": { + "lastModified": 1644358110, + "narHash": "sha256-X1TNZlmO2qDFk3OL4Z1v/gzvd3ouoACAiMweutsYek4=", + "owner": "srid", + "repo": "autodocodec", + "rev": "42b42a7407f33c6c74fa4e8c84906aebfed28daf", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "autodocodec", + "type": "github" + } + }, "cabal-32": { "flake": false, "locked": { @@ -650,16 +650,16 @@ "haskell-language-server_3": { "flake": false, "locked": { - "lastModified": 1638136578, - "narHash": "sha256-Reo9BQ12O+OX7tuRfaDPZPBpJW4jnxZetm63BxYncoM=", + "lastModified": 1643835246, + "narHash": "sha256-5LQHcQmi3mUGRgJu+X/m3jeM3kdkYjLD+KwgnxBlbeU=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "745ef26f406dbdd5e4a538585f8519af9f1ccb09", + "rev": "024ddc8b3904f8b8e8fe67ba6b9ebd8a4bd7ce76", "type": "github" }, "original": { "owner": "haskell", - "ref": "1.5.1", + "ref": "1.6.1.1", "repo": "haskell-language-server", "type": "github" } @@ -881,6 +881,22 @@ } }, "iohk-nix_2": { + "flake": false, + "locked": { + "lastModified": 1646330344, + "narHash": "sha256-EbhMDeneH26wDi+x5kz8nfru/dE9JZ241hJed4a8lz8=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "0a0126d8fb1bdc61ce1fd2ef61cf396de800fdad", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "repo": "iohk-nix", + "type": "github" + } + }, + "iohk-nix_3": { "flake": false, "locked": { "lastModified": 1626953580, @@ -1077,11 +1093,11 @@ }, "nixpkgs-2111_2": { "locked": { - "lastModified": 1646416052, - "narHash": "sha256-bfV62gYQGYjb/Gvw6MdMuEvWCcC838mI1Dzi1efjqTA=", + "lastModified": 1646844010, + "narHash": "sha256-NRDLmpjmBMNBRr/BiztSsGht5wJYl8WZFzj+b+6LhLk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "c78fc23f108b9a3bea9bf8693d2943ee0269c804", + "rev": "d59edd3833597be12763f1f017c7ad666cf1b810", "type": "github" }, "original": { @@ -1239,7 +1255,7 @@ "plutarch": { "inputs": { "Shrinker": "Shrinker", - "Win32-network": "Win32-network", + "autodocodec": "autodocodec", "cardano-base": "cardano-base", "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", @@ -1252,6 +1268,7 @@ "haskell-nix": "haskell-nix_3", "hercules-ci-effects": "hercules-ci-effects", "hs-memory": "hs-memory", + "iohk-nix": "iohk-nix_2", "nixpkgs": [ "plutarch", "haskell-nix", @@ -1259,20 +1276,24 @@ ], "plutus": "plutus_2", "protolude": "protolude", + "safe-coloured-text": "safe-coloured-text", "sized-functors": "sized-functors", - "th-extras": "th-extras" + "sydtest": "sydtest", + "th-extras": "th-extras", + "validity": "validity" }, "locked": { - "lastModified": 1646730784, - "narHash": "sha256-pVvSa4fBoKXCdCu/NGduoKhr1/gGESCmj/Tr9Y5l9B4=", + "lastModified": 1646941827, + "narHash": "sha256-/TmkSDVOYD0Nsf6/tsyCSWhFUIeefwPn0Lz1oeZ7lyQ=", "owner": "Plutonomicon", "repo": "plutarch", - "rev": "aecc2050eb63ff0041576473aa3193070fe91314", + "rev": "cb29ca64df4ed193d94a062e3fe26aa37e59b7bc", "type": "github" }, "original": { "owner": "Plutonomicon", "repo": "plutarch", + "rev": "cb29ca64df4ed193d94a062e3fe26aa37e59b7bc", "type": "github" } }, @@ -1310,23 +1331,23 @@ "hackage-nix": "hackage-nix_2", "haskell-language-server": "haskell-language-server_3", "haskell-nix": "haskell-nix_4", - "iohk-nix": "iohk-nix_2", + "iohk-nix": "iohk-nix_3", "nixpkgs": "nixpkgs_4", "pre-commit-hooks-nix": "pre-commit-hooks-nix_3", "sphinxcontrib-haddock": "sphinxcontrib-haddock_2", "stackage-nix": "stackage-nix_2" }, "locked": { - "lastModified": 1642004499, - "narHash": "sha256-LMAMixBJRYZ5wgINjp4rb8hifEGkXptX8Z5e2Ip8HeM=", + "lastModified": 1645203653, + "narHash": "sha256-HAi60mSkyMXzu1Wg3h6KdYZg+ufNMvX6obfcLo0ArL0=", "owner": "L-as", "repo": "plutus", - "rev": "6cceda4793ee125dc700c63ff780593e387696b0", + "rev": "5ec17953aae3ac9546f6d923201eb1dbb4e058bb", "type": "github" }, "original": { "owner": "L-as", - "ref": "master", + "ref": "ghc9", "repo": "plutus", "type": "github" } @@ -1411,6 +1432,23 @@ "plutarch": "plutarch" } }, + "safe-coloured-text": { + "flake": false, + "locked": { + "lastModified": 1644357337, + "narHash": "sha256-sXSKw8m6O9K/H2BBiYqO5e4sJIo+9UP+UvEukRn28d8=", + "owner": "srid", + "repo": "safe-coloured-text", + "rev": "034f3612525568b422e0c62b52417d77b7cf31c2", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "safe-coloured-text", + "type": "github" + } + }, "sized-functors": { "flake": false, "locked": { @@ -1524,6 +1562,23 @@ "type": "github" } }, + "sydtest": { + "flake": false, + "locked": { + "lastModified": 1645114028, + "narHash": "sha256-P6ZwwfFeN8fpi3fziz9yERTn7BfxdE/j/OofUu+4GdA=", + "owner": "srid", + "repo": "sydtest", + "rev": "9c6c7678f7aabe22e075aab810a6a2e304591d24", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "sydtest", + "type": "github" + } + }, "th-extras": { "flake": false, "locked": { @@ -1540,6 +1595,23 @@ "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", "type": "github" } + }, + "validity": { + "flake": false, + "locked": { + "lastModified": 1644358698, + "narHash": "sha256-dpMIu08qXMzy8Kilk/2VWpuwIsfqFtpg/3mkwt5pdjA=", + "owner": "srid", + "repo": "validity", + "rev": "f7982549b95d0ab727950dc876ca06b1862135ba", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "ghc921", + "repo": "validity", + "type": "github" + } } }, "root": "root", diff --git a/flake.nix b/flake.nix index 992dcfd..1962f4f 100644 --- a/flake.nix +++ b/flake.nix @@ -14,7 +14,8 @@ # see https://github.com/NixOS/nix/issues/6013 inputs.nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; - inputs.plutarch.url = "github:Plutonomicon/plutarch"; + inputs.plutarch.url = + "github:Plutonomicon/plutarch?rev=cb29ca64df4ed193d94a062e3fe26aa37e59b7bc"; inputs.plutarch.inputs.nixpkgs.follows = "plutarch/haskell-nix/nixpkgs-unstable"; @@ -49,7 +50,7 @@ extraSources = plutarch.extraSources ++ [ { src = inputs.plutarch; - subdirs = [ "." "plutarch-benchmark" ]; + subdirs = [ "." "plutarch-test" "plutarch-extra" ]; } { src = inputs.apropos-tx; @@ -79,8 +80,9 @@ additional = ps: [ ps.plutarch - ps.plutarch-benchmark + ps.plutarch-test ps.apropos-tx + ps.plutarch-extra ]; }; }; From 461478b1b73e4178e436dd5efac3d046f162e62b Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Tue, 15 Mar 2022 12:12:32 +0100 Subject: [PATCH 4/7] flake: fix hlint version to prevent parse errors --- flake.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/flake.nix b/flake.nix index 1962f4f..5086051 100644 --- a/flake.nix +++ b/flake.nix @@ -70,7 +70,7 @@ pkgs'.haskellPackages.apply-refact pkgs'.fd pkgs'.cabal-install - pkgs'.hlint + pkgs'.haskell.packages."${ghcVersion}".hlint pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt pkgs'.graphviz From f9244aca38b265a97b8d5a90d664d6ec1fbff562 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Tue, 15 Mar 2022 12:12:52 +0100 Subject: [PATCH 5/7] add comments to Multisig module --- agora-test/Spec/Stake.hs | 3 ++- agora/Agora/MultiSig.hs | 39 +++++++++++++++++++++++---------------- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 486252e..75d63c1 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -27,7 +27,8 @@ import Spec.Sample.Stake qualified as Stake -------------------------------------------------------------------------------- tests :: [TestTree] tests = - [ testGroup "policy" $ + [ testGroup + "policy" [ scriptTest "minting" (compile $ stakePolicy Stake.stake # pforgetData (pconstantData ()) # pconstant Stake.stakeCreation) ] ] diff --git a/agora/Agora/MultiSig.hs b/agora/Agora/MultiSig.hs index e074bfe..2014c02 100644 --- a/agora/Agora/MultiSig.hs +++ b/agora/Agora/MultiSig.hs @@ -4,6 +4,8 @@ Module : Agora.MultiSig Maintainer : riley_kilgore@outlook.com Description: A basic N of M multisignature validation function. + +A basic N of M multisignature validation function. -} module Agora.MultiSig ( validatedByMultisig, @@ -13,7 +15,7 @@ module Agora.MultiSig ( import Plutarch.Api.V1 ( PPubKeyHash, - PScriptContext (..), + PTxInfo (..), ) import Plutarch.DataRepr ( DerivePConstantViaData (DerivePConstantViaData), @@ -51,6 +53,7 @@ data MultiSig = MultiSig PlutusTx.makeLift ''MultiSig PlutusTx.unstableMakeIsData ''MultiSig +-- | Plutarch-level MultiSig newtype PMultiSig (s :: S) = PMultiSig { getMultiSig :: Term @@ -73,20 +76,24 @@ deriving via (DerivePConstantViaData MultiSig PMultiSig) instance (PConstant Mul -------------------------------------------------------------------------------- -validatedByMultisig :: MultiSig -> Term s (PScriptContext :--> PBool) -validatedByMultisig params = pvalidatedByMultisig # pconstant params +-- | Check if a Haskell-level MultiSig signs this transaction +validatedByMultisig :: MultiSig -> Term s (PTxInfo :--> PBool) +validatedByMultisig params = + phoistAcyclic $ + pvalidatedByMultisig # pconstant params -pvalidatedByMultisig :: Term s (PMultiSig :--> PScriptContext :--> PBool) +-- | Check if a Plutarch-level MultiSig signs this transaction +pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool) pvalidatedByMultisig = - plam $ \multi' ctx' -> P.do - ctx <- pletFields @'["txInfo", "purpose"] ctx' - multi <- pletFields @'["keys", "minSigs"] multi' - let signatories = pfield @"signatories" # ctx.txInfo - (pfromData multi.minSigs) - #<= ( plength #$ pfilter - # plam - ( \a -> - pelem # a # pfromData signatories - ) - # multi.keys - ) + phoistAcyclic $ + plam $ \multi' txInfo -> P.do + multi <- pletFields @'["keys", "minSigs"] multi' + let signatories = pfield @"signatories" # txInfo + pfromData multi.minSigs + #<= ( plength #$ pfilter + # plam + ( \a -> + pelem # a # pfromData signatories + ) + # multi.keys + ) From 611e6fa2a6c6af9622dc9afeeade8589cfd0ba34 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Tue, 15 Mar 2022 17:25:44 +0100 Subject: [PATCH 6/7] move `scriptTest` to Util module --- agora-test/Spec/Stake.hs | 15 +++------------ agora-test/Spec/Util.hs | 25 +++++++++++++++++++++++++ agora.cabal | 2 ++ 3 files changed, 30 insertions(+), 12 deletions(-) create mode 100644 agora-test/Spec/Util.hs diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 75d63c1..c3ba408 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -7,13 +7,11 @@ import Prelude -------------------------------------------------------------------------------- import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (assertFailure, testCase) -------------------------------------------------------------------------------- import Plutarch (compile) -import Plutarch.Evaluate (evalScript) -import Plutus.V1.Ledger.Scripts (Script) +import Plutarch.Builtin (pforgetData) -------------------------------------------------------------------------------- @@ -21,10 +19,11 @@ import Agora.Stake (stakePolicy) -------------------------------------------------------------------------------- -import Plutarch.Builtin (pforgetData) import Spec.Sample.Stake qualified as Stake +import Spec.Util (scriptTest) -------------------------------------------------------------------------------- + tests :: [TestTree] tests = [ testGroup @@ -32,11 +31,3 @@ tests = [ scriptTest "minting" (compile $ stakePolicy Stake.stake # pforgetData (pconstantData ()) # pconstant Stake.stakeCreation) ] ] - -scriptTest :: String -> Script -> TestTree -scriptTest name script = testCase name $ do - let (res, _budget, traces) = evalScript script - case res of - Left e -> do - assertFailure (show e <> " Traces: " <> show traces) - Right _v -> pure () diff --git a/agora-test/Spec/Util.hs b/agora-test/Spec/Util.hs new file mode 100644 index 0000000..9171641 --- /dev/null +++ b/agora-test/Spec/Util.hs @@ -0,0 +1,25 @@ +module Spec.Util (scriptTest) where + +-------------------------------------------------------------------------------- + +import Prelude + +-------------------------------------------------------------------------------- + +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (assertFailure, testCase) + +-------------------------------------------------------------------------------- + +import Plutarch.Evaluate (evalScript) +import Plutus.V1.Ledger.Scripts (Script) + +-------------------------------------------------------------------------------- + +scriptTest :: String -> Script -> TestTree +scriptTest name script = testCase name $ do + let (res, _budget, traces) = evalScript script + case res of + Left e -> do + assertFailure (show e <> " Traces: " <> show traces) + Right _v -> pure () diff --git a/agora.cabal b/agora.cabal index 7dad5f8..8d17d47 100644 --- a/agora.cabal +++ b/agora.cabal @@ -152,6 +152,8 @@ test-suite agora-test Spec.Sample.Stake Spec.Stake + Spec.Util + build-depends: , agora From fd7ef68b042c2d63603e85aa47a1e3195073ce83 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 16 Mar 2022 13:55:00 +0100 Subject: [PATCH 7/7] add intentionally failing examples --- agora-test/Spec/Sample/Stake.hs | 28 +++++++++++++++++++++++- agora-test/Spec/Stake.hs | 19 ++++++++++++++--- agora-test/Spec/Util.hs | 38 ++++++++++++++++++++++++++++----- flake.nix | 1 + 4 files changed, 77 insertions(+), 9 deletions(-) diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index 55897c8..96a54ad 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -9,8 +9,12 @@ module Spec.Sample.Stake ( stake, policy, policySymbol, - stakeCreation, validatorHashTN, + + -- * Script contexts + stakeCreation, + stakeCreationWrongDatum, + stakeCreationUnsigned, ) where -------------------------------------------------------------------------------- @@ -67,6 +71,7 @@ validator = mkValidator (stakeValidator stake) validatorHashTN :: TokenName validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh +-- | This script context should be a valid transaction stakeCreation :: ScriptContext stakeCreation = let st = Value.singleton policySymbol validatorHashTN 1 -- Stake ST @@ -94,3 +99,24 @@ stakeCreation = } , scriptContextPurpose = Minting policySymbol } + +-- | This ScriptContext should fail because the datum has too much GT +stakeCreationWrongDatum :: ScriptContext +stakeCreationWrongDatum = + let datum :: Datum + datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer) -- Too much GT + in ScriptContext + { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]} + , scriptContextPurpose = Minting policySymbol + } + +-- | This ScriptContext should fail because the datum has too much GT +stakeCreationUnsigned :: ScriptContext +stakeCreationUnsigned = + ScriptContext + { scriptContextTxInfo = + stakeCreation.scriptContextTxInfo + { txInfoSignatories = [] + } + , scriptContextPurpose = Minting policySymbol + } diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index c3ba408..dd51749 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -10,7 +10,6 @@ import Test.Tasty (TestTree, testGroup) -------------------------------------------------------------------------------- -import Plutarch (compile) import Plutarch.Builtin (pforgetData) -------------------------------------------------------------------------------- @@ -20,7 +19,7 @@ import Agora.Stake (stakePolicy) -------------------------------------------------------------------------------- import Spec.Sample.Stake qualified as Stake -import Spec.Util (scriptTest) +import Spec.Util (policyFailsWith, policySucceedsWith) -------------------------------------------------------------------------------- @@ -28,6 +27,20 @@ tests :: [TestTree] tests = [ testGroup "policy" - [ scriptTest "minting" (compile $ stakePolicy Stake.stake # pforgetData (pconstantData ()) # pconstant Stake.stakeCreation) + [ policySucceedsWith + "stakeCreation" + (stakePolicy Stake.stake) + (pforgetData (pconstantData ())) + Stake.stakeCreation + , policyFailsWith + "stakeCreationWrongDatum" + (stakePolicy Stake.stake) + (pforgetData (pconstantData ())) + Stake.stakeCreationWrongDatum + , policyFailsWith + "stakeCreationUnsigned" + (stakePolicy Stake.stake) + (pforgetData (pconstantData ())) + Stake.stakeCreationUnsigned ] ] diff --git a/agora-test/Spec/Util.hs b/agora-test/Spec/Util.hs index 9171641..3db7f53 100644 --- a/agora-test/Spec/Util.hs +++ b/agora-test/Spec/Util.hs @@ -1,4 +1,9 @@ -module Spec.Util (scriptTest) where +module Spec.Util ( + scriptSucceeds, + scriptFails, + policySucceedsWith, + policyFailsWith, +) where -------------------------------------------------------------------------------- @@ -11,15 +16,38 @@ import Test.Tasty.HUnit (assertFailure, testCase) -------------------------------------------------------------------------------- +import Plutarch +import Plutarch.Api.V1 (PMintingPolicy) import Plutarch.Evaluate (evalScript) +import Plutarch.Prelude () import Plutus.V1.Ledger.Scripts (Script) -------------------------------------------------------------------------------- -scriptTest :: String -> Script -> TestTree -scriptTest name script = testCase name $ do +policySucceedsWith :: String -> ClosedTerm PMintingPolicy -> ClosedTerm PData -> _ -> TestTree +policySucceedsWith tag policy redeemer scriptContext = + scriptSucceeds tag $ compile (policy # redeemer # pconstant scriptContext) + +policyFailsWith :: String -> ClosedTerm PMintingPolicy -> ClosedTerm PData -> _ -> TestTree +policyFailsWith tag policy redeemer scriptContext = + scriptFails tag $ compile (policy # redeemer # pconstant scriptContext) + +scriptSucceeds :: String -> Script -> TestTree +scriptSucceeds name script = testCase name $ do let (res, _budget, traces) = evalScript script case res of Left e -> do - assertFailure (show e <> " Traces: " <> show traces) - Right _v -> pure () + assertFailure $ + show e <> " Traces: " <> show traces + Right _v -> + pure () + +scriptFails :: String -> Script -> TestTree +scriptFails name script = testCase name $ do + let (res, _budget, traces) = evalScript script + case res of + Left _e -> + pure () + Right v -> + assertFailure $ + "Expected failure, but succeeded. " <> show v <> " Traces: " <> show traces diff --git a/flake.nix b/flake.nix index 5086051..fdf0dd8 100644 --- a/flake.nix +++ b/flake.nix @@ -32,6 +32,7 @@ overlays = [ haskell-nix.overlay ]; inherit (haskell-nix) config; }; + nixpkgsFor' = system: import nixpkgs { inherit system;