Merge branch 'master' of https://github.com/input-output-hk/plutus in…

…to effectfully/builtins/polish-handling-of-integral-types
IntersectMBO · May 27, 2024 · a76d1ac · a76d1ac
2 parents d39992e + 85cf1ed
commit a76d1ac
Show file tree

Hide file tree

Showing 229 changed files with 4,722 additions and 1,039 deletions.
diff --git a/.github/workflows/add-triage-label.yml b/.github/workflows/add-triage-label.yml
@@ -1,9 +1,13 @@
+# Whenever a new issue is opened, this workflow adds the "status: needs triage" 
+# label, unless the issue already has one of the "Internal" labels.
+
 name: Add Triage Label
 on:
   issues:
     types:
       - reopened
       - opened
+
 jobs:
   add-triage-label:
     runs-on: ubuntu-latest
@@ -13,10 +17,41 @@ jobs:
       - name: Run
         uses: actions/github-script@v7
         with:
-          script: |
-            github.rest.issues.addLabels({
-              issue_number: context.issue.number,
-              owner: context.repo.owner,
-              repo: context.repo.repo,
-              labels: ["status: needs triage"]
-            })
+          script: | 
+            const INTERNAL_LABELS = ["Internal", "status: triaged"];
+
+            async function getIssueLabels() {
+              const { data: labels } = await github.rest.issues.listLabelsOnIssue({
+                owner: context.repo.owner,
+                repo: context.repo.repo,
+                issue_number: context.issue.number
+              });
+              return labels.map(label => label.name);
+            }
+
+            async function issueHasInternalLabels() {
+              const labels = await getIssueLabels();
+              return INTERNAL_LABELS.some(item => labels.includes(item));
+            }
+
+            async function addNeedsTriageLabelToIssue() {
+              await github.rest.issues.addLabels({
+                issue_number: context.issue.number,
+                owner: context.repo.owner,
+                repo: context.repo.repo,
+                labels: ["status: needs triage"]
+              });
+            }
+
+            try {
+              if (!await issueHasInternalLabels()) {
+                await addNeedsTriageLabelToIssue();
+              }
+            } catch (error) {
+              core.setFailed(`Error: ${error}`);
+            } 
+
+
+
+
+            
diff --git a/.github/workflows/longitudinal-benchmark.yml b/.github/workflows/longitudinal-benchmark.yml
@@ -41,7 +41,7 @@ jobs:
         run: git config core.hooksPath no-hooks
 
       - name: Store benchmark result
-        uses: benchmark-action/github-action-benchmark@v1.19.3
+        uses: benchmark-action/github-action-benchmark@v1.20.3
         with:
           name: Plutus Benchmarks
           tool: 'customSmallerIsBetter'

diff --git a/.github/workflows/nightly.yml b/.github/workflows/nightly.yml
@@ -3,32 +3,32 @@ name: Nightly Test Suite
 on:
   schedule:
     - cron: 0 0 * * * # daily at midnight
+
   workflow_dispatch: # or manually dispatch the job
+    inputs:
+      hedgehog-tests:
+        description: Numer of tests to run (--hedgehog-tests XXXXX)
+        required: false
+        default: "100000"
+
+env: 
+  HEDGEHOG_TESTS: ${{ github.event.inputs.hedgehog-tests || 100000 }}
 
 jobs:
   nightly-test-suite:
-    runs-on: ubuntu-latest
+    runs-on: [self-hosted, plutus-benchmark]
     steps:
       - name: Checkout
         uses: actions/checkout@v4
 
-      - name: Quick Install Nix
-        uses: cachix/install-nix-action@V27
-        with:
-          extra_nix_config: |
-            experimental-features = nix-command flakes
-            accept-flake-config = true
-
       - name: plutus-core-nightly
-        if: always()
-        run: |
+        run: | 
           pushd plutus-core
-          nix run --no-warn-dirty --accept-flake-config .#plutus-core-test -- --hedgehog-tests 10000
+          nix run --no-warn-dirty --accept-flake-config .#plutus-core-test -- --hedgehog-tests $HEDGEHOG_TESTS
           popd
 
       - name: plutus-ir-nightly
-        if: always()
         run: |
           pushd plutus-core
-          nix run --no-warn-dirty --accept-flake-config .#plutus-ir-test -- --hedgehog-tests 10000
+          nix run --no-warn-dirty --accept-flake-config .#plutus-ir-test -- --hedgehog-tests $HEDGEHOG_TESTS
           popd
diff --git a/RELEASE.adoc b/RELEASE.adoc
@@ -75,19 +75,11 @@ This updates versions and version bounds, and assembles the changelogs.open a PR
 - Choose as git tag `x.y.z.0`
 - Choose as target the git commit hash which points to the release commit
 - Click `Generate release notes` to automatically fill in the details of what's changed
