From 1d5901a89754c411c56c19e676e2923c85f34cd3 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 10 Aug 2023 08:50:49 +0200 Subject: [PATCH] Create a hydra-plutus-extras package This allows better re-use of the utilities to wrap up validators and the time conversion functions. The Hydra.Plutus.Orphans is deliberately not called Hydra.Plutus.Extras.Orphans to not suggest it being re-exported through Hydra.Plutus.Extras --- CHANGELOG.md | 3 + cabal.project | 1 + hydra-node/bench/tx-cost/Main.hs | 2 +- hydra-node/bench/tx-cost/TxCost.hs | 2 +- hydra-node/hydra-node.cabal | 10 +- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/State.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 5 +- .../src/Hydra/Ledger/Cardano/Evaluate.hs | 2 +- .../test/Hydra/Chain/Direct/Contract/Close.hs | 4 +- .../Hydra/Chain/Direct/Contract/CollectCom.hs | 2 +- .../Hydra/Chain/Direct/Contract/Contest.hs | 4 +- .../Hydra/Chain/Direct/Contract/FanOut.hs | 4 +- .../Hydra/Chain/Direct/Contract/Mutation.hs | 2 +- .../test/Hydra/Chain/Direct/ContractSpec.hs | 2 +- hydra-plutus-extras/LICENSE | 202 ++++++++++++++++++ hydra-plutus-extras/NOTICE | 14 ++ hydra-plutus-extras/hydra-plutus-extras.cabal | 111 ++++++++++ .../src/Hydra}/Plutus/Extras.hs | 22 +- .../src/Hydra/Plutus/Extras/Time.hs | 29 +++ .../src/Hydra}/Plutus/Orphans.hs | 2 +- .../test/Hydra/Plutus/Extras/TimeSpec.hs | 27 +++ hydra-plutus-extras/test/Main.hs | 9 + hydra-plutus-extras/test/Spec.hs | 1 + hydra-plutus/hydra-plutus.cabal | 3 +- hydra-plutus/src/Hydra/Contract/Commit.hs | 6 +- hydra-plutus/src/Hydra/Contract/Hash.hs | 5 +- hydra-plutus/src/Hydra/Contract/Head.hs | 5 +- hydra-plutus/src/Hydra/Contract/HeadTokens.hs | 2 +- hydra-plutus/src/Hydra/Contract/Initial.hs | 5 +- .../src/Hydra/Data/ContestationPeriod.hs | 21 -- .../test/Hydra/Data/ContestationPeriodSpec.hs | 20 +- hydra-test-utils/src/Test/Plutus/Validator.hs | 22 -- nix/hydra/shell.nix | 1 + plutus-cbor/CHANGELOG.md | 2 + plutus-cbor/exe/encoding-cost/Main.hs | 7 +- .../Plutus/Codec/CBOR/Encoding/Validator.hs | 24 ++- plutus-cbor/plutus-cbor.cabal | 1 + plutus-merkle-tree/CHANGELOG.md | 2 + plutus-merkle-tree/bench/Validators.hs | 7 +- plutus-merkle-tree/plutus-merkle-tree.cabal | 1 + 41 files changed, 481 insertions(+), 117 deletions(-) create mode 100644 hydra-plutus-extras/LICENSE create mode 100644 hydra-plutus-extras/NOTICE create mode 100644 hydra-plutus-extras/hydra-plutus-extras.cabal rename {hydra-plutus/src => hydra-plutus-extras/src/Hydra}/Plutus/Extras.hs (80%) create mode 100644 hydra-plutus-extras/src/Hydra/Plutus/Extras/Time.hs rename {hydra-plutus/src => hydra-plutus-extras/src/Hydra}/Plutus/Orphans.hs (98%) create mode 100644 hydra-plutus-extras/test/Hydra/Plutus/Extras/TimeSpec.hs create mode 100644 hydra-plutus-extras/test/Main.hs create mode 100644 hydra-plutus-extras/test/Spec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index b382b6281f0..e5619d7e872 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -62,6 +62,9 @@ changes. - Change `minUTxOValue` to take `BundledProtocolParameters`. - Add `fromLedgerMultiAsset` helper as transactions only `mint` `MultiAsset`. +- Created `hydra-plutus-extras` package to re-use some utilities better between + packages. + ## [0.11.0] - 2023-06-30 This release contains breaking changes of the persistence and on-chain scripts diff --git a/cabal.project b/cabal.project index f03c9c6a0a2..947552bc3a8 100644 --- a/cabal.project +++ b/cabal.project @@ -19,6 +19,7 @@ packages: hydra-prelude hydra-cardano-api hydra-test-utils + hydra-plutus-extras plutus-cbor plutus-merkle-tree hydra-plutus diff --git a/hydra-node/bench/tx-cost/Main.hs b/hydra-node/bench/tx-cost/Main.hs index 0fa6e5bf34e..0a4e116d3ae 100644 --- a/hydra-node/bench/tx-cost/Main.hs +++ b/hydra-node/bench/tx-cost/Main.hs @@ -20,7 +20,7 @@ import Options.Applicative ( short, strOption, ) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import System.Directory (createDirectoryIfMissing, doesDirectoryExist) import System.FilePath (()) import System.IO.Unsafe (unsafePerformIO) diff --git a/hydra-node/bench/tx-cost/TxCost.hs b/hydra-node/bench/tx-cost/TxCost.hs index 8bd27a52bfa..40766585994 100644 --- a/hydra-node/bench/tx-cost/TxCost.hs +++ b/hydra-node/bench/tx-cost/TxCost.hs @@ -53,7 +53,7 @@ import Hydra.Ledger.Cardano.Evaluate ( usedExecutionUnits, ) import Hydra.Snapshot (genConfirmedSnapshot) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import PlutusLedgerApi.V2 (toBuiltinData) import PlutusTx.Builtins (lengthOfByteString, serialiseData) import Test.QuickCheck (generate) diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 249d04af3af..ce06f02ca5a 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -157,6 +157,7 @@ library , http-types , hydra-cardano-api , hydra-plutus + , hydra-plutus-extras , hydra-prelude , io-classes >=0.3.0.0 , iohk-monitoring @@ -223,14 +224,15 @@ executable hydra-net main-is: Main.hs other-modules: Log build-depends: - aeson + , aeson , contra-tracer , hydra-cardano-api - , network , hydra-node , hydra-prelude + , network , optparse-applicative - , ouroboros-network-framework >=0.3.0.0 + , ouroboros-network-framework >=0.3.0.0 + ghc-options: -threaded -rtsopts benchmark tx-cost @@ -248,6 +250,7 @@ benchmark tx-cost , hydra-cardano-api , hydra-node , hydra-plutus + , hydra-plutus-extras , hydra-prelude , optparse-applicative , plutus-ledger-api @@ -358,6 +361,7 @@ test-suite tests , hydra-cardano-api , hydra-node , hydra-plutus + , hydra-plutus-extras , hydra-prelude , hydra-test-utils , io-classes diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index d66f582361b..c218a76d056 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -61,7 +61,7 @@ import Hydra.Chain.Direct.Wallet ( import Hydra.ContestationPeriod (toNominalDiffTime) import Hydra.Ledger (ChainSlot (ChainSlot)) import Hydra.Logging (Tracer, traceWith) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import System.IO.Error (userError) -- | Handle of a local chain state that is kept in the direct chain layer. diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index 75152383cf2..4e9080545ac 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -104,7 +104,7 @@ import Hydra.Chain.Direct.Tx ( import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.Contract.HeadTokens (mkHeadTokenScript) import Hydra.Crypto (HydraKey) -import Hydra.Data.ContestationPeriod (posixToUTCTime) +import Hydra.Plutus.Extras (posixToUTCTime) import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (hashUTxO)) import Hydra.Ledger.Cardano (genOneUTxOFor, genUTxOAdaOnlyOfSize, genVerificationKey) import Hydra.Ledger.Cardano.Evaluate (genPointInTimeBefore, genValidityBoundsFromContestationPeriod, slotNoFromUTCTime) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index f047718f2c4..d466c5d6743 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -31,7 +31,7 @@ import qualified Hydra.Contract.Initial as Initial import Hydra.Contract.MintAction (MintAction (Burn, Mint)) import Hydra.Contract.Util (hydraHeadV1) import Hydra.Crypto (MultiSignature, toPlutusSignatures) -import Hydra.Data.ContestationPeriod (addContestationPeriod, posixFromUTCTime) +import Hydra.Data.ContestationPeriod (addContestationPeriod) import qualified Hydra.Data.ContestationPeriod as OnChain import qualified Hydra.Data.Party as OnChain import Hydra.Ledger (IsTx (hashUTxO)) @@ -49,8 +49,9 @@ import Hydra.Ledger.Cardano.Builder ( unsafeBuildTransaction, ) import Hydra.Party (Party, partyFromChain, partyToChain) +import Hydra.Plutus.Orphans () import Hydra.Snapshot (Snapshot (..), SnapshotNumber, fromChainSnapshot) -import Plutus.Orphans () +import Hydra.Plutus.Extras (posixFromUTCTime) import PlutusLedgerApi.V2 (CurrencySymbol (CurrencySymbol), fromBuiltin, toBuiltin) import qualified PlutusLedgerApi.V2 as Plutus diff --git a/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs b/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs index f4419b496ba..3945ddf14f3 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs +++ b/hydra-node/src/Hydra/Ledger/Cardano/Evaluate.hs @@ -67,7 +67,7 @@ import Hydra.Cardano.Api ( toLedgerUTxO, ) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) -import Hydra.Data.ContestationPeriod (posixToUTCTime) +import Hydra.Plutus.Extras (posixToUTCTime) import Ouroboros.Consensus.Cardano.Block (CardanoEras) import Ouroboros.Consensus.HardFork.History ( Bound (Bound, boundEpoch, boundSlot, boundTime), diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs index 33b3a8b9623..de6506c6957 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Close.hs @@ -36,7 +36,6 @@ import qualified Hydra.Contract.HeadState as Head import Hydra.Contract.HeadTokens (headPolicyId) import Hydra.Contract.Util (UtilError (MintingOrBurningIsForbidden)) import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign, toPlutusSignatures) -import Hydra.Data.ContestationPeriod (posixFromUTCTime) import qualified Hydra.Data.ContestationPeriod as OnChain import qualified Hydra.Data.Party as OnChain import Hydra.Ledger (hashUTxO) @@ -44,7 +43,8 @@ import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerifi import Hydra.Ledger.Cardano.Evaluate (genValidityBoundsFromContestationPeriod) import Hydra.Party (Party, deriveParty, partyToChain) import Hydra.Snapshot (Snapshot (..), SnapshotNumber) -import Plutus.Orphans () +import Hydra.Plutus.Extras (posixFromUTCTime) +import Hydra.Plutus.Orphans () import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds) import PlutusLedgerApi.V2 (BuiltinByteString, POSIXTime, PubKeyHash (PubKeyHash), toBuiltin) import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs index 9dea47381c5..ffb6fa96c61 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/CollectCom.hs @@ -49,7 +49,7 @@ import Hydra.Ledger.Cardano ( genVerificationKey, ) import Hydra.Party (Party, partyToChain) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import PlutusTx.Builtins (toBuiltin) import Test.QuickCheck (choose, elements, oneof, suchThat) import Test.QuickCheck.Instances () diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs index c345e9b82cf..6f882ad21d1 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest.hs @@ -37,7 +37,6 @@ import qualified Hydra.Contract.HeadState as Head import Hydra.Contract.HeadTokens (headPolicyId) import Hydra.Contract.Util (UtilError (MintingOrBurningIsForbidden)) import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign, toPlutusSignatures) -import Hydra.Data.ContestationPeriod (posixFromUTCTime) import qualified Hydra.Data.ContestationPeriod as OnChain import Hydra.Data.Party (partyFromVerificationKeyBytes) import qualified Hydra.Data.Party as OnChain @@ -45,8 +44,9 @@ import Hydra.Ledger (hashUTxO) import Hydra.Ledger.Cardano (genAddressInEra, genOneUTxOFor, genValue, genVerificationKey) import Hydra.Ledger.Cardano.Evaluate (slotNoToUTCTime) import Hydra.Party (Party, deriveParty, partyToChain) +import Hydra.Plutus.Orphans () import Hydra.Snapshot (Snapshot (..), SnapshotNumber) -import Plutus.Orphans () +import Hydra.Plutus.Extras (posixFromUTCTime) import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin) import qualified PlutusLedgerApi.V2 as Plutus import Test.Hydra.Fixture (aliceSk, bobSk, carolSk) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs index a1dc67bcb7c..f9c6730295a 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/FanOut.hs @@ -17,7 +17,6 @@ import Hydra.Contract.Error (toErrorCode) import Hydra.Contract.HeadError (HeadError (..)) import qualified Hydra.Contract.HeadState as Head import Hydra.Contract.HeadTokens (mkHeadTokenScript) -import Hydra.Data.ContestationPeriod (posixFromUTCTime) import qualified Hydra.Data.ContestationPeriod as OnChain import Hydra.Ledger (IsTx (hashUTxO)) import Hydra.Ledger.Cardano ( @@ -28,7 +27,8 @@ import Hydra.Ledger.Cardano ( ) import Hydra.Ledger.Cardano.Evaluate (slotNoFromUTCTime, slotNoToUTCTime) import Hydra.Party (partyToChain) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () +import Hydra.Plutus.Extras (posixFromUTCTime) import PlutusTx.Builtins (toBuiltin) import Test.QuickCheck (choose, elements, oneof, suchThat, vectorOf) import Test.QuickCheck.Instances () diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs index e471d00dd59..6c499963e42 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs @@ -155,7 +155,7 @@ import Hydra.Ledger.Cardano (genKeyPair, genOutput, genVerificationKey) import Hydra.Ledger.Cardano.Evaluate (evaluateTx) import Hydra.Party (Party) import Hydra.Prelude hiding (label) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime, toData) import qualified PlutusLedgerApi.V2 as Plutus import qualified System.Directory.Internal.Prelude as Prelude diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index b9f37992996..04c42748d6a 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -47,7 +47,7 @@ import Hydra.Ledger.Cardano ( import Hydra.Ledger.Simple (SimpleTx) import Hydra.Party (deriveParty, partyToChain) import Hydra.Snapshot (Snapshot (..)) -import Plutus.Orphans () +import Hydra.Plutus.Orphans () import PlutusLedgerApi.V2 (fromBuiltin, toBuiltin) import Test.QuickCheck ( Property, diff --git a/hydra-plutus-extras/LICENSE b/hydra-plutus-extras/LICENSE new file mode 100644 index 00000000000..b6ddde7af57 --- /dev/null +++ b/hydra-plutus-extras/LICENSE @@ -0,0 +1,202 @@ + + 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: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) 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 + + (d) 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 + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [2021-2022] [IOG] + + 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/hydra-plutus-extras/NOTICE b/hydra-plutus-extras/NOTICE new file mode 100644 index 00000000000..b31ac752e62 --- /dev/null +++ b/hydra-plutus-extras/NOTICE @@ -0,0 +1,14 @@ +Copyright 2021-2022 Input Output Global Ltd. + + 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/hydra-plutus-extras/hydra-plutus-extras.cabal b/hydra-plutus-extras/hydra-plutus-extras.cabal new file mode 100644 index 00000000000..67f264a4373 --- /dev/null +++ b/hydra-plutus-extras/hydra-plutus-extras.cabal @@ -0,0 +1,111 @@ +cabal-version: 3.0 +name: hydra-plutus-extras +version: 0.12.0 +synopsis: + Several extras and extensions of plutus-tx and plutus-ledger-api + +author: IOG +copyright: 2022 IOG +license: Apache-2.0 +license-files: + LICENSE + NOTICE + +source-repository head + type: git + location: https://github.com/input-output-hk/hydra + +flag hydra-development + description: Disable -Werror for development + default: False + manual: True + +common project-config + default-extensions: + NoImplicitPrelude + BangPatterns + BinaryLiterals + ConstraintKinds + DataKinds + DefaultSignatures + DeriveAnyClass + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + DerivingStrategies + EmptyDataDecls + ExistentialQuantification + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedStrings + PartialTypeSignatures + PatternGuards + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeFamilies + TypeOperators + TypeSynonymInstances + ViewPatterns + + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -Wunused-packages + -fprint-potential-instances + + if !flag(hydra-development) + ghc-options: -Werror + +library + import: project-config + exposed-modules: + Hydra.Plutus.Extras + Hydra.Plutus.Extras.Time + Hydra.Plutus.Orphans + + hs-source-dirs: src + build-depends: + , aeson + , base + , base16-bytestring + , bytestring + , cardano-api + , hydra-prelude + , plutus-ledger-api >=1.1.1.0 + , plutus-tx >=1.1.1.0 + , QuickCheck + , quickcheck-instances + , time + +test-suite tests + import: project-config + ghc-options: -threaded -rtsopts -with-rtsopts=-N + hs-source-dirs: test + main-is: Main.hs + type: exitcode-stdio-1.0 + other-modules: + Hydra.Plutus.Extras.TimeSpec + Spec + + build-depends: + , base + , hspec + , hydra-plutus-extras + , hydra-prelude + , QuickCheck + , time + + build-tool-depends: hspec-discover:hspec-discover diff --git a/hydra-plutus/src/Plutus/Extras.hs b/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs similarity index 80% rename from hydra-plutus/src/Plutus/Extras.hs rename to hydra-plutus-extras/src/Hydra/Plutus/Extras.hs index 79f68371075..9fee861f775 100644 --- a/hydra-plutus/src/Plutus/Extras.hs +++ b/hydra-plutus-extras/src/Hydra/Plutus/Extras.hs @@ -1,16 +1,22 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE PatternSynonyms #-} -module Plutus.Extras where +module Hydra.Plutus.Extras ( + module Hydra.Plutus.Extras, + module Hydra.Plutus.Extras.Time, +) where -import Hydra.Prelude hiding (fromMaybe) +import Hydra.Prelude -import Hydra.Cardano.Api ( +import Hydra.Plutus.Extras.Time + +import Cardano.Api ( + PlutusScriptVersion, SerialiseAsRawBytes (serialiseToRawBytes), - fromPlutusScript, hashScript, pattern PlutusScript, ) +import Cardano.Api.Shelley (PlutusScript (PlutusScriptSerialised)) import PlutusLedgerApi.Common (SerialisedScript) import PlutusLedgerApi.V2 (ScriptHash (..)) import PlutusTx (BuiltinData, UnsafeFromData (..)) @@ -56,11 +62,11 @@ wrapMintingPolicy f r c = -- | Compute the on-chain 'ScriptHash' for a given serialised plutus script. Use -- this to refer to another validator script. -scriptValidatorHash :: SerialisedScript -> ScriptHash -scriptValidatorHash = +scriptValidatorHash :: PlutusScriptVersion lang -> SerialisedScript -> ScriptHash +scriptValidatorHash version = ScriptHash . toBuiltin . serialiseToRawBytes . hashScript - . PlutusScript - . fromPlutusScript + . PlutusScript version + . PlutusScriptSerialised diff --git a/hydra-plutus-extras/src/Hydra/Plutus/Extras/Time.hs b/hydra-plutus-extras/src/Hydra/Plutus/Extras/Time.hs new file mode 100644 index 00000000000..8ba71e145f6 --- /dev/null +++ b/hydra-plutus-extras/src/Hydra/Plutus/Extras/Time.hs @@ -0,0 +1,29 @@ +-- | Converting to/from time on-chain +-- +-- XXX: Ideally, these functions would be upstreamed into plutus directly. +module Hydra.Plutus.Extras.Time where + +import Hydra.Prelude + +import Data.Fixed (Pico) +import Data.Ratio ((%)) +import Data.Time (nominalDiffTimeToSeconds) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import qualified PlutusLedgerApi.V1.Time as Plutus + +-- | Convert given on-chain 'POSIXTime' to a 'UTCTime'. +posixToUTCTime :: Plutus.POSIXTime -> UTCTime +posixToUTCTime (Plutus.POSIXTime ms) = + -- NOTE: POSIXTime records the number of milliseconds since epoch + posixSecondsToUTCTime (fromRational $ ms % 1000) + +-- | Compute on-chain 'POSIXTime' from a given 'UTCTime'. +posixFromUTCTime :: UTCTime -> Plutus.POSIXTime +posixFromUTCTime utcTime = + -- NOTE: POSIXTime records the number of milliseconds since epoch + Plutus.POSIXTime . truncate $ posixSeconds * 1000 + where + -- NOTE: 'Pico' is a 'Fixed' precision integer and denotes here the seconds + -- since epoch with picosecond precision. + posixSeconds :: Pico + posixSeconds = nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds utcTime diff --git a/hydra-plutus/src/Plutus/Orphans.hs b/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs similarity index 98% rename from hydra-plutus/src/Plutus/Orphans.hs rename to hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs index 6538e55a962..1986ee914f8 100644 --- a/hydra-plutus/src/Plutus/Orphans.hs +++ b/hydra-plutus-extras/src/Hydra/Plutus/Orphans.hs @@ -2,7 +2,7 @@ -- | Orphans instances partly copied from Plutus, partly coming from us for test -- purpose. -module Plutus.Orphans where +module Hydra.Plutus.Orphans where import Hydra.Prelude diff --git a/hydra-plutus-extras/test/Hydra/Plutus/Extras/TimeSpec.hs b/hydra-plutus-extras/test/Hydra/Plutus/Extras/TimeSpec.hs new file mode 100644 index 00000000000..21044a34208 --- /dev/null +++ b/hydra-plutus-extras/test/Hydra/Plutus/Extras/TimeSpec.hs @@ -0,0 +1,27 @@ +module Hydra.Plutus.Extras.TimeSpec where + +import Hydra.Prelude + +import Data.Fixed (Milli) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Hydra.Plutus.Extras.Time (posixFromUTCTime, posixToUTCTime) +import Hydra.Plutus.Orphans () +import Test.Hspec (Spec, describe) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (Positive (Positive), collect, (===)) + +spec :: Spec +spec = do + describe "posixToUTCTime" $ do + prop "is homomorphic w.r.t to Ord" $ \t1 t2 -> + let ordering = compare t1 t2 + in ordering + === compare (posixToUTCTime t1) (posixToUTCTime t2) + & collect ordering + + prop "roundtrip posixToUTCTime . posixFromUTCTime" $ \(Positive t) -> + posixFromUTCTime (posixToUTCTime t) === t + + prop "roundtrip posixFromUTCTime . posixToUTCTime (up to millisecond precision)" $ \(s :: Milli) -> + let t = posixSecondsToUTCTime $ realToFrac s + in posixToUTCTime (posixFromUTCTime t) === t diff --git a/hydra-plutus-extras/test/Main.hs b/hydra-plutus-extras/test/Main.hs new file mode 100644 index 00000000000..140e599faae --- /dev/null +++ b/hydra-plutus-extras/test/Main.hs @@ -0,0 +1,9 @@ +module Main where + +import Prelude + +import qualified Spec +import Test.Hspec (hspec) + +main :: IO () +main = hspec Spec.spec diff --git a/hydra-plutus-extras/test/Spec.hs b/hydra-plutus-extras/test/Spec.hs new file mode 100644 index 00000000000..5416ef6a866 --- /dev/null +++ b/hydra-plutus-extras/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/hydra-plutus/hydra-plutus.cabal b/hydra-plutus/hydra-plutus.cabal index 23ba767d03c..c640e4d5e52 100644 --- a/hydra-plutus/hydra-plutus.cabal +++ b/hydra-plutus/hydra-plutus.cabal @@ -90,8 +90,6 @@ library Hydra.Data.Party Hydra.Data.Utxo Hydra.ScriptContext - Plutus.Extras - Plutus.Orphans hs-source-dirs: src build-depends: @@ -102,6 +100,7 @@ library , containers , directory , hydra-cardano-api + , hydra-plutus-extras , hydra-prelude , plutus-core , plutus-ledger-api diff --git a/hydra-plutus/src/Hydra/Contract/Commit.hs b/hydra-plutus/src/Hydra/Contract/Commit.hs index 191fc6a25bf..6466ef0e677 100644 --- a/hydra-plutus/src/Hydra/Contract/Commit.hs +++ b/hydra-plutus/src/Hydra/Contract/Commit.hs @@ -14,14 +14,14 @@ import PlutusTx.Prelude import Codec.Serialise (deserialiseOrFail, serialise) import Data.ByteString.Lazy (fromStrict, toStrict) -import Hydra.Cardano.Api (CtxUTxO, fromPlutusTxOut, fromPlutusTxOutRef, toPlutusTxOut, toPlutusTxOutRef) +import Hydra.Cardano.Api (CtxUTxO, PlutusScriptVersion (PlutusScriptV2), fromPlutusTxOut, fromPlutusTxOutRef, toPlutusTxOut, toPlutusTxOutRef) import qualified Hydra.Cardano.Api as OffChain import Hydra.Cardano.Api.Network (Network) import Hydra.Contract.CommitError (CommitError (..), errorCode) import Hydra.Contract.Util (hasST, mustBurnST) import Hydra.Data.Party (Party) import Hydra.ScriptContext (ScriptContext (..), TxInfo (..)) -import Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) +import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) import PlutusLedgerApi.V2 ( CurrencySymbol, Datum (..), @@ -118,7 +118,7 @@ validatorScript :: SerialisedScript validatorScript = serialiseCompiledCode compiledValidator validatorHash :: ScriptHash -validatorHash = scriptValidatorHash validatorScript +validatorHash = scriptValidatorHash PlutusScriptV2 validatorScript datum :: DatumType -> Datum datum a = Datum (toBuiltinData a) diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index 93472610bbe..6573cc71946 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -13,7 +13,8 @@ import PlutusTx.Prelude import qualified Hydra.Prelude as Haskell -import Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) +import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2)) +import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) import PlutusLedgerApi.V2 ( Datum (Datum), @@ -59,7 +60,7 @@ validatorScript :: SerialisedScript validatorScript = serialiseCompiledCode compiledValidator validatorHash :: ScriptHash -validatorHash = scriptValidatorHash validatorScript +validatorHash = scriptValidatorHash PlutusScriptV2 validatorScript datum :: DatumType -> Datum datum a = Datum (toBuiltinData a) diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index 86c5809fb62..5e12b2b5ac3 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -12,6 +12,7 @@ module Hydra.Contract.Head where import PlutusTx.Prelude +import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2)) import Hydra.Contract.Commit (Commit (..)) import qualified Hydra.Contract.Commit as Commit import Hydra.Contract.HeadError (HeadError (..), errorCode) @@ -19,7 +20,7 @@ import Hydra.Contract.HeadState (Input (..), Signature, SnapshotNumber, State (. import Hydra.Contract.Util (hasST, mustNotMintOrBurn, (===)) import Hydra.Data.ContestationPeriod (ContestationPeriod, addContestationPeriod, milliseconds) import Hydra.Data.Party (Party (vkey)) -import Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) +import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) import PlutusLedgerApi.V1.Time (fromMilliSeconds) import PlutusLedgerApi.V1.Value (valueOf) @@ -612,4 +613,4 @@ validatorScript :: SerialisedScript validatorScript = serialiseCompiledCode compiledValidator validatorHash :: ScriptHash -validatorHash = scriptValidatorHash validatorScript +validatorHash = scriptValidatorHash PlutusScriptV2 validatorScript diff --git a/hydra-plutus/src/Hydra/Contract/HeadTokens.hs b/hydra-plutus/src/Hydra/Contract/HeadTokens.hs index 772ecbf9fbe..108e0448724 100644 --- a/hydra-plutus/src/Hydra/Contract/HeadTokens.hs +++ b/hydra-plutus/src/Hydra/Contract/HeadTokens.hs @@ -30,8 +30,8 @@ import Hydra.Contract.HeadTokensError (HeadTokensError (..), errorCode) import qualified Hydra.Contract.Initial as Initial import Hydra.Contract.MintAction (MintAction (Burn, Mint)) import Hydra.Contract.Util (hasST) +import Hydra.Plutus.Extras (MintingPolicyType, wrapMintingPolicy) import Hydra.ScriptContext (ScriptContext (..), TxInfo (txInfoInputs, txInfoMint), findDatum, ownCurrencySymbol, scriptOutputsAt) -import Plutus.Extras (MintingPolicyType, wrapMintingPolicy) import PlutusCore.Core (plcVersion100) import PlutusLedgerApi.V2 ( Datum (getDatum), diff --git a/hydra-plutus/src/Hydra/Contract/Initial.hs b/hydra-plutus/src/Hydra/Contract/Initial.hs index 7174d1c9e47..783b8ac612a 100644 --- a/hydra-plutus/src/Hydra/Contract/Initial.hs +++ b/hydra-plutus/src/Hydra/Contract/Initial.hs @@ -12,11 +12,13 @@ module Hydra.Contract.Initial where import PlutusTx.Prelude +import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2)) import Hydra.Contract.Commit (Commit (..)) import qualified Hydra.Contract.Commit as Commit import Hydra.Contract.Error (errorCode) import Hydra.Contract.InitialError (InitialError (..)) import Hydra.Contract.Util (mustBurnST) +import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) import Hydra.ScriptContext ( ScriptContext (..), TxInfo (txInfoMint, txInfoSignatories), @@ -26,7 +28,6 @@ import Hydra.ScriptContext ( scriptOutputsAt, valueLockedBy, ) -import Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) import PlutusCore.Core (plcVersion100) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) import PlutusLedgerApi.V1.Value (isZero) @@ -188,7 +189,7 @@ validatorScript :: SerialisedScript validatorScript = serialiseCompiledCode compiledValidator validatorHash :: ScriptHash -validatorHash = scriptValidatorHash validatorScript +validatorHash = scriptValidatorHash PlutusScriptV2 validatorScript datum :: DatumType -> Datum datum a = Datum (toBuiltinData a) diff --git a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs index d50877a62fa..40e380ed569 100644 --- a/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs +++ b/hydra-plutus/src/Hydra/Data/ContestationPeriod.hs @@ -7,10 +7,8 @@ import Hydra.Prelude import qualified PlutusTx.Prelude as Plutus -import Data.Fixed (Pico) import Data.Ratio ((%)) import Data.Time (nominalDiffTimeToSeconds, secondsToNominalDiffTime) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import PlutusLedgerApi.V1.Time (DiffMilliSeconds, fromMilliSeconds) import PlutusLedgerApi.V2 (POSIXTime (..)) import qualified PlutusTx @@ -44,22 +42,3 @@ contestationPeriodToDiffTime cp = addContestationPeriod :: POSIXTime -> ContestationPeriod -> POSIXTime addContestationPeriod time UnsafeContestationPeriod{milliseconds} = time Plutus.+ fromMilliSeconds milliseconds {-# INLINEABLE addContestationPeriod #-} - --- * Converting to/from time on-chain - --- | Convert given on-chain 'POSIXTime' to a 'UTCTime'. -posixToUTCTime :: POSIXTime -> UTCTime -posixToUTCTime (POSIXTime ms) = - -- NOTE: POSIXTime records the number of milliseconds since epoch - posixSecondsToUTCTime (fromRational $ ms % 1000) - --- | Compute on-chain 'POSIXTime' from a given 'UTCTime'. -posixFromUTCTime :: UTCTime -> POSIXTime -posixFromUTCTime utcTime = - -- NOTE: POSIXTime records the number of milliseconds since epoch - POSIXTime . truncate $ posixSeconds * 1000 - where - -- NOTE: 'Pico' is a 'Fixed' precision integer and denotes here the seconds - -- since epoch with picosecond precision. - posixSeconds :: Pico - posixSeconds = nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds utcTime diff --git a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs index b40e53ad134..418b14e2461 100644 --- a/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs +++ b/hydra-plutus/test/Hydra/Data/ContestationPeriodSpec.hs @@ -2,18 +2,13 @@ module Hydra.Data.ContestationPeriodSpec where import Hydra.Prelude -import Data.Fixed (Milli) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Hydra.Data.ContestationPeriod ( contestationPeriodFromDiffTime, contestationPeriodToDiffTime, - posixFromUTCTime, - posixToUTCTime, ) -import Plutus.Orphans () import Test.Hspec (Spec, describe) import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck (Positive (Positive), collect, (===)) +import Test.QuickCheck ((===)) spec :: Spec spec = do @@ -21,16 +16,3 @@ spec = do prop "is isomorphic to NominalDiffTime" $ \t -> let diff = contestationPeriodToDiffTime t in contestationPeriodFromDiffTime diff === t - - describe "posixToUTCTime" $ do - prop "is homomorphic w.r.t to Ord" $ \t1 t2 -> - let ordering = compare t1 t2 - in ordering === compare (posixToUTCTime t1) (posixToUTCTime t2) - & collect ordering - - prop "roundtrip posixToUTCTime . posixFromUTCTime" $ \(Positive t) -> - posixFromUTCTime (posixToUTCTime t) === t - - prop "roundtrip posixFromUTCTime . posixToUTCTime (up to millisecond precision)" $ \(s :: Milli) -> - let t = posixSecondsToUTCTime $ realToFrac s - in posixToUTCTime (posixFromUTCTime t) === t diff --git a/hydra-test-utils/src/Test/Plutus/Validator.hs b/hydra-test-utils/src/Test/Plutus/Validator.hs index 91deb7b47d5..f7d3092b1ce 100644 --- a/hydra-test-utils/src/Test/Plutus/Validator.hs +++ b/hydra-test-utils/src/Test/Plutus/Validator.hs @@ -65,31 +65,9 @@ import Hydra.Cardano.Api ( pattern TxOut, ) import PlutusLedgerApi.Common (SerialisedScript) -import PlutusLedgerApi.V2 (ScriptContext) -import PlutusTx (BuiltinData, UnsafeFromData (..)) import qualified PlutusTx as Plutus -import PlutusTx.Prelude (check) import qualified Prelude --- TODO: DRY with hydra-plutus - --- | Wrap a typed validator to get the basic `Validator` signature which can be passed to --- `Plutus.compile`. Vendored from `plutus-ledger`. --- REVIEW: There might be better ways to name this than "wrap" -wrapValidator :: - (UnsafeFromData datum, UnsafeFromData redeemer) => - (datum -> redeemer -> ScriptContext -> Bool) -> - (BuiltinData -> BuiltinData -> BuiltinData -> ()) --- We can use unsafeFromBuiltinData here as we would fail immediately anyway if parsing failed -wrapValidator f d r p = check $ f (unsafeFromBuiltinData d) (unsafeFromBuiltinData r) (unsafeFromBuiltinData p) -{-# INLINEABLE wrapValidator #-} - -distanceExecutionUnits :: ExecutionUnits -> ExecutionUnits -> ExecutionUnits -distanceExecutionUnits (ExecutionUnits c0 m0) (ExecutionUnits c1 m1) = - ExecutionUnits - (if c0 > c1 then c0 - c1 else c1 - c0) - (if m0 > m1 then m0 - m1 else m1 - m0) - -- TODO: DRY with Hydra.Ledger.Cardano.Evaluate evaluateScriptExecutionUnits :: diff --git a/nix/hydra/shell.nix b/nix/hydra/shell.nix index fad75e599ca..84ce520b871 100644 --- a/nix/hydra/shell.nix +++ b/nix/hydra/shell.nix @@ -77,6 +77,7 @@ let hydra-prelude hydra-cardano-api hydra-test-utils + hydra-plutus-extras plutus-cbor plutus-merkle-tree hydra-plutus diff --git a/plutus-cbor/CHANGELOG.md b/plutus-cbor/CHANGELOG.md index 5b28ccaaec0..8db2cd0ae34 100644 --- a/plutus-cbor/CHANGELOG.md +++ b/plutus-cbor/CHANGELOG.md @@ -15,6 +15,8 @@ using `plutus-cbor-x.y.z` tags. ## [1.0.1] - UNRELEASED +- Moved dependencies to `hydra-plutus-extras` instead of `hydra-test-utils`. + - Made compatible to latest `plutus-tx` and `cardano-api` changes (via `hydra-cardano-api` and `hydra-test-utils`). diff --git a/plutus-cbor/exe/encoding-cost/Main.hs b/plutus-cbor/exe/encoding-cost/Main.hs index c9d8ea62655..ec677355770 100644 --- a/plutus-cbor/exe/encoding-cost/Main.hs +++ b/plutus-cbor/exe/encoding-cost/Main.hs @@ -17,7 +17,6 @@ import qualified PlutusTx.AssocMap as Plutus.Map import Test.Plutus.Validator ( ExecutionUnits (..), defaultMaxExecutionUnits, - distanceExecutionUnits, evaluateScriptExecutionUnits, ) import Test.QuickCheck ( @@ -75,6 +74,12 @@ relativeCostOf a maxUnits mkValidator = , toInteger cpu % toInteger maxCpu ) +distanceExecutionUnits :: ExecutionUnits -> ExecutionUnits -> ExecutionUnits +distanceExecutionUnits (ExecutionUnits c0 m0) (ExecutionUnits c1 m1) = + ExecutionUnits + (if c0 > c1 then c0 - c1 else c1 - c0) + (if m0 > m1 then m0 - m1 else m1 - m0) + -- -- Helpers -- diff --git a/plutus-cbor/exe/encoding-cost/Plutus/Codec/CBOR/Encoding/Validator.hs b/plutus-cbor/exe/encoding-cost/Plutus/Codec/CBOR/Encoding/Validator.hs index c369f4a2c87..ba38871bef2 100644 --- a/plutus-cbor/exe/encoding-cost/Plutus/Codec/CBOR/Encoding/Validator.hs +++ b/plutus-cbor/exe/encoding-cost/Plutus/Codec/CBOR/Encoding/Validator.hs @@ -25,15 +25,16 @@ import PlutusLedgerApi.V1 ( CurrencySymbol (..), DatumHash (..), PubKeyHash (..), + ScriptContext, ScriptHash (..), TokenName (..), TxOut (..), Value (..), ) +import Hydra.Plutus.Extras (wrapValidator) import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) import qualified PlutusTx as Plutus -import Test.Plutus.Validator (wrapValidator) -- | A validator for measuring cost of encoding values. The validator is -- parameterized by the type of value. @@ -46,12 +47,13 @@ Plutus.unstableMakeIsData ''ValidatorKind encodeIntegerValidator :: ValidatorKind -> SerialisedScript encodeIntegerValidator = \case BaselineValidator -> - serialiseCompiledCode $$(Plutus.compile [||wrapValidator $ \() (_ :: Integer) _ctx -> True||]) + serialiseCompiledCode + $$(Plutus.compile [||wrapValidator $ \() (_ :: Integer) (_ :: ScriptContext) -> True||]) RealValidator -> serialiseCompiledCode $$( Plutus.compile [|| - wrapValidator $ \() a _ctx -> + wrapValidator $ \() a (_ :: ScriptContext) -> let bytes = encodingToBuiltinByteString (encodeInteger a) in lengthOfByteString bytes > 0 ||] @@ -61,12 +63,12 @@ encodeByteStringValidator :: ValidatorKind -> SerialisedScript encodeByteStringValidator = \case BaselineValidator -> serialiseCompiledCode - $$(Plutus.compile [||wrapValidator $ \() (_ :: BuiltinByteString) _ctx -> True||]) + $$(Plutus.compile [||wrapValidator $ \() (_ :: BuiltinByteString) (_ :: ScriptContext) -> True||]) RealValidator -> serialiseCompiledCode $$( Plutus.compile [|| - wrapValidator $ \() a _ctx -> + wrapValidator $ \() a (_ :: ScriptContext) -> let bytes = encodingToBuiltinByteString (encodeByteString a) in lengthOfByteString bytes > 0 ||] @@ -76,12 +78,12 @@ encodeListValidator :: ValidatorKind -> SerialisedScript encodeListValidator = \case BaselineValidator -> serialiseCompiledCode - $$(Plutus.compile [||wrapValidator $ \() (_ :: [BuiltinByteString]) _ctx -> True||]) + $$(Plutus.compile [||wrapValidator $ \() (_ :: [BuiltinByteString]) (_ :: ScriptContext) -> True||]) RealValidator -> serialiseCompiledCode $$( Plutus.compile [|| - wrapValidator $ \() xs _ctx -> + wrapValidator $ \() xs (_ :: ScriptContext) -> let bytes = encodingToBuiltinByteString $ encodeList encodeByteString xs @@ -93,12 +95,12 @@ encodeTxOutValidator :: ValidatorKind -> SerialisedScript encodeTxOutValidator = \case BaselineValidator -> serialiseCompiledCode - $$(Plutus.compile [||wrapValidator $ \() (_ :: TxOut) _ctx -> True||]) + $$(Plutus.compile [||wrapValidator $ \() (_ :: TxOut) (_ :: ScriptContext) -> True||]) RealValidator -> serialiseCompiledCode $$( Plutus.compile [|| - wrapValidator $ \() o _ctx -> + wrapValidator $ \() o (_ :: ScriptContext) -> let bytes = encodingToBuiltinByteString (encodeTxOut o) in lengthOfByteString bytes > 0 ||] @@ -108,12 +110,12 @@ encodeTxOutsValidator :: ValidatorKind -> SerialisedScript encodeTxOutsValidator = \case BaselineValidator -> serialiseCompiledCode - $$(Plutus.compile [||wrapValidator $ \() (_ :: [TxOut]) _ctx -> True||]) + $$(Plutus.compile [||wrapValidator $ \() (_ :: [TxOut]) (_ :: ScriptContext) -> True||]) RealValidator -> serialiseCompiledCode $$( Plutus.compile [|| - wrapValidator $ \() xs _ctx -> + wrapValidator $ \() xs (_ :: ScriptContext) -> let bytes = encodingToBuiltinByteString (encodeList encodeTxOut xs) in lengthOfByteString bytes > 0 ||] diff --git a/plutus-cbor/plutus-cbor.cabal b/plutus-cbor/plutus-cbor.cabal index 51d071c804b..90f5fab8e34 100644 --- a/plutus-cbor/plutus-cbor.cabal +++ b/plutus-cbor/plutus-cbor.cabal @@ -142,6 +142,7 @@ executable encoding-cost , hydra-prelude , hydra-test-utils >=0.10.0 , plutus-cbor + , hydra-plutus-extras , plutus-ledger-api >=1.1.0.0 , plutus-tx , plutus-tx-plugin diff --git a/plutus-merkle-tree/CHANGELOG.md b/plutus-merkle-tree/CHANGELOG.md index f108ede5720..8cdf6b0d95e 100644 --- a/plutus-merkle-tree/CHANGELOG.md +++ b/plutus-merkle-tree/CHANGELOG.md @@ -14,6 +14,8 @@ changes. ## [1.1.0] - UNRELEASED +- Moved dependencies to `hydra-plutus-extras` instead of `hydra-test-utils`. + - Added `on-chain-cost` benchmark executable. - Made compatible to latest `plutus-tx` and `cardano-api` changes (via diff --git a/plutus-merkle-tree/bench/Validators.hs b/plutus-merkle-tree/bench/Validators.hs index 24b24ebbdd0..54dbbb81bd3 100644 --- a/plutus-merkle-tree/bench/Validators.hs +++ b/plutus-merkle-tree/bench/Validators.hs @@ -9,10 +9,11 @@ module Validators where import PlutusTx.Prelude +import Hydra.Plutus.Extras (wrapValidator) import qualified Plutus.MerkleTree as MT import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode) +import PlutusLedgerApi.V2 (ScriptContext) import qualified PlutusTx as Plutus -import Test.Plutus.Validator (wrapValidator) -- | A validator for measuring cost of MT membership validation. merkleTreeMemberValidator :: SerialisedScript @@ -21,7 +22,7 @@ merkleTreeMemberValidator = $$( Plutus.compile [|| wrapValidator $ - \() (e, root, proof) _ctx -> + \() (e, root, proof) (_ :: ScriptContext) -> MT.member e root proof ||] ) @@ -34,7 +35,7 @@ merkleTreeBuilderValidator = $$( Plutus.compile [|| wrapValidator $ - \() (utxos, root) _ctx -> + \() (utxos, root) (_ :: ScriptContext) -> MT.rootHash (MT.fromList utxos) == root ||] ) diff --git a/plutus-merkle-tree/plutus-merkle-tree.cabal b/plutus-merkle-tree/plutus-merkle-tree.cabal index 3582e10f381..088cebc2b3c 100644 --- a/plutus-merkle-tree/plutus-merkle-tree.cabal +++ b/plutus-merkle-tree/plutus-merkle-tree.cabal @@ -122,6 +122,7 @@ benchmark on-chain-cost , containers , directory , filepath + , hydra-plutus-extras , hydra-prelude , hydra-test-utils >=0.10.0 , plutus-core