From c4c67a9f99b6ff574ed54834c96c8db4dcb25a92 Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Wed, 6 Nov 2024 17:46:01 +0100 Subject: [PATCH] Property tests --- plutus-ledger-api/plutus-ledger-api.cabal | 4 + plutus-ledger-api/test-plugin/Spec.hs | 2 + .../Spec/Value/WithCurrencySymbol.hs | 130 ++++++++++++++++++ 3 files changed, 136 insertions(+) create mode 100644 plutus-ledger-api/test-plugin/Spec/Value/WithCurrencySymbol.hs diff --git a/plutus-ledger-api/plutus-ledger-api.cabal b/plutus-ledger-api/plutus-ledger-api.cabal index 4f0231b3463..b2ed17d3887 100644 --- a/plutus-ledger-api/plutus-ledger-api.cabal +++ b/plutus-ledger-api/plutus-ledger-api.cabal @@ -216,6 +216,7 @@ test-suite plutus-ledger-api-plugin-test Spec.ReturnUnit.V3 Spec.ScriptSize Spec.Value + Spec.Value.WithCurrencySymbol if os(windows) buildable: False @@ -232,10 +233,13 @@ test-suite plutus-ledger-api-plugin-test , plutus-ledger-api:plutus-ledger-api-testlib , plutus-tx ^>=1.36 , plutus-tx-plugin ^>=1.36 + , plutus-tx-test-util , plutus-tx:plutus-tx-testlib , prettyprinter + , QuickCheck , tasty , tasty-hunit + , tasty-quickcheck -- This is a nightly test, so it is an executable instead of test-suite to avoid -- running this in CI. diff --git a/plutus-ledger-api/test-plugin/Spec.hs b/plutus-ledger-api/test-plugin/Spec.hs index 96e374e9e6a..c6fd02bd6aa 100644 --- a/plutus-ledger-api/test-plugin/Spec.hs +++ b/plutus-ledger-api/test-plugin/Spec.hs @@ -8,6 +8,7 @@ import Spec.ReturnUnit.V2 qualified import Spec.ReturnUnit.V3 qualified import Spec.ScriptSize qualified import Spec.Value qualified +import Spec.Value.WithCurrencySymbol qualified import Test.Tasty @@ -26,4 +27,5 @@ tests = , Spec.ReturnUnit.V3.tests , Spec.ScriptSize.tests , Spec.Value.test_EqValue + , Spec.Value.WithCurrencySymbol.tests ] diff --git a/plutus-ledger-api/test-plugin/Spec/Value/WithCurrencySymbol.hs b/plutus-ledger-api/test-plugin/Spec/Value/WithCurrencySymbol.hs new file mode 100644 index 00000000000..03dae30c127 --- /dev/null +++ b/plutus-ledger-api/test-plugin/Spec/Value/WithCurrencySymbol.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# OPTIONS_GHC -fno-full-laziness #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-spec-constr #-} +{-# OPTIONS_GHC -fno-specialise #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-} +{-# OPTIONS_GHC -fno-unbox-strict-fields #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} + +{-# HLINT ignore "Use const" #-} + +module Spec.Value.WithCurrencySymbol where + +import PlutusTx.Prelude + +import Data.ByteString (ByteString) +import PlutusCore.Generators.QuickCheck.Builtin (ArbitraryBuiltin (arbitraryBuiltin), shrinkBuiltin) +import PlutusLedgerApi.Test.V1.Value () +import PlutusLedgerApi.Test.V3.MintValue () +import PlutusLedgerApi.V1.Value (CurrencySymbol (..), TokenName (..), Value (..), currencySymbol, + singleton, symbols, tokenName, unCurrencySymbol, + withCurrencySymbol) +import PlutusTx.AssocMap qualified as Map +import PlutusTx.Code (CompiledCode, unsafeApplyCode) +import PlutusTx.Lift (liftCodeDef) +import PlutusTx.List qualified as List +import PlutusTx.Test.Util.Compiled (cekResultMatchesHaskellValue, compiledCodeToTerm) +import PlutusTx.TH (compile) +import Prelude qualified as Haskell +import Test.QuickCheck +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +tests :: TestTree +tests = testGroup "withCurrencySymbol" [testPropsInHaskell, testPropsInPlinth] + +-------------------------------------------------------------------------------- +-- Properties ------------------------------------------------------------------ + +prop_EachCurrencySymbolGetsContinuationApplied :: Value -> Bool +prop_EachCurrencySymbolGetsContinuationApplied v = + List.all (\cs -> withCurrencySymbol cs v False (\_tokens -> True)) (symbols v) + +prop_CorrectTokenQuantitiesAreSelected + :: (CurrencySymbol, TokenName, Integer) -> Bool +prop_CorrectTokenQuantitiesAreSelected (cs, tn, q) = + [(tn, q)] == withCurrencySymbol cs (singleton cs tn q) [] Map.toList + +-------------------------------------------------------------------------------- +-- Test properties in Haskell -------------------------------------------------- + +testPropsInHaskell :: TestTree +testPropsInHaskell = + testGroup + "Haskell" + [ test_Hask_EachCurrencySymbolGetsItsContinuationApplied + , test_Hask_CorrectTokenQuantitiesAreSelected + ] + +test_Hask_EachCurrencySymbolGetsItsContinuationApplied :: TestTree +test_Hask_EachCurrencySymbolGetsItsContinuationApplied = + testProperty "Each currency symbol in a Value gets its continuation applied" + $ scaleTestsBy 5 prop_EachCurrencySymbolGetsContinuationApplied + +test_Hask_CorrectTokenQuantitiesAreSelected :: TestTree +test_Hask_CorrectTokenQuantitiesAreSelected = + testProperty "Correct token quantities are selected" + $ scaleTestsBy 5 prop_CorrectTokenQuantitiesAreSelected + +-------------------------------------------------------------------------------- +-- Test properties in Plinth --------------------------------------------------- + +testPropsInPlinth :: TestTree +testPropsInPlinth = + testGroup + "Plinth" + [ test_Plinth_EachCurrencySymbolGetsItsContinuationApplied + , test_Plinth_CorrectTokenQuantitiesAreSelected + ] + +test_Plinth_EachCurrencySymbolGetsItsContinuationApplied :: TestTree +test_Plinth_EachCurrencySymbolGetsItsContinuationApplied = + testProperty "Each currency symbol in a Value gets its continuation applied" + $ cekProp + . \value -> + $$(compile [||prop_EachCurrencySymbolGetsContinuationApplied||]) + `unsafeApplyCode` liftCodeDef value + +test_Plinth_CorrectTokenQuantitiesAreSelected :: TestTree +test_Plinth_CorrectTokenQuantitiesAreSelected = + testProperty "Correct token quantities are selected" + $ cekProp + . \values -> + $$(compile [||prop_CorrectTokenQuantitiesAreSelected||]) + `unsafeApplyCode` liftCodeDef values + +-------------------------------------------------------------------------------- +-- Helper functions ------------------------------------------------------------ + +scaleTestsBy :: (Testable prop) => Haskell.Int -> prop -> Property +scaleTestsBy factor = + withMaxSuccess (100 Haskell.* factor) . mapSize (Haskell.* factor) + +cekProp :: CompiledCode Bool -> Property +cekProp code = + cekResultMatchesHaskellValue (compiledCodeToTerm code) (===) True + +instance Arbitrary CurrencySymbol where + arbitrary = Haskell.fmap currencySymbol (arbitraryBuiltin @ByteString) + shrink = + Haskell.fmap currencySymbol + . shrinkBuiltin + . fromBuiltin + . unCurrencySymbol + +instance Arbitrary TokenName where + arbitrary = Haskell.fmap tokenName (arbitraryBuiltin @ByteString) + shrink = + Haskell.fmap tokenName + . shrinkBuiltin + . fromBuiltin + . unTokenName