-- Create and attach pir&uplc executables to the release by running the following commands inside the repository where its HEAD is at the release commit:
-- 
-+
-[source,bash]
--------------
-nix build .#hydraJobs.x86_64-linux.musl64.ghc96.pir 
-cp ./result/bin/pir ./pir-x86_64-linux-ghc96
-
-nix build .#hydraJobs.x86_64-linux.musl64.ghc96.uplc
-cp ./result/bin/uplc ./uplc-x86_64-linux-ghc96
--------------
+- Create and attach pir&uplc executables to the release by running the following script inside the repository where its HEAD is at the release commit: `./scripts/prepare-bins.sh`. This will create `pir-x86_64-linux-ghc96` and `uplc-x86_64-linux-ghc96` executables, compress them and put in the project's root folder. Upload them to the release draft.
 - Click `Publish release`.
-7. Open a PR in the https://github.com/IntersectMBO/cardano-haskell-packages[CHaP repository] for publishing the new version. Run `./scripts/add-from-github.sh "https://github.com/IntersectMBO/plutus" COMMIT-SHA LIST-OF-UPDATED-PACKAGES` (see https://github.com/IntersectMBO/cardano-haskell-packages#-from-github[the README on CHaP]). Example: https://github.com/IntersectMBO/cardano-haskell-packages/pull/394.
+7. Open a PR in the https://github.com/IntersectMBO/cardano-haskell-packages[CHaP repository] for publishing the new version. +
+If you are making PR from your own fork then don't forget to sync your fork with the upstream first. +
+Run `./scripts/add-from-github.sh "https://github.com/IntersectMBO/plutus" COMMIT-SHA LIST-OF-UPDATED-PACKAGES` (see https://github.com/IntersectMBO/cardano-haskell-packages#-from-github[the README on CHaP]). Example: https://github.com/IntersectMBO/cardano-haskell-packages/pull/764. 
 - If issues are found, create a release branch `release/x.y.z`, fix the issues on master, backport the fixes to `release/x.y.z`, tag `x.y.z.0-rc2`, and go to step 4.
 - Why not just fix the issues on master and tag `x.y.z.0-rc2` from master?
 It is desirable to minimize the amount of change between `rc1` and `rc2`, because it may reduce the tests and checks that need to be performed against `rc2`.

diff --git a/cabal.project b/cabal.project
@@ -26,6 +26,7 @@ packages: doc/read-the-docs-site
           plutus-metatheory
           plutus-tx
           plutus-tx-plugin
+          plutus-tx-test-util
           prettyprinter-configurable
           stubs/plutus-ghc-stub
 

diff --git a/doc/notes/plutus-core/cek-budgeting-profiling/CostingDetails.md b/doc/notes/plutus-core/cek-budgeting-profiling/CostingDetails.md
@@ -70,7 +70,7 @@ instance (Eq fun, Hashable fun, ToExMemory term) =>
             Restricting resb ->
                 when (exceedsBudget resb newBudget) $
                     throwingWithCause _EvaluationError
-                        (UserEvaluationError $ CekOutOfExError resb newBudget)
+                        (OperationalEvaluationError $ CekOutOfExError resb newBudget)
                         Nothing  -- No value available for error
 ```
 
@@ -96,7 +96,7 @@ to the current mode:
                 newBudget <- exBudgetStateBudget <%= (<> budget)
                 when (exceedsBudget resb newBudget) $
                     throwingWithCause _EvaluationError
-                        (UserEvaluationError $ CekOutOfExError resb newBudget)
+                        (OperationalEvaluationError $ CekOutOfExError resb newBudget)
                         Nothing
 ```
 
@@ -114,7 +114,7 @@ of memory very quickly.  Changing the code to
             Restricting resb -> 
                 when (exceedsBudget resb newBudget) $
                     throwingWithCause _EvaluationError
-                        (UserEvaluationError $ CekOutOfExError resb newBudget)
+                        (OperationalEvaluationError $ CekOutOfExError resb newBudget)
                         Nothing
 ```
 

diff --git a/doc/read-the-docs-site/plutus-doc.cabal b/doc/read-the-docs-site/plutus-doc.cabal
@@ -17,13 +17,6 @@ source-repository head
   type:     git
   location: https://github.com/IntersectMBO/plutus
 
-flag defer-plugin-errors
-  description:
-    Defer errors from the plugin, useful for things like Haddock that can't handle it.
-
-  default:     False
-  manual:      True
-
 common lang
   default-language:   Haskell2010
   default-extensions:
@@ -47,8 +40,6 @@ common lang
     -fobject-code -fno-ignore-interface-pragmas
     -fno-omit-interface-pragmas
 
-  if flag(defer-plugin-errors)
-
 common ghc-version-support
   -- See the section on GHC versions in CONTRIBUTING
   if (impl(ghc <9.6) || impl(ghc >=9.7))

diff --git a/nix/project.nix b/nix/project.nix
@@ -141,6 +141,14 @@ let
                 ssreflect
                 equations
               ];
+
+            plutus-core.components.tests.plutus-core-test.postInstall = ''
+              wrapProgram $out/bin/plutus-core-test --set PATH ${lib.makeBinPath [ pkgs.diffutils ]}
+            '';
+
+            plutus-core.components.tests.plutus-ir-test.postInstall = ''
+              wrapProgram $out/bin/plutus-ir-test --set PATH ${lib.makeBinPath [ pkgs.diffutils ]}
+            '';
           };
         }
 

diff --git a/plutus-benchmark/common/PlutusBenchmark/Common.hs b/plutus-benchmark/common/PlutusBenchmark/Common.hs
@@ -35,14 +35,13 @@ import PlutusBenchmark.ProtocolParameters as PP
 
 import PlutusLedgerApi.Common qualified as LedgerApi
 
-import PlutusTx qualified as Tx
-
 import PlutusCore qualified as PLC
 import PlutusCore.Default
 import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
 import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
 
+import PlutusTx.Test.Util.Compiled
 import UntypedPlutusCore qualified as UPLC
 import UntypedPlutusCore.Evaluation.Machine.Cek as Cek
 import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC
@@ -52,7 +51,6 @@ import Criterion.Main
 import Criterion.Types (Config (..))
 import Data.ByteString qualified as BS
 import Data.SatInt (fromSatInt)
-import Data.Text (Text)
 import Flat qualified
 import GHC.IO.Encoding (setLocaleEncoding)
 import System.Directory
@@ -78,58 +76,6 @@ getConfig limit = do
                 timeLimit = limit
               }
 
-type Term = UPLC.Term PLC.NamedDeBruijn DefaultUni DefaultFun ()
-type Program = UPLC.Program PLC.NamedDeBruijn DefaultUni DefaultFun ()
-
-{- | Given a DeBruijn-named term, give every variable the name "v".  If we later
-   call unDeBruijn, that will rename the variables to things like "v123", where
-   123 is the relevant de Bruijn index.-}
-toNamedDeBruijnTerm
-    :: UPLC.Term UPLC.DeBruijn DefaultUni DefaultFun ()
-    -> UPLC.Term UPLC.NamedDeBruijn DefaultUni DefaultFun ()
-toNamedDeBruijnTerm = UPLC.termMapNames UPLC.fakeNameDeBruijn
-
-{- | Remove the textual names from a NamedDeBruijn term -}
-toAnonDeBruijnTerm
-    :: Term
-    -> UPLC.Term UPLC.DeBruijn DefaultUni DefaultFun ()
-toAnonDeBruijnTerm = UPLC.termMapNames UPLC.unNameDeBruijn
-
-toAnonDeBruijnProg
-    :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
-    -> UPLC.Program UPLC.DeBruijn      DefaultUni DefaultFun ()
-toAnonDeBruijnProg (UPLC.Program () ver body) =
-    UPLC.Program () ver $ toAnonDeBruijnTerm body
-
-
-{- | Just extract the body of a program wrapped in a 'CompiledCodeIn'.  We use this a lot. -}
-compiledCodeToTerm
-    :: Tx.CompiledCodeIn DefaultUni DefaultFun a -> Term
-compiledCodeToTerm (Tx.getPlcNoAnn -> UPLC.Program _ _ body) = body
-
-{- | Lift a Haskell value to a PLC term.  The constraints get a bit out of control
-   if we try to do this over an arbitrary universe.-}
-haskellValueToTerm
-    :: Tx.Lift DefaultUni a => a -> Term
-haskellValueToTerm = compiledCodeToTerm . Tx.liftCodeDef
-
-{- | Just run a term to obtain an `EvaluationResult` (used for tests etc.) -}
-unsafeRunTermCek :: Term -> EvaluationResult Term
-unsafeRunTermCek =
-    unsafeExtractEvaluationResult
-        . (\(res, _, _) -> res)
-        . runCekDeBruijn PLC.defaultCekParameters Cek.restrictingEnormous Cek.noEmitter
-
--- | Just run a term.
-runTermCek ::
-    Term ->
-    ( Either (CekEvaluationException UPLC.NamedDeBruijn DefaultUni DefaultFun) Term
-    , [Text]
-    )
-runTermCek =
-    (\(res, _, logs) -> (res, logs))
-        . runCekDeBruijn PLC.defaultCekParameters Cek.restrictingEnormous Cek.logEmitter
-
 -- | Evaluate a script and return the CPU and memory costs (according to the cost model)
 getCostsCek :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun () -> (Integer, Integer)
 getCostsCek (UPLC.Program _ _ prog) =
@@ -138,21 +84,6 @@ getCostsCek (UPLC.Program _ _ prog) =
           let ExBudget (ExCPU cpu)(ExMemory mem) = budget
           in (fromSatInt cpu, fromSatInt mem)
 
-{- | Evaluate a PLC term and check that the result matches a given Haskell value
-   (perhaps obtained by running the Haskell code that the term was compiled
-   from).  We evaluate the lifted Haskell value as well, because lifting may
-   produce reducible terms. The function is polymorphic in the comparison
-   operator so that we can use it with both HUnit Assertions and QuickCheck
-   Properties.  -}
-cekResultMatchesHaskellValue
-    :: Tx.Lift DefaultUni a
-    => Term
-    -> (EvaluationResult Term -> EvaluationResult Term -> b)
-    -> a
-    -> b
-cekResultMatchesHaskellValue term matches value =
-    (unsafeRunTermCek term) `matches` (unsafeRunTermCek $ haskellValueToTerm value)
-
 -- | Create the evaluation context for the benchmarks. This doesn't exactly match how it's done
 -- on-chain, but that's okay because the evaluation context is cached by the ledger, so we're
 -- deliberately not including it in the benchmarks.

diff --git a/plutus-benchmark/lists/test/Lookup/Spec.hs b/plutus-benchmark/lists/test/Lookup/Spec.hs
@@ -1,20 +1,20 @@
 module Lookup.Spec (tests) where
 
 import Test.Tasty
-import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc)
+import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc)
 
 import PlutusBenchmark.Lists.Lookup.Compiled qualified as Compiled
 
 import PlutusTx.Test qualified as Tx
 
 -- Make a set of golden tests with results stored in a given subdirectory
 -- inside a subdirectory determined by the GHC version.
-testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree
-testGroupGhcIn dir = runTestGroupNestedGhc (["lists", "test"] ++ dir)
+runTestGhc :: [FilePath] -> [TestNested] -> TestTree
+runTestGhc path = runTestNested (["lists", "test"] ++ path) . pure . testNestedGhc
 
 tests :: TestTree
 tests =
-  testGroupGhcIn ["Lookup"] $
+  runTestGhc ["Lookup"] $
     flip concatMap sizes $ \sz ->
       [ Tx.goldenBudget ("match-scott-list-" ++ show sz) $
         Compiled.mkMatchWithListsCode (Compiled.workloadOfSize sz)

diff --git a/plutus-benchmark/lists/test/Sum/Spec.hs b/plutus-benchmark/lists/test/Sum/Spec.hs
@@ -2,7 +2,7 @@
 module Sum.Spec (tests) where
 
 import Test.Tasty
-import Test.Tasty.Extras (TestNested, runTestGroupNestedGhc)
+import Test.Tasty.Extras (TestNested, runTestNested, testNestedGhc)
 import Test.Tasty.QuickCheck
 
 import PlutusBenchmark.Common (Term, cekResultMatchesHaskellValue)
@@ -14,8 +14,8 @@ import PlutusTx.Test qualified as Tx
 
 -- Make a set of golden tests with results stored in a given subdirectory
 -- inside a subdirectory determined by the GHC version.
-testGroupGhcIn :: [FilePath] -> [TestNested] -> TestTree
-testGroupGhcIn dir = runTestGroupNestedGhc (["lists", "test"] ++ dir)
+runTestGhc :: [FilePath] -> [TestNested] -> TestTree
+runTestGhc path = runTestNested (["lists", "test"] ++ path) . pure . testNestedGhc
 
 -- | Check that the various summation functions all give the same result as 'sum'
 
@@ -37,7 +37,7 @@ tests =
       , testProperty "Compiled left fold (built-in lists)"     $ prop_sum Compiled.mkSumLeftBuiltinTerm
       , testProperty "Compiled left fold (data lists)"         $ prop_sum Compiled.mkSumLeftDataTerm
       ]
-    , testGroupGhcIn ["Sum"]
+    , runTestGhc ["Sum"]
       [ Tx.goldenBudget "right-fold-scott"    $ Compiled.mkSumRightScottCode input
       , Tx.goldenBudget "right-fold-built-in" $ Compiled.mkSumRightBuiltinCode input
       , Tx.goldenBudget "right-fold-data"     $ Compiled.mkSumRightDataCode input