From a13c4c03da4f27d6cd53afcca65e5b68810df246 Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis Date: Fri, 21 Jun 2024 16:22:20 +0200 Subject: [PATCH 1/3] Added cardano-constitution package --- cabal.project | 3 +- cardano-constitution/.gitignore | 8 + cardano-constitution/LICENSE | 53 + cardano-constitution/NOTICE | 13 + cardano-constitution/README.md | 195 + .../cardano-constitution.cabal | 125 + .../documentation-traceability.md | 438 ++ .../certification/testing-traceability.md | 396 ++ .../data/defaultConstitution.json | 860 +++ .../data/defaultConstitution.schema.json | 131 + .../src/Cardano/Constitution/Config.hs | 30 + .../Constitution/Config/Instance/FromJSON.hs | 143 + .../Constitution/Config/Instance/TxLift.hs | 22 + .../src/Cardano/Constitution/Config/Types.hs | 97 + .../src/Cardano/Constitution/DataFilePaths.hs | 12 + .../src/Cardano/Constitution/Validator.hs | 26 + .../Cardano/Constitution/Validator/Common.hs | 117 + .../Cardano/Constitution/Validator/Sorted.hs | 63 + .../Constitution/Validator/Unsorted.hs | 50 + .../src/PlutusTx/NonCanonicalRational.hs | 35 + .../test/Cardano/Constitution/Config/Tests.hs | 40 + .../Constitution/Validator/GoldenTests.hs | 93 + .../GoldenTests/sorted.cbor.size.golden | 1 + .../GoldenTests/sorted.large.budget.golden | 1 + .../Validator/GoldenTests/sorted.pir.golden | 5355 +++++++++++++++++ .../GoldenTests/sorted.small.budget.golden | 1 + .../Validator/GoldenTests/sorted.uplc.golden | 1346 +++++ .../GoldenTests/unsorted.cbor.size.golden | 1 + .../GoldenTests/unsorted.large.budget.golden | 1 + .../Validator/GoldenTests/unsorted.pir.golden | 5279 ++++++++++++++++ .../GoldenTests/unsorted.small.budget.golden | 1 + .../GoldenTests/unsorted.uplc.golden | 1340 +++++ .../Constitution/Validator/PropTests.hs | 70 + .../Constitution/Validator/TestsCommon.hs | 72 + .../Constitution/Validator/UnitTests.hs | 216 + cardano-constitution/test/Driver.hs | 86 + cardano-constitution/test/Helpers/CekTests.hs | 57 + cardano-constitution/test/Helpers/Farey.hs | 101 + .../test/Helpers/Guardrail.hs | 805 +++ .../test/Helpers/Intervals.hs | 220 + .../test/Helpers/MultiParam.hs | 321 + .../test/Helpers/Spec/FareySpec.hs | 61 + .../test/Helpers/Spec/IntervalSpec.hs | 103 + .../test/Helpers/TestBuilders.hs | 403 ++ .../PlutusLedgerApi/V3/ArbitraryContexts.hs | 292 + 45 files changed, 19082 insertions(+), 1 deletion(-) create mode 100644 cardano-constitution/.gitignore create mode 100644 cardano-constitution/LICENSE create mode 100644 cardano-constitution/NOTICE create mode 100644 cardano-constitution/README.md create mode 100644 cardano-constitution/cardano-constitution.cabal create mode 100644 cardano-constitution/certification/documentation-traceability.md create mode 100644 cardano-constitution/certification/testing-traceability.md create mode 100644 cardano-constitution/data/defaultConstitution.json create mode 100644 cardano-constitution/data/defaultConstitution.schema.json create mode 100644 cardano-constitution/src/Cardano/Constitution/Config.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Config/Instance/FromJSON.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Config/Instance/TxLift.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Config/Types.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/DataFilePaths.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Validator.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Validator/Common.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Validator/Sorted.hs create mode 100644 cardano-constitution/src/Cardano/Constitution/Validator/Unsorted.hs create mode 100644 cardano-constitution/src/PlutusTx/NonCanonicalRational.hs create mode 100644 cardano-constitution/test/Cardano/Constitution/Config/Tests.hs create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs create mode 100644 cardano-constitution/test/Cardano/Constitution/Validator/UnitTests.hs create mode 100644 cardano-constitution/test/Driver.hs create mode 100644 cardano-constitution/test/Helpers/CekTests.hs create mode 100644 cardano-constitution/test/Helpers/Farey.hs create mode 100644 cardano-constitution/test/Helpers/Guardrail.hs create mode 100644 cardano-constitution/test/Helpers/Intervals.hs create mode 100644 cardano-constitution/test/Helpers/MultiParam.hs create mode 100644 cardano-constitution/test/Helpers/Spec/FareySpec.hs create mode 100644 cardano-constitution/test/Helpers/Spec/IntervalSpec.hs create mode 100644 cardano-constitution/test/Helpers/TestBuilders.hs create mode 100644 cardano-constitution/test/PlutusLedgerApi/V3/ArbitraryContexts.hs diff --git a/cabal.project b/cabal.project index ae88256c72e..68eed939eaa 100644 --- a/cabal.project +++ b/cabal.project @@ -18,7 +18,8 @@ index-state: -- Bump this if you need newer packages from CHaP , cardano-haskell-packages 2024-06-19T21:42:15Z -packages: plutus-benchmark +packages: cardano-constitution + plutus-benchmark plutus-conformance plutus-core plutus-ledger-api diff --git a/cardano-constitution/.gitignore b/cardano-constitution/.gitignore new file mode 100644 index 00000000000..b8f0ed53095 --- /dev/null +++ b/cardano-constitution/.gitignore @@ -0,0 +1,8 @@ +/.vim/ +/proto/ +/certification/data/ +single-param.json +multi-param.json +output.json +*.ignore.* +*.tix diff --git a/cardano-constitution/LICENSE b/cardano-constitution/LICENSE new file mode 100644 index 00000000000..0c8a80022ea --- /dev/null +++ b/cardano-constitution/LICENSE @@ -0,0 +1,53 @@ +Apache License + +Version 2.0, January 2004 + +http://www.apache.org/licenses/ + +TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + +1. Definitions. + +"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. + +"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. + +"Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. + +"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. + +"Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. + +"Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. + +"Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). + +"Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. + +"Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." + +"Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. + +2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. + +3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. + +4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: + +You must give any other recipients of the Work or Derivative Works a copy of this License; and +You must cause any modified files to carry prominent notices stating that You changed the files; and +You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and +If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. + +You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. +5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. + +6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. + +7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. + +8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. + +9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. + +END OF TERMS AND CONDITIONS diff --git a/cardano-constitution/NOTICE b/cardano-constitution/NOTICE new file mode 100644 index 00000000000..7bfbc260968 --- /dev/null +++ b/cardano-constitution/NOTICE @@ -0,0 +1,13 @@ +Copyright 2023 Input Output Global, Inc. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/cardano-constitution/README.md b/cardano-constitution/README.md new file mode 100644 index 00000000000..49d1f847ca9 --- /dev/null +++ b/cardano-constitution/README.md @@ -0,0 +1,195 @@ +

Constitution Script

+ +The overall purpose of a "Constitution Script" is to define +in Plutus, that part of the *Cardano Constitution* which is possible to +be automated as a smart contract. + +Currently, in this repository, we are focusing on defining a constitution +script to check that a `ParameterChange` proposal or `TreasuryWithdrawals` proposal +is "constitutional". In the future, we may +enhance the script to automate more parts of the *Cardano Constitution*. + +The script is written in the high-level `PlutusTx` language, which +is subsequently compiled to `Untyped Plutus Core` and executed +on then chain upon every new Governance Proposal. + +Being a smart contract, the constitution script is a validator function of the form: + +``` haskell +const_script :: BuiltinData -> BuiltinUnit +``` + +The sole argument to this function is the `BuiltinData`-encoded `V3.ScriptContext`. +Note the absence of the 2 extra arguments, previously known as `Datum` argument and the `Redeemer` argument. +Since V3 and CIP-69, the `Datum` and `Redeemer` values are not passed anymore as separate function arguments, +but embedded inside the `V3.ScriptContext` argument. +The "proposal under investigation" is also embedded inside the `ScriptContext`. + +`Datum` is not provided for the "constitution script", since it is not a spending validator. +`Redeemer` will be provided to the "constitution script", but the current script +implementations ignore any value given to it (see Clause D). + +When the script is fully applied, one of the 2 cases can happen: + +1. The script executes successfully by returning `BuiltinUnit`, which means that the Proposal under investigation is +*constitutional* (the next step of the process would be to vote on this proposal, but this is out-of-scope of this repository). + +2. The script fails with an error. There can be many different reasons for a script error: + +- logical error in the constitution script (in config and/or engine, see next section) +- Proposal is malformed +- Proposal violates a constitution rule. +- bug in the CEK evaluator + +Irregardless of the specific error, the outcome is the same: the proposal would be *un-constitutional* (and no further steps will be taken for this proposal). + +## Constitution Rules (a.k.a. GuardRails) + +The constitution rules (a.k.a. guardrails) may change in the future, which may require that the constitution script +be also accordingly updated, and re-submitted on the chain so as to be "enacted". + +To minimise the chances of introducing bugs when the constititution script has to be updated, +we decided to separate the fixed "logic part" of the script from the +possibly evolving part, i.e. the "constitution rules". +For this reason, the constitution rules are separately given as a `PlutusTx` ADT +(with type `Config`), which when applied to the fixed-logic part (named `engine` for short) +yields the actual constitution script: + +``` haskell +data Config = ... -- see Config/Types.hs +const_engine :: Config -> V3.ScriptContext -> BuiltinUnit +const_engine = ...fixed logic... + +const_script :: V3.ScriptContext -> BuiltinUnit +const_script = const_engine my_config +``` + +In other words, the `Config` is "eliminated" statically at compile-time, by partially applying it to +the constitution engine. + +These constitution rules can be thought of as predicates (PlutusTx functions that return `Bool`) +over the proposed values. We currently have 3 such predicates: + +``` haskell +minValue jsonValue proposedValue = jsonValue Tx.=< proposedValue +maxValue jsonValue proposedValue = jsonValue Tx.>= proposedValue +notEqual jsonValue proposedValue = jsonValue Tx./= proposedValue +``` + +An alternative & preferred method than constructing a `Config` value, is to +edit a configuration file that contains the "constitution rules" laid out in JSON. +Its default location is at `data/defaultConstitution.json`, +with its expected JSON schema specified at `data/defaultConstitution.schema.json`. +After editing this JSON configuration file and re-compiling the cabal package, the JSON will be statically translated +to a `Config` PlutusTx-value and applied to the engine to yield a new script. +This is the preferred method because, first, it does not require any prior PlutusTx/Haskell knowledge +and second, there can be extra sanity checks applied: e.g. when parsing/translating the JSON to `Config` +or when using an external JSON schema validator. + + +## ChangedParameters Format + +In case of a `ParameterChange` governance action, the ledger will construct out of the proposed parameters, a `ChangedParameters` value, +encode it as `BuiltinData`, then pass it onto us (the Constitution script) inside the `V3.ScriptContext`. +The `ChangedParameters` value` is decoded as a `Tx.AssocMap`: + +```pseudocode +ChangedParameters => Tx.AssocMap ChangedParamId ChangedParamValue +ChangedParamId => I Integer +ChangedParamValue => I Integer + , or => (I Integer, Cons(I Integer, Nil)) -- a Rational numerator, denominator, a.k.a unit_interval + , or => List(ChangedParamValue) -- an arbitrary-length, heterogeneous list of (integer, unit_interval) values +``` + +`Integer` is the usual arbitrary-precision Integer of Haskell/PlutusTx. +There is no other type of a changed parameter (e.g. nested-list parameter), so the script implementations will fail on any other format. + +## Specification of script implementation + +There can be many different implementations of the logic (engine) made for the constitution script. +A particular script implementation behaves correctly (is valid), when it +complies with **all** the following clauses: + +### Clauses + +- S01. If `thisGovAction` is `TreasuryWithdrawals _ _`, then `PASS` and no checks left. +- S02. If `thisGovAction` is `(ParameterChange _ proposedParams _)` and the decoded `proposedParams` is an empty list (a.k.a. Tx.AssocMap), then `UNSPECIFIED`. +- S03. If `thisGovAction` is `(ParameterChange _ proposedParams _)` and decoded `proposedParams` is a non-empty list, +start checking each proposed parameter in the list against the `Config`. +- S04. The Redeemer `BuiltinData` value is `UNSPECIFIED`. +- S05. In all other cases of decoded `ScriptContext` return `FAIL`. +- S06. Lookup in the `Config` the rules associated to the current `proposedParam`'s id and test these rules against the `proposedParam`'s value. If one or more tests fail => `FAIL`. +Otherwise, set the next `proposedParam` in the list as the current one and continue to (F). +- S07. If no `proposedParam` to check is left in the `proposedParams` list, `PASS` and no more checks left. +- S08. If a `proposedParam`'s id is not found in the `Config` => `FAIL`. This can happen if the parameter is unknown, or is known but wrongfully omitten from the config file. +- S09. If the `Config` says `{type: any}` under a given `proposedParam` , then do not try to decode the value of the `proposedParam`, but simply `PASS` and continue to next check. +- S10. In all other cases of `{type: integer/unit_interval/list}`, decode the `proposedParam` value according to the expected type (see "ChangedParameters Format"). If +the encoding of the `proposedParam` value does not match the expected encoding of that type, `FAIL`. +- S11. In case of expected type `list`, if more or less than the expected length of the list elements are proposed, `FAIL`. + +### Legend + +- `thisGovAction` : `(fromBuiltinData(v3_context) -> scriptcontextScriptInfo -> (ProposingScript _ (ProposalProcedure _ _ thisGovAction)))` +- `PASS`: An implementation accepts the check, and continues with the rest of the checks. +If there are no checks left, the script returns `BuiltinUnit`, thus deeming this proposal constitutional. +- `FAIL`: An implementation must make the overall script fail with an error (explicitly by calling `Tx.error ()` or implicitly e.g. `1/0`), thus deeming the proposal un-constitutional. +- `UNSPECIFIED`: The behavior is explicitly left unspecified, meaning that +implementations may decide to `PASS` or `FAIL` or loop indefinitely --- note that in reality, looping indefinitely +behaves the same as `FAIL` since plutus scripts are "guarded" by certain resource limits. + +### Ledger guarantees + +Although not part of the specification, the +ledger provides us extra **guarantees**, which a valid implementation may optionally +rely upon (i.e. take it as an assumption): + +- G01. The underlying AssocMap does not contain duplicate-key entries. +- G02. The underlying AssocMap is sorted on the keys (the usual Ordering Integer). +- G03. The underlying AssocMap is not empty. +- G04. Unit_Interval's denominator is strictly positive. +- G05. Unit_Interval's numerator and denominator are co-prime. +- G06. Unit_Interval's value range is [0,1] (i.e. both sides inclusive). +- G07. Protocol parameter IDs are positive. +- G08. Redeemer is encoded as `()`. +FIXME: any governance proposal? + +## Current script implementations + +There are 2 engine implementations: + +- `Unsorted` +- `Sorted` + +`Unsorted` and `Sorted` must be valid implementations, so they must comply to all clauses [S01..]. + +`Unsorted` does not rely on any ledger guarantees. +`Sorted` as the name implies relies on sortedness to work and thus assumes the G01,G02 guarantees. +`Sorted` further requires that the `Config` is also sorted, which must be guaranteed **by-construction** when using the JSON `Config` format +(this is not currently guaranteed when manually constructing a `Config` ADT value). + +Note that, although all implementations could theoretically work without problem with negative `proposedParam` ids, +the `Config` JSON format (not the ADT) and the Ledger are limited only to positive ids (see G07). + +The `Sorted` implementation will most likely be the implementation to be used on the mainnet chain. + +## Testing the implementations + +The testing infrastructure generates artificial proposals and unit/random tests them +against the 2 valid implementations, unsorted and sorted. + +The artificial proposals are built such as to satisfy all specification clauses `[S01..]` (required for validity). + +Since this repository's testing infrastructure cannot be aware or test the ledger's behavior, +we have to make explicit the ledger guarantees that the test code needs to rely upon. +To keep things simple and uniform, we decided that the (random) testing infrastructure has to rely on +the union (Sum) of the ledger guarantees required by all our current implementations, i.e. G01,G02. + +## Repository layout + +- `src/Cardano/Constitution/Config/*` : types and instances for the `Config` ADT +- `src/Cardano/Constitution/Config.hs` : "predicate meanings" and umbrella module for the `Config` +- `src/Cardano/Constitution/Validator/Sorted.hs` : sorted engine +- `src/Cardano/Constitution/Validator/Unsorted.hs` : unsorted engine +- `src/Cardano/Constitution/Validator/Common.hs` : common code between the 2 engines +- `data/*` : contains the JSON configuration files +- `test/*`: testing code diff --git a/cardano-constitution/cardano-constitution.cabal b/cardano-constitution/cardano-constitution.cabal new file mode 100644 index 00000000000..f399e8e941f --- /dev/null +++ b/cardano-constitution/cardano-constitution.cabal @@ -0,0 +1,125 @@ +cabal-version: 3.0 +name: cardano-constitution +version: 1.30.0.0 +license: Apache-2.0 +license-files: + LICENSE + NOTICE + +maintainer: nikolaos.bezirgiannis@iohk.io +author: Plutus Core Team +synopsis: Cardano's Constitution +description: The Cardano's Constitution plutus script part +category: Language +build-type: Simple +extra-doc-files: README.md +extra-source-files: + data/defaultConstitution.json + data/defaultConstitution.schema.json + +source-repository head + type: git + location: https://github.com/IntersectMBO/plutus + +common lang + default-language: Haskell2010 + default-extensions: + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + ExplicitForAll + FlexibleContexts + GeneralizedNewtypeDeriving + ImportQualifiedPost + MultiParamTypeClasses + ScopedTypeVariables + StandaloneDeriving + + -- See Plutus Tx readme for why we need the following flags: + -- -fobject-code -fno-ignore-interface-pragmas and -fno-omit-interface-pragmas + ghc-options: + -Wall -Wnoncanonical-monad-instances -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints -Widentities + -Wunused-packages -Wmissing-deriving-strategies -fobject-code + -fno-ignore-interface-pragmas -fno-omit-interface-pragmas + -fno-strictness + +common ghc-version-support + -- See the section on GHC versions in CONTRIBUTING + if (impl(ghc <9.6) || impl(ghc >=9.7)) + buildable: False + +library + import: lang, ghc-version-support + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: + Cardano.Constitution.Config + Cardano.Constitution.Config.Instance.FromJSON + Cardano.Constitution.Config.Instance.TxLift + Cardano.Constitution.Config.Types + Cardano.Constitution.DataFilePaths + Cardano.Constitution.Validator + Cardano.Constitution.Validator.Common + Cardano.Constitution.Validator.Sorted + Cardano.Constitution.Validator.Unsorted + PlutusTx.NonCanonicalRational + + build-depends: + , aeson + , base >=4.9 && <5 + , containers + , filepath + , plutus-core ^>=1.30 + , plutus-ledger-api ^>=1.30 + , plutus-tx ^>=1.30 + , plutus-tx-plugin ^>=1.30 + , regex-tdfa + , safe + , template-haskell + +test-suite cardano-constitution-test + import: lang, ghc-version-support + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + Cardano.Constitution.Config.Tests + Cardano.Constitution.Validator.GoldenTests + Cardano.Constitution.Validator.PropTests + Cardano.Constitution.Validator.TestsCommon + Cardano.Constitution.Validator.UnitTests + Helpers.CekTests + Helpers.Farey + Helpers.Guardrail + Helpers.Intervals + Helpers.MultiParam + Helpers.Spec.FareySpec + Helpers.Spec.IntervalSpec + Helpers.TestBuilders + PlutusLedgerApi.V3.ArbitraryContexts + + build-depends: + , aeson + , base >=4.9 && <5 + , bytestring + , cardano-constitution ^>=1.30 + , containers + , directory + , filepath + , plutus-core:{plutus-core, plutus-core-testlib} ^>=1.30 + , plutus-ledger-api ^>=1.30 + , plutus-tx ^>=1.30 + , QuickCheck + , serialise + , tasty + , tasty-expected-failure + , tasty-golden + , tasty-hunit + , tasty-json + , tasty-quickcheck diff --git a/cardano-constitution/certification/documentation-traceability.md b/cardano-constitution/certification/documentation-traceability.md new file mode 100644 index 00000000000..aebba6a9b04 --- /dev/null +++ b/cardano-constitution/certification/documentation-traceability.md @@ -0,0 +1,438 @@ +# Documentation Traceability Report + +## Version + +Version 1.1 + +## Authors + +Romain Soulat + +## Table of Contents + +- [Revision History](#revision-history) +- [References](#references) +- [Introduction](#introduction) +- [Parameter traceability](#parameter-traceability) +- [Documentation traceability](#documentation-traceability) + +## Revision History + +| Version | Date | Author | Changes | +| --- | --- | --- | --- | +| 1.0 | 2024-05-13 | Romain Soulat | Initial version | +| 1.1 | 2024-05-14 | Romain Soulat | Updated with new version of defaultConstitution.json | + +## References + +- Interim Constitution + - SHA 256: `7b4e7c896a8b48b1f1109c92934f1858ae7941183e223a35bf4e9a8e` + - URL: + +- CDDL description of the protocol parameters + - SHA 256: `5c712c432227acff7e4c26576343fcfe966a66dd0a09db1e61821b55283da47f` + - URL: + +- JSON used to generate the constitution script + - SHA 256: `9dfa556ee6321ed389444f186ce9d26c637359749be11d516c944711c8ef5af7` + - URL: + +## Introduction + +This document provides a traceability between the Interim Constitution, the cddl description of the protocol parameters and the JSON/TSV used to generate the constitution script. + +## Parameter traceability + +The Interim Constitution is a human readable document that describes the protocol parameters. The CDDL description of the protocol parameters is a machine readable document that describes the protocol parameters. + +| Interim Constitution Parameter Name | CDDL Parameter number | CDDL Parameter name (in comments) | +|---|---|---| +| txFeePerByte | 0 | min fee a | +| txFeeFixed | 1 | min fee b | +| maxBlockBodySize | 2 | max block body size | +| maxTxSize | 3 | max transaction size | +| maxBlockHeaderSize | 4 | max block header size | +| stakeAddressDeposit | 5 | key deposit | +| stakePoolDeposit | 6 | pool deposit | +| poolRetireMaxEpoch | 7 | maximum epoch | +| stakePoolTargetNum | 8 | n_opt: desired number of stake pool | +| poolPledgeInfluence | 9 | pool pledge influence | +| monetaryExpansion | 10 | expansion rate | +| treasuryCut | 11 | treasury growth rate | +| BLANK NO PARAMETER | 12 | BLANK NO PARAMETER | +| BLANK NO PARAMETER | 13 | BLANK NO PARAMETER | +| BLANK NO PARAMETER | 14 | BLANK NO PARAMETER | +| BLANK NO PARAMETER | 15 | BLANK NO PARAMETER | +| minPoolCost | 16 | min pool cost | +| utxoCostPerByte | 17 | ada per utxo byte | +| costModels | 18 | cost models for script language | +| executionUnitPrices | 19 | execution costs | +| executionUnitPrices[priceMemory] | 19.0 | execution costs mem| +| executionUnitPrices[priceSteps] | 19.1 | execution costs steps| +| maxTxExecutionUnits | 20 | max tx ex units | +| maxTxExecutionUnits[mem] | 20.0 | | +| maxTxExecutionUnits[steps] | 20.1 | | +| maxBlockExecutionUnits | 21 | max block ex units | +| maxBlockExecutionUnits[mem] | 21.0 | | +| maxBlockExecutionUnits[steps] | 21.1 | | +| maxValueSize | 22 | max value size | +| collateralPercentage | 23 | collateral percentage | +| maxCollateralInputs | 24 | max collateral inputs | +| poolVotingThresholds | 25 | pool voting thresholds | +| poolVotingThresholds[pvtMotionNoConfidence] | 25.0 | motion no confidence | +| poolVotingThresholds[pvtCommitteeNormal] | 25.1 | committee normal | +| poolVotingThresholds[pvtCommitteeNoConfidence] | 25.2 | committee no conficence | +| poolVotingThresholds[pvtHardForkInitiation] | 25.3 | hard fork initiation | +| poolVotingThresholds[pvtPPSecurityGroup] | 25.4 | security relevant parameter voting threshold| +| dRepVotingThresholds | 26 | DRep voting threshold | +| dRepVotingThresholds[dvtMotionNoConfidence] | 26.0 | motion no confidence | +| dRepVotingThresholds[dvtCommitteeNormal] | 26.1 | committee normal | +| dRepVotingThresholds[dvtCommitteeNoConfidence] | 26.2 | committee no confidence | +| dRepVotingThresholds[dvtUpdateToConstitution] | 26.3 | update constitution | +| dRepVotingThresholds[dvtHardForkInitiation] | 26.4 | hard fork initiation | +| dRepVotingThresholds[dvtPPNetworkGroup] | 26.5 | PP network group | +| dRepVotingThresholds[dvtPPEconomicGroup] | 26.6 | PP economic group | +| dRepVotingThresholds[dvtPPTechnicalGroup] | 26.7 | PP technical group | +| dRepVotingThresholds[dvtPPGovGroup] | 26.8 | PP governance group | +| dRepVotingThresholds[dvtTreasuryWithdrawal] | 26.9 | treasury withdrawal | +| committeeMinSize | 27 | min committee size | +| committeeMaxTermLimit | 28 | committee term limit | +| govActionLifetime | 29 | governance action validity lifetime | +| govDeposit | 30 | governance action deposit | +| dRepDeposit | 31 | DRep deposit | +| dRepActivity | 32 | DRep inactivity period | +| minFeeRefScriptCoinsPerByte | 33 | MinFee RefScriptCostPerByte | + +## Documentation Traceability + +We refer to `defaultConstitution.json` as "the JSON file" in the rest of this document. + +Note: Some `$comment`in the JSON file do not match the Interim Constitution. They are ignored by the script and present no incidence on the constitution script. + +They will be fixed in a subsequent version. + +### Section 2 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| PARAM-01 | No parameter falls under this requirement | :white_check_mark: | +| PARAM-02 | `"18": { "type": "any"}` | :white_check_mark: | + +### Section 2.1 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| PARAM-03 | Enforced by [VT-GEN-01] | :white_check_mark: | +| PARAM-05 | Enforced by [VT-GEN-01] | :white_check_mark: | + +### Section 2.2 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| TFPB-01 | In "0": `"minValue": 30`| :white_check_mark: | +| TFPB-02 | In "0": `"maxValue": 1000`| :white_check_mark: | +| TFPB-03 | In "0": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "0" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| TFF-01 | In "1": `"minValue": 100000` | :white_check_mark: | +| TFF-02 | In "1": `"maxValue": 10000000` | :white_check_mark: | +| TFF-03 | In "1": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "1" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| UCPB-01 | In "17": `"minValue": 3000` | :white_check_mark: | +| UCPB-02 | In "17": `"maxValue": 6500`| :white_check_mark: | +| UCPB-03 | In "17": `"notEqual": 0` | :white_check_mark: | +| UCPB-04 | In "17": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "17" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| SAD-01 | In "5": `"minValue": 1000000`| :white_check_mark: | +| SAD-02 | In "5": `"maxValue": 5000000` | :white_check_mark: | +| SAD-03 | In "5": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "5" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| SPD-01 | In "6": `"minValue": 250000000` | :white_check_mark: | +| SPD-02 | In "6": `"maxValue": 500000000` | :white_check_mark: | +| SPD-03 | In "6": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "6" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MPC-01 | In "16": `minValue": 0`| :white_check_mark: | +| MPC-02 | In "16": `"maxValue": 500000000` | :white_check_mark: | + +No additional entries in object "16" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| TC-01 | In "11": `"minValue": { "numerator": 10, "denominator": 100 }` | :white_check_mark: | +| TC-02 | In "11": `"maxValue": { "numerator": 30, "denominator": 100 }` | :white_check_mark: | +| TC-03 | In "11": `"minValue": { "numerator": 0, "denominator": 100 }` | :white_check_mark: | +| TC-04 | In "11": `"maxValue": { "numerator": 100, "denominator": 100 }`| :white_check_mark: | + +No additional entries in object "11" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| ME-01 | In "10": `"maxValue": { "numerator": 5, "denominator": 1000 }` | :white_check_mark: | +| ME-02 | In "10": `"minValue": { "numerator": 1, "denominator": 1000 }`| :white_check_mark: | +| ME-03 | In "10": `"minValue": { "numerator": 0, "denominator": 1000 }`| :white_check_mark: | + +No additional entries in object "10" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| EIUP-PS-01 | In "19[1]": `"maxValue": { "numerator": 2000, "denominator": 10000000 }` | :white_check_mark: | +| EIUP-PS-02 |  In "19[1]": `"minValue": { "numerator": 500, "denominator": 10000000 }` | :white_check_mark: | + +No additional entries in object "19[1]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| EIUP-PM-01 | In "19[0]": `"maxValue": { "numerator": 2000, "denominator": 10000 }`| :white_check_mark: | +| EIUP-PM-02 | In "19[0]": `"minValue": { "numerator": 400, "denominator": 10000 }` | :white_check_mark: | + +No additional entries in object "19[0]" in the JSON file. :white_check_mark + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MFRS-01 | In "33": `"maxValue": 1000` | :white_check_mark: | +| MFRS-02 | In "33": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "33" in the JSON file. :white_check_mark: + +### Section 2.3 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MBBS-01 | In "2": `"maxValue": 122880` | :white_check_mark: | +| MBBS-02 | In "2": `minValue: 24576` | :white_check_mark: | + +No additional entries in object "2" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MTS-01 | In "3": `"maxValue": 32768` | :white_check_mark: | +| MTS-02 | In "3": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "3" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MTEU-M-01 | In "20[0]": `"maxValue": 40000000` | :white_check_mark: | +| MTEU-M-02| In "20[0]": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "20[0]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MBEU-M-01 | In "21[0]": `"maxValue": 120000000` | :white_check_mark: | +| MBEU-M-02 | In "21[0]": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "21[0]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MTEU-S-01 | In "20[1]": `"maxValue": 15000000000` | | +| MTEU-S-02 | In "20[1]": `"minValue": 0` | | + +No additional entries in object "20[1]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MBEU-S-01 | In "21[1]": `"maxValue": 40000000000` | | +| MBEU-S-02 | In "21[1]": `"minValue": 0` | | + +No additional entries in object "21[1]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MBHS-01 | In "4": `"maxValue": 5000` | :white_check_mark: | +| MBHS-02 | In "4": `"minValue": 0` | :white_check_mark: | + + +No additional entries in object "4" in the JSON file. :white_check_mark: + +### Section 2.4 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| SPTN-01 | In "8": `"minValue": 250` | :white_check_mark: | +| SPTN-02 | In "8": `"maxValue": 2000` | :white_check_mark: | +| SPTN-03 | In "8": `"minValue": 0` | :white_check_mark: | +| SPTN-04 | In "8": `"notEqual": 0` | :white_check_mark: | + +No additional entries in object "8" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| PPI-01 | In "9": `"minValue": { "numerator": 1, "denominator": 10 }` | :white_check_mark: | +| PPI-02 | In "9": `"maxValue": { "numerator": 10, "denominator": 10 }` | :white_check_mark: | +| PPI-03 | In "9": `"minValue": { "numerator": 0, "denominator": 10 }` | :white_check_mark: | + +No additional entries in object "9" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| PRME-01 | In "7": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "7" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| CP-01 | In "23": `"minValue": 100` | :white_check_mark: | +| CP-02 | In "23": `"maxValue": 200` | :white_check_mark: | +| CP-03 | In "23": `"minValue": 0` | :white_check_mark: | +| CP-04 | In "23": `"notEqual": 0` | :white_check_mark: | + +No additional entries in object "23" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MCI-01 | In "24": `"minValue": 1` | :white_check_mark: | + +No additional entries in object "24" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| MVS-01 | In "22": `"maxValue": 12288` | :white_check_mark: | +| MVS-02 | In "22": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "22" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| Plutus Cost Models | In "18": `"type": "any"` | :white_check_mark: | + +No checkable guardrails for Plutus Cost Models. PARAM-02 applies. :white_check_mark: + +No additional entries in object "18" in the JSON file. :white_check_mark: + +### Section 2.5 + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| GD-01 | In "30": `"minValue": 0` | :white_check_mark: | +| GD-02 | In "30": `"minValue": 1000000` | :white_check_mark: | +| GD-03 | In "30": `"maxValue": 10000000000000` | :white_check_mark: | + +No additional entries in object "30" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| DRD-01 | In "31": `"minValue": 0` | :white_check_mark: | +| DRD-02 | In "31": `"minValue": 1000000` | :white_check_mark: | +| DRD-03 | In "31": `"maxValue": 100000000000` | :white_check_mark: | + +No additional entries in object "31" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| DRA-01 | In "32": `"minValue": 13` | :white_check_mark: | +| DRA-02 | In "32": `"maxValue": 37` | :white_check_mark: | +| DRA-03 | In "32": `"minValue": 0` | :white_check_mark: | + +No additional entries in object "32" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| VT-GEN-01 | In "25[0]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "25[1]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "25[2]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "25[3]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "25[4]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[0]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[1]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[2]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[3]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[4]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[5]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[6]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[7]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[8]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
In "26[9]": `"minValue": { "numerator": 50, "denominator": 100 }`, `"maxValue": { "numerator": 100, "denominator": 100 }`
| :white_check_mark: | +| VT-GEN-02 | In "26[5]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 75, "denominator": 100 }`
In "26[6]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 75, "denominator": 100 }`
In "26[7]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 75, "denominator": 100 }`
| :white_check_mark: | +| VT-GEN-03 | In "26[8]": `minValue": { "numerator": 75, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }` | :white_check_mark: | +| VT-HF-01 | In "25[3]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 80, "denominator": 100 }`
In "26[4]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 80, "denominator": 100 }`
| :white_check_mark: | +| VT-CON-01 | In "26[3]": `"minValue": { "numerator": 65, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }` | :white_check_mark: | +| VT-CC-01 | In "25[1]": `"minValue": { "numerator": 65, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }`
In "25[2]": `"minValue": { "numerator": 65, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }`
In "26[1]": `"minValue": { "numerator": 65, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }`
In "26[2]": `"minValue": { "numerator": 65, "denominator": 100 }`, `"maxValue": { "numerator": 90, "denominator": 100 }`| :white_check_mark: | +| VT-NC-01 | In "25[0]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 75, "denominator": 100 }`
In "26[0]": `"minValue": { "numerator": 51, "denominator": 100 }`, `"maxValue": { "numerator": 75, "denominator": 100 }`| :white_check_mark: | + +:question: This is the traceability inferred: + +- 25[0]: VT-GEN-01, VT-NC-01 +- 25[1]: VT-GEN-01, VT-CC-01 +- 25[2]: VT-GEN-01, VT-CC-01 +- 25[3]: VT-GEN-01, VT-HF-01 +- 25[4]: VT-GEN-01 + +- 26[0]: VT-GEN-01, VT-NC-01 +- 26[1]: VT-GEN-01, VT-CC-01 +- 26[2]: VT-GEN-01, VT-CC-01 +- 26[3]: VT-GEN-01, VT-CON-01 +- 26[4]: VT-GEN-01, VT-HF-01 +- 26[5]: VT-GEN-01, VT-GEN-02 +- 26[6]: VT-GEN-01, VT-GEN-02 +- 26[7]: VT-GEN-01, VT-GEN-02 +- 26[8]: VT-GEN-01, VT-GEN-03 +- 26[9]: VT-GEN-01 + +No additional in objects: "25[0]", "25[1]", "25[2]", "25[3]", "25[4]", "26[0]", "26[1]", "26[2]", "26[3]", "26[4]", "26[5]", "26[6]", "26[7]", "26[8]", and "26[9]" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| GAL-01 | In "29": `"minValue": 1` | :white_check_mark: | +| GAL-02 | In "29": `"maxValue": 15` | :white_check_mark: | + +No additional entries in object "29" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| CMTL-01 | In "28": `"notEqual": 0` | :white_check_mark: | +| CMTL-02 | In "28": `"minValue": 0` | :white_check_mark: | +| CMTL-03 | In "28": `"minValue": 18` | :white_check_mark: | +| CMTL-04 | In "28": `"maxValue": 293` | :white_check_mark: | + +No additional entries in object "28" in the JSON file. :white_check_mark: + +| Interim Constitution Guardrail | Entry in the JSON file | Status | +| --- | --- | -- | +| CMS-01 | In "27": `"minValue": 0` | :white_check_mark: | +| CMS-02 | In "27": `"minValue": 3` | :white_check_mark: | +| CMS-03 | In "27": `"maxValue": 10` | :white_check_mark: | + +No additional entries in object "27" in the JSON file. :white_check_mark: + +### Section 2.6 + +BLANK + +### Section 2.7 + +BLANK + +### Section 3 + +BLANK + +### Section 4 + +BLANK + +### Section 5 + +BLANK + +### Section 6 + +BLANK + +### Section 7 + +BLANK + +### Section 8 + +BLANK + +## Other entries in the JSON file + +There are no additional entries in the JSON file that are not covered by the Interim Constitution. :white_check_mark: diff --git a/cardano-constitution/certification/testing-traceability.md b/cardano-constitution/certification/testing-traceability.md new file mode 100644 index 00000000000..17b6dc1866f --- /dev/null +++ b/cardano-constitution/certification/testing-traceability.md @@ -0,0 +1,396 @@ +# Constitution Script Testing Traceability + +# Version + +Version: 1.1 + +## Authors + +Bogdan Manole (bogdan.manole@iohk.io) +Romain Soulat (romain.soulat@iohk.io) + +## Table of contents + +- [Revision History](#revision-history) +- [References](#references) +- [Traceability](#traceability) + +## Revision History + +| Version | Date | Authors | Comments | +|---|---|---|---| +| 1.0 | April, 30, 2024 | Bogdan Manole, Romain Soulat | Initial version | +| 1.1 | May, 14, 2024 | Romain Soulat | Update to May 07 version of the Constitution | + +## References + +- [Constitution](https://docs.google.com/document/d/1GwI_6qzfTa5V_BeEY4f-rZNhbfA8lXon) + - SHA 256: `XX` + - Date: May, 14, 2024 (latest) + +- Testing Framework + - Old constitution repo Commit: c422981 + - Date: May, 15, 2024 + +## Traceability + +### Assumptions + +The Introduction section of the Constitution states: +*This script is executed whenever a governance action is submitted on-chain. It acts as an additional safeguard to the ledger rule and types, filtering non-compliant governance actions. Guardrails only affect two types of governance actions:* + +*1. Protocol Update Actions, and* +*2. Treasury Withdrawal Actions.* + +#### Assumption 1 + +The script will only be called on Protocol Update Actions and Treasury Withdrawal Actions. + +#### Assumption 2 + +The script assumes all the guarantees provided by the ledger rules and types. + +### Guardrails and Guidelines on Protocol Update Actions + +#### :black_square_button: Critical Protocol Parameters + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +|PARAM-01| :white_check_mark: | No parameters were found to fall into this guardrail | :black_square_button: | +|PARAM-02| :white_check_mark: | Cost Models follow PARAM-02 | :black_square_button: | +|PARAM-03| :white_check_mark: | The script cannot enforce this guardrail directly, it is enforced by [VT-GEN-XX] | :black_square_button: | +|PARAM-04| :x: | | :white_check_mark: | +|PARAM-05| :white_check_mark: | The script cannot enforce this guardrail directly, it is enforced by [VT-GEN-XX] | :black_square_button: | +|PARAM-06| :x: | | :white_check_mark: | + +#### Economic Parameters + +##### Transaction Fee per Byte and fixed transaction fee + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| TFPB-01 | :white_check_mark: | ("TFPB-01", "txFeePerByte must not be lower than 30 (0.000030 ada)") `MustNotBe` NL 30 | :white_check_mark: | +| TFPB-02 | :white_check_mark: | ("TFPB-02", "txFeePerByte must not exceed 1,000 (0.001 ada)") `MustNotBe` NG 1_000 | :white_check_mark: | +| TFPB-03 | :white_check_mark: | ("TFPB-03", "txFeePerByte must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| TFF-01 | :white_check_mark: | ("TFF-01","txFeeFixed must not be lower than 100,000 (0.1 ada)") `MustNotBe` NL 100_000 | :white_check_mark: | +| TFF-02 | :white_check_mark: | ("TFF-02","txFeeFixed must not exceed 10,000,000 (10 ada)") `MustNotBe` NG 10_000_000 | :white_check_mark: | +| TFF-03 | :white_check_mark: | ("TFF-03","txFeeFixed must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| TFGEN-01 | :x: | | :white_check_mark: | +| TFGEN-02 | :x: | | :white_check_mark: | + +##### UTxO cost per byte + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| UCPB-01 | :white_check_mark: | ("UCPB-01","utxoCostPerByte must not be lower than 3,000 (0.003 ada)") `MustNotBe` NL 3_000 | :white_check_mark: | +| UCPB-02 | :white_check_mark: | ("UCPB-02","utxoCostPerByte must not exceed 6,500 (0.0065 ada)") `MustNotBe` NG 6_500 | :white_check_mark: | +| UCPB-03 | :white_check_mark: | Once (("UCPB-03","utxoCostPerByte must not be zero") `MustNotBe` NEQ 0) | :white_check_mark: | +| UCPB-04 | :white_check_mark: | ("UCPB-04","utxoCostPerByte must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| UCPB-05 | :x: | | :white_check_mark: | + +##### Stake address deposit + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| SAD-01 | :white_check_mark: | ("SAD-01","stakeAddressDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 | :white_check_mark: | +| SAD-02 | :white_check_mark: | ("SAD-02","stakeAddressDeposit must not exceed 5,000,000 (5 ada)") `MustNotBe` NG 5_000_000 | :white_check_mark: | +| SAD-03 | :white_check_mark: | ("SAD-03","stakeAddressDeposit must not be negative") `MustNotBe` NL 0 | :white_check_mark: | + +##### Stake pool deposit + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| SPD-01 | :white_check_mark: | ("SPD-01","stakePoolDeposit must not be lower than 250,000,000 (250 ada)") `MustNotBe` NL 250_000_000 | :white_check_mark: | +| SPD-02 | :white_check_mark: | ("SPD-02","stakePoolDeposit must not exceed 500,000,000 (500 ada)") `MustNotBe` NG 500_000_000 | :white_check_mark: | +| SPD-03 | :white_check_mark: | ("SDP-03","stakePoolDeposit must not be negative") `MustNotBe` NL 0 | :white_check_mark: | + +##### Minimum pool cost + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MPC-01 | :white_check_mark: | ("MPC-01","minPoolCost must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MPC-02 | :white_check_mark: | ("MPC-02","minPoolCost must not exceed 500,000,000 (500 ada)") `MustNotBe` NG 500_000_000 | :white_check_mark: | +| MPC-03 | :x: | | :white_check_mark: | + +##### Treasury Cut + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| TC-01 | :white_check_mark: | ("TC-01","treasuryCut must not be lower than 0.1 (10%)") `MustNotBe` NL 0.1 | :white_check_mark: | +| TC-02 | :white_check_mark: | ("TC-02", "treasuryCut must not exceed 0.3 (30%)") `MustNotBe` NG 0.3 | :white_check_mark: | +| TC-03 | :white_check_mark: | ("TC-03","treasuryCut must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| TC-04 | :white_check_mark: | ("TC-04", "treasuryCut must not exceed 1.0 (100%)") `MustNotBe` NG 1.0 | :white_check_mark: | +| TC-05 | :x: | | :white_check_mark: | + +##### Monetary Expansion Rate + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| ME-01 | :white_check_mark: | ("ME-01","monetaryExpansion must not exceed 0.005") `MustNotBe` NG 0.005 | :white_check_mark: | +| ME-02 | :white_check_mark: | ("ME-02","monetaryExpansion must not be lower than 0.001") `MustNotBe` NL 0.001 | :white_check_mark: | +| ME-03 | :white_check_mark: | ("ME-03","monetaryExpansion must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| ME-04 | :x: | | :white_check_mark: | +| ME-05 | :x: | | :white_check_mark: | + +##### Plutus Script Execution Prices + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| EIUP-PS-01 | :white_check_mark: | ("EIUP-PS-01","executionUnitPrices[priceSteps] must not exceed 2,000 / 10,000,000") `MustNotBe` NG (2_000 % 10_000_000) | :white_check_mark: | +| EIUP-PS-02 | :white_check_mark: | ("EIUP-PS-02","executionUnitPrices[priceSteps] must not be lower than 500 / 10,000,000") `MustNotBe` NL (500 % 10_000_000) | :white_check_mark: | +| EIUP-PM-01 | :white_check_mark: | ("EIUP-PM-01","executionUnitPrices[priceMemory] must not exceed 2_000 / 10_000") `MustNotBe` NG (2_000 % 10_000) | :white_check_mark: | +| EIUP-PM-02 | :white_check_mark: | ("EIUP-PM-02","executionUnitPrices[priceMemory] must not be lower than 400 / 10_000") `MustNotBe` NL (400 % 10_000) | :white_check_mark: | +| EIUP-GEN-01 | :x: | | :white_check_mark: | +| EIUP-GEN-02 | :x: | | :white_check_mark: | + +##### Transaction fee per byte for a reference script + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MFRS-01 | :white_check_mark: | ("MFRS-01", "minFeeRefScriptCoinsPerByte must not exceed 1,000 (0.001 ada)") `MustNotBe` NG 1_000 | :white_check_mark: | +| MFRS-02 | :white_check_mark: | ("MFRS-02", "minFeeRefScriptCoinsPerByte must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MFRS-03 | :x: | | :white_check_mark: | +| MFRS-04 | :x: | | :white_check_mark: | + +#### Network Parameters + +| Guardrail ID | Checkable | Checked by (if applicable) | Validation | +|---|:---:|---|:---:| +| NETWORK-1 | :x: | | :white_check_mark: | +| NETWORK-2 | :x: | | :white_check_mark: | + +##### Block Size + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MBBS-01 | :white_check_mark: | ("MBBS-01","maxBlockBodySize must not exceed 122,880 Bytes (120KB)") `MustNotBe` NG 122_880 | :white_check_mark: | +| MBBS-02 | :white_check_mark: | ("MBBS-02","maxBlockBodySize must not be lower than 24,576 Bytes (24KB)") `MustNotBe` NL 24_576 | :white_check_mark: | +| MBBS-03 | :x: | | :white_check_mark: | +| MBBS-04 | :x: | | :white_check_mark: | +| MBBS-05 | :x: | | :white_check_mark: | +| MBBS-06 | :x: | | :white_check_mark: | + +##### Transaction size + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MTS-01 | :white_check_mark: | ("MTS-01","maxTxSize must not exceed 32,768 Bytes (32KB)") `MustNotBe` NG 32_768 | :white_check_mark: | +| MTS-02 | :white_check_mark: | ("MTS-02","maxTxSize must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MTS-03 | :x: | | :white_check_mark: | +| MTS-04 | :x: | | :white_check_mark: | +| MTS-05 | :x: | | :white_check_mark: | +| MTS-06 | :x: | | :white_check_mark: | + +##### Memory Unit Limites + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MTEU-M-01 | :white_check_mark: | ("MTEU-M-01","maxTxExecutionUnits[memory] must not exceed 40,000,000 units") `MustNotBe` NG 40_000_000 | :white_check_mark: | +| MTEU-M-02 | :white_check_mark: | ("MTEU-M-02","maxTxExecutionUnits[memory] must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MTEU-M-03 | :x: | | :white_check_mark: | +| MTEU-M-04 | :x: | | :white_check_mark: | +| MBEU-M-01 | :white_check_mark: | ("MBEU-M-01","maxBlockExecutionUnits[memory] must not exceed 120,000,000 units") `MustNotBe` NG 120_000_000 | :white_check_mark: | +| MBEU-M-02 | :white_check_mark: | ("MBEU-M-02","maxBlockExecutionUnits[memory] must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MBEU-M-03 | :x: | | :white_check_mark: | +| MBEU-M-04 | :x: | | :white_check_mark: | +| MTEU-GEN-01 | :x: | | :white_check_mark: | + +##### CPU Unit Limits + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MTEU-S-01 | :white_check_mark: | ("MTEU-S-01","maxTxExecutionUnits[steps] must not exceed 15,000,000,000 (15Bn) units") `MustNotBe` NG 15_000_000_000 | :white_check_mark: | +| MTEU-S-02 | :white_check_mark: | ("MTEU-S-02","maxTxExecutionUnits[steps] must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MTEU-S-03 | :x: | | :white_check_mark: | +| MBEU-S-01 | :white_check_mark: | ("MBEU-S-01","maxBlockExecutionUnits[steps] must not exceed 40,000,000,000 (40Bn) units") `MustNotBe` NG 40_000_000_000 | :white_check_mark: | +| MBEU-S-02 | :white_check_mark: | ("MBEU-S-02","maxBlockExecutionUnits[steps] must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MTEU-S-04 | :x: | | :white_check_mark: | +| MBEU-S-03 | :x: | | :white_check_mark: | +| MEU-S-01 | :x: | | :white_check_mark: | + +##### Block Header Size + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MBHS-01 | :white_check_mark: | ("MBHS-01","maxBlockHeaderSize must not exceed 5,000 Bytes") `MustNotBe` NG 5_000 | :white_check_mark: | +| MBHS-02 | :white_check_mark: | ("MBHS-02","maxBlockHeaderSize must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MBHS-03 | :x: | | :white_check_mark: | +| MBHS-04 | :x: | | :white_check_mark: | +| MBHS-05 | :x: | | :white_check_mark: | + +#### Technical/Security Parameters + +##### Target Number of Stake Pools + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| SPTN-01 | :white_check_mark: | ("SPTN-01","stakePoolTargetNum must not be lower than 250") `MustNotBe` NL 250 | :white_check_mark: | +| SPTN-02 | :white_check_mark: | ("SPTN-02","stakePoolTargetNum must not exceed 2,000") `MustNotBe` NG 2_000 | :white_check_mark: | +| SPTN-03 | :white_check_mark: | ("SPTN-03","stakePoolTargetNum must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| SPTN-04 | :white_check_mark: | ("SPTN-04", "stakePoolTargetNum must not be zero") `MustNotBe` NEQ 0 | :white_check_mark: | + +##### Pledge Influence Factor + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| PPI-01 | :white_check_mark: | ("PPI-01","poolPledgeInfluence must not be lower than 0.1") `MustNotBe` NL (1 % 10) | :white_check_mark: | +| PPI-02 | :white_check_mark: | ("PPI-02","poolPledgeInfluence must not exceed 1.0") `MustNotBe` NG (10 % 10) | :white_check_mark: | +| PPI-03 | :white_check_mark: | ("PPI-03","poolPledgeInfluence must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| PPI-04 | :x: | | :white_check_mark: | + +##### Pool Retirement Window + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| PRME-01 | :white_check_mark: | ("PRME-01","poolRetireMaxEpoch must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| PRME-02 | :x: | | :white_check_mark: | + +##### Collateral Percentage + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| CP-01 | :white_check_mark: | ("CP-01","collateralPercentage must not be lower than 100") `MustNotBe` NL 100 | :white_check_mark: | +| CP-02 | :white_check_mark: | ("CP-02","collateralPercentage must not exceed 200") `MustNotBe` NG 200 | :white_check_mark: | +| CP-03 | :white_check_mark: | ("CP-03","collateralPercentage must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| CP-04 | :white_check_mark: | ("CP-04","collateralPercentage must not be zero") `MustNotBe` NEQ 0 | :white_check_mark: | + +##### Maximum number of collateral inputs + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MCI-01 | :white_check_mark: | ("MCI-01","maxCollateralInputs must not be lower than 1") `MustNotBe` NL 1 | :white_check_mark: | + +##### Maximum Value Size + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| MVS-01 | :white_check_mark: | ("MVS-01","maxValueSize must not exceed 12,288 Bytes (12KB)") `MustNotBe` NG 12_288 | :white_check_mark: | +| MVS-02 | :white_check_mark: | ("MVS-02","maxValueSize must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| MVS-03 | :x: | | :white_check_mark: | +| MVS-04 | :x: | | :white_check_mark: | +| MVS-05 | :x: | | :white_check_mark: | + +##### :x: Plutus Cost Models + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| PCM-01 | :x: | | :white_check_mark: | +| PCM-02 | :x: | | :white_check_mark: | +| PCM-03 | :x: | | :white_check_mark: | +| PCM-04 | :x: | | :white_check_mark: | + +Note: Test cases exist for the Plutus Cost Models, the presence of a Cost model will not change the output of the script. + +#### Governance Parameters + +##### Deposit for Governance Actions + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| GD-01 | :white_check_mark: | ("GD-01", "govDeposit must not be negative" ) `MustNotBe` NL 0 | :white_check_mark: | +| GD-02 | :white_check_mark: | ("GD-02", "govDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 | :white_check_mark: | +| GD-03 | :white_check_mark: | ("GD-03", "govDeposit must not be more than 10,000,000,000,000 (10 Million ada)") `MustNotBe` NG 10_000_000_000_000 | :white_check_mark: | +| GD-04 | :x: | | :white_check_mark: | + +##### Deposit for DReps + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| DRD-01 | :white_check_mark: | ("DRD-01", "dRepDeposit must not be negative" ) `MustNotBe` NL 0 | :white_check_mark: | +| DRD-02 | :white_check_mark: | ("DRD-02", "dRepDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 | :white_check_mark: | +| DRD-03 | :white_check_mark: | ("DRD-03", "dRepDeposit must be no more than 100,000,000,000 (100,000 ada)") `MustNotBe` NG 100_000_000_000 | :white_check_mark: | +| DRD-04 | :x: | | :white_check_mark: | + +##### Deposit Activity Period + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| DRA-01 | :white_check_mark: | ("DRA-01", "dRepActivity must not be less than 13 epochs (2 months)") `MustNotBe` NL 13 | :white_check_mark: | +| DRA-02 | :white_check_mark: | ("DRA-02", "dRepActivity must not exceed 37 epochs (6 months)") `MustNotBe` NG 37 | :white_check_mark: | +| DRA-03 | :white_check_mark: | ("DRA-03", "dRepActivity must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| DRA-04 | :x: | | :white_check_mark: | +| DRA-05 | :x: | | :white_check_mark: | + +##### Drep and SPO Governance Action Thresholds + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| VT-GEN-01 | :white_check_mark: | **poolVotingThresholds = ParamList @Rational 25 "poolVotingThresholds"**
Param 0 "motionNoConfidence" (2 % 3)
("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 1 "committeeNormal" (2 % 3)
("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 2 "committeeNoConfidence" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 3 "hardForkInitiation" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 4 "ppSecurityGroup" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

**dRepVotingThresholds = Collection @Rational 26 "dRepVotingThresholds"**
Param 0 "motionNoConfidence" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 1 "committeeNormal" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 2 "committeeNoConfidence" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 3 "updateConstitution" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 4 "hardForkInitiation" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 5 "ppNetworkGroup" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 6 "ppEconomicGroup" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 7 "ppTechnicalGroup" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 8 "ppGovernanceGroup" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

Param 9 "treasuryWithdrawal" (2 % 3)
("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2)
("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1)

| :white_check_mark: | +| VT-GEN-02 | :white_check_mark: | **dRepVotingThresholds = Collection @Rational 26 "dRepVotingThresholds"**
Param 5 "ppNetworkGroup" (2 % 3)
("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100)
("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100)

Param 6 "ppEconomicGroup" (2 % 3)
("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100)
("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100)

Param 7 "ppTechnicalGroup" (2 % 3)
("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100)
("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) | :white_check_mark: | +| VT-GOV-01 | :white_check_mark: | **dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds"**
Param 8 "ppGovernanceGroup" (4 % 5)
("VT-GOV-01", "Governance parameter thresholds must be in the range 75%-90%") `MustNotBe` NL (75 % 100)
("VT-GOV-01b", "Governance parameter thresholds must be in the range 75%-90%") `MustNotBe` NG (90 % 100) | :white_check_mark: | +| VT-HF-01 | :white_check_mark: | **poolVotingThresholds = ParamList @Rational 25 "poolVotingThresholds"**
Param 3 "hardForkInitiation" (2 % 3)
("VT-HF-01", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NL (51 % 100)
("VT-HF-01b", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NG (80 % 100)

**dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds"**
Param 4 "hardForkInitiation" (2 % 3)
("VT-HF-01", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NL (51 % 100)
("VT-HF-01b", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NG (80 % 100)| :white_check_mark: | +| VT-CON-01 | :white_check_mark: | **dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds"**
Param 3 "updateConstitution" (2 % 3)
("VT-CON-01", "Update Constitution or proposal policy action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100)
("VT-CON-01b", "Update Constitution or proposal policy action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100) | :white_check_mark: | +| VT-CC-01 | :white_check_mark: | **poolVotingThresholds = ParamList @Rational 25 "poolVotingThresholds"**
Param 1 "committeeNormal" (2 % 3)
("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100)
("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100)

Param 2 "committeeNoConfidence" (2 % 3)
("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100)
("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100)

**dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds"**
Param 1 "committeeNormal" (2 % 3)
("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100)
("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100)

Param 2 "committeeNoConfidence" (2 % 3)
("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100)
("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100)| :white_check_mark: | +| VT-NC-01 | :white_check_mark: | **poolVotingThresholds = ParamList @Rational 25 "poolVotingThresholds"**
Param 0 "motionNoConfidence" (2 % 3)
("VT-NC-01", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100)
("VT-NC-01b", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100)

**dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds"**
Param 0 "motionNoConfidence" (2 % 3)
("VT-NC-01", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100)
("VT-NC-01b", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) | :white_check_mark: | + +##### Governance Action Lifetime + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| GAL-01 | :white_check_mark: | ("GAL-01", "govActionLifetime must not be less than 1 epoch (5 days)") `MustNotBe` NL 1 | :white_check_mark: | +| GAL-03 | :x: | | :white_check_mark: | +| GAL-02 | :white_check_mark: | ("GAL-02", "govActionLifetime must not be greater than 15 epochs (75 days)") `MustNotBe` NG 15 | :white_check_mark: | +| GAL-04 | :x: | | :white_check_mark: | +| GAL-05 | :x: | | :white_check_mark: | + +##### Maximum Constitutional Committee Term + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| CMTL-01 | :white_check_mark: | ("CMTL-01", "committeeMaxTermLimit must not be zero") `MustNotBe` NEQ 0 | :white_check_mark: | +| CMTL-02 | :white_check_mark: | ("CMTL-01b", "committeeMaxTermLimit must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| CMTL-03 | :white_check_mark: | ("CMTL-03", "committeeMaxTermLimit must not be less than 18 epochs (90 days, or approximately 3 months)") `MustNotBe` NL 18 | :white_check_mark: | +| CMTL-04 | :white_check_mark: | ("CMTL-03", "committeeMaxTermLimit must not be more than 293 epochs (approximately 4 years)") `MustNotBe` NG 293 | :white_check_mark: | +| CMTL-05 | :x: | | :white_check_mark: | + +##### The minimum size of the Constitutional Committee + +|Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| CMS-01 | :white_check_mark: | ("CMS-01", "committeeMinSize must not be negative") `MustNotBe` NL 0 | :white_check_mark: | +| CMS-02 | :white_check_mark: | ("CMS-02", "committeeMinSize must not be less than 3") `MustNotBe` NL 3 | :white_check_mark: | +| CMS-03 | :white_check_mark: | ("CMS-03", "committeeMinSize must not be more than 10") `MustNotBe` NG 10 | :white_check_mark: | + +#### Monitoring and Reversion of Parameter Changes + +BLANK SECTION + +#### Non-updatable Protocol Parameters + +BLANK SECTION + + +### :x: Guardrails and Guidelines on Treasury Withdrawal Actions + +| Guardrail ID | Checkable | Checked by (if applicable)|Validation | +|---|:---:|---|:---:| +| TREASURY-01 | :x: | | :white_check_mark: | +| TREASURY-02 | :x: | | :white_check_mark: | +| TREASURY-03 | :x: | | :white_check_mark: | +| TREASURY-04 | :x: | | :white_check_mark: | + +**Note: The script currently does not validate on this Governance action** :x: + +### Guardrails and Guidelines on Hard Fork Actions + +The script is not called on hard fork actions. See [Assumption 1](#assumptions). + +### Guardrails and Guidelines on Update Constitutional Committee Actions or Thresholds Actions + +The script is not called Update Constitutional Committee Actions or Thresholds Actions. See [Assumption 1](#assumptions). + +### Guardrails and Guidelines on Update to the Constitution or Proposal Policy Actions + +The script is not called on Update to the Constitution or Proposal Policy Actions. See [Assumption 1](#assumptions). + +### Guardrail and Guidelines on No Confidence Actions + +The script is not called on No Confidence Actions. See [Assumption 1](#assumptions). + +### Guardrail and Guidelines on Info Actions + +The script is not called on Info Actions. See [Assumption 1](#assumptions). + +### Guardrails during the Interim Period + +The script is not called during the Interim Period. See [Assumption 1](#assumptions). diff --git a/cardano-constitution/data/defaultConstitution.json b/cardano-constitution/data/defaultConstitution.json new file mode 100644 index 00000000000..34d5bfcce12 --- /dev/null +++ b/cardano-constitution/data/defaultConstitution.json @@ -0,0 +1,860 @@ +{ + "0": { + "type": "integer", + "predicates": [ + { + "minValue": 30, + "$comment": "txFeePerByte must not be lower than 30 (0.000030 ada)" + }, + { + "maxValue": 1000, + "$comment": "txFeePerByte must not exceed 1,000 (0.001 ada)" + }, + { + "minValue": 0, + "$comment": "txFeePerByte must not be negative" + } + ], + "$comment": "txFeePerByte" + }, + + "1": { + "type": "integer", + "predicates": [ + { + "minValue": 100000, + "$comment": "txFeeFixed must not be lower than 100,000 (0.1 ada)" + }, + { + "maxValue": 10000000, + "$comment": "txFeeFixed must not exceed 10,000,000 (10 ada)" + }, + { + "minValue": 0, + "$comment": "txFeeFixed must not be negative" + } + ], + "$comment": "txFeeFixed" + }, + + "10": { + "type": "unit_interval", + "predicates": [ + { + "maxValue": { "numerator": 5, "denominator": 1000 }, + "$comment": "monetaryExpansion must not exceed 0.005" + }, + { + "minValue": { "numerator": 1, "denominator": 1000 }, + "$comment": "monetaryExpansion must not be lower than 0.001" + }, + { + "minValue": { "numerator": 0, "denominator": 1000 }, + "$comment": "monetaryExpansion must not be negative" + } + ], + "$comment": "monetaryExpansion" + }, + + "11": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 10, "denominator": 100 }, + "$comment": "treasuryCut must not be lower than 0.1 (10%)" + }, + { + "maxValue": { "numerator": 30, "denominator": 100 }, + "$comment": "treasuryCut must not exceed 0.3 (30%)" + }, + { + "minValue": { "numerator": 0, "denominator": 100 }, + "$comment": "treasuryCut must not be negative" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "treasuryCut must not exceed 1.0 (100%)" + } + ], + "$comment": "treasuryCut" + }, + + "16": { + "type": "integer", + "predicates": [ + { + "minValue": 0, + "$comment": "minPoolCost must not be negative" }, + { + "maxValue": 500000000, + "$comment": "minPoolCost must not be set above 500,000,000 (500 ada)" + } + ], + "$comment": "minPoolCost" + }, + + "17": { + "type": "integer", + "predicates": [ + { + "minValue": 3000, + "$comment": "utxoCostPerByte must not be lower than 3,000 (0.003 ada)" + }, + { + "maxValue": 6500, + "$comment": "utxoCostPerByte must not exceed 6,500 (0.0065 ada)" + }, + { + "notEqual": 0, + "$comment": "utxoCostPerByte must not be zero" + }, + { + "minValue": 0, + "$comment": "utxoCostPerByte must not be negative" + } + ], + "$comment": "utxoCostPerByte" + }, + + "19[0]": { + "type": "unit_interval", + "predicates": [ + { + "maxValue": { "numerator": 2000, "denominator": 10000 }, + "$comment": "executionUnitPrices[priceMemory] must not exceed 2,000 / 10,000" + }, + { + "minValue": { "numerator": 400, "denominator": 10000 }, + "$comment": "executionUnitPrices[priceMemory] must not be lower than 400 / 10,000" + } + ], + "$comment": "executionUnitPrices[priceMemory]" + }, + + "19[1]": { + "type": "unit_interval", + "predicates": [ + { + "maxValue": { "numerator": 2000, "denominator": 10000000 }, + "$comment": "executionUnitPrices[priceSteps] must not exceed 2,000 / 10,000,000" + }, + { + "minValue": { "numerator": 500, "denominator": 10000000 }, + "$comment": "executionUnitPrices[priceSteps] must not be lower than 500 / 10,000,000" + } + ], + "$comment": "executionUnitPrices[priceSteps]" + }, + + "2": { + "type": "integer", + "predicates": [ + { + "maxValue": 122880, + "$comment": "maxBlockBodySize must not exceed 122,880 Bytes (120KB)" + }, + { + "minValue": 24576, + "$comment": "maxBlockBodySize must not be lower than 24,576 Bytes (24KB)" + } + ], + "$comment": "maxBlockBodySize" + }, + + "20[0]": { + "type": "integer", + "predicates": [ + { + "maxValue": 40000000, + "$comment": "maxTxExecutionUnits[memory] must not exceed 40,000,000 units" + }, + { + "minValue": 0, + "$comment": "maxTxExecutionUnits[memory] must not be negative" + } + + ], + "$comment": "maxTxExecutionUnits[memory]" + }, + + "20[1]": { + "type": "integer", + "predicates": [ + { + "maxValue": 15000000000, + "$comment": "maxTxExecutionUnits[steps] must not exceed 15,000,000,000 (15Bn) units" + }, + { + "minValue": 0, + "$comment": "maxTxExecutionUnits[steps] must not be negative" + } + + ], + "$comment": "maxTxExecutionUnits[steps]" + }, + + "21[0]": { + "type": "integer", + "predicates": [ + { + "maxValue": 120000000, + "$comment": "maxBlockExecutionUnits[memory] must not exceed 120,000,000 units" + }, + { + "minValue": 0, + "$comment": "maxBlockExecutionUnits[memory] must not be negative" + } + ], + "$comment": "maxBlockExecutionUnits[memory]" + }, + + "21[1]": { + "type": "integer", + "predicates": [ + { + "maxValue": 40000000000, + "$comment": "maxBlockExecutionUnits[steps] must not exceed 40,000,000,000 (40Bn) units" + }, + { + "minValue": 0, + "$comment": "maxBlockExecutionUnits[steps] must not be negative" + } + ], + "$comment": "maxBlockExecutionUnits[steps]" + }, + + "22": { + "type": "integer", + "predicates": [ + { + "maxValue": 12288, + "$comment": "maxValueSize must not exceed 12,288 Bytes (12KB)" + }, + { + "minValue": 0, + "$comment": "maxValueSize must not be negative" + } + + ], + "$comment": "maxValueSize" + }, + + "23": { + "type": "integer", + "predicates": [ + { + "minValue": 100, + "$comment": "collateralPercentage must not be lower than 100" + }, + { + "maxValue": 200, + "$comment": "collateralPercentage must not exceed 200" + }, + { + "minValue": 0, + "$comment": "collateralPercentage must not be negative" + }, + { + "notEqual": 0, + "$comment": "collateralPercentage must not be zero" + } + + ], + "$comment": "collateralPercentage" + }, + + "24": { + "type": "integer", + "predicates": [ + { + "minValue": 1, + "$comment": "maxCollateralInputs must not be reduced below 1" + } + ], + "$comment": "maxCollateralInputs" + }, + + "25[0]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "No confidence action thresholds must be in the range 51%-75%" + }, + { + "maxValue": { "numerator": 75, "denominator": 100 }, + "$comment": "No confidence action thresholds must be in the range 51%-75%" + } + ], + "$comment": "poolVotingThresholds[motionNoConfidence]" + }, + + "25[1]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 65, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + } + ], + "$comment": "poolVotingThresholds[committeeNormal]" + }, + + "25[2]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 65, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + } + ], + "$comment": "poolVotingThresholds[committeeNoConfidence]" + }, + + "25[3]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "Hard fork action thresholds must be in the range 51%-80%" + }, + { + "maxValue": { "numerator": 80, "denominator": 100 }, + "$comment": "Hard fork action thresholds must be in the range 51%-80%" + } + ], + "$comment": "poolVotingThresholds[hardForkInitiation]" + }, + + "25[4]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + } + ], + "$comment": "poolVotingThresholds[ppSecurityGroup]" + }, + + "26[0]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "No confidence action thresholds must be in the range 51%-75%" + }, + { + "maxValue": { "numerator": 75, "denominator": 100 }, + "$comment": "No confidence action thresholds must be in the range 51%-75%" + } + ], + "$comment": "dRepVotingThresholds[motionNoConfidence]" + }, + + "26[1]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 65, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + } + ], + "$comment": "dRepVotingThresholds[committeeNormal]" + }, + + "26[2]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 65, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Update Constitutional committee action thresholds must be in the range 65%-90%" + } + ], + "$comment": "dRepVotingThresholds[committeeNoConfidence]" + }, + + "26[3]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 65, "denominator": 100 }, + "$comment": "Update Constitution of proposal policy action thresholds must be in the range 65%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Update Constitution of proposal policy action thresholds must be in the range 65%-90%" + } + ], + "$comment": "dRepVotingThresholds[updateToConstitution]" + }, + + "26[4]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "Hard fork action thresholds must be in the range 51%-80%" + }, + { + "maxValue": { "numerator": 80, "denominator": 100 }, + "$comment": "Hard fork action thresholds must be in the range 51%-80%" + } + ], + "$comment": "dRepVotingThresholds[hardForkInitiation]" + }, + + "26[5]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + }, + { + "maxValue": { "numerator": 75, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + } + ], + "$comment": "dRepVotingThresholds[ppNetworkGroup]" + }, + + "26[6]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + }, + { + "maxValue": { "numerator": 75, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + } + ], + "$comment": "dRepVotingThresholds[ppEconomicGroup]" + }, + + "26[7]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 51, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + }, + { + "maxValue": { "numerator": 75, "denominator": 100 }, + "$comment": "Economic, network and technical parameter thresholds must be in the range 51%-75%" + } + ], + "$comment": "dRepVotingThresholds[ppTechnicalGroup]" + }, + + "26[8]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "minValue": { "numerator": 75, "denominator": 100 }, + "$comment": "Governance parameter thresholds must be in the range 75%-90%" + }, + { + "maxValue": { "numerator": 90, "denominator": 100 }, + "$comment": "Governance parameter thresholds must be in the range 75%-90%" + } + ], + "$comment": "dRepVotingThresholds[ppGovGroup]" + }, + + "26[9]": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 50, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + }, + { + "maxValue": { "numerator": 100, "denominator": 100 }, + "$comment": "All thresholds must be in the range 50%-100%" + } + ], + "$comment": "dRepVotingThresholds[treasuryWithdrawal]" + }, + + "27": { + "type": "integer", + "predicates": [ + { + "minValue": 0, + "$comment": "committeeMinSize must not be negative" + }, + { + "minValue": 3, + "$comment": "committeeMinSize must not be lower than 3" + }, + { + "maxValue": 10, + "$comment": "committeeMinSize must not exceed than 10" + } + ], + "$comment": "committeeMinSize" + }, + + "28": { + "type": "integer", + "predicates": [ + { + "notEqual": 0, + "$comment": "committeeMaxTermLimit must not be zero" + }, + { + "minValue": 0, + "$comment": "committeeMaxTermLimit must not negative" + }, + { + "minValue": 18, + "$comment": "committeeMaxTermLimit must not be less than 18 epochs (90 days, or approximately 3 months)" + }, + { + "maxValue": 293, + "$comment": "committeeMaxTermLimit must not be more than 293 epochs (approximately 4 years)" + } + ], + "$comment": "committeeMaxTermLimit" + }, + + "29": { + "type": "integer", + "predicates": [ + { + "minValue": 1, + "$comment": "govActionLifetime must not be lower than 1 epoch (5 days)" + }, + { + "maxValue": 15, + "$comment": "govActionLifetime must not exceed than 15 epochs (75 days)" + } + ], + "$comment": "govActionLifetime" + }, + + "3": { + "type": "integer", + "predicates": [ + { + "maxValue": 32768, + "$comment": "maxTxSize must not exceed 32,768 Bytes (32KB)" + }, + { + "minValue": 0, + "$comment": "maxTxSize must not be negative" + } + ], + "$comment": "maxTxSize" + }, + + "30": { + "type": "integer", + "predicates": [ + { + "minValue": 0, + "$comment": "govDeposit must not be negative" + }, + { + "minValue": 1000000, + "$comment": "govDeposit must not be lower than 1,000,000 (1 ada)" + }, + { + "maxValue": 10000000000000, + "$comment": "govDeposit must not exceed 10,000,000,000,000 (10 Million ada)" + } + ], + "$comment": "govDeposit" + }, + + "31": { + "type": "integer", + "predicates": [ + { + "minValue": 0, + "$comment": "dRepDeposit must not be negative" + }, + { + "minValue": 1000000, + "$comment": "dRepDeposit must not be lower than 1,000,000 (1 ada)" + }, + { + "maxValue": 100000000000, + "$comment": "dRepDeposit must not exceed 100,000,000,000 (100,000 ada)" + } + ], + "$comment": "dRepDeposit" + }, + + "32": { + "type": "integer", + "predicates": [ + { + "minValue": 13, + "$comment": "dRepActivity must not be lower than 13 epochs (2 months)" + }, + { + "maxValue": 37, + "$comment": "dRepActivity must not exceed 37 epochs (6 months)" + }, + { + "minValue": 0, + "$comment": "dRepActivity must not be negative" + } + ], + "$comment": "dRepActivity" + }, + + "33": { + "type": "integer", + "predicates": [ + { + "maxValue": 1000, + "$comment": "minFeeRefScriptCoinsPerByte must not exceed 1,000 (0.001 ada)" + }, + { + "minValue": 0, + "$comment": "minFeeRefScriptCoinsPerByte must not be negative" + } + ], + "$comment": "minFeeRefScriptCoinsPerByte" + }, + + "4": { + "type": "integer", + "predicates": [ + { + "maxValue": 5000, + "$comment": "maxBlockHeaderSize must not be set below 250" + }, + { + "minValue": 0, + "$comment": "maxBlockHeaderSize must not be negative" + } + ], + "$comment": "maxBlockHeaderSize" + }, + + "5": { + "type": "integer", + "predicates": [ + { + "minValue": 1000000, + "$comment": "stakeAddressDeposit must not be lower than 1,000,000 (1 ada)" + }, + { + "maxValue": 5000000, + "$comment": "stakeAddressDeposit must not exceed 5,000,000 (5 ada)" + }, + { + "minValue": 0, + "$comment": "stakeAddressDeposit must not be negative" + } + ], + "$comment": "stakeAddressDeposit" + }, + + "6": { + "type": "integer", + "predicates": [ + { + "minValue": 250000000, + "$comment": "stakePoolDeposit must not be lower than 250,000,000 (250 ada)" + }, + { + "maxValue": 500000000, + "$comment": "stakePoolDeposit must not exceed 500,000,000 (500 ada)" + }, + { + "minValue": 0, + "$comment": "stakePoolDeposit must not be negative" + } + ], + "$comment": "stakePoolDeposit" + }, + + "7": { + "type": "integer", + "predicates": [ + { + "minValue": 0, + "$comment": "poolRetireMaxEpoch must not be negative" + } + ], + "$comment": "poolRetireMaxEpoch" + }, + + "8": { + "type": "integer", + "predicates": [ + { + "minValue": 250, + "$comment": "stakePoolTargetNum must not be lower than 250" + }, + { + "maxValue": 2000, + "$comment": "stakePoolTargetNum must not be set above 2,000" + }, + { + "minValue": 0, + "$comment": "stakePoolTargetNum must not be negative" + }, + { + "notEqual": 0, + "$comment": "stakePoolTargetNum must not be zero" + } + ], + "$comment": "stakePoolTargetNum" + }, + + "9": { + "type": "unit_interval", + "predicates": [ + { + "minValue": { "numerator": 1, "denominator": 10 }, + "$comment": "poolPledgeInfluence must not be set below 0.1" + }, + { + "maxValue": { "numerator": 10, "denominator": 10 }, + "$comment": "poolPledgeInfluence must not exceed 1.0" + }, + { + "minValue": { "numerator": 0, "denominator": 10 }, + "$comment": "poolPledgeInfluence must not be negative" + } + ], + "$comment": "poolPledgeInfluence" + }, + + "18": { + "type": "any", + "$comment": "costmodels for all plutus versions" + } +} diff --git a/cardano-constitution/data/defaultConstitution.schema.json b/cardano-constitution/data/defaultConstitution.schema.json new file mode 100644 index 00000000000..7cdc3f9c959 --- /dev/null +++ b/cardano-constitution/data/defaultConstitution.schema.json @@ -0,0 +1,131 @@ +{ + "$schema": "https://json-schema.org/draft/2019-09/schema", + "type": "object", + "propertyNames": { + "$comment": "The param id is supposed to be a non-negative integer" + , "$comment": "optionally followed by a square-bracketed non-negative integer" + , "$comment": "We enforce with a regex (^(0|[1-9][0-9]*)$) the param id to the non-negative decimal numbers" + , "$comment": "The regex also disallows leading zeroes, to avoid silent duplicates" + , "pattern": "^(0|[1-9][0-9]*)(\\[(0|[1-9][0-9]*)\\])?$" + }, + "additionalProperties": { + "type": "object", + "properties": { + "$comment": { "type": "string" }, + "type": {"type": "string", "enum": ["integer","unit_interval", "any"]}, + "predicates": { "type": "array" + , "items": { "$ref": "#/$defs/predKeyValue" } + , "$comment": "Unknown Parameters and Parameters with no restrictions are treated differently:" + , "$comment": "An unknown parameter is not specified in the json file, whereas a no-restrictions parameter is specified with type any or with predicates==[]." + } + }, + "required": ["type"], + "additionalProperties": false + }, + "$defs": { + "predKeyValue": {"oneOf": [ + {"type": "object", "properties": {"minValue": { "$ref": "#/$defs/predValue"}, "$comment": { "type": "string" }}, "additionalProperties": false, "required": ["minValue"]}, + {"type": "object", "properties": {"maxValue": { "$ref": "#/$defs/predValue"}, "$comment": { "type": "string" }}, "additionalProperties": false, "required": ["maxValue"]}, + {"type": "object", "properties": {"notEqual": { "$ref": "#/$defs/predValue"}, "$comment": { "type": "string" }}, "additionalProperties": false, "required": ["notEqual"]} + ] + }, + "predValue": {"oneOf": + [ {"type": "integer"}, + {"type": "object", "properties": {"numerator": {"type": "integer"}, "denominator": {"type": "integer"}}, "required": ["numerator","denominator"]} + ] + } + }, + "examples": [ + { "0": { + "type": "integer" + , "predicates": [{ "minValue": 1 }] + , "$comment": "This restricts the parameter to be at least 1" + }}, + {"0": { + "type": "integer" + , "predicates": [{ "minValue": 1}, {"maxValue": 1 }] + , "$comment": "Parameter should be least 1 and at most 1 ==> can only be 1" + , "$comment": "A hard/frozen restriction on the parameter, because it cannot change as long as constitution remains the same" + }}, + {"0": { + "type": "integer" + , "predicates": [{ "minValue": 1}, {"maxValue": -1 }] + , "$comment": "Must be at least 1 and at most -1. UNSATISFIABLE" + , "$comment": "A non-sense parameter restriction. A proposal trying to touch this parameter will always fail" + , "$comment": "Currently, we don't have a guard against configuring a constitution with such non-sense restrictions" + }}, + {"0": { + "type": "integer" + , "predicates": [{ "minValue": 1} , {"minValue": -1 }] + , "$comment": "An example with duplicated, redundant predicates" + , "$comment": "Both predicates must succeed, which implies that ==> {minValue: min(1,-1)} ==> {minValue: -1}" + }}, + {"0": { + "type": "integer" + , "predicates": [] + , "$comment": "Does not contain any restrictions, and thus is allowed to take any integer Value" + , "$comment": "This example of an empty-predicates parameter, acknowledges the existence of a parameter and allows it to be changed (*to any integer value*)." + , "$comment": "Unlike this example of a known parameter with no predicates, an unknown parameter (not specified at all in a constitution-config) would make its proposal fail." + }}, + {"0": { + "type": "any" + , "$comment": "An example of a known parameter that can take any value" + , "$comment": "This is different than specifying the type with predicates==[], since there is not going to be any de-serialization done for the proposed parameter's type" + }}, + {"0": { + "type": "integer" + , "predicates": [{ "minValue": 1, "minValue": 2 }] + , "$comment": "^ DUPLICATE ENTRY inside THE SAME PREDICATE OBJECT" + , "$comment": "This MIGHT be caught by the JSON schema validator but definitely NOT by AESON." + + , "$comment": "VERY IMPORTANT: json schema (and JSON) allows duplicate object entries." + , "$comment": "Only one of the duplicates will be *silently* loaded and we don't guarantee the order" + , "$comment": "SO DO NOT ENTER DUPLICATES inside the **SAME JSON OBJECT** in the configuration" + }}, + {"0": { + "type": "integer" + , "predicates": [{ "minValue": 1}] + , "predicates": [{ "maxValue": 1}, {"notEqual": 0}] + , "$comment": "^ DUPLICATE PREDICATES ENTRY inside the SAME PARAM OBJECT" + , "$comment": "This will definitely NOT be caught by any json schema validator or by AESON." + , "$comment": "VERY IMPORTANT: json schema (and JSON) allows duplicate object entries." + , "$comment": "Only one of the duplicates will be *silently* loaded and we don't guarantee the order" + , "$comment": "SO DO NOT ENTER DUPLICATES inside the **SAME JSON OBJECT** in the configuration" + }}, + {"0": { + "type": "unit_interval" + , "predicates": [ + { "maxValue": { "numerator": 2000, "denominator": 10000 }}, + { "minValue": { "numerator": 400, "denominator": 10000 } } + ] + , "$comment": "An example of a Rational value" + , "$comment": "Mixing values of different types (integer / unit_interval) will fail when parsing the config" + , "$comment": "The denominator is not allowed to be zero both for this expected value as well as the proposed value." + }}, + {"0[0]": { + "type": "unit_interval", + "predicates": [ + { "maxValue": { "numerator": 2000, "denominator": 10000 } }, + { "minValue": { "numerator": 400, "denominator": 10000 } } + ] + } + ,"0[1]": { + "type": "integer", + "predicates": [ + { "maxValue": 100 } + ] + , "$comment": "An example of a config with a parameter being a list of two elements" + , "$comment": "Each element can take a different type" + , "$comment": "Deeply nested lists are supported but currently we do not have a use for them." + } + }, + {"0[0]": {"type": "any"}, + "0[1]": {"type": "integer", + "predicates": [ + { "maxValue": 100 } + ] + , "$comment": "An example of a known parameter that takes a list of any and an integer" + } + } + ] +} diff --git a/cardano-constitution/src/Cardano/Constitution/Config.hs b/cardano-constitution/src/Cardano/Constitution/Config.hs new file mode 100644 index 00000000000..dc87628417a --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Config.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module Cardano.Constitution.Config + ( defaultConstitutionConfig + , defaultPredMeanings + , module Export + ) where + +import Cardano.Constitution.Config.Instance.FromJSON () +import Cardano.Constitution.Config.Instance.TxLift () +import Cardano.Constitution.Config.Types as Export +import Cardano.Constitution.DataFilePaths as DFP +import PlutusTx.Eq as Tx +import PlutusTx.Ord as Tx + +import Data.Aeson.THReader as Aeson + +-- | The default config read from "data/defaultConstitution.json" +{-# INLINABLE defaultConstitutionConfig #-} +defaultConstitutionConfig :: ConstitutionConfig +defaultConstitutionConfig = $$(Aeson.readJSONFromFile DFP.defaultConstitutionConfigFile) + +{-# INLINABLE defaultPredMeanings #-} +-- | NOTE: **BE CAREFUL** of the ordering. Expected value is first arg, Proposed Value is second arg +defaultPredMeanings :: PredKey -> PredMeaning a +defaultPredMeanings = \case + MinValue -> (Tx.<=) + MaxValue -> (Tx.>=) + NotEqual -> (Tx./=) diff --git a/cardano-constitution/src/Cardano/Constitution/Config/Instance/FromJSON.hs b/cardano-constitution/src/Cardano/Constitution/Config/Instance/FromJSON.hs new file mode 100644 index 00000000000..c5d9dac9b80 --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Config/Instance/FromJSON.hs @@ -0,0 +1,143 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ViewPatterns #-} +module Cardano.Constitution.Config.Instance.FromJSON () where + +import Cardano.Constitution.Config.Types + +import PlutusPrelude (lowerInitialChar) +import PlutusTx.Ratio as Tx + +import Control.Monad +import Data.Aeson.Key qualified as Aeson +import Data.Aeson.KeyMap qualified as Aeson +import Data.Aeson.Types as Aeson +import Data.Foldable +import Data.List as Haskell.List +import Data.Map qualified as M +import GHC.IsList +import Safe +import Text.Regex.TDFA as Rx + +-- | Replica ADTs of ParamValue & ConstitutionConfig , specialised only for FromJSON. +-- Alternatively, we could generalise the aforementationed ADTs (needs barbies, breaks TxLifting) +data RawParamValue = + RawParamInteger (Predicates Integer) + | RawParamRational (Predicates Tx.Rational) + | RawParamList (M.Map Integer RawParamValue) + | RawParamAny +newtype RawConstitutionConfig = RawConstitutionConfig (M.Map Integer RawParamValue) + +-- TODO: move to deriving-aeson +instance FromJSON PredKey where + parseJSON = genericParseJSON (defaultOptions { constructorTagModifier = lowerInitialChar }) + +-- TODO: move to deriving-aeson +instance Aeson.FromJSONKey PredKey where + fromJSONKey = genericFromJSONKey (defaultJSONKeyOptions { keyModifier = lowerInitialChar }) + +instance FromJSON a => FromJSON (Predicates a) where + parseJSON val = do + -- TODO: ugly code, refactor + ms <- parseJSON @[Object] val + -- filter out "$comment" from all keymaps + let ms' = fmap (Object . Aeson.delete commentKey) ms + -- re-parse correctly this time + m <- parseJSON @[M.Map PredKey a] (Aeson.Array $ fromList ms') + when (any ((/= 1) . length) m) $ + fail "Only one predicate-key per predicate inside the predicate list" + pure $ Predicates $ + -- using toAscList here ensures that the inner map is sorted + M.toAscList + -- combine the duplicate predicates into a list of predicate values + -- entries with same key combine their values with (++) + $ M.unionsWith (<>) + $ fmap (fmap pure) m + +instance FromJSON ConstitutionConfig where + parseJSON = + parseJSON -- first pass, parse raw + >=> + fromRaw -- second pass, flatten maps to lists, and check for contiguity + +-- 1st pass +instance FromJSON RawConstitutionConfig where + parseJSON = fmap RawConstitutionConfig + . withObject "RawConstitutionConfig" (foldlM insertParam mempty . Aeson.toAscList) + where + insertParam acc (outerKey, outerValue) = do + (index, msubIndex) <- parseParamKey outerKey + when (index < 0) $ fail "Negative Integer ParamKey given" + paramValue <- parseParamValue msubIndex outerValue + -- flipped version of Lens.at + M.alterF (\case + Nothing -> pure $ Just paramValue + Just paramValue' -> Just <$> mergeParamValues paramValue' paramValue + ) index acc + +-- second pass, flatten maps to lists, and check for contiguity +fromRaw :: MonadFail m => RawConstitutionConfig -> m ConstitutionConfig +fromRaw (RawConstitutionConfig rc) = ConstitutionConfig . M.toAscList <$> traverse flattenParamValue rc + where + flattenParamValue :: MonadFail m => RawParamValue -> m ParamValue + flattenParamValue = \case + RawParamList m -> do + -- This is the CONTIGUOUS check. + when (not $ M.keys m `isPrefixOf` [0..]) $ fail "The sub-indices are not in order." + -- the M.elems will be in ascending order + ParamList <$> traverse flattenParamValue (M.elems m) + -- boilerplate follows + RawParamInteger x -> pure $ ParamInteger x + RawParamRational x -> pure $ ParamRational x + RawParamAny -> pure ParamAny + +-- MAYBE: use instead attoparsec-aeson.jsonWith/jsonNoDup to fail on parsing duplicate Keys, +-- because right now Aeson silently ignores duplicated param entries (arbitrarily picks the last of duplicates) +parseParamKey :: Aeson.Key -> Aeson.Parser (Integer, Maybe Integer) +parseParamKey (Aeson.toString -> s) = do + -- MAYBE: fetch the regex pattern from the schema itself, it is easy + [[_, indexS,_,subIndexS]] :: [[String]] <- s Rx.=~~ ("^(0|[1-9][0-9]*)(\\[(0|[1-9][0-9]*)\\])?$" :: String) + indexI <- either fail pure $ readEitherSafe indexS + mSubIndexI <- + if null subIndexS + then pure Nothing + else Just <$> either fail pure (readEitherSafe subIndexS) + pure (indexI,mSubIndexI) + +-- | If there is a subkey given, treat the param as a paramlist +-- Otherwise, parse it based on the json's "type" +parseParamValue :: Maybe ParamKey -> Value -> Parser RawParamValue +parseParamValue = \case + Nothing -> parseTypedParamValue + -- if we parsed a sub-index, treat the param value as a `M.singleton subIndex value` + Just subIndex -> fmap (RawParamList . M.singleton subIndex) . parseTypedParamValue + where + parseTypedParamValue = withObject "RawParamValue" $ \o -> do + String ty <- o .: typeKey + case ty of + "integer" -> RawParamInteger <$> (o .: predicatesKey) + -- NOTE: even if the Tx.Ratio.Rational constructor is not exposed, the 2 arguments to the constructor + -- will be normalized (co-primed) when Tx.lift is called on them. + -- SO there is no speed benefit to statically co-prime them ourselves for efficiency. + "unit_interval" -> RawParamRational <$> (o .: predicatesKey) + "any" -> pure RawParamAny + _ -> fail "invalid type tag" + +-- | It is like an `mappend` when both inputs are ParamList's. +mergeParamValues :: MonadFail m => RawParamValue -> RawParamValue -> m RawParamValue +mergeParamValues (RawParamList m1) = \case + RawParamList m2 -> pure $ RawParamList $ m1 <> m2 + _ -> fail "param matched with subparam" +mergeParamValues _ = \case + RawParamList _ -> fail "param matched with subparam" + -- in reality this cannot be triggered, because we would then have duplicate params + -- , which default aeson and json allow + _ -> fail "this should not happen" + +predicatesKey, typeKey, commentKey :: Aeson.Key +predicatesKey = "predicates" +typeKey = "type" +commentKey = "$comment" diff --git a/cardano-constitution/src/Cardano/Constitution/Config/Instance/TxLift.hs b/cardano-constitution/src/Cardano/Constitution/Config/Instance/TxLift.hs new file mode 100644 index 00000000000..f289e3762a1 --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Config/Instance/TxLift.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Cardano.Constitution.Config.Instance.TxLift () where + +import Cardano.Constitution.Config.Types +import Language.Haskell.TH as TH +import PlutusCore.Default as Tx (DefaultUni) +import PlutusTx.Lift as Tx +import PlutusTx.Lift.Class as Tx + +-- `Tx.makeLift` depends on TH which is sensitive to re-ordering; try to NOT reorder the following. +---------- + +Tx.makeLift ''PredKey + +deriving newtype instance (Tx.Typeable Tx.DefaultUni predValue, Tx.Lift Tx.DefaultUni predValue) + => Tx.Lift Tx.DefaultUni (Predicates predValue) + +Tx.makeTypeable (TH.ConT ''Tx.DefaultUni) ''Predicates +Tx.makeLift ''ParamValue +Tx.makeLift ''ConstitutionConfig diff --git a/cardano-constitution/src/Cardano/Constitution/Config/Types.hs b/cardano-constitution/src/Cardano/Constitution/Config/Types.hs new file mode 100644 index 00000000000..7b843fe573e --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Config/Types.hs @@ -0,0 +1,97 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Cardano.Constitution.Config.Types + ( PredKey(..) + , Predicate + , Predicates(..) + , PredMeaning + , Param + , ParamKey + , ParamValue(..) + , ConstitutionConfig(..) + ) where + +import GHC.Generics +import Language.Haskell.TH.Syntax as TH +import PlutusTx.Eq as Tx +import PlutusTx.Ord as Tx +import PlutusTx.Ratio as Tx +import Prelude qualified as Haskell + +-- | The "unresolved" Predicate names, as read from JSON. At runtime, these PredKeys +-- will each be resolved to actual `PredMeaning` functions. +data PredKey = + MinValue + | MaxValue + | NotEqual + deriving stock (Haskell.Eq, Haskell.Ord, Haskell.Show, Haskell.Enum, Haskell.Bounded, Generic, TH.Lift) + +instance Tx.Eq PredKey where + {-# INLINABLE (==) #-} + -- See Note [No catch-all] + MinValue == MinValue = Haskell.True + MaxValue == MaxValue = Haskell.True + NotEqual == NotEqual = Haskell.True + MinValue == _ = Haskell.False + MaxValue == _ = Haskell.False + NotEqual == _ = Haskell.False + +-- | Polymorphic over the values. In reality, the value v is an Tx.Integer or Tx.Rational +type Predicate v = (PredKey, [v]) + +-- | newtype so we can overload FromJSON +newtype Predicates v = Predicates { unPredicates :: [Predicate v] } + deriving stock (TH.Lift) + deriving newtype (Haskell.Eq, Haskell.Show) + +-- | The "meaning" of a predicate, resolved from a `PredKey` (a string in JSON) +-- to a Tx binary predicate function. +type PredMeaning a = Tx.Ord a + => a -- ^ the expected value, supplied from the config (json) + -> a -- ^ the proposed value, taken from the ScriptContext + -> Haskell.Bool -- ^ True means the proposed value meets the expectations. + +-- | Promised to be a stable identifier (stable at least for a whole cardano era) +type ParamKey = Haskell.Integer + +data ParamValue = + ParamInteger (Predicates Haskell.Integer) + | ParamRational (Predicates Tx.Rational) + | ParamList [ParamValue] + | ParamAny + deriving stock (Haskell.Eq, Haskell.Show, TH.Lift) + +type Param = (ParamKey, ParamValue) + +{- Note [Manually constructing a Configuration value] + +1. The `ConstitutionConfig` has to be sorted before it is passed to +the engine (requirement for the Sorted engine implementation). +2. The `ConstitutionConfig` should not contain duplicates. + +Both 1 and 2 are guaranteed by construction only in case of using the JSON constitution format +and not when manually constructing a `ConstitutionConfig` ADT value. +-} + +-- | See Note [Manually constructing a Configuration value] +newtype ConstitutionConfig = ConstitutionConfig { unConstitutionConfig :: [Param] } + deriving stock (TH.Lift) + deriving newtype (Haskell.Eq, Haskell.Show) + +-- Taken from the older Reference impl: src/Cardano/Constitution/Validator/Reference/Types.hs +instance TH.Lift Tx.Rational where + lift r = + [| + Tx.unsafeRatio + $(TH.lift (Tx.numerator r)) + $(TH.lift (Tx.denominator r)) + |] + liftTyped r = + [|| + Tx.unsafeRatio + $$(TH.liftTyped (Tx.numerator r)) + $$(TH.liftTyped (Tx.denominator r)) + ||] diff --git a/cardano-constitution/src/Cardano/Constitution/DataFilePaths.hs b/cardano-constitution/src/Cardano/Constitution/DataFilePaths.hs new file mode 100644 index 00000000000..81db09a01fb --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/DataFilePaths.hs @@ -0,0 +1,12 @@ +module Cardano.Constitution.DataFilePaths + ( defaultConstitutionConfigFile + , defaultConstitutionJSONSchemaFile + ) where + +import System.FilePath + +defaultConstitutionConfigFile :: FilePath +defaultConstitutionConfigFile = "data" "defaultConstitution" <.> "json" + +defaultConstitutionJSONSchemaFile :: FilePath +defaultConstitutionJSONSchemaFile = defaultConstitutionConfigFile `replaceExtension` "schema.json" diff --git a/cardano-constitution/src/Cardano/Constitution/Validator.hs b/cardano-constitution/src/Cardano/Constitution/Validator.hs new file mode 100644 index 00000000000..bab2c35bf05 --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Validator.hs @@ -0,0 +1,26 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE OverloadedLists #-} +module Cardano.Constitution.Validator + ( module Export + , defaultValidators + , defaultValidatorsWithCodes + ) where + +import Cardano.Constitution.Validator.Common as Export +import Cardano.Constitution.Validator.Sorted qualified as S +import Cardano.Constitution.Validator.Unsorted qualified as U +--import Cardano.Constitution.Validator.Reference.Script qualified as R + +import Data.Map.Strict qualified as M +import PlutusTx.Code + +defaultValidatorsWithCodes :: M.Map String (ConstitutionValidator, CompiledCode ConstitutionValidator) +defaultValidatorsWithCodes = + [ ("sorted", (S.defaultConstitutionValidator, S.defaultConstitutionCode)) + , ("unsorted", (U.defaultConstitutionValidator, U.defaultConstitutionCode)) + -- Disabled, 7 tests fail + -- , ("ref", (R.constitutionScript, R.compiledConstitutionScript)) + ] + +defaultValidators :: M.Map String ConstitutionValidator +defaultValidators = fmap fst defaultValidatorsWithCodes diff --git a/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs b/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs new file mode 100644 index 00000000000..dcbdf83328b --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs @@ -0,0 +1,117 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +module Cardano.Constitution.Validator.Common + ( withChangedParams + , ChangedParams + , ConstitutionValidator + , lookupUnsafe + , validateParamValue + ) where + +import Control.Category hiding ((.)) + +import Cardano.Constitution.Config +import Data.Coerce +import PlutusLedgerApi.V3 as V3 +import PlutusTx.Builtins qualified as B +import PlutusTx.Builtins.Internal qualified as BI +import PlutusTx.NonCanonicalRational as NCRatio +import PlutusTx.Prelude as Tx hiding (toList) + +type ConstitutionValidator = BuiltinData -- ^ ScriptContext, deep inside is the changed-parameters proposal + -> BuiltinUnit -- ^ No-error means the proposal conforms to the constitution + +-- OPTIMIZE: operate on BuiltinList directly, needs major refactoring of sorted&unsorted Validators +type ChangedParams = [(BuiltinData, BuiltinData)] + +{- HLINT ignore "Redundant lambda" -} -- I like to see until where it supposed to be first applied. +{- HLINT ignore "Collapse lambdas" -} -- I like to see and comment on each arg +{-# INLINABLE withChangedParams #-} +withChangedParams :: (ChangedParams -> Bool) -> ConstitutionValidator +withChangedParams fun (scriptContextToValidGovAction -> validGovAction) = + case validGovAction of + Just cparams -> if fun cparams + then BI.unitval + else BI.trace "ChangedParams failed to validate" (B.error ()) + Nothing -> BI.unitval -- this is a treasury withdrawal, we just accept it + +{-# INLINABLE validateParamValue #-} +validateParamValue :: ParamValue -> BuiltinData -> Bool +validateParamValue = \case + ParamInteger preds -> validatePreds preds . B.unsafeDataAsI + ParamRational preds -> validatePreds preds . coerce . unsafeFromBuiltinData @NonCanonicalRational + ParamList paramValues -> validateParamValues paramValues . BI.unsafeDataAsList + -- accept the actual proposed value without examining it + ParamAny -> const True + where + validateParamValues :: [ParamValue] -> BI.BuiltinList BuiltinData -> Bool + validateParamValues = \case + (paramValueHd : paramValueTl) -> \actualValueData -> + -- if actualValueData is not a cons, it will error + validateParamValue paramValueHd (BI.head actualValueData) + && validateParamValues paramValueTl (BI.tail actualValueData) + -- if reached the end of list of param-values to check, ensure no more proposed data are left + [] -> B.fromOpaque . BI.null + + validatePreds :: forall a. Tx.Ord a => Predicates a -> a -> Bool + validatePreds (Predicates preds) (validatePred -> validatePredAppliedToActual) = + Tx.all validatePredAppliedToActual preds + + validatePred :: forall a. Tx.Ord a => a -> Predicate a -> Bool + validatePred actualValue (predKey, expectedPredValues) = + Tx.all meaningWithActual expectedPredValues + where + -- we find the meaning (function) from the PredKey + meaning = defaultPredMeanings predKey + -- apply the meaning to actual value: expectedValue is 1st argument, actualValue is 2nd argument + meaningWithActual = (`meaning` actualValue) + +{-# INLINABLE scriptContextToValidGovAction #-} +scriptContextToValidGovAction :: BuiltinData -> Maybe ChangedParams +scriptContextToValidGovAction = scriptContextToScriptInfo + >>> scriptInfoToProposalProcedure + >>> proposalProcedureToGovernanceAction + >>> governanceActionToValidGovAction + where + scriptContextToScriptInfo :: BuiltinData -> BuiltinData -- aka ScriptContext -> ScriptInfo + scriptContextToScriptInfo = BI.unsafeDataAsConstr + >>> BI.snd + >>> BI.tail + >>> BI.tail + >>> BI.head + + scriptInfoToProposalProcedure :: BuiltinData -> BuiltinData + scriptInfoToProposalProcedure (BI.unsafeDataAsConstr -> si) = + if BI.fst si `B.equalsInteger` 5 -- Constructor Index of `ProposingScript` + then BI.head (BI.tail (BI.snd si)) + else B.trace "Not a ProposalProcedure. This should not ever happen, because ledger should guard before, against it." (B.error ()) + + proposalProcedureToGovernanceAction :: BuiltinData -> BuiltinData + proposalProcedureToGovernanceAction = BI.unsafeDataAsConstr + >>> BI.snd + >>> BI.tail + >>> BI.tail + >>> BI.head + + governanceActionToValidGovAction :: BuiltinData -> Maybe ChangedParams + governanceActionToValidGovAction (BI.unsafeDataAsConstr -> govAction@(BI.fst -> govActionConstr)) + -- Constructor Index of `ChangedParams` is 0 + | govActionConstr `B.equalsInteger` 0 = Just (B.unsafeDataAsMap (BI.head (BI.tail (BI.snd govAction)))) + -- Constructor Index of `TreasuryWithdrawals` is 2 + | govActionConstr `B.equalsInteger` 2 = Nothing -- means treasurywithdrawal + | otherwise = B.trace "Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it." (B.error ()) + +{-# INLINEABLE lookupUnsafe #-} +-- | An unsafe version of PlutusTx.AssocMap.lookup, specialised to Integer keys +lookupUnsafe :: Integer -> [(Integer, v)] -> v +lookupUnsafe k = go + where + go [] = B.trace "Unsorted lookup failed" (B.error ()) + go ((k', i) : xs') = if k `B.equalsInteger` k' + then i + else go xs' diff --git a/cardano-constitution/src/Cardano/Constitution/Validator/Sorted.hs b/cardano-constitution/src/Cardano/Constitution/Validator/Sorted.hs new file mode 100644 index 00000000000..cc92acc2995 --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Validator/Sorted.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} +-- Following is for tx compilation +{-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:remove-trace #-} +module Cardano.Constitution.Validator.Sorted + ( constitutionValidator + , defaultConstitutionValidator + , mkConstitutionCode + , defaultConstitutionCode + ) where + +import Cardano.Constitution.Config +import Cardano.Constitution.Validator.Common as Common +import PlutusCore.Version (plcVersion110) +import PlutusTx as Tx +import PlutusTx.Builtins as B +import PlutusTx.Prelude as Tx + +-- | Expects a constitution-configuration, statically *OR* at runtime via Tx.liftCode +constitutionValidator :: ConstitutionConfig -> ConstitutionValidator +constitutionValidator (ConstitutionConfig cfg) = + Common.withChangedParams (runRules cfg) + +-- | The `runRules` is a loop that works element-wise from left-to-right on the 2 sorted maps. +runRules :: [Param] -- ^ the config (sorted by default) + -> ChangedParams -- ^ the params (came sorted by the ledger) + -> Bool +runRules ((expectedPid, paramValue) : cfgRest) + cparams@((B.unsafeDataAsI -> actualPid, actualValueData) : cparamsRest) = + case actualPid `compare` expectedPid of + EQ -> + Common.validateParamValue paramValue actualValueData + -- drop both heads, and continue checking the next changed param + && runRules cfgRest cparamsRest + + GT -> -- skip configHead pointing to a parameter not being proposed + runRules cfgRest cparams + LT -> -- actualPid not found in json config, the constitution fails + False +-- if no cparams left: success +-- if cparams left: it means we reached the end of config without validating all cparams +runRules _ cparams = Tx.null cparams + +-- | Statically configure the validator with the `defaultConstitutionConfig`. +defaultConstitutionValidator :: ConstitutionValidator +defaultConstitutionValidator = constitutionValidator defaultConstitutionConfig + +{-| Make a constitution code by supplied the config at runtime. + +See Note [Manually constructing a Configuration value] +-} +mkConstitutionCode :: ConstitutionConfig -> CompiledCode ConstitutionValidator +mkConstitutionCode cCfg = $$(compile [|| constitutionValidator ||]) + `unsafeApplyCode` liftCode plcVersion110 cCfg + +-- | The code of the constitution statically configured with the `defaultConstitutionConfig`. +defaultConstitutionCode :: CompiledCode ConstitutionValidator +defaultConstitutionCode = $$(compile [|| defaultConstitutionValidator ||]) diff --git a/cardano-constitution/src/Cardano/Constitution/Validator/Unsorted.hs b/cardano-constitution/src/Cardano/Constitution/Validator/Unsorted.hs new file mode 100644 index 00000000000..0c6546c2e08 --- /dev/null +++ b/cardano-constitution/src/Cardano/Constitution/Validator/Unsorted.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} +-- Following is for tx compilation +{-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:remove-trace #-} +module Cardano.Constitution.Validator.Unsorted + ( constitutionValidator + , defaultConstitutionValidator + , mkConstitutionCode + , defaultConstitutionCode + ) where + +import Cardano.Constitution.Config +import Cardano.Constitution.Validator.Common as Common +import PlutusCore.Version (plcVersion110) +import PlutusTx as Tx +import PlutusTx.Builtins as B +import PlutusTx.Prelude as Tx + +-- | Expects a constitution-configuration, statically *OR* at runtime via Tx.liftCode +constitutionValidator :: ConstitutionConfig -> ConstitutionValidator +constitutionValidator cfg = Common.withChangedParams + (all (validateParam cfg)) + +validateParam :: ConstitutionConfig -> (BuiltinData, BuiltinData) -> Bool +validateParam (ConstitutionConfig cfg) (B.unsafeDataAsI -> actualPid, actualValueData) = + Common.validateParamValue + -- If param not found, it will error + (Common.lookupUnsafe actualPid cfg) + actualValueData + +-- | Statically configure the validator with the `defaultConstitutionConfig`. +defaultConstitutionValidator :: ConstitutionValidator +defaultConstitutionValidator = constitutionValidator defaultConstitutionConfig + +{-| Make a constitution code by supplied the config at runtime. + +See Note [Manually constructing a Configuration value] +-} +mkConstitutionCode :: ConstitutionConfig -> CompiledCode ConstitutionValidator +mkConstitutionCode cCfg = $$(compile [|| constitutionValidator ||]) + `unsafeApplyCode` liftCode plcVersion110 cCfg + +-- | The code of the constitution statically configured with the `defaultConstitutionConfig`. +defaultConstitutionCode :: CompiledCode ConstitutionValidator +defaultConstitutionCode = $$(compile [|| defaultConstitutionValidator ||]) diff --git a/cardano-constitution/src/PlutusTx/NonCanonicalRational.hs b/cardano-constitution/src/PlutusTx/NonCanonicalRational.hs new file mode 100644 index 00000000000..e963fdef248 --- /dev/null +++ b/cardano-constitution/src/PlutusTx/NonCanonicalRational.hs @@ -0,0 +1,35 @@ +-- editorconfig-checker-disable-file +-- | Same representation as Tx.Ratio but uses a different BuiltinData encoding +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +module PlutusTx.NonCanonicalRational + ( NonCanonicalRational (..) + ) where + +import PlutusTx as Tx +import PlutusTx.Builtins as B +import PlutusTx.Builtins.Internal as BI +import PlutusTx.Ratio as Tx + +-- We agreed to have a different BuiltinData encoding for Rationals for the ConstitutionScript, +-- other than the canonical encoding for datatypes. +-- This wrapper overloads the ToData to this agreed-upon encoding, for testing and benchmarking. +newtype NonCanonicalRational = NonCanonicalRational Tx.Rational + +instance ToData NonCanonicalRational where + {-# INLINABLE toBuiltinData #-} + toBuiltinData (NonCanonicalRational tx) = + let num = Tx.numerator tx + den = Tx.denominator tx + in toBuiltinData [num,den] + +instance UnsafeFromData NonCanonicalRational where + {-# INLINABLE unsafeFromBuiltinData #-} + unsafeFromBuiltinData (BI.unsafeDataAsList -> bl) = + -- this is the fastest way I found to convert to Rational + let bl' = BI.tail bl + in BI.ifThenElse (BI.null (BI.tail bl')) + (\() -> NonCanonicalRational (Tx.unsafeRatio (B.unsafeDataAsI (BI.head bl)) (B.unsafeDataAsI (BI.head bl')))) + (\() -> BI.trace "A Rational had too many list components" (B.error ())) + () diff --git a/cardano-constitution/test/Cardano/Constitution/Config/Tests.hs b/cardano-constitution/test/Cardano/Constitution/Config/Tests.hs new file mode 100644 index 00000000000..2ca93e167ee --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Config/Tests.hs @@ -0,0 +1,40 @@ +-- | Test that the "examples"" inside the defaultConstitutionJSONSchema, +-- can be parsed with aeson. Usually the json-schema validators ignore these examples. +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Cardano.Constitution.Config.Tests + ( tests + ) where + +import Cardano.Constitution.Config +import Cardano.Constitution.DataFilePaths as DFP + +import Data.Aeson as Aeson +import Data.Aeson.THReader as Aeson +import Data.Aeson.Types as Aeson +import Data.Either +import Helpers.TestBuilders +import Test.Tasty.QuickCheck + +defaultConstitutionJSONSchema :: Aeson.Value +defaultConstitutionJSONSchema = + $$(Aeson.readJSONFromFile DFP.defaultConstitutionJSONSchemaFile) + +-- | All the examples in the JSON schema are parseable as a list of ConstitutionConfigs. +-- Actually the examples 9005 and 9006 should not normally parse, +-- but currently they are not stopped by the Aeson instances. +examplesAsConfigsParser :: Value -> Aeson.Parser [ConstitutionConfig] +examplesAsConfigsParser = withObject "toplevel" (.: "examples") + +-- all these are actually unit tests (by using QuickCheck.once) +test_parseSchemaExamples :: Property +test_parseSchemaExamples = once $ + let res = parseEither examplesAsConfigsParser defaultConstitutionJSONSchema + in counterexample (fromLeft "cannot happen, must be left then" res) $ + isRight res + +tests :: TestTreeWithTestState +tests = testGroup' "Config" $ fmap (const . uncurry testProperty) [ + ("parseSchemaExamples", test_parseSchemaExamples) + ] diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs new file mode 100644 index 00000000000..10d280a3caf --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs @@ -0,0 +1,93 @@ +-- editorconfig-checker-disable-file +module Cardano.Constitution.Validator.GoldenTests + ( tests + ) where + +import Cardano.Constitution.Config +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import Helpers.TestBuilders +import PlutusCore.Evaluation.Machine.ExBudget +import PlutusCore.Evaluation.Machine.ExBudgetingDefaults +import PlutusCore.Pretty (prettyPlcReadableDef) +import PlutusLedgerApi.V3 as V3 +import PlutusLedgerApi.V3.ArbitraryContexts as V3 +import PlutusTx.Code as Tx +import UntypedPlutusCore as UPLC +import UntypedPlutusCore.Evaluation.Machine.Cek as UPLC + +import Data.ByteString.Short qualified as SBS +import Data.Map.Strict qualified as M +import Data.Maybe +import Data.String +import System.FilePath +import Test.Tasty +import Test.Tasty.Golden + +import Helpers.Guardrail + +-- The golden files may change, so use `--accept` in cabal `--test-options` to accept the changes **after reviewing them**. + +test_cbor, test_budget_small, test_budget_large, test_readable_pir, test_readable_uplc :: TestTree + +test_cbor = testGroup "Cbor" $ M.elems $ + (\vName (_, vCode) -> + -- The unit of measurement is in bytes + goldenVsString vName (mkPath vName ["cbor","size"]) $ + pure $ fromString $ show $ SBS.length $ V3.serialiseCompiledCode vCode + ) `M.mapWithKey` defaultValidatorsWithCodes + +test_budget_large = testGroup "BudgetLarge" $ M.elems $ + (\vName (_, vCode) -> + -- The unit of measurement is in execution steps. + -- See maxTxExSteps, maxTxExMem for limits for chain limits: + goldenVsString vName (mkPath vName ["large","budget"]) $ + pure $ fromString $ show $ runForBudget vCode $ V3.mkFakeParameterChangeContext getFakeLargeParamsChange -- mkLargeFakeProposal defaultConstitutionConfig + )`M.mapWithKey` defaultValidatorsWithCodes + +test_budget_small = testGroup "BudgetSmall" $ M.elems $ + (\vName (_, vCode) -> + -- The unit of measurement is in execution steps. + -- See maxTxExSteps, maxTxExMem for limits for chain limits: + goldenVsString vName (mkPath vName ["small","budget"]) $ + pure $ fromString $ show $ runForBudget vCode $ V3.mkSmallFakeProposal defaultConstitutionConfig + )`M.mapWithKey` defaultValidatorsWithCodes + +test_readable_pir = testGroup "ReadablePir" $ M.elems $ + (\vName (_, vCode) -> + goldenVsString vName (mkPath vName ["pir"]) $ + pure $ fromString $ show $ prettyPlcReadableDef $ fromJust $ getPirNoAnn vCode + )`M.mapWithKey` defaultValidatorsWithCodes + +test_readable_uplc = testGroup "ReadableUplc" $ M.elems $ + (\vName (_, vCode) -> + goldenVsString vName (mkPath vName ["uplc"]) $ + pure $ fromString $ show $ prettyPlcReadableDef $ getPlcNoAnn vCode + )`M.mapWithKey` defaultValidatorsWithCodes + +tests :: TestTreeWithTestState +tests = testGroup' "Golden" $ fmap const + [ test_cbor + , test_budget_large + , test_budget_small + , test_readable_pir + , test_readable_uplc + ] + +-- HELPERS + +mkPath :: String -> [String] -> FilePath +mkPath vName exts = foldl1 () ["test","Cardano","Constitution","Validator","GoldenTests", foldl (<.>) vName (exts++["golden"])] + +runForBudget :: (ToData ctx) + => CompiledCode ConstitutionValidator + -> ctx + -> ExBudget +runForBudget v ctx = + let vPs = UPLC._progTerm $ getPlcNoAnn $ v + `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + in case UPLC.runCekDeBruijn defaultCekParametersForTesting counting noEmitter vPs of + -- Here, we guard against the case that a ConstitutionValidator **FAILS EARLY** (for some reason), + -- resulting in misleading low budget costs. + (Left _, _, _) -> error "For safety, we only compare budget of succesful executions." + (Right _ , UPLC.CountingSt budget, _) -> budget diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden new file mode 100644 index 00000000000..04d25ec2b29 --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -0,0 +1 @@ +2095 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden new file mode 100644 index 00000000000..bb776b76e20 --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -0,0 +1 @@ +ExBudget {exBudgetCPU = ExCPU 584116400, exBudgetMemory = ExMemory 2883157} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden new file mode 100644 index 00000000000..da02a35d1e0 --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -0,0 +1,5355 @@ +(program + 1.1.0 + (let + data Ordering | Ordering_match where + EQ : Ordering + GT : Ordering + LT : Ordering + data Bool | Bool_match where + True : Bool + False : Bool + data (Ord :: * -> *) a | Ord_match where + CConsOrd : + (\a -> a -> a -> Bool) a -> + (a -> a -> Ordering) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> a) -> + (a -> a -> a) -> + Ord a + data PredKey | PredKey_match where + MaxValue : PredKey + MinValue : PredKey + NotEqual : PredKey + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + !validatePreds : + all a. Ord a -> (\v -> List (Tuple2 PredKey (List v))) a -> a -> Bool + = /\a -> + \(`$dOrd` : Ord a) + (ds : (\v -> List (Tuple2 PredKey (List v))) a) + (ds : a) -> + letrec + !go : List (Tuple2 PredKey (List a)) -> Bool + = \(ds : List (Tuple2 PredKey (List a))) -> + List_match + {Tuple2 PredKey (List a)} + ds + {all dead. Bool} + (/\dead -> True) + (\(x : Tuple2 PredKey (List a)) + (xs : List (Tuple2 PredKey (List a))) -> + /\dead -> + Tuple2_match + {PredKey} + {List a} + x + {Bool} + (\(predKey : PredKey) + (expectedPredValues : List a) -> + let + !meaning : a -> a -> Bool + = PredKey_match + predKey + {all dead. a -> a -> Bool} + (/\dead -> + Ord_match + {a} + `$dOrd` + {a -> a -> Bool} + (\(v : (\a -> a -> a -> Bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v)) + (/\dead -> + Ord_match + {a} + `$dOrd` + {a -> a -> Bool} + (\(v : (\a -> a -> a -> Bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v)) + (/\dead -> + \(x : a) (y : a) -> + Bool_match + (Ord_match + {a} + `$dOrd` + {(\a -> a -> a -> Bool) a} + (\(v : + (\a -> a -> a -> Bool) + a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v) + x + y) + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. dead} + in + letrec + !go : List a -> Bool + = \(ds : List a) -> + List_match + {a} + ds + {all dead. Bool} + (/\dead -> go xs) + (\(x : a) (xs : List a) -> + /\dead -> + Bool_match + (meaning x ds) + {all dead. Bool} + (/\dead -> go xs) + (/\dead -> False) + {all dead. dead}) + {all dead. dead} + in + go expectedPredValues)) + {all dead. dead} + in + go ds + !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering + = \(eta : integer) (eta : integer) -> + ifThenElse + {all dead. Ordering} + (equalsInteger eta eta) + (/\dead -> EQ) + (/\dead -> + ifThenElse + {all dead. Ordering} + (lessThanEqualsInteger eta eta) + (/\dead -> LT) + (/\dead -> GT) + {all dead. dead}) + {all dead. dead} + data Rational | Rational_match where + Rational : integer -> integer -> Rational + !`$fOrdRational0_$c<=` : Rational -> Rational -> Bool + = \(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + True + False)) + in + letrec + !euclid : integer -> integer -> integer + = \(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (equalsInteger 0 y) + (/\dead -> x) + (/\dead -> euclid y (modInteger x y)) + {all dead. dead} + in + letrec + !unsafeRatio : integer -> integer -> Rational + = \(n : integer) (d : integer) -> + ifThenElse + {all dead. Rational} + (equalsInteger 0 d) + (/\dead -> error {Rational}) + (/\dead -> + ifThenElse + {all dead. Rational} + (lessThanInteger d 0) + (/\dead -> + unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) + (/\dead -> + let + !gcd' : integer = euclid n d + in + Rational (quotientInteger n gcd') (quotientInteger d gcd')) + {all dead. dead}) + {all dead. dead} + in + let + data Unit | Unit_match where + Unit : Unit + in + letrec + data ParamValue | ParamValue_match where + ParamAny : ParamValue + ParamInteger : + (\v -> List (Tuple2 PredKey (List v))) integer -> ParamValue + ParamList : List ParamValue -> ParamValue + ParamRational : + (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue + in + letrec + !validateParamValue : ParamValue -> data -> Bool + = \(eta : ParamValue) (eta : data) -> + let + ~bl : list data = unListData eta + ~bl' : list data = tailList {data} bl + in + ParamValue_match + eta + {all dead. Bool} + (/\dead -> True) + (\(preds : (\v -> List (Tuple2 PredKey (List v))) integer) -> + /\dead -> + validatePreds + {integer} + (CConsOrd + {integer} + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (equalsInteger x y) True False) + `$fOrdInteger_$ccompare` + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (lessThanInteger x y) True False) + (\(x : integer) (y : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) + (\(x : integer) (y : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + False + True) + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (lessThanInteger x y) False True) + (\(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (lessThanEqualsInteger x y) + (/\dead -> y) + (/\dead -> x) + {all dead. dead}) + (\(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (lessThanEqualsInteger x y) + (/\dead -> x) + (/\dead -> y) + {all dead. dead})) + preds + (unIData eta)) + (\(paramValues : List ParamValue) -> + /\dead -> validateParamValues paramValues (unListData eta)) + (\(preds : (\v -> List (Tuple2 PredKey (List v))) Rational) -> + /\dead -> + validatePreds + {Rational} + (CConsOrd + {Rational} + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {all dead. Bool} + (equalsInteger n n') + (/\dead -> + ifThenElse + {Bool} + (equalsInteger d d') + True + False) + (/\dead -> False) + {all dead. dead}))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Ordering} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Ordering} + (\(n' : integer) (d' : integer) -> + `$fOrdInteger_$ccompare` + (multiplyInteger n d') + (multiplyInteger n' d)))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + True + False))) + `$fOrdRational0_$c<=` + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + False + True))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + False + True))) + (\(x : Rational) (y : Rational) -> + Bool_match + (`$fOrdRational0_$c<=` x y) + {all dead. Rational} + (/\dead -> y) + (/\dead -> x) + {all dead. dead}) + (\(x : Rational) (y : Rational) -> + Bool_match + (`$fOrdRational0_$c<=` x y) + {all dead. Rational} + (/\dead -> x) + (/\dead -> y) + {all dead. dead})) + preds + (ifThenElse + {Unit -> Rational} + (nullList {data} (tailList {data} bl')) + (\(ds : Unit) -> + unsafeRatio + (unIData (headList {data} bl)) + (unIData (headList {data} bl'))) + (\(ds : Unit) -> error {Rational}) + Unit)) + {all dead. dead} + !validateParamValues : List ParamValue -> list data -> Bool + = \(ds : List ParamValue) -> + List_match + {ParamValue} + ds + {list data -> Bool} + (\(eta : list data) -> + ifThenElse {Bool} (nullList {data} eta) True False) + (\(paramValueHd : ParamValue) + (paramValueTl : List ParamValue) + (actualValueData : list data) -> + Bool_match + (validateParamValue + paramValueHd + (headList {data} actualValueData)) + {all dead. Bool} + (/\dead -> + validateParamValues + paramValueTl + (tailList {data} actualValueData)) + (/\dead -> False) + {all dead. dead}) + in + letrec + !runRules : + List (Tuple2 integer ParamValue) -> List (Tuple2 data data) -> Bool + = \(ds : List (Tuple2 integer ParamValue)) + (cparams : List (Tuple2 data data)) -> + let + !fail : unit -> Bool + = \(ds : unit) -> + (let + a = Tuple2 data data + in + \(ds : List a) -> + List_match + {a} + ds + {all dead. Bool} + (/\dead -> True) + (\(ipv : a) (ipv : List a) -> /\dead -> False) + {all dead. dead}) + cparams + in + List_match + {Tuple2 integer ParamValue} + ds + {all dead. Bool} + (/\dead -> fail ()) + (\(ds : Tuple2 integer ParamValue) + (cfgRest : List (Tuple2 integer ParamValue)) -> + /\dead -> + Tuple2_match + {integer} + {ParamValue} + ds + {Bool} + (\(expectedPid : integer) (paramValue : ParamValue) -> + List_match + {Tuple2 data data} + cparams + {all dead. Bool} + (/\dead -> fail ()) + (\(ds : Tuple2 data data) + (cparamsRest : List (Tuple2 data data)) -> + /\dead -> + Tuple2_match + {data} + {data} + ds + {Bool} + (\(ds : data) (actualValueData : data) -> + Ordering_match + (`$fOrdInteger_$ccompare` + (unIData ds) + expectedPid) + {all dead. Bool} + (/\dead -> + Bool_match + (validateParamValue + paramValue + actualValueData) + {all dead. Bool} + (/\dead -> + runRules cfgRest cparamsRest) + (/\dead -> False) + {all dead. dead}) + (/\dead -> runRules cfgRest cparams) + (/\dead -> False) + {all dead. dead})) + {all dead. dead})) + {all dead. dead} + in + let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + in + letrec + !go : list (pair data data) -> List (Tuple2 data data) + = \(l : list (pair data data)) -> + chooseList + {pair data data} + {unit -> List (Tuple2 data data)} + l + (\(ds : unit) -> Nil {Tuple2 data data}) + (\(ds : unit) -> + Cons + {Tuple2 data data} + (let + !p : pair data data = headList {pair data data} l + in + Tuple2 + {data} + {data} + (fstPair {data} {data} p) + (sndPair {data} {data} p)) + (go (tailList {pair data data} l))) + () + in + let + !fun : List (Tuple2 data data) -> Bool + = runRules + ((let + a = Tuple2 integer ParamValue + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : Tuple2 integer ParamValue -> a -> a) (n : a) -> + c + (Tuple2 + {integer} + {ParamValue} + 0 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : Tuple2 PredKey (List integer) -> a -> a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) (n : a) -> + c 30 (c 0 n)) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 1000 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 1 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> a -> a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 100000 (c 0 n)) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 10000000 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 2 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 24576 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 122880 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 3 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 32768 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 4 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : + all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : + integer -> a -> a) + (n : a) -> + c 5000 n) + (\(ds : integer) + (ds : + List integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 5 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : + all b. + (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : + integer -> a -> a) + (n : a) -> + c 1000000 (c 0 n)) + (\(ds : integer) + (ds : + List integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 5000000 n) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 6 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List integer) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c + 250000000 + (c 0 n)) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 500000000 n) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 7 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List integer) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (Tuple2 + {integer} + {ParamValue} + 8 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List integer) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c + 250 + (c 0 n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 2000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 9 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List Rational) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 10) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 10 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1000) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 200) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 11 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 10) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 3 + 10) + (c + (unsafeRatio + 1 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 16 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 500000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 17 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 3000 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 6500 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 18 + ParamAny) + (c + (Tuple2 + {integer} + {ParamValue} + 19 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 25) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 5) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 20000) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 5000) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 20 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 40000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 15000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 21 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 120000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 40000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 22 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 12288 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 23 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 100 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 200 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 24 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (Tuple2 + {integer} + {ParamValue} + 25 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 4 + 5) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n))))) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 26 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 4 + 5) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n)))))))))) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 27 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 3 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 10 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 28 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 18 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 293 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 29 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 15 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 30 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 1000000 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 10000000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 31 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 1000000 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 100000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 32 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 13 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 37 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 33 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + n))))))))))))))))))))))))))))))) + in + \(ds : data) -> + Maybe_match + {List (Tuple2 data data)} + (let + !ds : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData + (let + !ds : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData ds)))) + ~si : pair integer (list data) = unConstrData ds + in + ifThenElse + {all dead. data} + (equalsInteger + 5 + (fstPair {integer} {list data} si)) + (/\dead -> + headList + {data} + (tailList + {data} + (sndPair {integer} {list data} si))) + (/\dead -> error {data}) + {all dead. dead}))))) + ~ds : pair integer (list data) = unConstrData ds + !x : integer = fstPair {integer} {list data} ds + in + ifThenElse + {all dead. Maybe (List (Tuple2 data data))} + (equalsInteger 0 x) + (/\dead -> + Just + {List (Tuple2 data data)} + (go + (unMapData + (headList + {data} + (tailList {data} (sndPair {integer} {list data} ds)))))) + (/\dead -> + ifThenElse + {all dead. Maybe (List (Tuple2 data data))} + (equalsInteger 2 x) + (/\dead -> Nothing {List (Tuple2 data data)}) + (/\dead -> error {Maybe (List (Tuple2 data data))}) + {all dead. dead}) + {all dead. dead}) + {all dead. unit} + (\(cparams : List (Tuple2 data data)) -> + /\dead -> + Bool_match + (fun cparams) + {all dead. unit} + (/\dead -> ()) + (/\dead -> error {unit}) + {all dead. dead}) + (/\dead -> ()) + {all dead. dead})) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden new file mode 100644 index 00000000000..50843f1da2f --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -0,0 +1 @@ +ExBudget {exBudgetCPU = ExCPU 85774882, exBudgetMemory = ExMemory 383294} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden new file mode 100644 index 00000000000..d46034c2c0f --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -0,0 +1,1346 @@ +(program + 1.1.0 + ((\fix1 -> + (\`$fOrdRational0_$c<=` -> + (\`$fOrdInteger_$ccompare` -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\runRules -> + (\go -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force + (force + ifThenElse + (equalsInteger + 0 + x) + (delay + (constr 0 + [ (go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (constr 1 + [ ])) + (delay + error)))))) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ((\cse -> + force + (force + ifThenElse + (equalsInteger + 5 + (force + (force + fstPair) + cse)) + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) + (delay + error))) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 100) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (constr 1 + [ (cse + 1) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 5)) + (cse + 10)) + (cse 4)) + (cse 2)) + (cse 10)) + (cse 1)) + (constr 1 + [ 0 + , (constr 0 + []) ])) + (unsafeRatio 51)) + (unsafeRatio 13)) + (unsafeRatio 9)) + (unsafeRatio 4)) + (unsafeRatio 1)) + (unsafeRatio 0)) + (unsafeRatio 3)) + (fix1 + (\go l -> + force (force chooseList) + l + (\ds -> constr 0 []) + (\ds -> + constr 1 + [ ((\p -> + constr 0 + [ (force + (force fstPair) + p) + , (force + (force sndPair) + p) ]) + (force headList l)) + , (go (force tailList l)) ]) + ()))) + (fix1 + (\runRules ds cparams -> + force + ((\fail -> + case + ds + [ (delay (fail ())) + , (\ds cfgRest -> + delay + (case + ds + [ (\expectedPid + paramValue -> + force + (case + cparams + [ (delay + (fail + ())) + , (\ds + cparamsRest -> + delay + (case + ds + [ (\ds + actualValueData -> + force + (case + (`$fOrdInteger_$ccompare` + (unIData + ds) + expectedPid) + [ (delay + (force + (case + (validateParamValue + paramValue + actualValueData) + [ (delay + (runRules + cfgRest + cparamsRest)) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (runRules + cfgRest + cparams)) + , (delay + (constr 1 + [ ])) ])) ])) ])) ])) ]) + (\ds -> + force + (case + cparams + [ (delay (constr 0 [])) + , (\ipv ipv -> + delay + (constr 1 + [])) ])))))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose + validateParamValue + validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + force ifThenElse + (equalsInteger + x + y) + (constr 0 []) + (constr 1 [])) + , `$fOrdInteger_$ccompare` + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force + (force + ifThenElse + (lessThanEqualsInteger + x + y) + (delay y) + (delay x))) + , (\x y -> + force + (force + ifThenElse + (lessThanEqualsInteger + x + y) + (delay x) + (delay + y))) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + ((\cse -> + validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (force + ifThenElse + (equalsInteger + n + n') + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + x) + , (delay + y) ])) ]) + preds + ((\cse -> + force ifThenElse + (force nullList + (force + tailList + cse)) + (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse)))) + (force tailList + cse) + (\ds -> error) + (constr 0 []))) + (unListData eta))) ])) + (\ds -> + case + ds + [ (\eta -> + force ifThenElse + (force nullList eta) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 + [])) ])) ])))))) + (fix1 + (\unsafeRatio n d -> + force + (force ifThenElse + (equalsInteger 0 d) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + (unsafeRatio + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) + (fix1 + (\euclid x y -> + force + (force ifThenElse + (equalsInteger 0 y) + (delay x) + (delay (euclid y (modInteger x y))))))) + (\`$dOrd` ds ds -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (go xs)) + , (\x xs -> + delay + (force + (case + (meaning + x + ds) + [ (delay + (go + xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ])) + , (delay + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ])) + , (delay + (\x y -> + force + (case + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) + (\eta eta -> + force + (force ifThenElse + (equalsInteger eta eta) + (delay (constr 0 [])) + (delay + (force + (force ifThenElse + (lessThanEqualsInteger eta eta) + (delay (constr 2 [])) + (delay (constr 1 [])))))))) + (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' d' -> + force ifThenElse + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + (constr 0 []) + (constr 1 [])) ]) ])) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden new file mode 100644 index 00000000000..2e407b3cc5f --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -0,0 +1 @@ +2087 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden new file mode 100644 index 00000000000..9c5e8ce880a --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -0,0 +1 @@ +ExBudget {exBudgetCPU = ExCPU 884410570, exBudgetMemory = ExMemory 4411827} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden new file mode 100644 index 00000000000..048ec91fe8f --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -0,0 +1,5279 @@ +(program + 1.1.0 + (let + data Ordering | Ordering_match where + EQ : Ordering + GT : Ordering + LT : Ordering + data Bool | Bool_match where + True : Bool + False : Bool + data (Ord :: * -> *) a | Ord_match where + CConsOrd : + (\a -> a -> a -> Bool) a -> + (a -> a -> Ordering) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> a) -> + (a -> a -> a) -> + Ord a + data PredKey | PredKey_match where + MaxValue : PredKey + MinValue : PredKey + NotEqual : PredKey + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + !validatePreds : + all a. Ord a -> (\v -> List (Tuple2 PredKey (List v))) a -> a -> Bool + = /\a -> + \(`$dOrd` : Ord a) + (ds : (\v -> List (Tuple2 PredKey (List v))) a) + (ds : a) -> + letrec + !go : List (Tuple2 PredKey (List a)) -> Bool + = \(ds : List (Tuple2 PredKey (List a))) -> + List_match + {Tuple2 PredKey (List a)} + ds + {all dead. Bool} + (/\dead -> True) + (\(x : Tuple2 PredKey (List a)) + (xs : List (Tuple2 PredKey (List a))) -> + /\dead -> + Tuple2_match + {PredKey} + {List a} + x + {Bool} + (\(predKey : PredKey) + (expectedPredValues : List a) -> + let + !meaning : a -> a -> Bool + = PredKey_match + predKey + {all dead. a -> a -> Bool} + (/\dead -> + Ord_match + {a} + `$dOrd` + {a -> a -> Bool} + (\(v : (\a -> a -> a -> Bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v)) + (/\dead -> + Ord_match + {a} + `$dOrd` + {a -> a -> Bool} + (\(v : (\a -> a -> a -> Bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v)) + (/\dead -> + \(x : a) (y : a) -> + Bool_match + (Ord_match + {a} + `$dOrd` + {(\a -> a -> a -> Bool) a} + (\(v : + (\a -> a -> a -> Bool) + a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v) + x + y) + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. dead} + in + letrec + !go : List a -> Bool + = \(ds : List a) -> + List_match + {a} + ds + {all dead. Bool} + (/\dead -> go xs) + (\(x : a) (xs : List a) -> + /\dead -> + Bool_match + (meaning x ds) + {all dead. Bool} + (/\dead -> go xs) + (/\dead -> False) + {all dead. dead}) + {all dead. dead} + in + go expectedPredValues)) + {all dead. dead} + in + go ds + !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering + = \(eta : integer) (eta : integer) -> + ifThenElse + {all dead. Ordering} + (equalsInteger eta eta) + (/\dead -> EQ) + (/\dead -> + ifThenElse + {all dead. Ordering} + (lessThanEqualsInteger eta eta) + (/\dead -> LT) + (/\dead -> GT) + {all dead. dead}) + {all dead. dead} + data Rational | Rational_match where + Rational : integer -> integer -> Rational + !`$fOrdRational0_$c<=` : Rational -> Rational -> Bool + = \(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + True + False)) + in + letrec + !euclid : integer -> integer -> integer + = \(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (equalsInteger 0 y) + (/\dead -> x) + (/\dead -> euclid y (modInteger x y)) + {all dead. dead} + in + letrec + !unsafeRatio : integer -> integer -> Rational + = \(n : integer) (d : integer) -> + ifThenElse + {all dead. Rational} + (equalsInteger 0 d) + (/\dead -> error {Rational}) + (/\dead -> + ifThenElse + {all dead. Rational} + (lessThanInteger d 0) + (/\dead -> + unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) + (/\dead -> + let + !gcd' : integer = euclid n d + in + Rational (quotientInteger n gcd') (quotientInteger d gcd')) + {all dead. dead}) + {all dead. dead} + in + let + data Unit | Unit_match where + Unit : Unit + in + letrec + data ParamValue | ParamValue_match where + ParamAny : ParamValue + ParamInteger : + (\v -> List (Tuple2 PredKey (List v))) integer -> ParamValue + ParamList : List ParamValue -> ParamValue + ParamRational : + (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue + in + letrec + !validateParamValue : ParamValue -> data -> Bool + = \(eta : ParamValue) (eta : data) -> + let + ~bl : list data = unListData eta + ~bl' : list data = tailList {data} bl + in + ParamValue_match + eta + {all dead. Bool} + (/\dead -> True) + (\(preds : (\v -> List (Tuple2 PredKey (List v))) integer) -> + /\dead -> + validatePreds + {integer} + (CConsOrd + {integer} + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (equalsInteger x y) True False) + `$fOrdInteger_$ccompare` + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (lessThanInteger x y) True False) + (\(x : integer) (y : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + True + False) + (\(x : integer) (y : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger x y) + False + True) + (\(x : integer) (y : integer) -> + ifThenElse {Bool} (lessThanInteger x y) False True) + (\(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (lessThanEqualsInteger x y) + (/\dead -> y) + (/\dead -> x) + {all dead. dead}) + (\(x : integer) (y : integer) -> + ifThenElse + {all dead. integer} + (lessThanEqualsInteger x y) + (/\dead -> x) + (/\dead -> y) + {all dead. dead})) + preds + (unIData eta)) + (\(paramValues : List ParamValue) -> + /\dead -> validateParamValues paramValues (unListData eta)) + (\(preds : (\v -> List (Tuple2 PredKey (List v))) Rational) -> + /\dead -> + validatePreds + {Rational} + (CConsOrd + {Rational} + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {all dead. Bool} + (equalsInteger n n') + (/\dead -> + ifThenElse + {Bool} + (equalsInteger d d') + True + False) + (/\dead -> False) + {all dead. dead}))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Ordering} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Ordering} + (\(n' : integer) (d' : integer) -> + `$fOrdInteger_$ccompare` + (multiplyInteger n d') + (multiplyInteger n' d)))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + True + False))) + `$fOrdRational0_$c<=` + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + False + True))) + (\(ds : Rational) (ds : Rational) -> + Rational_match + ds + {Bool} + (\(n : integer) (d : integer) -> + Rational_match + ds + {Bool} + (\(n' : integer) (d' : integer) -> + ifThenElse + {Bool} + (lessThanInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + False + True))) + (\(x : Rational) (y : Rational) -> + Bool_match + (`$fOrdRational0_$c<=` x y) + {all dead. Rational} + (/\dead -> y) + (/\dead -> x) + {all dead. dead}) + (\(x : Rational) (y : Rational) -> + Bool_match + (`$fOrdRational0_$c<=` x y) + {all dead. Rational} + (/\dead -> x) + (/\dead -> y) + {all dead. dead})) + preds + (ifThenElse + {Unit -> Rational} + (nullList {data} (tailList {data} bl')) + (\(ds : Unit) -> + unsafeRatio + (unIData (headList {data} bl)) + (unIData (headList {data} bl'))) + (\(ds : Unit) -> error {Rational}) + Unit)) + {all dead. dead} + !validateParamValues : List ParamValue -> list data -> Bool + = \(ds : List ParamValue) -> + List_match + {ParamValue} + ds + {list data -> Bool} + (\(eta : list data) -> + ifThenElse {Bool} (nullList {data} eta) True False) + (\(paramValueHd : ParamValue) + (paramValueTl : List ParamValue) + (actualValueData : list data) -> + Bool_match + (validateParamValue + paramValueHd + (headList {data} actualValueData)) + {all dead. Bool} + (/\dead -> + validateParamValues + paramValueTl + (tailList {data} actualValueData)) + (/\dead -> False) + {all dead. dead}) + in + let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + in + letrec + !go : list (pair data data) -> List (Tuple2 data data) + = \(l : list (pair data data)) -> + chooseList + {pair data data} + {unit -> List (Tuple2 data data)} + l + (\(ds : unit) -> Nil {Tuple2 data data}) + (\(ds : unit) -> + Cons + {Tuple2 data data} + (let + !p : pair data data = headList {pair data data} l + in + Tuple2 + {data} + {data} + (fstPair {data} {data} p) + (sndPair {data} {data} p)) + (go (tailList {pair data data} l))) + () + in + let + !cfg : List (Tuple2 integer ParamValue) + = (let + a = Tuple2 integer ParamValue + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) + (/\a -> + \(c : Tuple2 integer ParamValue -> a -> a) (n : a) -> + c + (Tuple2 + {integer} + {ParamValue} + 0 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : Tuple2 PredKey (List integer) -> a -> a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) (n : a) -> + c 30 (c 0 n)) + (\(ds : integer) (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) (n : a) -> + c 1000 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 1 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : Tuple2 PredKey (List integer) -> a -> a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) (n : a) -> + c 100000 (c 0 n)) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 10000000 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 2 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> a -> a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 24576 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 122880 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 3 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 32768 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 4 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 PredKey (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 5000 n) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 5 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : + all b. (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : integer -> a -> a) + (n : a) -> + c 1000000 (c 0 n)) + (\(ds : integer) + (ds : List integer) -> + Cons {integer} ds ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : + integer -> a -> a) + (n : a) -> + c 5000000 n) + (\(ds : integer) + (ds : + List integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 6 + (ParamInteger + ((let + a = Tuple2 PredKey (List integer) + in + \(g : + all b. + (a -> b -> b) -> b -> b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : + integer -> a -> a) + (n : a) -> + c 250000000 (c 0 n)) + (\(ds : integer) + (ds : + List integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a = List integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 500000000 n) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 7 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List integer) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a = List integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 0 n) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil {integer}))) + n)))) + (c + (Tuple2 + {integer} + {ParamValue} + 8 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List integer) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 250 (c 0 n)) + (\(ds : integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : a) -> + c 2000 n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c 0 n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 9 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List Rational) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : a) -> + c + (unsafeRatio + 1 + 10) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 10 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List Rational) + in + \(g : + all b. + (a -> b -> b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : List a) -> + Cons {a} ds ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1000) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 200) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 11 + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 10) + (c + (unsafeRatio + 0 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 3 + 10) + (c + (unsafeRatio + 1 + 1) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 16 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 500000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 17 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List a} + (\(ds : a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 3000 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 6500 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 18 + ParamAny) + (c + (Tuple2 + {integer} + {ParamValue} + 19 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 25) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 5) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 20000) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 5000) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 20 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 40000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 15000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 21 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 120000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 40000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + n)) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 22 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 12288 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 23 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 100 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 200 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 24 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))) + (c + (Tuple2 + {integer} + {ParamValue} + 25 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 4 + 5) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n))))) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 26 + (ParamList + ((let + a + = List + ParamValue + in + \(c : + ParamValue -> + a -> + a) + (n : + a) -> + c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 13 + 20) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 4 + 5) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 51 + 100) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + (c + (unsafeRatio + 3 + 4) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + (c + (unsafeRatio + 9 + 10) + n)) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + (c + (ParamRational + ((let + a + = Tuple2 + PredKey + (List + Rational) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + Rational) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + Rational} + MinValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 2) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + (c + (Tuple2 + {PredKey} + {List + Rational} + MaxValue + ((let + a + = List + Rational + in + \(c : + Rational -> + a -> + a) + (n : + a) -> + c + (unsafeRatio + 1 + 1) + n) + (\(ds : + Rational) + (ds : + List + Rational) -> + Cons + {Rational} + ds + ds) + (Nil + {Rational}))) + n)))) + n)))))))))) + (\(ds : + ParamValue) + (ds : + List + ParamValue) -> + Cons + {ParamValue} + ds + ds) + (Nil + {ParamValue})))) + (c + (Tuple2 + {integer} + {ParamValue} + 27 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 3 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 10 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 28 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 18 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 293 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + NotEqual + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n)))))) + (c + (Tuple2 + {integer} + {ParamValue} + 29 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 15 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 30 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 1000000 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 10000000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 31 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + (c + 1000000 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 100000000000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 32 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 13 + (c + 0 + n)) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 37 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + (c + (Tuple2 + {integer} + {ParamValue} + 33 + (ParamInteger + ((let + a + = Tuple2 + PredKey + (List + integer) + in + \(g : + all b. + (a -> + b -> + b) -> + b -> + b) -> + g + {List + a} + (\(ds : + a) + (ds : + List + a) -> + Cons + {a} + ds + ds) + (Nil + {a})) + (/\a -> + \(c : + Tuple2 + PredKey + (List + integer) -> + a -> + a) + (n : + a) -> + c + (Tuple2 + {PredKey} + {List + integer} + MinValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 0 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + (c + (Tuple2 + {PredKey} + {List + integer} + MaxValue + ((let + a + = List + integer + in + \(c : + integer -> + a -> + a) + (n : + a) -> + c + 1000 + n) + (\(ds : + integer) + (ds : + List + integer) -> + Cons + {integer} + ds + ds) + (Nil + {integer}))) + n))))) + n)))))))))))))))))))))))))))))) + !fun : List (Tuple2 data data) -> Bool + = (let + a = Tuple2 data data + in + \(f : a -> Bool) -> + letrec + !go : List a -> Bool + = \(ds : List a) -> + List_match + {a} + ds + {all dead. Bool} + (/\dead -> True) + (\(x : a) (xs : List a) -> + /\dead -> + Bool_match + (f x) + {all dead. Bool} + (/\dead -> go xs) + (/\dead -> False) + {all dead. dead}) + {all dead. dead} + in + \(eta : List a) -> go eta) + (\(ds : Tuple2 data data) -> + Tuple2_match + {data} + {data} + ds + {Bool} + (\(ds : data) (actualValueData : data) -> + validateParamValue + (let + !k : integer = unIData ds + in + letrec + !go : List (Tuple2 integer ParamValue) -> ParamValue + = \(ds : List (Tuple2 integer ParamValue)) -> + List_match + {Tuple2 integer ParamValue} + ds + {all dead. ParamValue} + (/\dead -> error {ParamValue}) + (\(ds : Tuple2 integer ParamValue) + (xs' : List (Tuple2 integer ParamValue)) -> + /\dead -> + Tuple2_match + {integer} + {ParamValue} + ds + {ParamValue} + (\(k' : integer) (i : ParamValue) -> + ifThenElse + {all dead. ParamValue} + (equalsInteger k k') + (/\dead -> i) + (/\dead -> go xs') + {all dead. dead})) + {all dead. dead} + in + go cfg) + actualValueData)) + in + \(ds : data) -> + Maybe_match + {List (Tuple2 data data)} + (let + !ds : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData + (let + !ds : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData ds)))) + ~si : pair integer (list data) = unConstrData ds + in + ifThenElse + {all dead. data} + (equalsInteger + 5 + (fstPair {integer} {list data} si)) + (/\dead -> + headList + {data} + (tailList + {data} + (sndPair {integer} {list data} si))) + (/\dead -> error {data}) + {all dead. dead}))))) + ~ds : pair integer (list data) = unConstrData ds + !x : integer = fstPair {integer} {list data} ds + in + ifThenElse + {all dead. Maybe (List (Tuple2 data data))} + (equalsInteger 0 x) + (/\dead -> + Just + {List (Tuple2 data data)} + (go + (unMapData + (headList + {data} + (tailList {data} (sndPair {integer} {list data} ds)))))) + (/\dead -> + ifThenElse + {all dead. Maybe (List (Tuple2 data data))} + (equalsInteger 2 x) + (/\dead -> Nothing {List (Tuple2 data data)}) + (/\dead -> error {Maybe (List (Tuple2 data data))}) + {all dead. dead}) + {all dead. dead}) + {all dead. unit} + (\(cparams : List (Tuple2 data data)) -> + /\dead -> + Bool_match + (fun cparams) + {all dead. unit} + (/\dead -> ()) + (/\dead -> error {unit}) + {all dead. dead}) + (/\dead -> ()) + {all dead. dead})) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden new file mode 100644 index 00000000000..3d4148fcf90 --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -0,0 +1 @@ +ExBudget {exBudgetCPU = ExCPU 83144992, exBudgetMemory = ExMemory 369392} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden new file mode 100644 index 00000000000..0f48237984a --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -0,0 +1,1340 @@ +(program + 1.1.0 + ((\fix1 -> + (\`$fOrdRational0_$c<=` -> + (\`$fOrdInteger_$ccompare` -> + (\validatePreds -> + (\euclid -> + (\unsafeRatio -> + (\cse -> + (\validateParamValue -> + (\validateParamValues -> + (\go -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force + (force + ifThenElse + (equalsInteger + 0 + x) + (delay + (constr 0 + [ (go + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse))))) ])) + (delay + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (constr 1 + [ ])) + (delay + error)))))) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ((\cse -> + force + (force + ifThenElse + (equalsInteger + 5 + (force + (force + fstPair) + cse)) + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + cse)))) + (delay + error))) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ds)))))))))))))) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case + (case + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + fix1 + (\go + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (force + ifThenElse + (equalsInteger + k + k') + (delay + i) + (delay + (go + xs')))) ])) ])) + cfg) + (unIData + ds)) + actualValueData) ]) + [ (delay + (go + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (cse + 1) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 100)) + (cse + 10)) + (cse 2)) + (cse 10)) + (cse 1)) + (cse 4)) + (unsafeRatio 9)) + (constr 1 + [0, (constr 0 [])])) + (unsafeRatio 13)) + (unsafeRatio 0)) + (unsafeRatio 1)) + (unsafeRatio 3)) + (unsafeRatio 4)) + (unsafeRatio 51)) + (fix1 + (\go l -> + force (force chooseList) + l + (\ds -> constr 0 []) + (\ds -> + constr 1 + [ ((\p -> + constr 0 + [ (force (force fstPair) + p) + , (force (force sndPair) + p) ]) + (force headList l)) + , (go (force tailList l)) ]) + ()))) + (cse (\arg_0 arg_1 -> arg_1))) + (cse (\arg_0 arg_1 -> arg_0))) + (force + ((\s -> s s) + (\s h -> + delay + (\fr -> + (\k -> + fr + (\x -> k (\f_0 f_1 -> f_0 x)) + (\x -> k (\f_0 f_1 -> f_1 x))) + (\fq -> force (s s h) (force h fq)))) + (delay + (\choose + validateParamValue + validateParamValues -> + choose + (\eta eta -> + force + (case + eta + [ (delay (constr 0 [])) + , (\preds -> + delay + (validatePreds + (constr 0 + [ (\x y -> + force ifThenElse + (equalsInteger + x + y) + (constr 0 []) + (constr 1 [])) + , `$fOrdInteger_$ccompare` + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + (constr 0 []) + (constr 1 [])) + , (\x y -> + force ifThenElse + (lessThanEqualsInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force ifThenElse + (lessThanInteger + x + y) + (constr 1 []) + (constr 0 [])) + , (\x y -> + force + (force + ifThenElse + (lessThanEqualsInteger + x + y) + (delay y) + (delay x))) + , (\x y -> + force + (force + ifThenElse + (lessThanEqualsInteger + x + y) + (delay x) + (delay + y))) ]) + preds + (unIData eta))) + , (\paramValues -> + delay + (validateParamValues + paramValues + (unListData eta))) + , (\preds -> + delay + ((\cse -> + validatePreds + (constr 0 + [ (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + (force + ifThenElse + (equalsInteger + n + n') + (delay + (force + ifThenElse + (equalsInteger + d + d') + (constr 0 + [ ]) + (constr 1 + [ ]))) + (delay + (constr 1 + [ ])))) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + `$fOrdInteger_$ccompare` + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=` + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' + d' -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n + d') + (multiplyInteger + n' + d)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + y) + , (delay + x) ])) + , (\x y -> + force + (case + (`$fOrdRational0_$c<=` + x + y) + [ (delay + x) + , (delay + y) ])) ]) + preds + ((\cse -> + force ifThenElse + (force nullList + (force + tailList + cse)) + (\ds -> + unsafeRatio + (unIData + (force + headList + cse)) + (unIData + (force + headList + cse)))) + (force tailList + cse) + (\ds -> error) + (constr 0 []))) + (unListData eta))) ])) + (\ds -> + case + ds + [ (\eta -> + force ifThenElse + (force nullList eta) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd + paramValueTl + actualValueData -> + force + (case + (validateParamValue + paramValueHd + (force headList + actualValueData)) + [ (delay + (validateParamValues + paramValueTl + (force tailList + actualValueData))) + , (delay + (constr 1 + [])) ])) ])))))) + (fix1 + (\unsafeRatio n d -> + force + (force ifThenElse + (equalsInteger 0 d) + (delay error) + (delay + (force + (force ifThenElse + (lessThanInteger d 0) + (delay + (unsafeRatio + (subtractInteger 0 n) + (subtractInteger 0 d))) + (delay + ((\gcd' -> + constr 0 + [ (quotientInteger n gcd') + , (quotientInteger d gcd') ]) + (euclid n d)))))))))) + (fix1 + (\euclid x y -> + force + (force ifThenElse + (equalsInteger 0 y) + (delay x) + (delay (euclid y (modInteger x y))))))) + (\`$dOrd` ds ds -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (case + x + [ (\predKey expectedPredValues -> + (\meaning -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (go xs)) + , (\x xs -> + delay + (force + (case + (meaning + x + ds) + [ (delay + (go + xs)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues) + (force + (case + predKey + [ (delay + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ])) + , (delay + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ])) + , (delay + (\x y -> + force + (case + (case + `$dOrd` + [ (\v + v + v + v + v + v + v + v -> + v) ] + x + y) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds)) + (\eta eta -> + force + (force ifThenElse + (equalsInteger eta eta) + (delay (constr 0 [])) + (delay + (force + (force ifThenElse + (lessThanEqualsInteger eta eta) + (delay (constr 2 [])) + (delay (constr 1 [])))))))) + (\ds ds -> + case + ds + [ (\n d -> + case + ds + [ (\n' d' -> + force ifThenElse + (lessThanEqualsInteger + (multiplyInteger n d') + (multiplyInteger n' d)) + (constr 0 []) + (constr 1 [])) ]) ])) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs new file mode 100644 index 00000000000..060b707426b --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs @@ -0,0 +1,70 @@ +-- editorconfig-checker-disable-file +{-# OPTIONS_GHC -Wno-orphans #-} +module Cardano.Constitution.Validator.PropTests + ( tests + ) where + +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import Data.Map.Strict qualified as M +import Helpers.TestBuilders +import PlutusLedgerApi.V3.ArbitraryContexts qualified as V3 +import PlutusTx as Tx +import PlutusTx.Builtins.Internal as BI (BuiltinUnit (..)) +import UntypedPlutusCore as UPLC + +import Test.Tasty.QuickCheck + + +-- | Tests that all `ConstitutionValidator` implementations return the same output +-- for the same random input **when run inside Haskell**. +prop_hsValidatorsAgreeAll :: V3.ArbitraryContext -> Property +prop_hsValidatorsAgreeAll = hsValidatorsAgree $ M.elems defaultValidators + +-- | Test (in Haskell) each validator in the list with the same random input, +-- and make sure that all of the validators return the same result. +hsValidatorsAgree :: [ConstitutionValidator] + -> (V3.ArbitraryContext -> Property) +hsValidatorsAgree vs ctx = go vs + where + go (v1:v2:vrest) = ioProperty ((===) + <$> tryApplyOnData v1 ctx + <*> tryApplyOnData v2 ctx + ) + .&&. if null vrest + then property True -- done + else go (v2:vrest) + go _ = property False -- needs at least two validators, otherwise the property fails + + +{- Given some random input, running each validator offline (in Haskell) and online (in Tx) yields the same result. +This is different from `prop_hsValidatorsAgree`: it evals each validator individually +with two different eval machines (Hs/Tx) and checks that the machines agree. +-} +prop_hsAgreesWithTxAll :: Property +prop_hsAgreesWithTxAll = conjoin $ hsAgreesWithTx <$> M.elems defaultValidatorsWithCodes + +hsAgreesWithTx :: (ConstitutionValidator, CompiledCode ConstitutionValidator) + -> (V3.ArbitraryContext -> Property) +hsAgreesWithTx (vHs, vCode) ctx = ioProperty $ do + resHs <- tryApplyOnData vHs ctx + let vPs = _progTerm $ getPlcNoAnn $ vCode + `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + resPs = runCekRes vPs + + pure $ case (resHs, resPs) of + (Left _, Left _) -> property True + (Right okHs, Right okPs) -> liftCode110Norm okHs === okPs + _ -> property False + +tests :: TestTreeWithTestState +tests = testGroup' "Property" $ fmap const + [ + testProperty "hsValidatorsAgreeAll" prop_hsValidatorsAgreeAll + , testProperty "hsAgreesWithTxAll" prop_hsAgreesWithTxAll + ] + +-- for testing purposes +instance Eq BI.BuiltinUnit where + -- not sure if needed to patternmatch everything here + BI.BuiltinUnit () == BI.BuiltinUnit () = True diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs b/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs new file mode 100644 index 00000000000..b8d3530d13a --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs @@ -0,0 +1,72 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE TypeOperators #-} +module Cardano.Constitution.Validator.TestsCommon + ( applyOnData + , tryApplyOnData + , allVldtrsErred + , allVldtrsPassed + , runCekRes + , unsafeRunCekRes + , liftCode110 + , liftCode110Norm + ) where + +import Cardano.Constitution.Validator.Common +import PlutusCore.Evaluation.Machine.ExBudgetingDefaults +import PlutusCore.Version (plcVersion110) +import PlutusPrelude +import PlutusTx as Tx +import PlutusTx.Builtins as B +import PlutusTx.Builtins.Internal as B +import UntypedPlutusCore as UPLC +import UntypedPlutusCore.Evaluation.Machine.Cek as UPLC + +import Control.Exception +import Test.Tasty.QuickCheck + +applyOnData :: (ToData ctx) + => ConstitutionValidator + -> ctx + -> BuiltinUnit +applyOnData v ctx = v (Tx.toBuiltinData ctx) + +-- | Here we try to catch the calls to `Tx.error`. +tryApplyOnData :: (ToData ctx) + => ConstitutionValidator + -> ctx + -> IO (Either ErrorCall BuiltinUnit) +-- TODO: I am not sure that this is enough to test both in Haskell and Tx side, since we may throw +-- other kinds of errors , e.g. `PatternMatchFail` in Haskell-side? +tryApplyOnData v ctx = try $ evaluate $ applyOnData v ctx + +allVldtrsErred, allVldtrsPassed + :: (ToData ctx) + => [ConstitutionValidator] + -> ctx + -> Property + +-- | All given validators have to err +allVldtrsErred vs ctx = conjoin $ + fmap (\v -> ioProperty (isLeft <$> tryApplyOnData v ctx)) vs + +{- | All given validators have to not err + +Doing (ioProperty . isRight . tryApplyEval) is probably redundant here, since QC will catch any exceptions +-} +allVldtrsPassed vs ctx = conjoin $ fmap (B.fromOpaque . (`applyOnData` ctx)) vs + +unsafeRunCekRes :: (t ~ Term NamedDeBruijn DefaultUni DefaultFun ()) + => t -> t +unsafeRunCekRes = unsafeFromRight . runCekRes + +runCekRes :: (t ~ Term NamedDeBruijn DefaultUni DefaultFun ()) + => t -> Either (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) t +runCekRes t = + (\(res,_,_) -> res) $ + UPLC.runCekDeBruijn defaultCekParametersForTesting restrictingEnormous noEmitter t + +liftCode110 :: Lift DefaultUni a => a -> CompiledCode a +liftCode110 = liftCode plcVersion110 + +liftCode110Norm :: Lift DefaultUni a => a -> Term NamedDeBruijn DefaultUni DefaultFun () +liftCode110Norm = unsafeRunCekRes . _progTerm . getPlcNoAnn . liftCode110 diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/UnitTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/UnitTests.hs new file mode 100644 index 00000000000..6a8e68dbf8f --- /dev/null +++ b/cardano-constitution/test/Cardano/Constitution/Validator/UnitTests.hs @@ -0,0 +1,216 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module Cardano.Constitution.Validator.UnitTests + ( unitTests + , singleParamTests + ) where + +import Cardano.Constitution.Config () +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import Data.Map.Strict as M +import Helpers.Guardrail qualified as Guards +import Helpers.TestBuilders +import PlutusLedgerApi.V3 as V3 +import PlutusLedgerApi.V3.ArbitraryContexts qualified as V3 +import PlutusTx.Builtins as Tx (lengthOfByteString, serialiseData) +import PlutusTx.IsData.Class +import PlutusTx.NonCanonicalRational +import PlutusTx.Ratio as Tx +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +-- What should be in Unit tests +-- Range tests +-- Limit tests +-- Guardrail tests + +-- We should reach +-- All guardrails tested +-- All limits tested +-- MC/DC coverage + +{- Note [Why de-duplicated ChangedParameters] +**ALL** The following ScriptContext examples *MUST* be de-duplicated Lists. +Otherwise, both the sorted and unsorted scripts will produce +"wrong" results (for different reasons). +See also Guarantee(2) in README.md +-} + +-- all these are actually unit tests (by using QuickCheck.once) + +-- Manually kept sorted&deduped to not give false expectations upon reading the example; +-- We rely on guarantee (2) and (3) in README.md + +test_pos :: TestTreeWithTestState +test_pos = const $ testGroup "Positive" $ + fmap (\(n, c) -> testProperty n $ allVldtrsPassed (M.elems defaultValidators) c) + [ ("pos1", V3.mkFakeParameterChangeContext @Integer + [ (0, 30) -- in limits + , (1, 10_000_000) -- in limits + , (17, 6_250) -- in limits + ]) + , ("pos2", V3.mkFakeParameterChangeContext + [ (10, NonCanonicalRational $ Tx.unsafeRatio 1 1000) -- in limits + ]) + , ("pos3", V3.mkFakeParameterChangeContext + [ (19, + [ NonCanonicalRational $ Tx.unsafeRatio 2_000 10_000 -- exmem in limits + , NonCanonicalRational $ Tx.unsafeRatio 500 10_000_000 -- exsteps in limits + ]) + ]) + -- NOTE: According to constitution-script specification, this is a NOT_SPECIFIED behavior, + -- meaning a valid const.script can decide to return success or fail either way. + -- In reality, the ledger prohibits empty proposals, thus the const.script will not even run. + -- Here, we only do "regression testing" of our validators, which happen to succeed + -- for this out-of-spec behavior. + , ("pos4", V3.mkFakeParameterChangeContext @Integer + [ -- empty params + ]) + ] ++ [ + testProperty "pos5" $ forAll V3.treasuryWithdrawalsCtxGen + $ allVldtrsPassed (M.elems defaultValidators) + ] + + + +test_neg :: TestTreeWithTestState +test_neg = const $ testGroup "Negative" $ + fmap (\(n, c) -> testProperty n $ allVldtrsErred (M.elems defaultValidators) c) + [ ("neg1", V3.mkFakeParameterChangeContext @Integer + [ (0, 29) -- **smaller than minbound** + , (1, 10_000_000) -- in limits + , (2, -10_000_000_000) -- unknown param + , (17, 6_250) -- in limits + ]) + , ("neg2", V3.mkFakeParameterChangeContext @Integer + [ (0, 29) -- **smaller than minbound** + , (1, 10_000_000) -- in limits + , (17, 6_251) -- ** larger than maxbound ** + ]) + , ("neg3", V3.mkFakeParameterChangeContext @Integer + [ (-1, -1_000) -- unknown param + ]) + , ("neg4", V3.mkFakeParameterChangeContext @Integer + [ (10, 1) -- type mismatch, 10 is supposed to be Rational + ]) + , ("neg5", V3.mkFakeParameterChangeContext + [ (0, NonCanonicalRational $ Tx.unsafeRatio 1 1) -- type mismatch, 0 is supposed to be integer + ]) + , ("neg6", V3.mkFakeParameterChangeContext + [ (10, NonCanonicalRational $ Tx.unsafeRatio 0 1000) -- out of limits + ]) + , ("neg7", V3.mkFakeParameterChangeContext + [ (19, + [ NonCanonicalRational $ Tx.unsafeRatio 2_000 10_000 -- exmem in limits + , NonCanonicalRational $ Tx.unsafeRatio 0 10_000_000 -- exsteps out of limits + ]) + ]) + , ("neg8", V3.mkFakeParameterChangeContext + [ (19, [ NonCanonicalRational $ Tx.unsafeRatio 2_000 10_000 -- exmem in limits + , NonCanonicalRational $ Tx.unsafeRatio 500 10_000_000 -- exsteps in limits + , NonCanonicalRational $ Tx.unsafeRatio 500 10_000_000 -- TOO MUCH SUBS in list SUPPLIED + ]) + ]) + , ("neg9", V3.mkFakeParameterChangeContext + [ (19, [ NonCanonicalRational $ Tx.unsafeRatio 2_000 10_000 -- exmem in limits + -- TOO FEW SUBS in list SUPPLIED + ]) + ]) + , ("neg10", V3.mkFakeParameterChangeContext @[Integer] + [ (19, [ + -- TOO FEW SUBS in list SUPPLIED + ]) + ]) + , ("neg11", V3.mkFakeParameterChangeContext + [ (19, + -- TOO DEEPLY NESTED + [ + [ NonCanonicalRational $ Tx.unsafeRatio 2_000 10_000 -- exmem in limits + , NonCanonicalRational $ Tx.unsafeRatio 500 10_000_000 -- exsteps in limits + ] + ] + ) + ]) + -- anything other than ParameterChange or TreasuryWithdrawals is `FAIL` + , ("neg12", V3.mkFakeContextFromGovAction V3.InfoAction) + ] + +test_unsorted1 :: TestTreeWithTestState +test_unsorted1 = const $ testProperty "unsorted1" $ + -- unsorted fails for the right reason, sorted fails for the wrong reason + allVldtrsErred (M.elems defaultValidators) ctx + where + ctx = V3.mkFakeParameterChangeContext @Integer + -- deliberately kept unsorted to demonstrate the different behaviour between + -- SORTED and UNSORTED flavour. See guarantee (3) in README.md + [ (0, 30) -- in limits + , (17, 6_250) -- in limits, **but breaks sorting** + -- out of limits **should make constitution script fail** + -- unsorted flavor fails, for the right reason (out of limits) + -- sorted flavor fails, for the wrong reason (it ran past the config, and fail to find actualPid) + , (1, 10_000_001) + ] + +test_unsorted2 :: TestTreeWithTestState +test_unsorted2 = const $ testProperty "unsorted2" $ + -- The unsorted flavour does not depend on guarantee 3, + -- so it can work with unsorted input map as well + allVldtrsPassed [defaultValidators M.! "unsorted"] ctx + -- The sorted flavour depends on guarantee 3, so it breaks with unsorted maps: + -- the constitution scripts should fail, but they don't + .&&. allVldtrsErred [defaultValidators M.! "sorted"] ctx + + where + ctx = V3.mkFakeParameterChangeContext @Integer + -- deliberately kept unsorted to demonstrate the different behaviour between + -- SORTED and UNSORTED flavour. See guarantee (3) in README.md + [ (0, 30) -- in limits + , (17, 6_250) -- in limits, **but breaks sorting** + -- in limits + -- unsorted flavor passes + -- sorted flavor fails (it ran past the config, and fail to find actualPid) + , (1, 10_000_000) + ] + +{- | A safety check to make sure that a `ScriptContext` containg a large proposal +will not reach the maxTxSize currently set by the chain. +In reality, proposals will not be that big. + +If this size becomes so big that it is an issue, there is the option (*in certain cases only!*), +to split up such large proposal to smaller parts and submit them to the chain separately. +-} +test_LargeProposalSize :: TestTreeWithTestState +test_LargeProposalSize = const $ testCaseInfo "largeProposalSize" $ do + let largeSize = Tx.lengthOfByteString $ Tx.serialiseData $ toBuiltinData $ + V3.mkFakeParameterChangeContext Guards.getFakeLargeParamsChange + -- current maxTxSize is 16384 Bytes set on 07/29/2020 23:44:51 + -- , but we set this limit a bit lower (to accomodate other tx costs?) + maxTxSize = 10_000 + -- current maxTxSize + assertBool "Large Proposal does not fit transaction-size limits." (largeSize < maxTxSize) + pure $ "A large proposal has " <> show largeSize <> " below the limit set to " <> show maxTxSize + +unitTests :: TestTreeWithTestState +unitTests = testGroup' "Unit" + [ test_pos + , test_neg + , test_unsorted1 + , test_unsorted2 + , test_LargeProposalSize + ] + +singleParamTests :: TestTreeWithTestState +singleParamTests = testGroup' "Single Parameter Proposals" tests + where + tests = fmap f Guards.allParams + + f :: Guards.GenericParam -> TestTreeWithTestState + f (Guards.MkGenericParam gr@(Guards.Param{})) = Guards.testSet gr + f (Guards.MkGenericParam gr@(Guards.WithinDomain{})) = Guards.testSet gr + f (Guards.MkGenericParam gr@(Guards.ParamList{})) = Guards.paramListTestSet gr diff --git a/cardano-constitution/test/Driver.hs b/cardano-constitution/test/Driver.hs new file mode 100644 index 00000000000..53d6171e228 --- /dev/null +++ b/cardano-constitution/test/Driver.hs @@ -0,0 +1,86 @@ +-- editorconfig-checker-disable-file +module Main where + +import Cardano.Constitution.Config.Tests qualified as ConfigTests +import Cardano.Constitution.Validator.GoldenTests qualified as GoldenTests +import Cardano.Constitution.Validator.PropTests qualified as PropTests +import Cardano.Constitution.Validator.UnitTests qualified as UnitTests +import Control.Exception +import Data.Aeson +import Data.ByteString.Char8 qualified as BS +import Data.IORef +import Helpers.Guardrail (allParams) +import Helpers.MultiParam +import Helpers.Spec.FareySpec qualified as FareySpec +import Helpers.Spec.IntervalSpec qualified as IntervalSpec +import Helpers.TestBuilders +import System.Directory +import System.Exit +import System.FilePath +import System.IO () +import Test.Tasty +import Test.Tasty.Ingredients.Basic +import Test.Tasty.JsonReporter + +expectTrue :: (a, b) -> a +expectTrue = fst + +expectFalse :: (Bool, b) -> Bool +expectFalse = not . fst + +main :: IO () +main = do + -- initialize the state for tests results + ref <- newIORef (TestState mempty mempty) + + -- tests to be run + let mainTest = testGroup' "Testing Campaign" [ + UnitTests.unitTests, + PropTests.tests, + ConfigTests.tests, + GoldenTests.tests, + UnitTests.singleParamTests, + testGroup' "Multiple Parameter Changes" + [ + testProperty' "Proposal with all parameters at their current (or default value if new)" $ + multiParamProp 1 (allValid allParams) expectTrue, + testProperty' "Proposals with one parameter missing, and all the other ones within their ranges" $ + multiParamProp 2 (allValidAndOneMissing allParams) expectTrue, + testProperty' "Proposals with one parameter lower than its lower bound, and all the other ones within their ranges" $ + multiParamProp 3 (allValidAndOneLessThanLower allParams) expectFalse, + testProperty' "Proposals with one parameter greater than its upper bound, and all the other ones within their ranges" $ + multiParamProp 4 (allValidAndOneGreaterThanUpper allParams) expectFalse, + testProperty' "Proposals with one parameter unknown and all the other ones within their ranges" $ + multiParamProp 5 (allValidAndOneUnknown allParams) expectFalse, + testProperty' "Proposals with all parameters but one, all within their ranges, plus one unknown" $ -- To see if they don't do a trick on proposal length + multiParamProp 6 (allValidButOnePlusOneUnknown allParams) expectFalse, + testProperty' "Proposals with all parameters within their ranges" $ + multiParamProp 7 (allValid allParams) expectTrue, + testProperty' "Proposals with all parameters outside their ranges " $ + multiParamProp 8 (allInvalid allParams) expectFalse, + testProperty' "Proposals with a selection of parameters within their ranges" $ + multiParamProp 9 (someValidParams allParams) expectTrue, + testProperty' "Proposals with a selection of parameters, some within their ranges, some outside" $ + multiParamProp 10 (someInvalidAndSomeValidParams allParams) expectFalse, + testProperty' "Proposals with a selection of parameters within their ranges + costModels" $ + multiParamProp' 11 (someValidParams allParams) ((:[]) <$> costModelsParamGen) expectTrue, + testProperty' "Proposals with a selection of parameters, some within their ranges, some outside + costModels" $ + multiParamProp' 12 (someInvalidAndSomeValidParams allParams) ((:[]) <$> costModelsParamGen) expectFalse + ], + testGroup' "Internal Tests" [ + const IntervalSpec.internalTests, + const FareySpec.internalTests + ] + ] + + -- run the tests + defaultMainWithIngredients [listingTests, consoleAndJsonReporter] (mainTest ref) + `catch` (\(e :: ExitCode) -> do + -- write the results to a file + (TestState oneParamS multiParamS) <- readIORef ref + let directory = "certification" "data" + createDirectoryIfMissing True directory + BS.writeFile (directory "single-param.json") $ BS.toStrict $ encode oneParamS + BS.writeFile (directory "multi-param.json") $ BS.toStrict $ encode multiParamS + putStrLn $ "JSON files written to " <> directory + throwIO e) diff --git a/cardano-constitution/test/Helpers/CekTests.hs b/cardano-constitution/test/Helpers/CekTests.hs new file mode 100644 index 00000000000..fe262f35da4 --- /dev/null +++ b/cardano-constitution/test/Helpers/CekTests.hs @@ -0,0 +1,57 @@ +module Helpers.CekTests + ( hsValidatorsAgreesAndPassAll + , hsValidatorsAgreesAndErrAll + , hsAgreesWithTxBool + ) where + +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import PlutusLedgerApi.V3.ArbitraryContexts qualified as V3 +import PlutusTx as Tx +import Test.Tasty.QuickCheck +import UntypedPlutusCore as UPLC + +hsValidatorsAgreesAndPassAll :: [(ConstitutionValidator, CompiledCode ConstitutionValidator)] + -> V3.FakeProposedContext -> Property +hsValidatorsAgreesAndPassAll vs ctx = conjoin $ fmap (`hsValidatorsAgreesAndPass` ctx) vs + +hsValidatorsAgreesAndErrAll :: [(ConstitutionValidator, CompiledCode ConstitutionValidator)] + -> V3.FakeProposedContext -> Property +hsValidatorsAgreesAndErrAll vs ctx = conjoin $ fmap (`hsValidatorsAgreesAndErr` ctx) vs + +hsAgreesWithTxBool :: (ConstitutionValidator, CompiledCode ConstitutionValidator) + -> V3.FakeProposedContext -> IO Bool +hsAgreesWithTxBool (vHs, vCode) ctx = do + resHs <- tryApplyOnData vHs ctx + let vPs = _progTerm $ getPlcNoAnn $ vCode + `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + resPs = runCekRes vPs + + pure $ case (resHs, resPs) of + (Left _, Left _) -> True + (Right okHs, Right okPs) -> liftCode110Norm okHs == okPs + _ -> False + +hsValidatorsAgreesAndErr :: (ConstitutionValidator, CompiledCode ConstitutionValidator) + -> V3.FakeProposedContext -> Property +hsValidatorsAgreesAndErr (vHs, vCode) ctx = ioProperty $ do + resHs <- tryApplyOnData vHs ctx + let vPs = _progTerm $ getPlcNoAnn $ vCode + `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + resPs = runCekRes vPs + + pure $ case (resHs, resPs) of + (Left _, Left _) -> property True + _ -> property False + +hsValidatorsAgreesAndPass :: (ConstitutionValidator, CompiledCode ConstitutionValidator) + -> V3.FakeProposedContext -> Property +hsValidatorsAgreesAndPass (vHs, vCode) ctx = ioProperty $ do + resHs <- tryApplyOnData vHs ctx + let vPs = _progTerm $ getPlcNoAnn $ vCode + `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + resPs = runCekRes vPs + + pure $ case (resHs, resPs) of + (Right okHs, Right okPs) -> liftCode110Norm okHs === okPs + _ -> property False diff --git a/cardano-constitution/test/Helpers/Farey.hs b/cardano-constitution/test/Helpers/Farey.hs new file mode 100644 index 00000000000..e3b028738ff --- /dev/null +++ b/cardano-constitution/test/Helpers/Farey.hs @@ -0,0 +1,101 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE TypeApplications #-} + +module Helpers.Farey (findTightestRationalBounds, Digits) where + +import Data.Ratio ((%)) + +goLeftInFsbTree :: + Integer -> + Integer -> + Integer -> + Integer -> + (Integer, Integer, Integer, Integer) +goLeftInFsbTree a b c d = + let (e, f) = (c, d) + (c', d') = (a + c, b + d) + in (c', d', e, f) + +goRightInFsbTree :: + Integer -> + Integer -> + Integer -> + Integer -> + (Integer, Integer, Integer, Integer) +goRightInFsbTree c d e f = + let (a, b) = (c, d) + (c', d') = (c + e, d + f) + in (a, b, c', d') + +findFsbSubtree :: + Rational -> + Integer -> + (Integer, Integer, Integer, Integer, Integer, Integer) +findFsbSubtree target limNumb = + let (a, b, c, d, e, f) = (0, 1, 1, 1, 1, 0) + in loop a b c d e f + where + loop a b c d e f + | c % d == target || any (>= limNumb) [a, b, c, d, e, f] = (a, b, c, d, e, f) + | a % b < target && target < c % d = + let (c', d', e', f') = goLeftInFsbTree a b c d + in loop a b c' d' e' f' + | otherwise = + let (a', b', c', d') = goRightInFsbTree c d e f + in loop a' b' c' d' e f + +findSuccInFsbTree :: + (Integer, Integer, Integer, Integer) -> + Integer -> + (Integer, Integer) +findSuccInFsbTree (c, d, e, f) limNumb = + -- The successors are in the right subtree, the smallest one is the leftmost leaf + let (a, b, c', d') = goRightInFsbTree c d e f + -- Replaced the iterative go_left with a single step since it follows an arithmetic progression + n_d = (limNumb - d') `div` b + n_c = (limNumb - c') `div` a + n = min n_d n_c + in (c' + n * a, d' + n * b) + +findPredInFsbTree :: + (Integer, Integer, Integer, Integer) -> + Integer -> + (Integer, Integer) +findPredInFsbTree (a, b, c, d) limNumb = + -- The predecessors are in the left subtree, the smallest one is the rightmost leaf + let (c', d', e, f) = goLeftInFsbTree a b c d + -- Replaced the iterative go_right with a single step since it follows an arithmetic progression + n_d = (limNumb - d') `div` f + n_c = (limNumb - c') `div` e + n = min n_d n_c + in (c' + n * e, d' + n * f) + +findTightestRationalBounds' :: + Bool -> + Rational -> + Integer -> + (Rational, Rational) +findTightestRationalBounds' flipped target limNumb = + case compare target 0 of + EQ -> (-1 % limNumb, 1 % limNumb) + LT -> findTightestRationalBounds' True (abs target) limNumb + _anyOther -> + let (a, b, c, d, e, f) = findFsbSubtree target limNumb + (p_n, p_d) = findPredInFsbTree (a, b, c, d) limNumb + (s_n, s_d) = findSuccInFsbTree (c, d, e, f) limNumb + in if flipped + then (-s_n % s_d, -p_n % p_d) + else (p_n % p_d, s_n % s_d) + +type Digits = Int +findTightestRationalBounds :: Rational -> Digits -> (Rational, Rational) +findTightestRationalBounds ratio digits = findTightestRationalBounds' False ratio (2 ^ digits - 1) + +-- >>> findTightestRationalBounds (17 % 20) 64 +-- (15679732462653118871 % 18446744073709551613,15679732462653118866 % 18446744073709551607) + +-- >>> findTightestRationalBounds (17 % 20) 4 +-- (11 % 13,6 % 7) + +-- >>> findTightestRationalBounds (1 % 20) 1 +-- Ratio has zero denominator diff --git a/cardano-constitution/test/Helpers/Guardrail.hs b/cardano-constitution/test/Helpers/Guardrail.hs new file mode 100644 index 00000000000..4ebf080b9ff --- /dev/null +++ b/cardano-constitution/test/Helpers/Guardrail.hs @@ -0,0 +1,805 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +module Helpers.Guardrail + ( txFeePerByte + , txFeeFixed + , utxoCostPerByte + , stakeAddressDeposit + , stakePoolDeposit + , minPoolCost + , treasuryCut + , monetaryExpansion + , executionUnitPrices + , minFeeRefScriptCoinsPerByte + , maxBlockBodySize + , maxTxSize + , maxBlockExecutionUnits + , maxTxExecutionUnits + , maxBlockHeaderSize + , stakePoolTargetNum + , poolPledgeInfluence + , poolRetireMaxEpoch + , collateralPercentage + , maxCollateralInputs + , maxValueSize + , guardrailsNotChecked + , govDeposit + , dRepDeposit + , dRepActivity + , dRepVotingThresholds + , poolVotingThresholds + , govActionLifetime + , committeeMaxTermLimit + , committeeMinSize + + , ignoreTestBecauseIf + , getGuardrailTestGroup + , getCombinedConstraintTest + , boundaries + , paramRange + , getParamIx + , getParamName + + , IntervalEnum(..) + , Guardrail(..) + , Scalar + , Boundary(..) + , Param + , Collection + , GenericParam(..) + , getDomain + , getDefaultValue + , testSet + , paramListTestSet + , allParams + , getFakeLargeParamsChange + )where +import Helpers.TestBuilders hiding (Range (..)) + +import Data.Aeson +import Data.List (foldl', sortOn) +import Helpers.Farey +import Helpers.Intervals +import PlutusTx.IsData.Class +import Test.Tasty.QuickCheck + +import Helpers.Intervals qualified as I +import Test.Tasty.ExpectedFailure + +import Cardano.Constitution.Config.Types (ParamKey) +import Data.Ratio +import PlutusLedgerApi.V3 (BuiltinData) + +data Scalar a +data Collection a +data Param a +--data FixedList a + +data Assertion a + +data Guardrail a where + MustNotBe :: (String, String) -> RangeConstraint a -> Guardrail (Assertion a) + + Once :: Guardrail (Assertion a) -> Guardrail (Assertion a) + + Param :: (IntervalEnum a,ToData a,ToJSON a, Show a,HasRange a, HasDomain a,Num a,Ord a) + => Integer -> String -> a -> [Guardrail (Assertion a)] -> Guardrail (Param (Scalar a)) + + WithinDomain :: (IntervalEnum a, ToData a, ToJSON a, Show a, HasRange a, HasDomain a, Num a, Ord a) + => Guardrail (Param (Scalar a)) -> (a,a) -> Guardrail (Param (Scalar a)) + + ParamList :: (IntervalEnum a, ToData a, ToJSON a, Show a, Num a, HasRange a, Ord a, HasDomain a) + => Integer -> String -> [Guardrail (Param (Scalar a))] -> Guardrail (Param (Collection a)) + +guardrailsNotChecked :: Guardrail (Param (Scalar Integer)) +guardrailsNotChecked = Param @Integer 999 "guardrailsNotChecked" 0 + [ ("PARAM-01", "Any protocol parameter that is not explicitly named in this document must not be changed by a parameter update governance action") `MustNotBe` NL 0 + , ("PARAM-02", "Where a parameter is explicitly listed in this document but no guardrails are specified, the script must not impose any constraints on changes to the parameter") `MustNotBe` NL 0 + , ("PARAM-03", "Critical protocol parameters require an SPO vote in addition to a DRep vote: SPOs must say \"yes\" with a collective support of more than 60% of all active block production stake. This is enforced by the guardrails on the `ppSecurityParam` voting threshold") `MustNotBe` NL 0 + , ("PARAM-05", "DReps must vote \"yes\" with a collective support of more than 50% of all active voting stake. This is enforced by the guardrails on the DRep voting thresholds") `MustNotBe` NL 0 + ] + +txFeePerByte :: Guardrail (Param (Scalar Integer)) +txFeePerByte = Param @Integer 0 "txFeePerByte" 44 + [ ("TFPB-01", "txFeePerByte must not be lower than 30 (0.000030 ada)") `MustNotBe` NL 30 + , ("TFPB-02", "txFeePerByte must not exceed 1,000 (0.001 ada)") `MustNotBe` NG 1_000 + , ("TFPB-03", "txFeePerByte must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,5_000) + +txFeeFixed :: Guardrail (Param (Scalar Integer)) +txFeeFixed = Param @Integer 1 "txFeeFixed" 155_381 + [ ("TFF-01","txFeeFixed must not be lower than 100,000 (0.1 ada)") `MustNotBe` NL 100_000 + , ("TFF-02","txFeeFixed must not exceed 10,000,000 (10 ada)") `MustNotBe` NG 10_000_000 + , ("TFF-03","txFeeFixed must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-100_000,12_000_000) + +utxoCostPerByte :: Guardrail (Param (Scalar Integer)) +utxoCostPerByte = Param @Integer 17 "utxoCostPerByte" 4_310 + [ ("UCPB-01","utxoCostPerByte must not be lower than 3,000 (0.003 ada)") `MustNotBe` NL 3_000 + , ("UCPB-02","utxoCostPerByte must not exceed 6,500 (0.0065 ada)") `MustNotBe` NG 6_500 + , Once (("UCPB-03","utxoCostPerByte must not be set to 0") `MustNotBe` NEQ 0) + , ("UCPB-04","utxoCostPerByte must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,10_000) + +stakeAddressDeposit :: Guardrail (Param (Scalar Integer)) +stakeAddressDeposit = Param @Integer 5 "stakeAddressDeposit" 2_000_000 + [ ("SAD-01","stakeAddressDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 + , ("SAD-02","stakeAddressDeposit must not exceed 5,000,000 (5 ada)") `MustNotBe` NG 5_000_000 + , ("SAD-03","stakeAddressDeposit must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,10_000_000) + +stakePoolDeposit :: Guardrail (Param (Scalar Integer)) +stakePoolDeposit = Param @Integer 6 "stakePoolDeposit" 500_000_000 + [ ("SPD-01","stakePoolDeposit must not be lower than 250,000,000 (250 ada)") `MustNotBe` NL 250_000_000 + , ("SPD-02","stakePoolDeposit must not exceed 500,000,000 (500 ada)") `MustNotBe` NG 500_000_000 + , ("SDP-03","stakePoolDeposit must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,700_000_000) + + +minPoolCost :: Guardrail (Param (Scalar Integer)) +minPoolCost = Param @Integer 16 "minPoolCost" 170_000_000 + [ ("MPC-01","minPoolCost must not be negative") `MustNotBe` NL 0 + , ("MPC-02","minPoolCost must not exceed 500,000,000 (500 ada)") `MustNotBe` NG 500_000_000 + ] + `WithinDomain` (-5_000,600_000_000) + +treasuryCut :: Guardrail (Param (Scalar Rational)) +treasuryCut = Param @Rational 11 "treasuryCut" 0.3 + [ ("TC-01","treasuryCut must not be lower than 0.1 (10%)") `MustNotBe` NL 0.1 + , ("TC-02", "treasuryCut must not exceed 0.3 (30%)") `MustNotBe` NG 0.3 + , ("TC-03","treasuryCut must not be negative") `MustNotBe` NL 0 + , ("TC-04", "treasuryCut must not exceed 1.0 (100%)") `MustNotBe` NG 1.0 + ] + `WithinDomain` (-1.0,1.0) + +monetaryExpansion :: Guardrail (Param (Scalar Rational)) +monetaryExpansion = Param @Rational 10 "monetaryExpansion" 0.003 + [ ("ME-01","monetaryExpansion must not exceed 0.005") `MustNotBe` NG 0.005 + , ("ME-02","monetaryExpansion must not be lower than 0.001") `MustNotBe` NL 0.001 + , ("ME-03","monetaryExpansion must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-1.0,1.0) + +executionUnitPrices :: Guardrail (Param (Collection Rational)) +executionUnitPrices = ParamList @Rational 19 "executionUnitPrices" + [ Param 0 "priceMemory" (577 % 10_000) + [ ("EIUP-PM-01","executionUnitPrices[priceMemory] must not exceed 2_000 / 10_000") `MustNotBe` NG (2_000 % 10_000) + , ("EIUP-PM-02","executionUnitPrices[priceMemory] must not be lower than 400 / 10_000") `MustNotBe` NL (400 % 10_000) + ] `WithinDomain` (0.0, 1.0) + , Param 1 "priceSteps" (721 % 10_000_000) + [ ("EIUP-PS-01","executionUnitPrices[priceSteps] must not exceed 2,000 / 10,000,000") `MustNotBe` NG (2_000 % 10_000_000) + , ("EIUP-PS-02","executionUnitPrices[priceSteps] must not be lower than 500 / 10,000,000") `MustNotBe` NL (500 % 10_000_000) + ] `WithinDomain` (0.0, 1.0) + ] + +minFeeRefScriptCoinsPerByte :: Guardrail (Param (Scalar Integer)) +minFeeRefScriptCoinsPerByte = Param @Integer 33 "minFeeRefScriptCoinsPerByte" 1 + [ ("MFRS-01", "minFeeRefScriptCoinsPerByte must not exceed 1,000 (0.001 ada)") `MustNotBe` NG 1_000 + , ("MFRS-02", "minFeeRefScriptCoinsPerByte must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,10_000) + +maxBlockBodySize :: Guardrail (Param (Scalar Integer)) +maxBlockBodySize = Param @Integer 2 "maxBlockBodySize" 90_112 + [ ("MBBS-01","maxBlockBodySize must not exceed 122,880 Bytes (120KB)") `MustNotBe` NG 122_880 + , ("MBBS-02","maxBlockBodySize must not be lower than 24,576 Bytes (24KB)") `MustNotBe` NL 24_576 + ] + `WithinDomain` (-5_000,200_000) + +maxTxSize :: Guardrail (Param (Scalar Integer)) +maxTxSize = Param @Integer 3 "maxTxSize" 16_384 + [ ("MTS-01","maxTxSize must not exceed 32,768 Bytes (32KB)") `MustNotBe` NG 32_768 + , ("MTS-02","maxTxSize must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,50_000) + +maxBlockExecutionUnits :: Guardrail (Param (Collection Integer)) +maxBlockExecutionUnits = ParamList @Integer 21 "maxBlockExecutionUnits" + [ Param 0 "memory" 62_000_000 + [ ("MBEU-M-01","maxBlockExecutionUnits[memory] must not exceed 120,000,000 units") `MustNotBe` NG 120_000_000 + , ("MBEU-M-02","maxBlockExecutionUnits[memory] must not be negative") `MustNotBe` NL 0 + ] `WithinDomain` (-100,200_000_000) + , Param 1 "steps" 20_000_000_000 + [ ("MBEU-S-01","maxBlockExecutionUnits[steps] must not exceed 40,000,000,000 (40Bn) units") `MustNotBe` NG 40_000_000_000 + , ("MBEU-S-02","maxBlockExecutionUnits[steps] must not be negative") `MustNotBe` NL 0 + ] `WithinDomain` (-100,50_000_000_000) + ] + +maxTxExecutionUnits :: Guardrail (Param (Collection Integer)) +maxTxExecutionUnits = ParamList 20 "maxTxExecutionUnits" + [ Param 0 "mem" 20_000_000 + [ ("MTEU-M-01","maxTxExecutionUnits[memory] must not exceed 40,000,000 units") `MustNotBe` NG 40_000_000 + , ("MTEU-M-02","maxTxExecutionUnits[memory] must not be negative") `MustNotBe` NL 0 + ] `WithinDomain` (-100,50_000_000) + , Param 1 "steps" 10_000_000_000 + [ ("MTEU-S-01","maxTxExecutionUnits[steps] must not exceed 15,000,000,000 (15Bn) units") `MustNotBe` NG 15_000_000_000 + , ("MTEU-S-02","maxTxExecutionUnits[steps] must not be negative") `MustNotBe` NL 0 + ] `WithinDomain` (-100,16_000_000_000) + ] + +maxBlockHeaderSize :: Guardrail (Param (Scalar Integer)) +maxBlockHeaderSize = Param @Integer 4 "maxBlockHeaderSize" 1_100 + [ ("MBHS-01","maxBlockHeaderSize must not exceed 5,000 Bytes") `MustNotBe` NG 5_000 + , ("MBHS-02","maxBlockHeaderSize must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,10_000) + +stakePoolTargetNum :: Guardrail (Param (Scalar Integer)) +stakePoolTargetNum = Param @Integer 8 "stakePoolTargetNum" 500 + [ ("SPTN-01","stakePoolTargetNum must not be lower than 250") `MustNotBe` NL 250 + , ("SPTN-02","stakePoolTargetNum must not exceed 2,000") `MustNotBe` NG 2_000 + , ("SPTN-03","stakePoolTargetNum must not be negative") `MustNotBe` NL 0 + , ("SPTN-04", "stakePoolTargetNum must not be zero") `MustNotBe` NEQ 0 + ] + `WithinDomain` (-5_000,10_000) + +poolPledgeInfluence :: Guardrail (Param (Scalar Rational)) +poolPledgeInfluence = Param @Rational 9 "poolPledgeInfluence" 0.3 + [ ("PPI-01","poolPledgeInfluence must not be lower than 0.1") `MustNotBe` NL (1 % 10) + , ("PPI-02","poolPledgeInfluence must not exceed 1.0") `MustNotBe` NG (10 % 10) + , ("PPI-03","poolPledgeInfluence must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-1.0,2.0) + +poolRetireMaxEpoch :: Guardrail (Param (Scalar Integer)) +poolRetireMaxEpoch = Param @Integer 7 "poolRetireMaxEpoch" 18 + [ ("PRME-01","poolRetireMaxEpoch must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,10_000) + + +collateralPercentage :: Guardrail (Param (Scalar Integer)) +collateralPercentage = Param @Integer 23 "collateralPercentage" 150 + [ ("CP-01","collateralPercentage must not be lower than 100") `MustNotBe` NL 100 + , ("CP-02","collateralPercentage must not exceed 200") `MustNotBe` NG 200 + , ("CP-03","collateralPercentage must not be negative") `MustNotBe` NL 0 + , ("CP-04","collateralPercentage must not be set to 0") `MustNotBe` NEQ 0 + ] + `WithinDomain` (-100,300) + +maxCollateralInputs :: Guardrail (Param (Scalar Integer)) +maxCollateralInputs = Param @Integer 24 "maxCollateralInputs" 3 + [ ("MCI-01","maxCollateralInputs must not be lower than 1") `MustNotBe` NL 1 + ] + `WithinDomain` (-10,100) + +maxValueSize :: Guardrail (Param (Scalar Integer)) +maxValueSize = Param @Integer 22 "maxValueSize" 5_000 + [ ("MVS-01","maxValueSize must not exceed 12,288 Bytes (12KB)") `MustNotBe` NG 12_288 + , ("MVS-02","maxValueSize must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-5_000,20_000) + +govDeposit :: Guardrail (Param (Scalar Integer)) +govDeposit = Param @Integer 30 "govDeposit" 1_000_000 + [ ("GD-01", "govDeposit must not be negative" ) `MustNotBe` NL 0 + , ("GD-02", "govDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 + , ("GD-03", "govDeposit must not exceed 10,000,000,000,000 (10 Million ada)") `MustNotBe` NG 10_000_000_000_000 + ] + `WithinDomain` (-5_000,11_000_000_000_000) + + +dRepDeposit :: Guardrail (Param (Scalar Integer)) +dRepDeposit = Param @Integer 31 "dRepDeposit" 1_000_000 + [ ("DRD-01", "dRepDeposit must not be negative" ) `MustNotBe` NL 0 + , ("DRD-02", "dRepDeposit must not be lower than 1,000,000 (1 ada)") `MustNotBe` NL 1_000_000 + , ("DRD-03", "dRepDeposit must be no more than 100,000,000,000 (100,000 ada)") `MustNotBe` NG 100_000_000_000 + ] + `WithinDomain` (-5_000,110_000_000_000) + +dRepActivity :: Guardrail (Param (Scalar Integer)) +dRepActivity = Param @Integer 32 "dRepActivity" 25 + [ ("DRA-01", "dRepActivity must not be lower than 13 epochs (2 months)") `MustNotBe` NL 13 + , ("DRA-02", "dRepActivity must not exceed 37 epochs (6 months)") `MustNotBe` NG 37 + , ("DRA-03", "dRepActivity must not be negative") `MustNotBe` NL 0 + ] + `WithinDomain` (-10, 100) + +poolVotingThresholds :: Guardrail (Param (Collection Rational)) +poolVotingThresholds = ParamList @Rational 25 "poolVotingThresholds" + [ Param 0 "motionNoConfidence" (2 % 3) + [ ("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-NC-01", "No confidence action thresholds must be in the range 51%-75%") + `MustNotBe` NL (51 % 100) + , ("VT-NC-01b", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) + ] `WithinDomain` (0,1.5) + + , Param 1 "committeeNormal" (2 % 3) + [ ("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") + `MustNotBe` NL (65 % 100) + , ("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") + `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 2 "committeeNoConfidence" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") + `MustNotBe` NL (65 % 100) + , ("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") + `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 3 "hardForkInitiation" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-HF-01", "Hard fork action thresholds must be in the range 51%-80%") + `MustNotBe` NL (51 % 100) + , ("VT-HF-01b", "Hard fork action thresholds must be in the range 51%-80%") + `MustNotBe` NG (80 % 100) + ] `WithinDomain` (0,1.5) + + , Param 4 "ppSecurityGroup" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + ] `WithinDomain` (0,1.5) + ] + +dRepVotingThresholds :: Guardrail (Param (Collection Rational)) +dRepVotingThresholds = ParamList @Rational 26 "dRepVotingThresholds" + [ Param 0 "motionNoConfidence" (2 % 3) + [ ("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-NC-01", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100) + , ("VT-NC-01b", "No confidence action thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) + ] `WithinDomain` (0,1.5) + + , Param 1 "committeeNormal" (2 % 3) + [ ("VT-GEN-01" ,"All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100) + , ("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 2 "committeeNoConfidence" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-CC-01","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100) + , ("VT-CC-01b","Update Constitutional Committee action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 3 "updateConstitution" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-CON-01", "Update Constitution or proposal policy action thresholds must be in the range 65%-90%") `MustNotBe` NL (65 % 100) + , ("VT-CON-01b", "Update Constitution or proposal policy action thresholds must be in the range 65%-90%") `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 4 "hardForkInitiation" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-HF-01", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NL (51 % 100) + , ("VT-HF-01b", "Hard fork action thresholds must be in the range 51%-80%") `MustNotBe` NG (80 % 100) + ] `WithinDomain` (0,1.5) + + , Param 5 "ppNetworkGroup" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100) + , ("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) + ] `WithinDomain` (0,1.5) + + , Param 6 "ppEconomicGroup" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100) + , ("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) + ] `WithinDomain` (0,1.5) + + , Param 7 "ppTechnicalGroup" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-GEN-02", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NL (51 % 100) + , ("VT-GEN-02b", "Economic, network, and technical parameters thresholds must be in the range 51%-75%") `MustNotBe` NG (75 % 100) + ] `WithinDomain` (0,1.5) + + , Param 8 "ppGovernanceGroup" (4 % 5) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + , ("VT-GOV-01", "Governance parameter thresholds must be in the range 75%-90%") `MustNotBe` NL (75 % 100) + , ("VT-GOV-01b", "Governance parameter thresholds must be in the range 75%-90%") `MustNotBe` NG (90 % 100) + ] `WithinDomain` (0,1.5) + + , Param 9 "treasuryWithdrawal" (2 % 3) + [ ("VT-GEN-01","All thresholds must be in the range 50%-100%") `MustNotBe` NL (1 % 2) + , ("VT-GEN-01b","All thresholds must be in the range 50%-100%") `MustNotBe` NG (1 % 1) + ] `WithinDomain` (0,1.5) + ] + +govActionLifetime :: Guardrail (Param (Scalar Integer)) +govActionLifetime = Param @Integer 29 "govActionLifetime" 5 + [ ("GAL-01", "govActionLifetime must not be lower than 1 epoch (5 days)") `MustNotBe` NL 1 + , ("GAL-02", "govActionLifetime must not be greater than 15 epochs (75 days)") `MustNotBe` NG 15 + ] + `WithinDomain` (-10, 100) + + +committeeMaxTermLimit :: Guardrail (Param (Scalar Integer)) +committeeMaxTermLimit = Param @Integer 28 "committeeMaxTermLimit" 50 + [ ("CMTL-01", "committeeMaxTermLimit must not be zero") `MustNotBe` NEQ 0 + , ("CMTL-02", "committeeMaxTermLimit must not be negative") `MustNotBe` NL 0 + , ("CMTL-03", "committeeMaxTermLimit must not be lower than 18 epochs (90 days, or approximately 3 months)") `MustNotBe` NL 18 + , ("CMTL-04", "committeeMaxTermLimit must not exceed 293 epochs (approximately 4 years)") `MustNotBe` NG 293 + ] + `WithinDomain` (-10, 400) + +committeeMinSize :: Guardrail (Param (Scalar Integer)) +committeeMinSize = Param @Integer 27 "committeeMinSize" 3 + [ ("CMS-01", "committeeMinSize must not be negative") `MustNotBe` NL 0 + , ("CMS-02", "committeeMinSize must not be lower than 3") `MustNotBe` NL 3 + , ("CMS-03", "committeeMinSize must not exceed 10") `MustNotBe` NG 10 + ] + `WithinDomain` (-10, 50) + +gStr :: [Char] -> [Char] -> [Char] +gStr g str = g ++ ": " ++ str + +-------------------------------------------------------------------------------- +-- | property test for each guardrail +getGuardrailTestTree' :: (Num a,HasRange a,Ord a, ToJSON a , Show a, ToData a ) + => (a,a) + -> ParamId + -> (a -> ParamValues) + -> Guardrail (Assertion a) + -> TestTreeWithTestState +getGuardrailTestTree' domain' paramIx toData' assertion@(MustNotBe (g,str) _) = + testProperty' (gStr g str) $ + getGuardrailProperty domain' toData' paramIx assertion +getGuardrailTestTree' domain' paramIx toData' g@(Once guardrail) = + testProperty' (getStr guardrail) $ + getGuardrailProperty domain' toData' paramIx g + where + getStr :: Guardrail (Assertion a) -> String + getStr (MustNotBe (g',str) _) = g' ++ ": " ++ str + getStr (Once guardrail') = getStr guardrail' + +getGuardrailProperty :: (Num a,HasRange a,Ord a, ToJSON a , Show a, ToData a ) + => (a,a) + -> (a -> ParamValues) + -> ParamId + -> Guardrail (Assertion a) + -> PropertyWithTestState +getGuardrailProperty domain' toData' paramIx (MustNotBe _ range) = + oneParamProp' paramIx toData' (I.rangeGen' domain' range) (not . fst) + +getGuardrailProperty domain' toData' paramIx (Once guardrail) = once . getGuardrailProperty domain' toData' paramIx guardrail + +getGuardrailTestGroup :: forall a. ( Num a,HasRange a,Ord a, ToJSON a , Show a, ToData a , HasDomain a ) + => Guardrail (Param (Scalar a)) + -> TestTreeWithTestState +getGuardrailTestGroup gr = + getGuardrailTestGroup' (oneParamChange $ getParamIx gr) (\ix _ -> show ix) gr + +getGuardrailTestGroup' :: forall a. ( Num a,HasRange a,Ord a, ToJSON a , Show a, ToData a , HasDomain a ) + => (a -> ParamValues) + -> (Integer -> String -> String) + -> Guardrail (Param (Scalar a)) + -> TestTreeWithTestState +getGuardrailTestGroup' toData' getParamId (Param paramIx paramName _ assertions) = + testGroup' ("Guardrails for " ++ show paramIx) $ + map (getGuardrailTestTree' domain (getParamId paramIx paramName) toData') assertions +getGuardrailTestGroup' toData' getParamId (WithinDomain group domain') = + propWithDomain domain' group + where + propWithDomain :: (a,a) + -> Guardrail (Param (Scalar a)) + -> TestTreeWithTestState + propWithDomain _ (WithinDomain group' domain'') = propWithDomain domain'' group' + propWithDomain domain'' (Param paramIx paramName _ assertions) = + testGroup' ("Guardrails for " ++ show paramIx) $ + map (getGuardrailTestTree' domain'' (getParamId paramIx paramName) toData') assertions + +-------------------------------------------------------------------------------- +-- | Combine constraints and negate one of each + +getAssertionRangeAndStr :: Guardrail (Assertion a) -> (String,RangeConstraint a) +getAssertionRangeAndStr (MustNotBe (g,_) range) = (g,range) +getAssertionRangeAndStr (Once guardrail) = getAssertionRangeAndStr guardrail + + +negateOneConstraint :: [(String,RangeConstraint a)] + -> Integer + -> (String,[RangeConstraint a]) +negateOneConstraint xs ix = foldl' f ("",[]) $ zip xs [0..] + where + f :: (String, [RangeConstraint a]) + -> ((String, RangeConstraint a), Integer) + -> (String, [RangeConstraint a]) + f (g,constraints) ((g',constraint),i) + | ix == i = (prefix ++ "!" ++ g', negateRange constraint ++ constraints) + | otherwise = (prefix ++ g',constraint:constraints) + where prefix = if null g then "" else g ++ " & " + +allNegationCases :: [(String,RangeConstraint a)] -> [(String,[RangeConstraint a])] +allNegationCases xs = map (negateOneConstraint xs) + [0..(toInteger $ length xs - 1)] + +allPositive :: [(String, RangeConstraint a)] -> (String, [RangeConstraint a]) +allPositive xs = negateOneConstraint xs (-1) + +ignoreTestBecauseIf :: Bool -> String -> TestTreeWithTestState -> TestTreeWithTestState +ignoreTestBecauseIf cond' str tst = + if cond' then ignoreTestBecause str . tst else tst + +expectTo :: (Num a,HasRange a,Ord a, ToJSON a , Show a, ToData a) + => Bool + -> (a,a) + -> (a -> ParamValues) + -> ParamId + -> (String, [RangeConstraint a]) + -> TestTreeWithTestState +expectTo expectToSucceed domain' toData' paramId (g,constraints) ref = + case gapsWithinRange domain' constraints of + [] -> ignoreTestBecause "No domain to choose values from" $ testProperty g True + xs -> + let gen = generateFromIntervals xs + testName = g ++ " should " + ++ (if expectToSucceed then "succeed" else "fail") + ++ " in range " ++ showIntervals xs + in testProperty testName $ oneParamProp' paramId toData' gen ((== expectToSucceed) . fst) ref + +getCombinedConstraintTest :: forall a. + ( Num a, HasRange a, Ord a, ToJSON a , Show a, ToData a , HasDomain a ) + => Guardrail (Param (Scalar a)) + -> TestTreeWithTestState +getCombinedConstraintTest group = + getCombinedConstraintTest' toData' (\ix _ -> show ix) group + where + toData' = oneParamChange (getParamIx group) + +getCombinedConstraintTest' :: forall a. + ( Num a, HasRange a, Ord a, ToJSON a , Show a, ToData a , HasDomain a ) + => (a -> ParamValues) + -> (Integer -> String -> String) + -> Guardrail (Param (Scalar a)) + -> TestTreeWithTestState +getCombinedConstraintTest' toData' getParamId (WithinDomain group domain') = + propWithDomain domain' group + where + propWithDomain :: (a,a) + -> Guardrail (Param (Scalar a)) + -> TestTreeWithTestState + propWithDomain _ (WithinDomain group' domain'') = propWithDomain domain'' group' + propWithDomain domain'' (Param paramIx paramName _ assertions) = + let paramId = getParamId paramIx paramName + in testGroup' ("Combined Guardrails for " ++ show paramIx) $ + -- first all positive cases + expectTo succeed' domain'' toData' paramId (allPositive ranges) + -- then all negation cases + : map (expectTo fail' domain'' toData' paramId) allNegationCases' + where + ranges = map getAssertionRangeAndStr assertions + allNegationCases' = allNegationCases ranges + +getCombinedConstraintTest' toData' getParamId (Param paramIx name defaultValue assertions) = + getCombinedConstraintTest' + toData' + getParamId + (WithinDomain (Param paramIx name defaultValue assertions) domain) + + +fail', succeed' :: Bool +fail' = False +succeed' = True + +getAllRangeConstraints :: Guardrail (Param (Scalar a)) -> [(String,RangeConstraint a)] +getAllRangeConstraints (WithinDomain group _) = getAllRangeConstraints group +getAllRangeConstraints (Param _ _ _ assertions) = map getAssertionRangeAndStr assertions + +getDomain :: HasDomain a => Guardrail (Param (Scalar a)) -> (a,a) +getDomain (WithinDomain _ domain') = domain' +getDomain (Param{}) = domain + +class IntervalEnum a where + boundaryPred :: Boundary a -> a + boundarySucc :: Boundary a -> a + + +instance IntervalEnum Integer where + boundaryPred (Closed a) = a - 1 + boundaryPred (Open a) = a + boundarySucc (Closed a) = a + 1 + boundarySucc (Open a) = a + +instance a ~ Integer => IntervalEnum (Ratio a) where + boundaryPred (Closed a) = fst $ findTightestRationalBounds a 64 + boundaryPred (Open a) = a + boundarySucc (Closed a) = snd $ findTightestRationalBounds a 64 + boundarySucc (Open a) = a + +boundaries :: (IntervalEnum a,HasDomain a,Num a,Ord a) + => Guardrail (Param (Scalar a)) + -> (a, a) +boundaries x = + let + domain' = getDomain x + in boundaries' domain' x + +boundaries' :: (IntervalEnum a,Num a,Ord a) + => (a,a) + -> Guardrail (Param (Scalar a)) + -> (a, a) +boundaries' domain' x = + let constraints = map snd $ getAllRangeConstraints x + xs = gapsWithinRange domain' constraints + (start,end) = case xs of + [] -> error "No domain to choose values from" + xs' -> (fst $ head xs', snd $ last xs') + in case (start,end) of + (Open a,Open b) -> (boundaryPred $ Open a,boundarySucc $ Open b) + (Closed a,Open b) -> (a,boundarySucc $ Open b) + (Open a,Closed b) -> (boundaryPred $ Open a,b) + (Closed a,Closed b) -> (a,b) + + + +getDefaultValue :: Guardrail (Param (Scalar a)) -> a +getDefaultValue (WithinDomain group _) = getDefaultValue group +getDefaultValue (Param _ _ defaultValue _) = defaultValue + +getParamIx :: Guardrail (Param a) -> ParamIx +getParamIx (WithinDomain group _) = getParamIx group +getParamIx (Param paramIx' _ _ _) = paramIx' +getParamIx (ParamList paramIx' _ _) = paramIx' +--getParamIx (ParamStructure paramIx' _ _) = paramIx' + +getParamName :: Guardrail (Param (Scalar a)) -> String +getParamName (WithinDomain group _) = getParamName group +getParamName (Param _ name _ _) = name + +paramRange :: (IntervalEnum a,ToData a,ToJSON a, Show a,HasRange a, HasDomain a,Num a,Ord a) + => Guardrail (Param (Scalar a)) + -> (ParamIx,ParamRange) +paramRange a = + let (low,high) = boundaries a + domain' = getDomain a + range = MkParamRangeWithinDomain (low,high) domain' + in (getParamIx a,range) + + +-------------------------------------------------------------------------------- +-- | test set + +testSet :: forall a. + ( IntervalEnum a, ToJSON a, ToData a, Show a + , Num a, HasRange a, Ord a, HasDomain a + ) + => Guardrail (Param (Scalar a)) -> TestTreeWithTestState +testSet guardRail = + testSet' toData' (\ix _ -> show ix) guardRail + where + toData' = oneParamChange $ getParamIx guardRail + +paramListTestSet :: forall a. + ( IntervalEnum a, ToJSON a, ToData a, Show a + , Num a, HasRange a, Ord a, HasDomain a + ) + => Guardrail (Param (Collection a)) -> TestTreeWithTestState +paramListTestSet (ParamList paramIx name xs) = + testGroup' name $ map testParam xs + where + testParam :: Guardrail (Param (Scalar a)) -> TestTreeWithTestState + testParam gr = testSet' (toData' gr) getParamId gr + + toData' :: Guardrail (Param (Scalar a)) -> a -> ParamValues + toData' gr value = [(paramIx,toValues' gr value)] + + getParamId :: Integer -> String -> String + getParamId = getSubParamId paramIx + + toValues' :: Guardrail (Param (Scalar a)) -> a -> Printable + toValues' selectedGr val = + let selectedParamName = getParamName selectedGr + xs' = flip map xs $ \x -> + let paramName = getParamName x + in if selectedParamName == paramName + then val + else getDefaultValue x + in pack xs' + +getSubParamId :: Integer -> Integer -> String -> String +getSubParamId paramIx subParamIx _ = show paramIx ++ "[" ++ show subParamIx ++ "]" + +testSet' :: forall a. + ( IntervalEnum a, ToJSON a + , ToData a, Show a + , Num a, Ord a, HasDomain a + , HasRange a + ) + => (a -> ParamValues) + -> (Integer -> String -> String) + -> Guardrail (Param (Scalar a)) -> TestTreeWithTestState +testSet' toData' getParamId guardRail = testGroup' paramName + [ testGroup' "In range tests" + [ testCase' ("At upper bound (" ++ show upper ++ ")") $ unitTestTemplatePositive' paramId toData' upper + , testCase' ("At lower bound (" ++ show lower ++ ")") $ unitTestTemplatePositive' paramId toData' lower + , testCase' ("Current (" ++ show defaultValue ++ ")") $ unitTestTemplatePositive' paramId toData' defaultValue + ] + , testGroup' "Outside bounds" + [ ignoreTestBecauseIf (succUpper > ed) "No upper limit" $ + testCase' ("Upper Bound (" ++ show succUpper ++ ")") $ unitTestTemplateNegative' paramId toData' succUpper + , ignoreTestBecauseIf (predLower < sd) "No lower limit" $ + testCase' ("Lower Bound (" ++ show predLower ++ ")") $ unitTestTemplateNegative' paramId toData' predLower + ] + , getCombinedConstraintTest' toData' getParamId guardRail + , getGuardrailTestGroup' toData' getParamId guardRail + , testGroup' "Property Based Tests" + [ testProperty' ("In range [" ++ show lower ++", " ++ show upper ++ "]") $ + pbtParamValidRange' paramId toData' (lower, upper) ] + ] + where + defaultValue = getDefaultValue guardRail + paramNo = getParamIx guardRail + paramName = getParamName guardRail + paramId = getParamId paramNo paramName + (lower, upper) = boundaries guardRail + (sd, ed) = getDomain guardRail + predLower = boundaryPred $ Closed lower + succUpper = boundarySucc $ Closed upper + +data GenericParam = forall a. MkGenericParam (Guardrail (Param a)) + +allParams :: [GenericParam] +allParams = + [ MkGenericParam txFeePerByte + , MkGenericParam txFeeFixed + , MkGenericParam utxoCostPerByte + , MkGenericParam maxBlockBodySize + , MkGenericParam maxTxSize + , MkGenericParam maxBlockHeaderSize + , MkGenericParam minPoolCost + , MkGenericParam maxValueSize + , MkGenericParam collateralPercentage + , MkGenericParam maxCollateralInputs + , MkGenericParam stakeAddressDeposit + , MkGenericParam stakePoolDeposit + , MkGenericParam poolRetireMaxEpoch + , MkGenericParam stakePoolTargetNum + , MkGenericParam poolPledgeInfluence + , MkGenericParam minFeeRefScriptCoinsPerByte + , MkGenericParam govDeposit + , MkGenericParam dRepDeposit + , MkGenericParam dRepActivity + , MkGenericParam govActionLifetime + , MkGenericParam committeeMaxTermLimit + , MkGenericParam committeeMinSize + , MkGenericParam monetaryExpansion + , MkGenericParam treasuryCut + , MkGenericParam poolVotingThresholds + , MkGenericParam dRepVotingThresholds + , MkGenericParam executionUnitPrices + , MkGenericParam maxBlockExecutionUnits + , MkGenericParam maxTxExecutionUnits + ] + +makeChangedParams :: (forall a. Guardrail (Param a) -> BuiltinData) + -> [GenericParam] + -> [(ParamKey, BuiltinData)] +makeChangedParams getValue params = + let changedParams = map (\(MkGenericParam gr) -> (getParamIx gr, getValue gr)) params + allCostModels':: (ParamKey, BuiltinData) = (18, toBuiltinData allCostModels) + in sortOn fst (allCostModels' : changedParams) + +getMaxValue' :: Guardrail (Param a) -> BuiltinData +getMaxValue' gr@(Param{}) = + let max' = 2 ^ (64 :: Int) - 1 + in toBuiltinData $ boundaryPred $ (Closed $ snd $ boundaries' (-max' ,max') gr) +getMaxValue' (WithinDomain gr _) = getMaxValue' gr +getMaxValue' (ParamList _ _ xs) = toBuiltinData $ map getMaxValue' xs + +getFakeLargeParamsChange :: [(ParamKey, BuiltinData)] +getFakeLargeParamsChange = makeChangedParams getMaxValue' allParams diff --git a/cardano-constitution/test/Helpers/Intervals.hs b/cardano-constitution/test/Helpers/Intervals.hs new file mode 100644 index 00000000000..cfee4364a74 --- /dev/null +++ b/cardano-constitution/test/Helpers/Intervals.hs @@ -0,0 +1,220 @@ + +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ViewPatterns #-} + +module Helpers.Intervals where +import Control.Monad (guard) +import Data.List +import Helpers.TestBuilders hiding (rangeGen) +import Test.QuickCheck (Gen, oneof, suchThat) + +-------------------------------------------------------------------------------- +-- | Boundaries +data Boundary a = Closed !a | Open !a + deriving stock (Show, Eq) + +boundaryValue :: Boundary a -> a +boundaryValue (Closed a) = a +boundaryValue (Open a) = a + + +instance (Num a,Ord a) => Ord (Boundary a) where + compare (boundaryValue -> a) (boundaryValue -> b) + | a /= b = compare a b + compare (Open a) (Closed _) = 0 `compare` a + compare (Closed a) (Open _) = a `compare` 0 + compare (Open _) (Open _) = EQ + compare (Closed _) (Closed _) = EQ + +-------------------------------------------------------------------------------- +-- | Ranges + +data RangeConstraint a = NL !a | NG !a | NLEQ !a | NGEQ !a | NEQ !a + deriving stock (Show, Eq) + +rangeValue :: RangeConstraint a -> a +rangeValue (NL a) = a +rangeValue (NG a) = a +rangeValue (NLEQ a) = a +rangeValue (NGEQ a) = a +rangeValue (NEQ a) = a + +type Interval a = (Boundary a ,Boundary a) + + +showInterval :: Show a => Interval a -> String +showInterval (Closed a,Closed b) = "[" <> show a <> ", " <> show b <> "]" +showInterval (Open a,Open b) = "(" <> show a <> ", " <> show b <> ")" +showInterval (Open a,Closed b) = "(" <> show a <> ", " <> show b <> "]" +showInterval (Closed a,Open b) = "[" <> show a <> ", " <> show b <> ")" + +-- | Show a list of intervals +-- (a,b) | (c,d) | (e,f) | ... +showIntervals :: Show a => [Interval a] -> String +showIntervals = foldl' f "" + where + f [] x = showInterval x + f acc x = acc <> " | " <> showInterval x + +rangeToInterval :: forall a. Ord a => (a,a) -> RangeConstraint a -> Interval a +rangeToInterval (min',max') a = + let value = rangeValue a + in if min' > value || max' < value + then error "rangeToInterval: value not in range" + else toInterval a + where + toInterval :: RangeConstraint a -> Interval a + toInterval (NL v) = (Closed min', Open v) + toInterval (NG v) = (Open v, Closed max') + toInterval (NLEQ v) = (Closed min', Closed v) + toInterval (NGEQ v) = (Closed v, Closed max') + toInterval (NEQ v) = (Closed v, Closed v) + +negateRange :: RangeConstraint a -> [RangeConstraint a] +negateRange (NL a) = [NGEQ a] +negateRange (NG a) = [NLEQ a] +negateRange (NLEQ a) = [NG a] +negateRange (NGEQ a) = [NL a] +negateRange (NEQ a) = [NL a, NG a] + + +mergeIntervals :: (Num a,Ord a) => Interval a -> Interval a -> [Interval a] +-- if the b value is less than the c value, then the intervals +-- do not overlap +mergeIntervals (a,b) (c,d) + | boundaryValue b < boundaryValue c = [(a,b),(c,d)] + +-- if the b value is equal to the c value +-- but both are open, then the intervals do not overlap +mergeIntervals (a,Open b) (Open c,d) + | b == c = [(a,Open b),(Open c,d)] + +mergeIntervals (a,b) (c,d) = [(min a c,max b d)] + +mergeIntervalList :: forall a. (Num a,Ord a) => [Interval a] -> [Interval a] +mergeIntervalList list = merge sorted + where + sorted = sortOn fst list + + merge :: [Interval a] -> [Interval a] + merge [] = [] + merge [x] = [x] + merge (x:y:xs) = case mergeIntervals x y of + [] -> merge xs + [x1] -> merge (x1:xs) + x1:x2:_ -> x1 : merge (x2:xs) + +reverseBoundary :: Boundary a -> Boundary a +reverseBoundary (Closed a) = Open a +reverseBoundary (Open a) = Closed a + +type Domain a = Interval a + +diff :: (Num a,Ord a) => Domain a -> Interval a -> (Maybe (Interval a),Maybe (Interval a)) +diff (a,b) (c,d) = (first, second) + where + first = guard (a < c) >> Just (a,reverseBoundary c) + second = guard (d < b) >> Just (reverseBoundary d,b) + +intervalPoints :: Interval a -> [Boundary a] +intervalPoints (a,b) = [a,b] + +intervalsToPoints :: [Interval a] -> [Boundary a] +intervalsToPoints = concatMap intervalPoints + +addDomainPoints :: (Num a,Ord a) => Domain a -> [Boundary a] -> [Boundary a] +addDomainPoints d [] = intervalPoints d +addDomainPoints _ [_] = error "addDomainPoints: invalid input" +addDomainPoints (a,b) (head':xs) = + let + lst = last xs + middle = take (length xs - 1) xs + begin = if a < head' then [a,reverseBoundary head'] else [] + end = if lst < b then [reverseBoundary lst,b] else [] + in begin ++ map reverseBoundary middle ++ end + +boundaryListToIntervalList :: [Boundary a] -> [Interval a] +boundaryListToIntervalList [] = [] +boundaryListToIntervalList (x:y:xs) = (x,y) : boundaryListToIntervalList xs +boundaryListToIntervalList [_] = error "boundaryListToIntervalList: invalid input" + +gaps :: (Num a,Ord a) => Domain a -> [Interval a] -> [Interval a] +gaps d intervals = + let merged = mergeIntervalList intervals + points = addDomainPoints d $ intervalsToPoints merged + in boundaryListToIntervalList points + + +gapsWithinRange :: (Num a,Ord a) => (a,a) -> [RangeConstraint a] -> [Interval a] +gapsWithinRange d@(d1,d2) ranges = + let intervals = map (rangeToInterval d) ranges + d' = (Closed d1, Closed d2) + in gaps d' intervals + +{- +>>> gapsWithinRange (0,10) [NL 1, NG 5] +[(Closed 1,Closed 5)] + +>>> -- not less then , and not greater than 6 and not equal to 0 +>>> gapsWithinRange (-10,10) [NL 1, NG 6, NEQ 0] +[(Closed 1,Closed 6)] + +>>> -- not less then 3 , not greater than 6 and not less then 0 +>>> gapsWithinRange (-10,10) [NL 3, NG 6, NL 0] +[(Closed 3,Closed 6)] + +>>> -- not less then 1 and not greater than 5 and equal to 0 +>>> gapsWithinRange (-10,10) $ [NL 1, NG 5 ] ++ negateRange (NEQ 0) +[] + +>>> -- not less then 1 and not greater than 5 and equal to 3 +>>> gapsWithinRange (-10,10) $ [NL 1, NG 5 ] ++ negateRange (NEQ 3) +[(Closed 3,Closed 3)] + +>>> gapsWithinRange (-10,10) [NEQ 0] +[(Closed (-10),Open 0),(Open 0,Closed 10)] + +>>> gapsWithinRange (0,10) [NL 1] +[(Closed 1,Closed 10)] + +>>> gapsWithinRange (-5000,5000) $ negateRange (NL 30) ++ [NL 0, NG 1000] +[(Closed 0,Open 30)] + +-} + +-------------------------------------------------------------------------------- +-- | Generators + +generateFromInterval :: (HasRange a,Ord a) => Interval a -> Gen a +generateFromInterval (a, b) = + let range = choose' (boundaryValue a,boundaryValue b) + in case (a,b) of + (Closed _,Closed _) -> range + (Open _,Open _) -> range `suchThat` (\x -> x > boundaryValue a && x < boundaryValue b) + (Closed _,Open _) -> range `suchThat` (\x -> x < boundaryValue b) + (Open _,Closed _) -> range `suchThat` (\x -> x > boundaryValue a) + +generateFromIntervals :: (HasRange a,Ord a) => [Interval a] -> Gen a +generateFromIntervals = oneof . map generateFromInterval + +generateFromConstraints :: (HasRange a,Ord a,Num a) + => (a,a) + -> [RangeConstraint a] + -> Gen a +generateFromConstraints d ranges = generateFromIntervals $ gapsWithinRange d ranges + +rangeGen :: forall a. (Num a,HasDomain a,HasRange a,Ord a) + => RangeConstraint a + -> Gen a +rangeGen = rangeGen' domain + +rangeGen' :: forall a. (Num a,HasRange a,Ord a) + => (a,a) + -> RangeConstraint a + -> Gen a +rangeGen' (lower,upper) range = case range of + NL x -> choose' (lower,x) `suchThat` (< x) + NG x -> choose' (x,max upper (upper + x)) `suchThat` (> x) + NEQ x -> pure x + NLEQ x -> choose' (lower,x) + NGEQ x -> choose' (x,upper) diff --git a/cardano-constitution/test/Helpers/MultiParam.hs b/cardano-constitution/test/Helpers/MultiParam.hs new file mode 100644 index 00000000000..816743273d4 --- /dev/null +++ b/cardano-constitution/test/Helpers/MultiParam.hs @@ -0,0 +1,321 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TupleSections #-} + +module Helpers.MultiParam + ( allValidAndOneMissing + , allValid + , allValidAndOneGreaterThanUpper + , allValidAndOneLessThanLower + , allInvalid + , someInvalidAndSomeValidParams + , someValidParams + , allValidButOnePlusOneUnknown + , allValidAndOneUnknown + , onlyUnknownParams + , GenericParam(..) + , multiParamProp + , multiParamProp' + ) + where + +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import Data.List (nub, sortOn) +import PlutusLedgerApi.V3.ArbitraryContexts qualified as V3 + +import Control.Monad (foldM, unless, when) +import Control.Monad.IO.Class +import Data.Either +import Data.Map.Strict hiding (map) +import Data.Traversable +import Test.QuickCheck.Monadic +import Test.Tasty.QuickCheck as TSQ + +import Helpers.CekTests +import Helpers.Guardrail as G +import Helpers.TestBuilders + + +getGenericParamIx :: GenericParam -> ParamIx +getGenericParamIx (MkGenericParam gr) = getParamIx gr + +-------------------------------------------------------------------------------- +-- | Multi param property based test builders + +--TODO: think about other name +multiParamProp :: (Testable prop) + => TestNumber + -> Gen ParamValues + -> ((Bool, ParamValues) -> prop) + -> PropertyWithTestState +multiParamProp testNo gen = multiParamProp' testNo gen (pure []) + +combine2Gen :: Gen a -> Gen b -> Gen (a,b) +combine2Gen genA genB = (,) <$> genA <*> genB + +--TODO: think about other name +multiParamProp' :: (Testable prop) + => TestNumber + -> Gen ParamValues + -> Gen ParamValues + -> ((Bool, ParamValues) -> prop) + -> PropertyWithTestState +multiParamProp' testNo gen extraGen finalProp ref = withMaxSuccess 9_999 $ + TSQ.forAll (combine2Gen gen extraGen) $ + \(params',extraParams) -> monadicIO $ do + + let params = case extraParams of + [] -> params' + -- if there are extra params, sort them by index + _nonEmpty -> sortOn fst $ params' ++ extraParams + let (V3.ArbitraryContext ctx) = V3.simpleContextWithParam params + -- validate all the validators + results' <- liftIO $ for defaultValidators $ \ v -> tryApplyOnData v ctx + complyResults <- liftIO $ for defaultValidatorsWithCodes $ \v -> hsAgreesWithTxBool v (V3.FakeProposedContext ctx) + let results = map isRight $ elems results' + -- remove duplicates. + -- in the happy path, there should be only one result + joinedResults = nub results + + -- Fail if v1 or v2 or v3 or v4 are wrong + when (length joinedResults /= 1) $ + fail $ "Validator results are not the same: " ++ show results' + + let headResult = head results + headComplyResult = head $ elems complyResults + complyResult = and complyResults + + unless complyResult $ + fail "Validator results do not comply" + + -- update the test state with the result and the generated params + -- (skip the extra params) + liftIO $ updateMultiParamStateRef testNo params' (headResult && headComplyResult) ref + + -- pass the evaluation to the root property caller + pure $ finalProp (headResult && headComplyResult,params') +-------------------------------------------------------------------------------- +-- | Multi param by guard-rails + +allValidAndOneMissing :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValidAndOneMissing [] = pure [] +allValidAndOneMissing [_] = pure [] +allValidAndOneMissing validRanges = do + -- shuffle the valid ranges and get all the values + shuffled <- shuffle validRanges + let generators = fmap (\(MkGenericParam gr) -> inRangeSingleParamValues gr) shuffled + validValues <- sequence generators + case validValues of + [] -> pure [] + _:xs' -> pure $ sortOn fst xs' + +allValid :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValid [] = pure [] +allValid params = do + let generators = fmap (\(MkGenericParam gr) -> inRangeSingleParamValues gr) params + validValues <- sequence generators + pure $ sortOn fst validValues + +allValidAndOneCustom :: (GenericParam -> Maybe (Gen Printable)) + -> [GenericParam] + -> Gen [(ParamIx,Printable)] +allValidAndOneCustom _ [] = pure [] +allValidAndOneCustom customGen [gr@(MkGenericParam param)] = + case customGen gr of + Nothing -> error "No possible custom generator" + Just gen -> do + value <- gen + pure [(getParamIx param, value)] +allValidAndOneCustom customGen params = do + tryGenerate + where + tryGenerate = do + xs <- shuffle params + + tailValues <- mapM (\(MkGenericParam gr) -> inRangeSingleParamValues gr) + $ tail xs + case customGen $ head xs of + Nothing -> tryGenerate + Just customOne -> do + value <- customOne + pure $ sortOn fst ((getGenericParamIx $ head xs,value):tailValues) + +allValidAndOneGreaterThanUpper :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValidAndOneGreaterThanUpper = allValidAndOneCustom + (\(MkGenericParam x) -> greaterThanUpperParamValue One x ) + +allValidAndOneLessThanLower :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValidAndOneLessThanLower = allValidAndOneCustom + (\(MkGenericParam x) -> lessThanLowerParamValue One x ) + +allInvalid :: [GenericParam] -> Gen [(ParamIx,Printable)] +allInvalid xs = do + values <- outOfRangeParamValues All xs + pure $ sortOn fst values + +allValidAndOneUnknown :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValidAndOneUnknown xs = do + allValidValues <- allValid xs + unknownValue <- unknownParamValue () + pure $ sortOn fst (unknownValue : allValidValues) + +unknownParamValue :: a -> Gen (ParamIx, Printable) +unknownParamValue _ = do + paramIx <- chooseInteger (1_000, 2_000) + value <- chooseInteger domain + pure (paramIx, MkPrintable value) + +allValidButOnePlusOneUnknown :: [GenericParam] -> Gen [(ParamIx,Printable)] +allValidButOnePlusOneUnknown xs = do + -- shuffle params and get all the values + values <- oneof [allValidAndOneLessThanLower xs + ,allValidAndOneGreaterThanUpper xs] + + -- remove one value and sort the list + unknownValue <- unknownParamValue () + pure $ sortOn fst (unknownValue : values) + +someValidParams :: [GenericParam] -> Gen [(ParamIx,Printable)] +someValidParams xs = do + -- shuffle params and take a sublist of them + shuffle xs >>= sublistOf1 >>= allValid + +someInvalidAndSomeValidParams :: [GenericParam] -> Gen [(ParamIx,Printable)] +someInvalidAndSomeValidParams params = do + tryGenerate + where + tryGenerate = do + -- shuffle the params and choose a sublist of them + -- the sublist must not be empty + xs <- shuffle params >>= sublistOf1 + -- at least one param must be out of range + splitAt' <- choose (1, length xs) + let forOutOfRange = Prelude.take splitAt' xs + forInRange = Prelude.drop splitAt' xs + invalidValues <- outOfRangeParamValues One forOutOfRange + case invalidValues of + [] -> tryGenerate + _xs -> do + validValues <- forM forInRange \(MkGenericParam gr) -> inRangeSingleParamValues gr + + -- return the values sorted by the param index + pure $ sortOn fst (invalidValues ++ validValues) + +onlyUnknownParams :: Gen [(ParamIx,Printable)] +onlyUnknownParams = listOf1 (unknownParamValue ()) + +-------------------------------------------------------------------------------- +-- | Primitives + +sublistOf1 :: [a] -> Gen [a] +sublistOf1 = flip suchThat (not . Prelude.null) . sublistOf + +-- all invalid , unsorted +outOfRangeParamValues :: GeneratorSpectrum -> [GenericParam] -> Gen [(ParamIx,Printable)] +outOfRangeParamValues spectrum xs = do + foldM (\acc (MkGenericParam gr) -> + case outOfRangeParamValue spectrum gr of + -- if it can't generate a value, return the accumulator + Nothing -> pure acc + -- if it can generate a value, add it to the accumulator + Just gen -> do + value <- gen + pure $ (getParamIx gr,value) : acc + ) + [] xs + +inRangeParamValues :: [Guardrail (Param a)] -> Gen [(ParamIx,Printable)] +inRangeParamValues paramRanges = + forM paramRanges inRangeSingleParamValues + +inRangeSingleParamValues :: forall a. Guardrail (Param a) + -> Gen (ParamIx,Printable) +inRangeSingleParamValues gr@(G.WithinDomain _ _) = + let (paramIx,range) = paramRange gr + in case range of + MkParamRangeWithinDomain (a,b) domain' -> + (paramIx,) . pack <$> rangeGen domain' (IN' a b) +inRangeSingleParamValues gr@(Param{} ) = + inRangeSingleParamValues $ G.WithinDomain gr $ getDomain gr + +inRangeSingleParamValues (ParamList paramIx _ subparams ) = do + xs <- fmap snd <$> forM subparams inRangeSingleParamValues + return (paramIx, pack xs) + +data GeneratorSpectrum = All | One + +-- | choose a random value lower than the lower bound of the range +-- NOTE: if the range is unbounded Nothing is returned +lessThanLowerParamValue :: forall a. GeneratorSpectrum + -> Guardrail (Param a) + -> Maybe (Gen Printable) +lessThanLowerParamValue _ gr@(Param {}) = lessThanLowerParamValue All $ G.WithinDomain gr $ getDomain gr +lessThanLowerParamValue _ gr@(G.WithinDomain _ _) = lessThanLowerParamValue' range + where + (_,range) = paramRange gr + lessThanLowerParamValue' (MkParamRangeWithinDomain (a,_) (start,_)) | a <= start = Nothing + lessThanLowerParamValue' (MkParamRangeWithinDomain (a,_) domain') = Just $ + pack <$> rangeGen domain' (LT' a) + +lessThanLowerParamValue spectrum (ParamList _ _ xs) = + withInvalidator (lessThanLowerParamValue spectrum) All xs + +-- | choose a random value greater than the upper bound of the range +-- NOTE: if the range is unbounded Nothing is returned +greaterThanUpperParamValue :: forall a. GeneratorSpectrum -> Guardrail (Param a) -> Maybe (Gen Printable) +greaterThanUpperParamValue _ gr@(Param {}) = greaterThanUpperParamValue All $ G.WithinDomain gr $ getDomain gr +greaterThanUpperParamValue _ gr@(G.WithinDomain _ _) = greaterThanUpperParamValue' range + where + (_,range) = paramRange gr + greaterThanUpperParamValue' (MkParamRangeWithinDomain (_,b) (_,end)) | b >= end = Nothing + greaterThanUpperParamValue' (MkParamRangeWithinDomain (_,b) domain') = Just $ + pack <$> rangeGen domain' (GT' b) +greaterThanUpperParamValue spectrum (ParamList _ _ xs) = + withInvalidator (greaterThanUpperParamValue spectrum) All xs + + +-- | choose a random value out of the range +-- NOTE: if the range is unbounded Nothing is returned +outOfRangeParamValue :: forall a.GeneratorSpectrum -> Guardrail (Param a) -> Maybe (Gen Printable) +outOfRangeParamValue _ gr@(Param {}) = outOfRangeParamValue All $ G.WithinDomain gr $ getDomain gr +outOfRangeParamValue _ gr@(G.WithinDomain _ _) = outOfRangeParamValue' range + where + (_,range) = paramRange gr + outOfRangeParamValue' (MkParamRangeWithinDomain (a,b) (start,end)) | a > start && b < end = Just $ + pack <$> rangeGen (start,end) (OUT' a b) + outOfRangeParamValue' (MkParamRangeWithinDomain (a,_) (start,_)) | a > start = lessThanLowerParamValue All gr + outOfRangeParamValue' (MkParamRangeWithinDomain (_,b) (_,end)) | b < end = greaterThanUpperParamValue All gr + outOfRangeParamValue' _ = Nothing +outOfRangeParamValue spectrum (ParamList _ _ xs) = + withInvalidator (outOfRangeParamValue spectrum) All xs + + +-- | custom invalid value generator for single param +withInvalidator :: forall a. + (Guardrail (Param (Scalar a)) -> Maybe (Gen Printable)) + -> GeneratorSpectrum + -> [Guardrail (Param (Scalar a))] + -> Maybe (Gen Printable) +withInvalidator f All xs = + -- we generate a random value for each subparam + let subparamsGen = mapM f xs + in case subparamsGen of + Just gens -> Just $ do + subparams <- sequence gens + return $ pack subparams + Nothing -> Nothing +withInvalidator _ One [] = Nothing +withInvalidator f One (first:xs) = + let + validGenerators = inRangeParamValues xs + invalidGenerator = f first + in case invalidGenerator of + Nothing -> Nothing + Just gen -> Just $ do + subparams <- fmap snd <$> validGenerators + invalid <- gen + return $ pack $ invalid : subparams + diff --git a/cardano-constitution/test/Helpers/Spec/FareySpec.hs b/cardano-constitution/test/Helpers/Spec/FareySpec.hs new file mode 100644 index 00000000000..b2e3f001afe --- /dev/null +++ b/cardano-constitution/test/Helpers/Spec/FareySpec.hs @@ -0,0 +1,61 @@ +module Helpers.Spec.FareySpec where + +import Helpers.Farey + +import Test.Tasty + +-- import Test.QuickCheck.Property (Result(testCase)) + +import Data.Ratio +import Test.Tasty.HUnit + +import Test.Tasty.QuickCheck as TSQ + +internalTests :: TestTree +internalTests = + testGroup + "Farey sequences" + [ testCase "(17 % 20) on 64 bits" $ + findTightestRationalBounds (17 % 20) 64 + @?= ( 15679732462653118871 % 18446744073709551613 + , 15679732462653118866 % 18446744073709551607 + ) + , testCase "(17 % 20) on 4 bits" $ + findTightestRationalBounds (17 % 20) 4 + @?= (11 % 13, 6 % 7) + , testCase "(17 % 20) on 2 bits" $ + findTightestRationalBounds (17 % 20) 2 + @?= (1 % 2, 1 % 1) + , TSQ.testProperty "between" $ \(x :: Rational) -> + let (a, b) = findTightestRationalBounds x 64 + in a < x && x < b + , TSQ.testProperty "same distance" $ + TSQ.forAll (arbitrary `suchThat` (/= 0)) $ \(x :: Rational) -> + let (p, s) = findTightestRationalBounds x 64 + (a, b) = (numerator p, denominator p) + (c, d) = (numerator s, denominator s) + in (a + c) * denominator x == (b + d) * numerator x + , TSQ.testProperty "previous is close to ratio" $ + TSQ.forAll (arbitrary `suchThat` (\x -> x > 0 && x < 1)) $ \(x :: Rational) -> + let digits = 64 + (p, _) = findTightestRationalBounds x digits + in p + (1 % (2 ^ digits - 1)) > x + , TSQ.testProperty "successor is close to ratio" $ + TSQ.forAll (arbitrary `suchThat` (\x -> x > 0 && x < 1)) $ \(x :: Rational) -> + let digits = 64 + (_, s) = findTightestRationalBounds x digits + in s - (1 % (2 ^ digits - 1)) < x + , TSQ.testProperty "boundaries remain within 64 bits" $ \(s :: Rational) -> + let + domain = 64 + (prev, next) = findTightestRationalBounds s domain + maxSize = 2 ^ domain + in + abs (numerator prev) < maxSize + && abs (denominator prev) < maxSize + && abs (numerator next) < maxSize + && abs (denominator next) < maxSize + ] + +-- >>> findTightestRationalBounds (3650722194 % 4294967287) 32 +-- (17 % 20,3650722177 % 4294967267) diff --git a/cardano-constitution/test/Helpers/Spec/IntervalSpec.hs b/cardano-constitution/test/Helpers/Spec/IntervalSpec.hs new file mode 100644 index 00000000000..90e35051357 --- /dev/null +++ b/cardano-constitution/test/Helpers/Spec/IntervalSpec.hs @@ -0,0 +1,103 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE TypeApplications #-} +module Helpers.Spec.IntervalSpec where + +import Helpers.Intervals +import Test.Tasty +--import Test.QuickCheck.Property (Result(testCase)) +import Data.List (foldl') +import Data.Ratio +import Helpers.TestBuilders +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as TSQ + + +-- NOTE: if you want to use rationals the test name won't +-- be guaranteed to be the same, since the show instance of +-- rationals is simplified +intervalTest :: (Num a,Ord a,Show a) => (a,a) -> [RangeConstraint a] -> [(Boundary a,Boundary a)] -> TestTree +intervalTest domain' constraints expected = testCase testStr $ + gapsWithinRange domain' constraints @?= + expected + + where + testStr = inputStr ++ " => " ++ expectedStr + inputStr = removeLastAnd $ foldl' f "not: " constraints + f acc (NL a)= acc ++ "(< " ++ show a ++ ") && " + f acc (NG a)= acc ++ "( > " ++ show a ++ ") && " + f acc (NEQ a)= acc ++ "(!= " ++ show a ++ ") && " + f acc (NLEQ a)=acc ++ "(<= " ++ show a ++ ") && " + f acc (NGEQ a)=acc ++ "(>= " ++ show a ++ ") && " + removeLastAnd = reverse . drop 4 . reverse + + expectedStr = removeLastOr $ foldl g "" expected + g acc (Open a, Open b) = acc ++ "(" ++ show a ++ "," ++ show b ++ ") | " + g acc (Open a, Closed b) = acc ++ "(" ++ show a ++ "," ++ show b ++ "] | " + g acc (Closed a, Open b) = acc ++ "[" ++ show a ++ "," ++ show b ++ ") | " + g acc (Closed a, Closed b) = acc ++ "[" ++ show a ++ "," ++ show b ++ "] | " + removeLastOr = reverse . drop 3 . reverse + +internalTests :: TestTree +internalTests = testGroup "Tools: Intervals" [ + testGroup "gapsWithinRange" + [ testCase "no constraint gives back the full domain " $ + gapsWithinRange' [] @?= [(Closed negInf,Closed 10)] + + , testCase "no less than 1 => [1,inf] " $ + gapsWithinRange' [NL 1] @?= [(Closed 1,Closed 10)] + + , testCase "not less than 1 and not greater than 5 => [1,5]" $ + gapsWithinRange' [NL 1, NG 5] @?= [(Closed 1,Closed 5)] + + , testCase "not less than 1, not greater than 5 and not equal to 0 => [1,5]" $ + gapsWithinRange' [NL 1, NG 5, NEQ 0] @?= [(Closed 1,Closed 5)] + + , testCase "not less than 3, not greater than 6 and not less than 0 => [3,6]" $ + gapsWithinRange' [NL 3, NG 6, NL 0] @?= [(Closed 3,Closed 6)] + + , testCase "not less then 1 and not greater than 5 and equal to 0 => []" $ + gapsWithinRange' ([NL 1, NG 5 ] ++ negateRange (NEQ 0)) @?= [] + + , testCase "not less then 1 and not greater than 5 and equal to 3 => [3,3]" $ + gapsWithinRange' ([NL 1, NG 5 ] ++ negateRange (NEQ 3)) @?= [(Closed 3,Closed 3)] + + , testCase "not equal to 0 => [-inf,0) | (0,+inf]" $ + gapsWithinRange' ([NL 1, NG 5 ] ++ negateRange (NEQ 3)) @?= [(Closed 3,Closed 3)] + + , intervalTest @Integer (-10000,10000) [NL 3125, NG 6250, NEQ 0, NL 0] [(Closed 3125,Closed 6250)] + + , intervalTest @Integer (-10000,10000) [NG 6250, NEQ 0, NL 0] [(Open 0,Closed 6250)] + + , intervalTest @Integer (-10000,10000) [NL 1 , NG 3, NEQ 2] [(Closed 1,Open 2),(Open 2,Closed 3)] + + , intervalTest @Integer (-10000,10000) [NL 1 , NG 10, NEQ 2,NEQ 4,NEQ 8] + [(Closed 1,Open 2),(Open 2,Open 4),(Open 4,Open 8),(Open 8,Closed 10)] + + , intervalTest @Integer (-10000,10000) [NL 10 , NG 9] [] + + , testCase "not: (< 1 % 10) && (> 10 % 10) => [1 % 10, 1 % 1]" $ + gapsWithinRange @Rational (-1,3) [NL (1 % 10), NG (10 % 10) ] @?= [(Closed (1 % 10),Closed (1 % 1))] + + , TSQ.testProperty "[NL (1 % 10), NG (10 % 10) ] should generate within the boundaries" $ + TSQ.forAll (rationalGenerator [NL (1 % 10), NG (10 % 10) ]) $ + \x -> x >= 1 % 10 && x <= 1 + + , testCase "[NL (50 % 100), NG (100 % 100), NL (65 % 100) , NG (90 % 100) ] => [65 % 100, 90 % 100]" $ + gapsWithinRange @Rational (-1,1) [NL (50 % 100), NG (100 % 100), NL (65 % 100) , NG (90 % 100)] @?= + [(Closed (65%100),Closed (90%100))] + + , TSQ.testProperty "[NL (50 % 100), NG (100 % 100), NL (65 % 100) , NG (90 % 100) ] should generate within the boundaries" $ + TSQ.forAll (rationalGenerator [NL (50 % 100), NG (100 % 100), NL (65 % 100) , NG (90 % 100)]) $ + \x -> x >= 65 % 100 && x <= 90 % 100 + + , TSQ.testProperty "rationals should be generated within the boundaries" $ + withMaxSuccess 600 $ TSQ.forAll (choose' @Rational (0,1)) $ + \x -> x >= 0 && x <= 100 + ] + ] + where + rationalGenerator = generateFromIntervals . gapsWithinRange @Rational (-1,3) + gapsWithinRange' = gapsWithinRange @Integer domain' + domain' = (negInf,posInf) + negInf = -10 + posInf = 10 diff --git a/cardano-constitution/test/Helpers/TestBuilders.hs b/cardano-constitution/test/Helpers/TestBuilders.hs new file mode 100644 index 00000000000..fbdd2d94676 --- /dev/null +++ b/cardano-constitution/test/Helpers/TestBuilders.hs @@ -0,0 +1,403 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Helpers.TestBuilders where + +import Cardano.Constitution.Config.Types +import Cardano.Constitution.Validator +import Cardano.Constitution.Validator.TestsCommon +import Data.List (nub, sortOn) +import PlutusLedgerApi.V3 qualified as V3 +import PlutusLedgerApi.V3.ArbitraryContexts qualified as V3 +import PlutusTx.IsData.Class + +import Control.Arrow +import Control.Monad (unless, when) +import Control.Monad.IO.Class +import Data.Aeson +import Data.Either +import Data.IORef +import Data.Map.Strict hiding (map) +import Data.Ratio +import Data.Traversable +import Test.QuickCheck.Monadic +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as TSQ + +import Helpers.CekTests +import PlutusTx.AssocMap qualified as Tx +import PlutusTx.Builtins.Internal qualified as BI +import PlutusTx.IsData qualified as Tx + +none :: Foldable t => (a -> Bool) -> t a -> Bool +none f = not . any f + +-- | Wrapper for a test case that includes a reference to the test state +-------------------------------------------------------------------------------- + +-- | Heterogeneous values that can be printed and serialized +data Printable = forall a . (Show a,ToJSON a,ToData a) => MkPrintable a + +deriving stock instance Show Printable +instance ToJSON Printable where + toJSON (MkPrintable a) = toJSON a + +instance ToData Printable where + toBuiltinData (MkPrintable a) = toBuiltinData a + + +-- | Pack a value into a Printable +pack :: (ToJSON a,Show a,ToData a) => a -> Printable +pack = MkPrintable + + +type TestNumber = Int +type ParamValues =[(ParamKey,Printable)] +type MultiParamState = Map TestNumber [(ParamValues,Bool)] +type SingleParamState = Map ParamId [(Printable,Bool)] +type ParamId = String + +-- testProperty "#1" # template [(ParamKey,Printable)] +-- | Test state +data TestState = TestState + { oneParamState :: !SingleParamState + , multiParamState :: !MultiParamState + } deriving stock (Show) + +-- | Update the test state with a new test result of a single parameter test +updateSingleParamState :: (ToJSON n,Show n,ToData n) + => ParamId + -> n + -> Bool + -> TestState + -> TestState +updateSingleParamState paramIx value result (TestState oneS multiS) = + TestState newMap multiS + where + newMap = alter (Just . f) paramIx oneS + f (Just xs) = (pack value, result) : xs + f Nothing = [(pack value, result)] + +-- | Update the test state ioRef with a new test result of a single parameter test +updateSingleParamStateRef :: (ToJSON n,Show n,ToData n) + => ParamId + -> n + -> Bool + -> IORef TestState + -> IO () +updateSingleParamStateRef paramId value result ref = + atomicModifyIORef' ref (\ts -> (updateSingleParamState paramId value result ts, ())) + +-- | Update the test state with a new test result of a multi parameter test +updateMultiParamState :: TestNumber + -> ParamValues + -> Bool + -> TestState + -> TestState +updateMultiParamState testNo params result (TestState oneS multiS) = + TestState oneS newMap + where + newMap = alter (Just . f) testNo multiS + f (Just xs) = (params,result) : xs + f Nothing = [(params,result)] + +-- | Update the test state ioRef with a new test result of a multi parameter test +updateMultiParamStateRef :: TestNumber + -> ParamValues + -> Bool + -> IORef TestState + -> IO () +updateMultiParamStateRef testNo params result ref = + atomicModifyIORef' ref (\ts -> (updateMultiParamState testNo params result ts, ())) + +-- | Property with a reference to the test state +type PropertyWithTestState = IORef TestState -> Property + +-- | Test tree with a reference to the test state +type TestTreeWithTestState = IORef TestState -> TestTree + +type AssertionWithTestState = IORef TestState -> Assertion + +-- | Class for testable values that can be run with a reference to the test state +-- used for TestTreeWithTestState but also for simple Property +class TestableWithState a where + testProperty' :: TestName -> a -> TestTreeWithTestState + +instance Testable a => TestableWithState (IORef TestState -> a) where + testProperty' name f = testProperty name . f + +instance TestableWithState Property where + testProperty' name val _ = testProperty name val + +class AssertableWithState a where + testCase' :: TestName -> a -> TestTreeWithTestState + +instance AssertableWithState (IORef TestState -> Assertion) where + testCase' name f = testCase name . f + +instance AssertableWithState Assertion where + testCase' name a _ = testCase name a + +-- | Test tree with a reference to the test state +testGroup' :: TestName -> [TestTreeWithTestState] -> TestTreeWithTestState +testGroup' name tests ref = testGroup name $ map ($ ref) tests + +-------------------------------------------------------------------------------- +-- Unit test builders + +unitTestTemplatePositive :: (ToJSON b,Show b, ToData b) + => ParamKey + -> b + -> AssertionWithTestState +unitTestTemplatePositive paramIx = + unitTestTemplatePositive' (show paramIx) (oneParamChange paramIx ) + +unitTestTemplatePositive' :: (ToJSON b,Show b, ToData b) + => ParamId + -> (b -> ParamValues) + -> b + -> AssertionWithTestState +unitTestTemplatePositive' paramIx toData' val ref = do + let ctx = V3.mkFakeParameterChangeContext $ toData' val + results <- for defaultValidators $ \ v -> tryApplyOnData v ctx + complyResults <- for defaultValidatorsWithCodes $ \v -> hsAgreesWithTxBool v ctx + let result = all isRight results + complyResult = and complyResults + headResult = isRight $ head $ elems results + headComplyResult = head $ elems $ complyResults + + assertBool ("Validator results are not all valid: " ++ show results) result + assertBool "Validator results do not comply" complyResult + + liftIO $ updateSingleParamStateRef paramIx val (headResult && headComplyResult) ref + +unitTestTemplateNegative :: (ToJSON b,Show b, ToData b) + => ParamKey + -> b + -> AssertionWithTestState +unitTestTemplateNegative paramIx = + unitTestTemplateNegative' (show paramIx) (oneParamChange paramIx) + +unitTestTemplateNegative' :: (ToJSON b,Show b, ToData b) + => ParamId + -> (b -> ParamValues) + -> b + -> AssertionWithTestState +unitTestTemplateNegative' paramIx toData' val ref = do + let ctx = V3.mkFakeParameterChangeContext $ toData' val + results <- for defaultValidators $ \ v -> tryApplyOnData v ctx + complyResults <- for defaultValidatorsWithCodes $ \v -> hsAgreesWithTxBool v ctx + let result = none isRight results + complyResult = and complyResults + headResult = isRight $ head $ elems results + headComplyResult = head $ elems $ complyResults + + assertBool ("Some validator results are valid: " ++ show results) result + assertBool "Validator results do not comply" complyResult + + liftIO $ updateSingleParamStateRef paramIx val (headResult && headComplyResult) ref + +-------------------------------------------------------------------------------- +-- Property based test builders + +oneParamProp :: (ToJSON b,Show b, Testable prop, ToData b) + => ParamKey + -> Gen b + -> ((Bool, b) -> prop) + -> PropertyWithTestState +oneParamProp paramIx = oneParamProp' (show paramIx) (oneParamChange paramIx) + +oneParamChange :: (ToJSON a, Show a, ToData a) + => ParamIx + -> a + -> [(ParamIx, Printable)] +oneParamChange paramIx value = [(paramIx, pack value)] + +oneParamProp' :: (ToJSON a,Show a, Testable prop, ToData a) + => ParamId + -> (a -> ParamValues) + -> Gen a + -> ((Bool, a) -> prop) + -> PropertyWithTestState +oneParamProp' paramIx toData' gen finalProp ref = withMaxSuccess 600 $ TSQ.forAll gen $ + \value -> monadicIO $ do + + let (V3.ArbitraryContext ctx) = V3.simpleContextWithParam (toData' value) + + -- validate all the validators + results' <- liftIO $ for defaultValidators $ \ v -> tryApplyOnData v ctx + complyResults <- liftIO $ for defaultValidatorsWithCodes $ \v -> hsAgreesWithTxBool v (V3.FakeProposedContext ctx) + + -- remove duplicates. + -- in the happy path, there should be only one result + let results = map isRight $ elems results' + joinedResults = nub results + + -- Fail if v1 or v2 or v3 or v4 are wrong + when (length joinedResults /= 1) $ + fail $ "Validator results are not the same: " ++ show results + + let headResult = isRight $ head $ elems results' + headComplyResult = head $ elems complyResults + complyResult = and complyResults + + unless complyResult $ + fail "Validator results do not comply" + + -- update the test state with the result + liftIO $ updateSingleParamStateRef paramIx value (headResult && headComplyResult) ref + + -- pass the evaluation to the root property caller + pure $ finalProp (headResult && headComplyResult,value) + +pbtParamValidRange :: (ToJSON a,Show a,ToData a,HasRange a) + => ParamKey + -> (a, a) + -> PropertyWithTestState +pbtParamValidRange paramIx (lower, upper) = + pbtParamValidRange' (show paramIx) (oneParamChange paramIx) (lower, upper) + +pbtParamValidRange' :: (ToJSON a,Show a,ToData a,HasRange a) + => ParamId + -> (a -> ParamValues) + -> (a, a) + -> PropertyWithTestState +pbtParamValidRange' param toData' (lower, upper) = + oneParamProp' param toData' (choose' (lower,upper)) fst + +pbtParamInvalidRange :: ParamKey -> (Integer, Integer) -> PropertyWithTestState +pbtParamInvalidRange param (lower, upper) = oneParamProp param gen (not . fst) + where + gen = oneof [ + chooseInteger ( lower - 5_000 , lower - 1 ), + chooseInteger ( upper + 1 , upper + 5_000) + ] + +class HasRange a where + choose' :: (a, a) -> Gen a + +class HasDomain a where + domain :: (a,a) + +instance HasDomain Integer where + domain = (-upperBound,upperBound) + where + upperBound = 10_000 + +instance HasDomain Rational where + domain = (-upperBound,upperBound) + where + upperBound = 10_000 + +instance HasRange Integer where + choose' = chooseInteger + +instance ToData Rational where + toBuiltinData ratio = + let num = numerator ratio + den = denominator ratio + in toBuiltinData [num,den] + +instance HasRange Rational where + choose' (min_ratio,max_ratio) = do + let (a,b) = (numerator &&& denominator) min_ratio + (c,d) = (numerator &&& denominator) max_ratio + den <- chooseInteger + ( if a == 0 then 1 else max 1 (ceiling (b % a)) + , maxDenominator + ) + num <- chooseInteger (ceiling (den * a % b), floor (den * c % d)) + pure (num % den) + where + + {-# INLINEABLE maxDenominator #-} + maxDenominator = 2^(64 :: Integer)-1 + +data Range a = LT' a | GT' a | EQ' a | NEQ' a | LEQT' a | GEQT' a | IN' a a | OUT' a a + deriving stock (Show) + +rangeGen :: forall a. (Num a,HasRange a,Ord a) + => (a,a) + -> Range a + -> Gen a +rangeGen (lower,upper) range = case range of + LT' x -> choose' (lower,x) `suchThat` (< x) + GT' x -> choose' (x,max upper (upper + x)) `suchThat` (> x) + EQ' x -> pure x + NEQ' x -> choose' (lower,upper) `suchThat` (/= x) + LEQT' x -> choose' (lower,x) + GEQT' x -> choose' (x,upper) + IN' x y -> choose' (x,y) + OUT' x y -> oneof [choose' (lower,x) `suchThat` (/= x), choose' (y,upper) `suchThat` (/= y)] + +mergeDomains :: (Ord a) => (a,a) -> (a,a) -> [(a,a)] +mergeDomains (a,b) (c,d) | b < c = [(a,b),(c,d)] + | otherwise = [(min a c,max b d)] + +mergeDomainList :: forall a. (Ord a) => [(a,a)] -> [(a,a)] +mergeDomainList = Prelude.foldr f [] . sort' + where + sort' = sortOn fst + f :: (a,a) -> [(a,a)] -> [(a,a)] + f d []= [d] + f d (x:xs) = case mergeDomains d x of + [] -> xs + [d1] -> d1 : xs + d1:d2:_ -> d1 : d2 : xs + +type ParamIx = Integer + +mkCtxFromChangedParams :: ToData b => [(ParamIx,b)] -> V3.ScriptContext +mkCtxFromChangedParams = + V3.ScriptContext V3.memptyTxInfo V3.emptyRedeemer + . V3.ProposingScript 0 + . V3.ProposalProcedure 0 (V3.PubKeyCredential "") + . flip (V3.ParameterChange Nothing) Nothing + . V3.ChangedParameters + . Tx.toBuiltinData + . Tx.safeFromList + +-- a heterogeneous data type to store the valid ranges +data ParamRange + = forall a . (Num a, Show a, ToJSON a, HasRange a, ToData a, Ord a) + => MkParamRangeWithinDomain !(a,a) !(a,a) + +instance Show ParamRange where + show (MkParamRangeWithinDomain (a,b) (c,d)) = "MkParamRangeWithinDomain " ++ show (a,b) <> " within " <> show (c,d) + +-- for testing purposes +instance Show BI.BuiltinUnit where + -- not sure if needed to patternmatch everything here + show (BI.BuiltinUnit ()) = "BuiltinUnit" + +instance ToJSON (Tx.Map Integer [Integer]) where + toJSON = toJSON . Tx.toList + +costModelsValuesGen :: Gen (Tx.Map Integer [Integer]) +costModelsValuesGen = Tx.unsafeFromList <$> sublistOf allCostModelsFlat + +costModelsParamGen :: Gen (ParamIx, Printable) +costModelsParamGen = do + values <- costModelsValuesGen + pure (18, pack values) + +allCostModelsFlat :: [(Integer, [Integer])] +allCostModelsFlat = + [ (0, [ val | _ <- [1 :: Int ..166]]) + , (1, [ val | _ <- [1 :: Int ..175]]) + , (2, [ val | _ <- [1 :: Int ..233]]) + , (3, [ val | _ <- [1 :: Int ..300]]) + ] + where + val = 9_223_372_036_854_775_807 :: Integer + +allCostModels :: Tx.Map Integer [Integer] +allCostModels = Tx.unsafeFromList allCostModelsFlat diff --git a/cardano-constitution/test/PlutusLedgerApi/V3/ArbitraryContexts.hs b/cardano-constitution/test/PlutusLedgerApi/V3/ArbitraryContexts.hs new file mode 100644 index 00000000000..57aaa60e470 --- /dev/null +++ b/cardano-constitution/test/PlutusLedgerApi/V3/ArbitraryContexts.hs @@ -0,0 +1,292 @@ +-- editorconfig-checker-disable-file +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +module PlutusLedgerApi.V3.ArbitraryContexts + ( ArbitraryContext (..) + , GovernanceAction (..) + , FakeProposedContext (..) + , mkFakeParameterChangeContext + , mkFakeContextFromGovAction + , mkLargeFakeProposal + , mkSmallFakeProposal + , memptyTxInfo + , emptyRedeemer + , simpleContextWithParam + , withOneParamGen + , treasuryWithdrawalsCtxGen + ) where + +import Cardano.Constitution.Config +import PlutusCore.Generators.QuickCheck () +import PlutusLedgerApi.V3 as V3 +import PlutusTx.AssocMap as AssocMap +import PlutusTx.AssocMap as Tx +import PlutusTx.Base as Tx +import PlutusTx.Builtins as Tx +import PlutusTx.IsData as Tx +import PlutusTx.Maybe as Tx +import PlutusTx.Monoid +import PlutusTx.NonCanonicalRational +import PlutusTx.Numeric +import PlutusTx.Ratio as Tx + +import Codec.Serialise +import Control.Monad qualified as Haskell +import Data.Bifunctor qualified as Haskell +import Data.ByteString.Lazy qualified as BSL (length) +import Data.Function (on) +import Data.Int +import Data.List as List +import Data.String qualified as Haskell +import Prelude qualified as Haskell +import Test.Tasty.QuickCheck + +-- | An arbitrary context, focusing mostly on generating proposals for changing parameters +newtype ArbitraryContext = ArbitraryContext + { unArbitraryContext :: V3.ScriptContext + } + deriving newtype (Haskell.Show, Tx.ToData) + +instance Arbitrary ArbitraryContext where + arbitrary = ArbitraryContext Haskell.<$> (V3.ScriptContext + Haskell.<$> arbitraryTxInfo + Haskell.<*> arbitraryRedeemer + Haskell.<*> arbitraryScriptInfo + ) + +arbitraryTxInfo :: Gen TxInfo +arbitraryTxInfo = Haskell.pure memptyTxInfo + +arbitraryRedeemer :: Gen Redeemer +arbitraryRedeemer = Redeemer . BuiltinData Haskell.<$> arbitrary -- BuiltinData + +memptyTxInfo :: TxInfo +memptyTxInfo = TxInfo + { txInfoInputs = mempty + , txInfoReferenceInputs = mempty + , txInfoOutputs = mempty + , txInfoFee = zero + , txInfoMint = mempty + , txInfoTxCerts = mempty + , txInfoWdrl = AssocMap.unsafeFromList mempty + , txInfoValidRange = always + , txInfoSignatories = mempty + , txInfoRedeemers = AssocMap.unsafeFromList mempty + , txInfoData = AssocMap.unsafeFromList mempty + , txInfoId = V3.TxId mempty + , txInfoVotes = AssocMap.unsafeFromList mempty + , txInfoProposalProcedures = mempty + -- cant'use mempty, Lovelace is not Semigroup + , txInfoCurrentTreasuryAmount = Nothing + -- cant'use mempty, Lovelace is not Semigroup + , txInfoTreasuryDonation = Nothing + } + +emptyRedeemer :: Redeemer +emptyRedeemer = Redeemer (toBuiltinData ()) + +arbitraryScriptInfo :: Gen ScriptInfo +arbitraryScriptInfo = frequency + [(1, Haskell.pure (MintingScript "")) -- negative testing + ,(5, ProposingScript zero Haskell.<$> arbitraryProposalProcedure ) + ] + +arbitraryProposalProcedure :: Gen ProposalProcedure +arbitraryProposalProcedure = ProposalProcedure zero + Haskell.<$> arbitraryCredential + Haskell.<*> arbitraryGovernanceAction + +arbitraryCredential :: Gen Credential +arbitraryCredential = Haskell.pure (PubKeyCredential "") + +arbitraryGovernanceAction :: Gen GovernanceAction +arbitraryGovernanceAction = ParameterChange Nothing + Haskell.<$> arbitraryChangedParameters + Haskell.<*> Haskell.pure Nothing + +twAction :: Gen GovernanceAction +twAction = TreasuryWithdrawals + Haskell.<$> treasuryWithdrawalsCredentials + Haskell.<*> Haskell.pure Nothing + +-- Define a generator for a single hexadecimal character +hexChar :: Gen Haskell.Char +hexChar = elements $ ['0'..'9'] ++ ['a'..'f'] + +-- Define a generator for a hexadecimal string of a given length +hexString :: Int -> Gen Haskell.String +hexString len = Haskell.replicateM len hexChar + +-- Generate a list of arbitrary length hexadecimal strings +arbitraryHexStrings :: Gen [(Credential,Lovelace)] +arbitraryHexStrings = sized $ \n -> do + k <- choose (0, n) -- Generate a length for the list + let toCredential = Haskell.map (PubKeyCredential . Haskell.fromString) + str <- toCredential Haskell.<$> vectorOf k (hexString 16) -- Generate a list of hex strings + int <- Haskell.map Lovelace Haskell.<$> vectorOf k (chooseInteger (1, 100000000)) -- Generate a list of integers + Haskell.pure $ zip str int + +treasuryWithdrawalsCredentials :: Gen (Map Credential Lovelace) +treasuryWithdrawalsCredentials = do + unsafeFromList Haskell.<$> arbitraryHexStrings + +treasuryWithdrawalsCtxGen :: Gen ScriptContext +treasuryWithdrawalsCtxGen = V3.ScriptContext + Haskell.<$> arbitraryTxInfo + Haskell.<*> arbitraryRedeemer + Haskell.<*> twInfo + +twInfo :: Gen ScriptInfo +twInfo = ProposingScript zero Haskell.<$> twProposalProcedure + +twProposalProcedure :: Gen ProposalProcedure +twProposalProcedure = ProposalProcedure zero + Haskell.<$> arbitraryCredential + Haskell.<*> twAction + +arbitraryChangedParameters :: Gen ChangedParameters +arbitraryChangedParameters = ChangedParameters Haskell.<$> frequency + [ (1, Haskell.pure (Tx.toBuiltinData (Tx.mkList []))) -- negative testing + , (1, Haskell.pure (Tx.toBuiltinData (Tx.mkI zero))) -- negative testing + -- See guarantees (2) and (3) in README.md + , (10, Tx.toBuiltinData + -- sort the random Map, see guarantee (3) in README.md + -- Ugly code, but we want to use an external sorting function here (GHC stdlib) + -- because we do not want to rely for our tests on + -- our experimental `PlutusTx.SortedMap` sorting functions. + -- NOTE: do not use safeFromList; it destroys sortedness. + . AssocMap.unsafeFromList . List.sortOn fst . AssocMap.toList + -- using safeFromList here de-deduplicates the Map, + -- See guarantee (2) in README.md + -- See Note [Why de-duplicated ChangedParameters] + . AssocMap.safeFromList + Haskell.<$> listOf arbitraryChangedParameter) + ] + +arbitraryChangedParameter :: Gen (ParamKey, BuiltinData) +arbitraryChangedParameter = (,) + -- TODO: this is too arbitrary, create more plausible keys + Haskell.<$> arbitrary + Haskell.<*> arbitraryParamValue + where + + arbitraryParamValue :: Gen BuiltinData + arbitraryParamValue = + frequency [ + (2, arbitraryLeaf) + , (1, arbitraryNode) -- testing subs + ] + where + arbitraryLeaf = oneof [ + -- TODO: this is too arbitrary, create more plausible values + Tx.toBuiltinData Haskell.<$> arbitrary @Integer + -- TODO: this is too arbitrary, create more plausible values + , Haskell.fmap (Tx.toBuiltinData . NonCanonicalRational) . Tx.unsafeRatio + Haskell.<$> arbitrary + -- unsafeRatio err's on zero denominator + Haskell.<*> arbitrary `suchThat` (Haskell./= 0) + ] + -- 1-level nested, arbitrary-level can become too expensive + arbitraryNode = Tx.toBuiltinData Haskell.<$> listOf arbitraryLeaf + +-- | An arbitrary context, focusing mostly on generating proposals for changing parameters +newtype FakeProposedContext = FakeProposedContext + { unFakeProposedContext :: V3.ScriptContext + } + deriving newtype (Haskell.Show, ToData) + +-- | Make a fake proposed context given some changed parameters. +-- It keeps a) the order of pairs in the input and b) any duplicates in the input list. +-- Thus it can be used only for testing purposes. +-- In reality, the ledger guarantees sorted *AND* de-duped ChangedParams. +mkFakeParameterChangeContext :: ToData b => [(ParamKey, b)] -> FakeProposedContext +mkFakeParameterChangeContext = + mkFakeContextFromGovAction + . flip (V3.ParameterChange Nothing) Nothing + . V3.ChangedParameters + . Tx.toBuiltinData + -- this is the unsafe version so we can test duplicates also. + -- NOTE: do not use safeFromList; it destroys sortedness. + . AssocMap.unsafeFromList + +mkFakeContextFromGovAction :: V3.GovernanceAction -> FakeProposedContext +mkFakeContextFromGovAction = + FakeProposedContext + . V3.ScriptContext memptyTxInfo emptyRedeemer + . V3.ProposingScript 0 + . V3.ProposalProcedure 0 (V3.PubKeyCredential "") + +simpleContextWithParam :: forall a. ToData a => [(ParamKey, a)] -> ArbitraryContext +simpleContextWithParam param = ArbitraryContext scriptContext + where + scriptContext = V3.ScriptContext memptyTxInfo emptyRedeemer arbitraryScriptInfo' + + arbitraryScriptInfo' :: ScriptInfo + arbitraryScriptInfo' = ProposingScript zero arbitraryProposalProcedure' + + arbitraryProposalProcedure' :: ProposalProcedure + arbitraryProposalProcedure' = ProposalProcedure zero (PubKeyCredential "") arbitraryGovernanceAction' + + arbitraryGovernanceAction' :: GovernanceAction + arbitraryGovernanceAction' = ParameterChange Nothing paramChange Nothing + + paramChange = ChangedParameters (Tx.toBuiltinData . Tx.unsafeFromList $ param ) + +withOneParamGen :: ToData a => Gen (ParamKey,a) -> Gen ArbitraryContext +withOneParamGen gen = do + a <- gen + Haskell.pure $ simpleContextWithParam [a] + +mkLargeFakeProposal, mkSmallFakeProposal :: ConstitutionConfig -> FakeProposedContext + +{-| Constructs a large proposal, that proposes to change *every parameter* mentioned in the given config. + +This proposal will most likely be accepted by the Validators, see `mkChangedParamsFromMinValues`. + +We want this for budget-testing the WORST-CASE scenario. +-} +--TODO: replaced by Guardrails.getFakeLargeParamsChange +-- ( we can't use it here because of the circular dependency ) +mkLargeFakeProposal = mkFakeParameterChangeContext . mkChangedParamsFromMinValues + +{-| Constructs a small proposal, that proposes to change *only one parameter* (the first one) mentioned in the given config. + +This proposal will most likely be accepted by the Validators, see `mkChangedParamsFromMinValues`. + +We want this for budget-testing the BEST-CASE scenario. We cannot use an empty proposal, +because all ConstitutionValidators guard *against* empty proposals, so they will never pass and be rejected very early. +-} +mkSmallFakeProposal = mkFakeParameterChangeContext + . Haskell.pure + -- arbitrary choose one parameter keyvalue that is the smallest in serialised size + -- this does not necessary lead to smallest execution time, but it is just more explicitly defined than using `head` + . minimumBy (Haskell.compare `on` (BSL.length . serialise . toData)) + . mkChangedParamsFromMinValues + + +{-| This is is used to construct a LARGE ChangedParams. + +It does so by transforming the give constitution config to a Fake Proposal, using this arbitrary method: + +- take the LARGEST `minValue` number (integer or rational) for each (sub-)parameter. +- if a `minValue` predicate is missing, use a `def`ault 0 (if Integer), 0/1 if Rational. + +If this ChangedParams is inputted to a ConstitutionValidator, it will most likely result into a successful execution. +"Most likely" because, the chosen value may interfere with other predicates (notEqual, maxValue). +-} +mkChangedParamsFromMinValues :: ConstitutionConfig -> [(ParamKey, BuiltinData)] +mkChangedParamsFromMinValues = Haskell.fmap (Haskell.second getLargestMinValue) . unConstitutionConfig + where + getLargestMinValue :: ParamValue -> BuiltinData + getLargestMinValue = \case + ParamInteger preds -> toBuiltinData $ maximum $ fromMaybe [0] $ List.lookup MinValue $ unPredicates preds + ParamRational preds -> toBuiltinData $ NonCanonicalRational $ maximum $ fromMaybe [Tx.unsafeRatio 0 1] $ List.lookup MinValue $ unPredicates preds + ParamList values -> toBuiltinData $ Haskell.fmap getLargestMinValue values + -- Currently we only have param 18 as "any". So this generation applies only for 18. + -- Here we try to generate an 1000-integer-list for the 18 parameter. + -- Note: This is not the correct encoding of the 18 parameter, it is only for simulating a large size of proposal. + -- Even with a wrong encoding, it will be accepted by the constitution script, + -- because "any" in the config means accept any encoding: the script does not check the encoding at all. + ParamAny -> toBuiltinData $ replicate 1000 (Haskell.toInteger $ Haskell.maxBound @Int64) From 310cbc3db8f161671ad6079124d4c9d197c55d96 Mon Sep 17 00:00:00 2001 From: zeme Date: Tue, 25 Jun 2024 12:51:53 +0200 Subject: [PATCH 2/3] Remove cardano-constitution checks from CI --- nix/project.nix | 3 +++ 1 file changed, 3 insertions(+) diff --git a/nix/project.nix b/nix/project.nix index 4d986debedf..2e46859fa82 100644 --- a/nix/project.nix +++ b/nix/project.nix @@ -139,6 +139,9 @@ let plutus-core.components.tests.plutus-ir-test.postInstall = '' wrapProgram $out/bin/plutus-ir-test --set PATH ${lib.makeBinPath [ pkgs.diffutils ]} ''; + + # We want to build it but not run the tests in CI. + cardano-constitution.doCheck = false; }; } From 0fd7f5c21e972afc3b5a45162d305857a456d3bd Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis Date: Wed, 26 Jun 2024 14:58:32 +0200 Subject: [PATCH 3/3] Restrist x-compiling --- cardano-constitution/cardano-constitution.cabal | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cardano-constitution/cardano-constitution.cabal b/cardano-constitution/cardano-constitution.cabal index f399e8e941f..eb0fce6d1d6 100644 --- a/cardano-constitution/cardano-constitution.cabal +++ b/cardano-constitution/cardano-constitution.cabal @@ -52,8 +52,12 @@ common ghc-version-support if (impl(ghc <9.6) || impl(ghc >=9.7)) buildable: False +common os-support + if (impl(ghcjs) || os(windows)) + buildable: False + library - import: lang, ghc-version-support + import: lang, ghc-version-support, os-support hs-source-dirs: src default-language: Haskell2010 exposed-modules: @@ -82,7 +86,7 @@ library , template-haskell test-suite cardano-constitution-test - import: lang, ghc-version-support + import: lang, ghc-version-support, os-support hs-source-dirs: test default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N