From 2843e1dd63e46e8685a6a76013e831d35ab49a5e Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 30 Nov 2022 01:26:47 +0100 Subject: [PATCH] use liqwid-nix 2.0 --- agora-bench/Bench.hs | 6 +- agora-specs/Property/Generator.hs | 4 +- agora-specs/Property/Governor.hs | 9 +- .../UnauthorizedMintingExploit.hs | 4 +- agora-specs/Sample/Effect/GovernorMutation.hs | 22 +- .../Sample/Effect/TreasuryWithdrawal.hs | 14 +- agora-specs/Sample/Governor/Initialize.hs | 30 ++- agora-specs/Sample/Governor/Mutate.hs | 30 ++- agora-specs/Sample/Proposal/Advance.hs | 19 +- agora-specs/Sample/Proposal/Cosign.hs | 12 +- agora-specs/Sample/Proposal/Create.hs | 22 +- .../Sample/Proposal/PrivilegeEscalate.hs | 12 +- agora-specs/Sample/Proposal/Unlock.hs | 16 +- agora-specs/Sample/Proposal/Vote.hs | 12 +- agora-specs/Sample/Shared.hs | 100 ++++----- agora-specs/Sample/Stake.hs | 6 +- agora-specs/Sample/Stake/Create.hs | 8 +- agora-specs/Sample/Stake/Destroy.hs | 4 +- agora-specs/Sample/Stake/SetDelegate.hs | 6 +- .../Stake/UnauthorizedMintingExploit.hs | 8 +- agora-specs/Sample/Treasury.hs | 4 +- agora-specs/Spec/AuthorityToken.hs | 12 +- agora-specs/Spec/Treasury.hs | 5 +- agora-testlib/Test/Specification.hs | 61 +++--- agora-testlib/Test/Util.hs | 5 +- agora/Agora/Effect/GovernorMutation.hs | 13 +- agora/Agora/Governor/Scripts.hs | 147 +++++++------ agora/Agora/Linker.hs | 30 ++- agora/Agora/Proposal.hs | 8 +- agora/Agora/Proposal/Scripts.hs | 127 +++++------ agora/Agora/Stake/Scripts.hs | 16 +- agora/Agora/Utils.hs | 12 +- default.nix | 3 + flake-module.nix | 28 +++ flake.nix | 207 ++++-------------- 35 files changed, 458 insertions(+), 564 deletions(-) create mode 100644 default.nix create mode 100644 flake-module.nix diff --git a/agora-bench/Bench.hs b/agora-bench/Bench.hs index 80b970f..99e7f8a 100644 --- a/agora-bench/Bench.hs +++ b/agora-bench/Bench.hs @@ -2,18 +2,16 @@ module Bench (Benchmark (..), benchmarkScript, specificationTreeToBenchmarks) where -import Codec.Serialise (serialise) -import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Short qualified as SBS import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=)) import Data.List (intercalate) import Data.Text (Text, pack) import Plutarch.Evaluate (evalScript) +import Plutarch.Script (Script, serialiseScript) import PlutusLedgerApi.V2 ( ExBudget (ExBudget), ExCPU (..), ExMemory (..), - Script, ) import Prettyprinter (Pretty (pretty), indent, vsep) import Test.Specification ( @@ -66,7 +64,7 @@ benchmarkScript name script = Benchmark (pack name) cpu mem size where (_res, ExBudget cpu mem, _traces) = evalScript script - size = SBS.length . SBS.toShort . LBS.toStrict . serialise $ script + size = SBS.length . serialiseScript $ script specificationTreeToBenchmarks :: SpecificationTree -> [Benchmark] specificationTreeToBenchmarks = go [] diff --git a/agora-specs/Property/Generator.hs b/agora-specs/Property/Generator.hs index ec76191..885706b 100644 --- a/agora-specs/Property/Generator.hs +++ b/agora-specs/Property/Generator.hs @@ -42,9 +42,9 @@ import PlutusLedgerApi.V2 ( Address (Address), Credential (..), PubKeyHash (PubKeyHash), + ScriptHash (ScriptHash), TxId (..), TxOutRef (..), - ValidatorHash (ValidatorHash), Value, toBuiltin, ) @@ -76,7 +76,7 @@ genUserCredential = PubKeyCredential . PubKeyHash . toBuiltin <$> genHashByteStr -- | Random script credential. genScriptCredential :: Gen Credential -genScriptCredential = ScriptCredential . ValidatorHash . toBuiltin <$> genHashByteString +genScriptCredential = ScriptCredential . ScriptHash . toBuiltin <$> genHashByteString -- | Random credential: combination of user and script credential generators. genCredential :: Gen Credential diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index cbd9a08..53a4a97 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -57,6 +57,7 @@ import Plutarch.Context ( import Plutarch.Evaluate (evalTerm) import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.Compile (mustCompile) +import Plutarch.Script (Script) import Plutarch.Test.QuickCheck ( Equality (OnPEq), Partiality (ByComplete), @@ -66,14 +67,14 @@ import Plutarch.Test.QuickCheck ( shouldCrash, shouldRun, ) -import PlutusLedgerApi.V2 (Script, ScriptContext) +import PlutusLedgerApi.V2 (ScriptContext) import Property.Generator (genInput, genOutput) import Sample.Shared ( deterministicTracingConfig, governor, governorAssetClass, + governorScriptHash, governorSymbol, - governorValidatorHash, gstUTXORef, ) import Test.QuickCheck ( @@ -109,7 +110,7 @@ instance Arbitrary GovernorDatumCases where -} governorDatumValidProperty :: Property governorDatumValidProperty = - haskEquiv @( 'OnPEq) @( 'ByComplete) + haskEquiv @('OnPEq) @('ByComplete) isValidModelImpl (TestableTerm pisGovernorDatumValid) (genDatum :* Nil) @@ -283,7 +284,7 @@ mkGovMintingCasePropertyTest name case' positiveCaseName negativeCaseName = outputToGov = output $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withValue gst , withDatum govDatum ] diff --git a/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs b/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs index 27791bc..d0e614f 100644 --- a/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs +++ b/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs @@ -6,7 +6,7 @@ module Sample.AuthorityToken.UnauthorizedMintingExploit ( import Control.Exception (assert) import Plutarch.Context (input, mint, normalizeValue, output, script, withValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared (authorityTokenPolicy, authorityTokenSymbol, minAda) import Test.Specification (SpecificationTree, testPolicy) @@ -32,7 +32,7 @@ exploit (Parameters burntGAT mintedGAT) = gatValue hash = Value.singleton authorityTokenSymbol - (validatorHashToTokenName hash) + (scriptHashToTokenName hash) mkGATUTxO hash = mconcat diff --git a/agora-specs/Sample/Effect/GovernorMutation.hs b/agora-specs/Sample/Effect/GovernorMutation.hs index dd25bed..c7520f3 100644 --- a/agora-specs/Sample/Effect/GovernorMutation.hs +++ b/agora-specs/Sample/Effect/GovernorMutation.hs @@ -2,7 +2,7 @@ module Sample.Effect.GovernorMutation ( mkEffectTxInfo, effectValidator, effectValidatorAddress, - effectValidatorHash, + effectScriptHash, atAssetClass, govRef, effectRef, @@ -20,9 +20,10 @@ import Agora.SafeMoney (AuthorityTokenTag) import Data.Default.Class (Default (def)) import Data.Map ((!)) import Data.Tagged (Tagged (..)) -import Plutarch.Api.V2 (validatorHash) +import Plutarch.Api.V2 (scriptHash) import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) +import Plutarch.Script (Script) import PlutusLedgerApi.V1 qualified as Interval (always) import PlutusLedgerApi.V1.Address (scriptHashAddress) import PlutusLedgerApi.V1.Value qualified as Value ( @@ -32,14 +33,13 @@ import PlutusLedgerApi.V2 ( Address, Datum (..), OutputDatum (OutputDatumHash), + ScriptHash, ScriptPurpose (Spending), ToData (..), TxInInfo (..), TxInfo (..), TxOut (..), TxOutRef (TxOutRef), - Validator (Validator), - ValidatorHash (..), ) import PlutusTx.AssocMap qualified as AssocMap import Sample.Shared ( @@ -54,22 +54,22 @@ import Sample.Shared ( import Test.Util (datumPair, toDatumHash) -- | The effect validator instance. -effectValidator :: Validator -effectValidator = Validator $ agoraScripts ! "agora:mutateGovernorValidator" +effectValidator :: Script +effectValidator = agoraScripts ! "agora:mutateGovernorValidator" -- | The hash of the validator instance. -effectValidatorHash :: ValidatorHash -effectValidatorHash = validatorHash effectValidator +effectScriptHash :: ScriptHash +effectScriptHash = scriptHash effectValidator -- | The address of the validator. effectValidatorAddress :: Address -effectValidatorAddress = scriptHashAddress effectValidatorHash +effectValidatorAddress = scriptHashAddress effectScriptHash -- | The assetclass of the authority token. atAssetClass :: Tagged AuthorityTokenTag AssetClass atAssetClass = Tagged $ AssetClass authorityTokenSymbol tokenName where - tokenName = validatorHashToTokenName effectValidatorHash + tokenName = scriptHashToTokenName effectScriptHash -- | The mock reference of the governor state UTXO. govRef :: TxOutRef diff --git a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs index 02491a4..7489d95 100644 --- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs @@ -24,7 +24,8 @@ import Agora.Effect.TreasuryWithdrawal ( TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), ) import Data.Map ((!)) -import Plutarch.Api.V2 (validatorHash) +import Plutarch.Api.V2 (scriptHash) +import Plutarch.Script (Script) import PlutusLedgerApi.V1.Interval qualified as Interval (always) import PlutusLedgerApi.V1.Value qualified as Value (singleton) import PlutusLedgerApi.V2 ( @@ -36,14 +37,13 @@ import PlutusLedgerApi.V2 ( PubKeyHash, Redeemer (Redeemer), ScriptContext (..), + ScriptHash (ScriptHash), ScriptPurpose (Spending), TokenName (TokenName), TxInInfo (TxInInfo), TxInfo (..), TxOut (..), TxOutRef (TxOutRef), - Validator (Validator), - ValidatorHash (ValidatorHash), Value, toBuiltinData, ) @@ -72,7 +72,7 @@ inputGAT = TxInInfo (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) TxOut - { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + { txOutAddress = Address (ScriptCredential $ scriptHash validator) Nothing , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST , txOutDatum = OutputDatumHash (DatumHash "") , txOutReferenceScript = Nothing @@ -147,12 +147,12 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs } -- | Effect validator instance. -validator :: Validator -validator = Validator $ agoraScripts ! "agora:treasuryWithdrawalValidator" +validator :: Script +validator = agoraScripts ! "agora:treasuryWithdrawalValidator" -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator. validatorHashTN :: TokenName -validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh +validatorHashTN = let ScriptHash hash = scriptHash validator in TokenName hash buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext buildScriptContext inputs outputs = diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index e080923..6c6b692 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -31,10 +31,8 @@ import Data.Default (Default (..)) import Data.Map (Map, (!)) import Data.Text (Text) import Optics (view) -import Plutarch.Api.V2 ( - mintingPolicySymbol, - validatorHash, - ) +import Plutarch (Script) +import Plutarch.Api.V2 (scriptHash) import Plutarch.Context ( input, mint, @@ -50,12 +48,10 @@ import Plutarch.Context ( import PlutusLedgerApi.V1.Value (AssetClass (..)) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( - CurrencySymbol, - MintingPolicy (MintingPolicy), - Script, + CurrencySymbol (CurrencySymbol), + ScriptHash, TxOutRef (TxOutRef), - Validator (Validator), - ValidatorHash, + getScriptHash, ) import Sample.Shared ( deterministicTracingConfig, @@ -128,20 +124,20 @@ scripts = governor ) -govPolicy :: MintingPolicy -govPolicy = MintingPolicy $ scripts ! "agora:governorPolicy" +govPolicy :: Script +govPolicy = scripts ! "agora:governorPolicy" -govValidator :: Validator -govValidator = Validator $ scripts ! "agora:governorValidator" +govValidator :: Script +govValidator = scripts ! "agora:governorValidator" govSymbol :: CurrencySymbol -govSymbol = mintingPolicySymbol govPolicy +govSymbol = CurrencySymbol . getScriptHash $ scriptHash govPolicy govAssetClass :: AssetClass govAssetClass = AssetClass (govSymbol, "") -govValidatorHash :: ValidatorHash -govValidatorHash = validatorHash govValidator +govScriptHash :: ScriptHash +govScriptHash = scriptHash govValidator -------------------------------------------------------------------------------- @@ -215,7 +211,7 @@ mintGST ps = builder else mempty in output $ mconcat - [ script govValidatorHash + [ script govScriptHash , withValue governorValue , datum ] diff --git a/agora-specs/Sample/Governor/Mutate.hs b/agora-specs/Sample/Governor/Mutate.hs index 11577f7..e387e28 100644 --- a/agora-specs/Sample/Governor/Mutate.hs +++ b/agora-specs/Sample/Governor/Mutate.hs @@ -20,7 +20,9 @@ import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..)) import Data.Default (def) import Data.Map ((!)) -import Plutarch.Api.V2 (PMintingPolicy, mintingPolicySymbol, mkMintingPolicy, validatorHash) +import Data.Text qualified as T +import Plutarch (Script) +import Plutarch.Api.V2 (PMintingPolicy, scriptHash) import Plutarch.Context ( input, mint, @@ -35,12 +37,9 @@ import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( - CurrencySymbol (CurrencySymbol), Data, - ScriptHash (ScriptHash), + ScriptHash, TxOutRef (TxOutRef), - Validator (Validator), - ValidatorHash, Value, toData, ) @@ -48,8 +47,8 @@ import Sample.Shared ( agoraScripts, authorityTokenSymbol, governorAssetClass, + governorScriptHash, governorValidator, - governorValidatorHash, minAda, ) import Test.Specification (SpecificationTree, testValidator) @@ -151,14 +150,14 @@ mkGovernorBuilder ps = gstOutput = if ps.stealGST then pubKey $ head pubKeyHashes - else script governorValidatorHash + else script governorScriptHash withGSTDatum = maybe mempty withDatum $ mkGovernorOutputDatum ps.governorOutputDatumValidity in mconcat [ input $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withDatum governorInputDatum , withValue value , withRef governorRef @@ -173,19 +172,18 @@ mkGovernorBuilder ps = -------------------------------------------------------------------------------- -mockEffectValidator :: Validator -mockEffectValidator = Validator $ agoraScripts ! "agora:noOpValidator" +mockEffectValidator :: Script +mockEffectValidator = agoraScripts ! "agora:noOpValidator" -mockEffectValidatorHash :: ValidatorHash -mockEffectValidatorHash = validatorHash mockEffectValidator +mockEffectScriptHash :: ScriptHash +mockEffectScriptHash = scriptHash mockEffectValidator mockAuthScript :: ClosedTerm PMintingPolicy mockAuthScript = plam $ \_ _ -> popaque $ pcon PUnit mockAuthScriptHash :: ScriptHash mockAuthScriptHash = - let CurrencySymbol h = mintingPolicySymbol $ mkMintingPolicy def mockAuthScript - in ScriptHash h + scriptHash . either (error . T.unpack) id $ compile def mockAuthScript mkGATValue :: GATValidity -> Integer -> Value mkGATValue NoGAT _ = mempty @@ -211,12 +209,12 @@ mkMockEffectBuilder ps = [ mint burnt , input $ mconcat - [ script mockEffectValidatorHash + [ script mockEffectScriptHash , withValue inputValue ] , output $ mconcat - [ script mockEffectValidatorHash + [ script mockEffectScriptHash , withValue outputValue ] ] diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index c36a878..cd98bc6 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -101,7 +101,6 @@ import PlutusLedgerApi.V2 ( PubKeyHash, ScriptHash, TxOutRef (TxOutRef), - ValidatorHash, ) import PlutusTx qualified import Sample.Proposal.Shared ( @@ -114,15 +113,15 @@ import Sample.Shared ( authorityTokenSymbol, governor, governorAssetClass, + governorScriptHash, governorValidator, - governorValidatorHash, minAda, proposalAssetClass, + proposalScriptHash, proposalValidator, - proposalValidatorHash, signer, stakeAssetClass, - stakeValidatorHash, + stakeScriptHash, ) import Test.Specification ( SpecificationTree, @@ -191,7 +190,7 @@ data AuthorityTokenParameters = forall , PIsData pdatum ) => AuthorityTokenParameters - { mintGATsFor :: ValidatorHash + { mintGATsFor :: ScriptHash -- ^ GATs will be minted and sent to the given group of effects. , carryDatum :: Maybe datum -- ^ The datum that GAT UTxOs will be carrying. @@ -337,14 +336,14 @@ mkProposalBuilder ps = in mconcat [ input $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withRef proposalRef , withDatum (mkProposalInputDatum ps) , withValue value ] , output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withDatum (mkProposalOutputDatum ps) , withValue value ] @@ -402,7 +401,7 @@ mkStakeBuilder ps = [ withSig , referenceInput $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withRef (mkStakeRef idx) , withValue perStakeValue , withInlineDatum i @@ -450,7 +449,7 @@ mkGovernorBuilder ps@(GovernorParameters _ redeemer) = in mconcat [ input $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withValue value , withRef governorRef , withDatum governorInputDatum @@ -458,7 +457,7 @@ mkGovernorBuilder ps@(GovernorParameters _ redeemer) = ] , output $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withValue value , withRef governorRef , withDatum (mkGovernorOutputDatum ps) diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index 44bc01e..f4ef7b0 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -76,11 +76,11 @@ import Sample.Shared ( governor, minAda, proposalAssetClass, + proposalScriptHash, proposalValidator, - proposalValidatorHash, stakeAssetClass, + stakeScriptHash, stakeValidator, - stakeValidatorHash, ) import Test.Specification ( SpecificationTree, @@ -248,7 +248,7 @@ cosign ps = builder mconcat [ input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withInlineDatum stakeInputDatum , withRef stakeRef @@ -256,7 +256,7 @@ cosign ps = builder ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withInlineDatum stakeOutputDatum ] @@ -275,7 +275,7 @@ cosign ps = builder mconcat [ input $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withDatum proposalInputDatum , withRef proposalRef @@ -283,7 +283,7 @@ cosign ps = builder ] , output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withDatum proposalOutputDatum ] diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs index bcd49df..82943b2 100644 --- a/agora-specs/Sample/Proposal/Create.hs +++ b/agora-specs/Sample/Proposal/Create.hs @@ -71,7 +71,7 @@ import Plutarch.Context ( withValue, ) import Plutarch.Extra.AssetClass (assetClassValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( Credential (PubKeyCredential), @@ -86,20 +86,20 @@ import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( governor, governorAssetClass, + governorScriptHash, governorValidator, - governorValidatorHash, minAda, proposalAssetClass, proposalPolicy, proposalPolicySymbol, + proposalScriptHash, proposalStartingTimeFromTimeRange, - proposalValidatorHash, signer, signer2, stakeAssetClass, + stakeScriptHash, stakeSymbol, stakeValidator, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, group, testPolicy, testValidator) import Test.Util ( @@ -319,7 +319,7 @@ createProposal ps = builder , withValue $ Value.singleton stakeSymbol - (validatorHashToTokenName attacker) + (scriptHashToTokenName attacker) 1 , withDatum $ (mkStakeInputDatum ps) @@ -363,7 +363,7 @@ createProposal ps = builder timeRange $ mkTimeRange ps , input $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withValue governorValue , withDatum governorInputDatum , withRedeemer ps.governorRedeemer @@ -371,7 +371,7 @@ createProposal ps = builder ] , output $ mconcat - [ script governorValidatorHash + [ script governorScriptHash , withValue governorValue , withDatum (mkGovernorOutputDatum ps) ] @@ -385,7 +385,7 @@ createProposal ps = builder , withValue $ Value.singleton stakeSymbol - (validatorHashToTokenName attacker) + (scriptHashToTokenName attacker) 1 , withDatum $ (mkStakeInputDatum ps) @@ -397,14 +397,14 @@ createProposal ps = builder mconcat [ input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withDatum (mkStakeInputDatum ps) , withRef stakeRef ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withDatum (mkStakeOutputDatum ps) ] @@ -412,7 +412,7 @@ createProposal ps = builder , --- output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withDatum (mkProposalOutputDatum ps) ] diff --git a/agora-specs/Sample/Proposal/PrivilegeEscalate.hs b/agora-specs/Sample/Proposal/PrivilegeEscalate.hs index 157e609..53b4e27 100644 --- a/agora-specs/Sample/Proposal/PrivilegeEscalate.hs +++ b/agora-specs/Sample/Proposal/PrivilegeEscalate.hs @@ -49,11 +49,11 @@ import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( minAda, proposalAssetClass, + proposalScriptHash, proposalValidator, - proposalValidatorHash, stakeAssetClass, + stakeScriptHash, stakeValidator, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, group, testValidator) import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes) @@ -166,7 +166,7 @@ privilegeEscalate op = mconcat @b [ input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withDatum stakeInput , withValue stakeValue , withRef $ mkStakeRef index @@ -174,7 +174,7 @@ privilegeEscalate op = ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withDatum stakeOutput , withValue stakeValue ] @@ -196,7 +196,7 @@ privilegeEscalate op = mconcat @b [ input $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withDatum proposalInput , withRedeemer $ mkProposalRedeemer op , withValue proposalValue @@ -204,7 +204,7 @@ privilegeEscalate op = ] , output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withDatum proposalOutput , withValue proposalValue ] diff --git a/agora-specs/Sample/Proposal/Unlock.hs b/agora-specs/Sample/Proposal/Unlock.hs index 4a4731d..a9305fd 100644 --- a/agora-specs/Sample/Proposal/Unlock.hs +++ b/agora-specs/Sample/Proposal/Unlock.hs @@ -72,7 +72,7 @@ import Plutarch.Context ( withValue, ) import Plutarch.Extra.AssetClass (assetClassValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( Credential (PubKeyCredential), @@ -85,11 +85,11 @@ import Sample.Shared ( governor, minAda, proposalAssetClass, + proposalScriptHash, proposalValidator, - proposalValidatorHash, + stakeScriptHash, stakeSymbol, stakeValidator, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, group, testValidator) import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes) @@ -282,7 +282,7 @@ unlock ps = builder mconcat [ input $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withDatum proposalInputDatum , withRef proposalRef @@ -290,7 +290,7 @@ unlock ps = builder ] , output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withDatum proposalOutputDatum ] @@ -299,7 +299,7 @@ unlock ps = builder --- sstName = case ps.stakeParameters.sstOwner of - StakeValidator -> validatorHashToTokenName stakeValidatorHash + StakeValidator -> scriptHashToTokenName stakeScriptHash _ -> "" sst = Value.singleton stakeSymbol sstName 1 @@ -350,14 +350,14 @@ unlock ps = builder mconcat [ input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeInputValue , withDatum stakeInputDatum , withRef $ mkStakeRef i ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeOutputValue , withDatum stakeOutputDatum ] diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 576e190..e02cd6b 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -76,11 +76,11 @@ import Sample.Shared ( governor, minAda, proposalAssetClass, + proposalScriptHash, proposalValidator, - proposalValidatorHash, stakeAssetClass, + stakeScriptHash, stakeValidator, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, group, testValidator) import Test.Util ( @@ -297,7 +297,7 @@ vote params = mconcat [ input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeInputValue , withInlineDatum $ mixOwner i stakeInputDatum , withRedeemer stakeRedeemer @@ -308,7 +308,7 @@ vote params = else output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeOutputValue , withInlineDatum $ mixOwner i stakeOutputDatum ] @@ -353,7 +353,7 @@ vote params = mconcat [ input $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withRedeemer proposalRedeemer , withInlineDatum proposalInputDatum @@ -361,7 +361,7 @@ vote params = ] , output $ mconcat - [ script proposalValidatorHash + [ script proposalScriptHash , withValue proposalValue , withInlineDatum proposalOutputDatum ] diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index e5a7b73..cb9dc8d 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -24,7 +24,7 @@ module Sample.Shared ( stakeAssetClass, stakePolicy, stakeValidator, - stakeValidatorHash, + stakeScriptHash, stakeAddress, stakeSymbol, @@ -35,14 +35,14 @@ module Sample.Shared ( governorSymbol, governorAssetClass, governorValidatorAddress, - governorValidatorHash, + governorScriptHash, gstUTXORef, -- ** Proposal proposalPolicy, proposalPolicySymbol, proposalValidator, - proposalValidatorHash, + proposalScriptHash, proposalValidatorAddress, proposalStartingTimeFromTimeRange, proposalAssetClass, @@ -77,13 +77,10 @@ import Data.Map (Map, (!)) import Data.Tagged (Tagged (..)) import Data.Text (Text) import Optics (view) -import Plutarch (Config (..), TracingMode (DetTracing)) -import Plutarch.Api.V2 ( - mintingPolicySymbol, - validatorHash, - ) +import Plutarch (Config (..), Script, TracingMode (DetTracing)) +import Plutarch.Api.V1 (scriptHash) import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Address (scriptHashAddress) import PlutusLedgerApi.V1.Value (TokenName, Value) import PlutusLedgerApi.V1.Value qualified as Value ( @@ -92,16 +89,15 @@ import PlutusLedgerApi.V1.Value qualified as Value ( import PlutusLedgerApi.V2 ( Address (Address), Credential (ScriptCredential), - CurrencySymbol, + CurrencySymbol (CurrencySymbol), Extended (..), Interval (..), LowerBound (..), - MintingPolicy (..), OutputDatum (NoOutputDatum), POSIXTimeRange, PubKeyHash, Redeemer (..), - Script, + ScriptHash (getScriptHash), ToData (toBuiltinData), TxOut ( TxOut, @@ -112,8 +108,6 @@ import PlutusLedgerApi.V2 ( ), TxOutRef (TxOutRef), UpperBound (..), - Validator (Validator), - ValidatorHash (ValidatorHash), ) import PlutusTx qualified import ScriptExport.ScriptInfo (runLinker) @@ -146,50 +140,50 @@ agoraScripts = governor ) -stakePolicy :: MintingPolicy -stakePolicy = MintingPolicy $ agoraScripts ! "agora:stakePolicy" +stakePolicy :: Script +stakePolicy = agoraScripts ! "agora:stakePolicy" stakeSymbol :: CurrencySymbol -stakeSymbol = mintingPolicySymbol stakePolicy +stakeSymbol = CurrencySymbol . getScriptHash $ scriptHash stakePolicy stakeAssetClass :: Tagged StakeSTTag AssetClass -stakeAssetClass = Tagged $ AssetClass stakeSymbol (validatorHashToTokenName stakeValidatorHash) +stakeAssetClass = Tagged $ AssetClass stakeSymbol (scriptHashToTokenName stakeScriptHash) -stakeValidator :: Validator -stakeValidator = Validator $ agoraScripts ! "agora:stakeValidator" +stakeValidator :: Script +stakeValidator = agoraScripts ! "agora:stakeValidator" -stakeValidatorHash :: ValidatorHash -stakeValidatorHash = validatorHash stakeValidator +stakeScriptHash :: ScriptHash +stakeScriptHash = scriptHash stakeValidator stakeAddress :: Address -stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing +stakeAddress = Address (ScriptCredential stakeScriptHash) Nothing gstUTXORef :: TxOutRef gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 -governorPolicy :: MintingPolicy -governorPolicy = MintingPolicy $ agoraScripts ! "agora:governorPolicy" +governorPolicy :: Script +governorPolicy = agoraScripts ! "agora:governorPolicy" -governorValidator :: Validator -governorValidator = Validator $ agoraScripts ! "agora:governorValidator" +governorValidator :: Script +governorValidator = agoraScripts ! "agora:governorValidator" governorSymbol :: CurrencySymbol -governorSymbol = mintingPolicySymbol governorPolicy +governorSymbol = CurrencySymbol . getScriptHash $ scriptHash governorPolicy governorAssetClass :: Tagged GovernorSTTag AssetClass governorAssetClass = Tagged $ AssetClass governorSymbol "" -governorValidatorHash :: ValidatorHash -governorValidatorHash = validatorHash governorValidator +governorScriptHash :: ScriptHash +governorScriptHash = scriptHash governorValidator governorValidatorAddress :: Address -governorValidatorAddress = scriptHashAddress governorValidatorHash +governorValidatorAddress = scriptHashAddress governorScriptHash -proposalPolicy :: MintingPolicy -proposalPolicy = MintingPolicy $ agoraScripts ! "agora:proposalPolicy" +proposalPolicy :: Script +proposalPolicy = agoraScripts ! "agora:proposalPolicy" proposalPolicySymbol :: CurrencySymbol -proposalPolicySymbol = mintingPolicySymbol proposalPolicy +proposalPolicySymbol = CurrencySymbol . getScriptHash $ scriptHash proposalPolicy proposalAssetClass :: Tagged ProposalSTTag AssetClass proposalAssetClass = Tagged $ AssetClass proposalPolicySymbol "" @@ -202,14 +196,14 @@ signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" signer2 :: PubKeyHash signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192" -proposalValidator :: Validator -proposalValidator = Validator $ agoraScripts ! "agora:proposalValidator" +proposalValidator :: Script +proposalValidator = agoraScripts ! "agora:proposalValidator" -proposalValidatorHash :: ValidatorHash -proposalValidatorHash = validatorHash proposalValidator +proposalScriptHash :: ScriptHash +proposalScriptHash = scriptHash proposalValidator proposalValidatorAddress :: Address -proposalValidatorAddress = scriptHashAddress proposalValidatorHash +proposalValidatorAddress = scriptHashAddress proposalScriptHash {- | Default value of 'Agora.Proposal.ProposalThresholds'. For testing purpose only. @@ -224,11 +218,11 @@ instance Default ProposalThresholds where , cosign = Tagged 100 } -authorityTokenPolicy :: MintingPolicy -authorityTokenPolicy = MintingPolicy $ agoraScripts ! "agora:authorityTokenPolicy" +authorityTokenPolicy :: Script +authorityTokenPolicy = agoraScripts ! "agora:authorityTokenPolicy" authorityTokenSymbol :: CurrencySymbol -authorityTokenSymbol = mintingPolicySymbol authorityTokenPolicy +authorityTokenSymbol = CurrencySymbol . getScriptHash $ scriptHash authorityTokenPolicy {- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'. For testing purpose only. @@ -279,32 +273,30 @@ treasuryOut = gatCs :: CurrencySymbol gatCs = authorityTokenSymbol -trValidator :: Validator -trValidator = Validator $ agoraScripts ! "agora:treasuryValidator" +trValidator :: Script +trValidator = agoraScripts ! "agora:treasuryValidator" -- | `ScriptCredential` used for the dummy treasury validator. trCredential :: Credential -trCredential = ScriptCredential $ validatorHash trValidator +trCredential = ScriptCredential $ scriptHash trValidator -- | `TokenName` for GAT generated from address of `mockTrEffect`. gatTn :: TokenName -gatTn = validatorHashToTokenName $ validatorHash mockTrEffect +gatTn = scriptHashToTokenName $ scriptHash mockTrEffect -- | Mock treasury effect script, used for testing. -mockTrEffect :: Validator -mockTrEffect = Validator $ agoraScripts ! "agora:noOpValidator" +mockTrEffect :: Script +mockTrEffect = agoraScripts ! "agora:noOpValidator" -- | Mock treasury effect validator hash -mockTrEffectHash :: ValidatorHash -mockTrEffectHash = validatorHash mockTrEffect +mockTrEffectHash :: ScriptHash +mockTrEffectHash = scriptHash mockTrEffect {- | A SHA-256 hash which (in all certainty) should not match the hash of the dummy effect script. -} -wrongEffHash :: ValidatorHash -wrongEffHash = - ValidatorHash - "a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b" +wrongEffHash :: ScriptHash +wrongEffHash = "a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b" ------------------------------------------------------------------ diff --git a/agora-specs/Sample/Stake.hs b/agora-specs/Sample/Stake.hs index 9a2b982..3a377ac 100644 --- a/agora-specs/Sample/Stake.hs +++ b/agora-specs/Sample/Stake.hs @@ -44,8 +44,8 @@ import Sample.Shared ( governor, signer, stakeAssetClass, + stakeScriptHash, stakeSymbol, - stakeValidatorHash, ) import Test.Util (sortValue) @@ -77,7 +77,7 @@ stakeDepositWithdraw config = , signedWith signer , input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue ( sortValue $ st @@ -88,7 +88,7 @@ stakeDepositWithdraw config = ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue ( sortValue $ st diff --git a/agora-specs/Sample/Stake/Create.hs b/agora-specs/Sample/Stake/Create.hs index b8eac00..808ebba 100644 --- a/agora-specs/Sample/Stake/Create.hs +++ b/agora-specs/Sample/Stake/Create.hs @@ -35,7 +35,7 @@ import Plutarch.Context ( withValue, ) import Plutarch.Extra.AssetClass (assetClassValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import Plutarch.Lift (PUnsafeLiftDecl (PLifted)) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( @@ -49,8 +49,8 @@ import Sample.Shared ( signer, signer2, stakePolicy, + stakeScriptHash, stakeSymbol, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, testPolicy) import Test.Util (CombinableBuilder, mkMinting, validatorHashes) @@ -93,7 +93,7 @@ create ps@Parameters {stakeDatum} = sstName = if ps.invalidSSTName then "114514" - else validatorHashToTokenName stakeValidatorHash + else scriptHashToTokenName stakeScriptHash sst = Value.singleton stakeSymbol sstName 1 @@ -105,7 +105,7 @@ create ps@Parameters {stakeDatum} = stakeBuilder = mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue $ normalizeValue $ sst <> perStakeGTs , withStakeDatum ] diff --git a/agora-specs/Sample/Stake/Destroy.hs b/agora-specs/Sample/Stake/Destroy.hs index c107768..b820961 100644 --- a/agora-specs/Sample/Stake/Destroy.hs +++ b/agora-specs/Sample/Stake/Destroy.hs @@ -53,9 +53,9 @@ import Sample.Shared ( signer2, stakeAssetClass, stakePolicy, + stakeScriptHash, stakeSymbol, stakeValidator, - stakeValidatorHash, ) import Test.Specification ( SpecificationTree, @@ -125,7 +125,7 @@ destroy ps = stakeUTxOTemplate = mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withDatum stakeInputDatum , withValue $ normalizeValue $ sst <> minAda ] diff --git a/agora-specs/Sample/Stake/SetDelegate.hs b/agora-specs/Sample/Stake/SetDelegate.hs index ce4268c..efc7833 100644 --- a/agora-specs/Sample/Stake/SetDelegate.hs +++ b/agora-specs/Sample/Stake/SetDelegate.hs @@ -50,8 +50,8 @@ import Sample.Shared ( signer, signer2, stakeAssetClass, + stakeScriptHash, stakeValidator, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, testValidator) import Test.Util (pubKeyHashes, sortValue) @@ -132,14 +132,14 @@ setDelegate ps = buildSpending' builder , signedWith signer , input $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withDatum stakeInput , withRef stakeRef ] , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue stakeValue , withDatum stakeOutput ] diff --git a/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs b/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs index 88dd673..9460015 100644 --- a/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs +++ b/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs @@ -13,14 +13,14 @@ import Plutarch.Context ( withValue, ) import Plutarch.Extra.AssetClass (assetClassValue) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( minAda, stakeAssetClass, stakePolicy, + stakeScriptHash, stakeSymbol, - stakeValidatorHash, ) import Test.Specification (SpecificationTree, testPolicy) import Test.Util ( @@ -51,7 +51,7 @@ exploit (Parameters inputSST) = , mint sst , output $ mconcat - [ script stakeValidatorHash + [ script stakeScriptHash , withValue $ normalizeValue $ minAda <> sst @@ -63,7 +63,7 @@ exploit (Parameters inputSST) = fakeSSTValue = Value.singleton stakeSymbol - (validatorHashToTokenName attacker) + (scriptHashToTokenName attacker) . fromIntegral sst = assetClassValue stakeAssetClass 1 diff --git a/agora-specs/Sample/Treasury.hs b/agora-specs/Sample/Treasury.hs index 7928dc4..1ac076d 100644 --- a/agora-specs/Sample/Treasury.hs +++ b/agora-specs/Sample/Treasury.hs @@ -37,7 +37,7 @@ import PlutusLedgerApi.V2 ( Credential (PubKeyCredential), OutputDatum (NoOutputDatum), PubKeyHash (PubKeyHash), - ValidatorHash (ValidatorHash), + ScriptHash (ScriptHash), ) import PlutusLedgerApi.V2.Contexts ( ScriptContext (..), @@ -101,7 +101,7 @@ treasuryRef = -} walletIn :: TxInInfo walletIn = - let (ValidatorHash addressBs) = mockTrEffectHash + let (ScriptHash addressBs) = mockTrEffectHash in TxInInfo { txInInfoOutRef = TxOutRef diff --git a/agora-specs/Spec/AuthorityToken.hs b/agora-specs/Spec/AuthorityToken.hs index b169b42..2da7fea 100644 --- a/agora-specs/Spec/AuthorityToken.hs +++ b/agora-specs/Spec/AuthorityToken.hs @@ -12,16 +12,16 @@ module Spec.AuthorityToken (specs) where import Agora.AuthorityToken (singleAuthorityTokenBurned) import Data.Tagged (Tagged (Tagged)) import Plutarch.Extra.Compile (mustCompile) +import Plutarch.Script (Script) import Plutarch.Unsafe (punsafeCoerce) import PlutusLedgerApi.V1 ( Address (Address), Credential (PubKeyCredential, ScriptCredential), CurrencySymbol, - Script, + ScriptHash (ScriptHash), TxInInfo (TxInInfo), TxOut (TxOut), TxOutRef (TxOutRef), - ValidatorHash (ValidatorHash), Value, ) import PlutusLedgerApi.V1.Value qualified as Value ( @@ -68,7 +68,7 @@ specs = <> Value.singleton "aa" "USDC" 100_000 ) [ TxOut - (Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) + (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing) (Value.singleton currencySymbol "deadbeef" 1) Nothing ] @@ -84,7 +84,7 @@ specs = (Value.singleton "aaabcc" "hello-token" 1) Nothing , TxOut - (Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) + (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing) (Value.singleton currencySymbol "deadbeef" 1) Nothing , TxOut @@ -99,7 +99,7 @@ specs = ( Value.singleton currencySymbol "i'm not deadbeef!" (-1) ) [ TxOut - (Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) + (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing) (Value.singleton currencySymbol "i'm not deadbeef!" 1) Nothing ] @@ -136,7 +136,7 @@ specs = <> Value.singleton "aa" "USDC" 100_000 ) [ TxOut - (Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) + (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing) (Value.singleton currencySymbol "deadbeef" 2) Nothing ] diff --git a/agora-specs/Spec/Treasury.hs b/agora-specs/Spec/Treasury.hs index f840757..d42280d 100644 --- a/agora-specs/Spec/Treasury.hs +++ b/agora-specs/Spec/Treasury.hs @@ -21,11 +21,12 @@ Tests need to fail when: -} module Spec.Treasury (specs) where +import Plutarch.Script (Script) import PlutusLedgerApi.V1.Credential ( StakingCredential (StakingHash), ) import PlutusLedgerApi.V1.Value qualified as Value (singleton) -import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey), Validator) +import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey)) import PlutusLedgerApi.V2.Contexts ( ScriptContext (scriptContextPurpose, scriptContextTxInfo), ScriptPurpose (Certifying, Minting, Rewarding), @@ -46,7 +47,7 @@ import Test.Specification ( validatorSucceedsWith, ) -compiledTreasuryValidator :: Validator +compiledTreasuryValidator :: Script compiledTreasuryValidator = trValidator specs :: [SpecificationTree] diff --git a/agora-testlib/Test/Specification.hs b/agora-testlib/Test/Specification.hs index 1ba300e..8fb1bd2 100644 --- a/agora-testlib/Test/Specification.hs +++ b/agora-testlib/Test/Specification.hs @@ -53,23 +53,21 @@ import Control.Composition ((.**), (.***)) import Data.Coerce (coerce) import Data.Text qualified as Text import Plutarch.Evaluate (evalScript) -import PlutusLedgerApi.V1.Scripts ( - Context (Context), - applyMintingPolicyScript, - applyValidator, - ) +import Plutarch.Script (Script (Script)) +import PlutusCore.Data qualified as PLC +import PlutusCore.MkPlc qualified as PLC import PlutusLedgerApi.V2 ( Datum (..), - MintingPolicy, Redeemer (Redeemer), - Script, ScriptContext, ToData (toBuiltinData), - Validator, + toData, ) +import PlutusPrelude (over) import PlutusTx.IsData qualified as PlutusTx (ToData) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) +import UntypedPlutusCore qualified as UPLC {- | Expectations upon execution of script @Success@ indicates a successful execution. @@ -169,9 +167,6 @@ scriptSucceeds name script = Terminal $ Specification name Success script scriptFails :: String -> Script -> SpecificationTree scriptFails name script = Terminal $ Specification name Failure script -mkContext :: ScriptContext -> Context -mkContext = Context . toBuiltinData - mkRedeemer :: forall redeemer. (PlutusTx.ToData redeemer) => @@ -188,37 +183,39 @@ mkDatum = Datum . toBuiltinData applyMintingPolicy' :: (PlutusTx.ToData redeemer) => - MintingPolicy -> + Script -> redeemer -> ScriptContext -> Script applyMintingPolicy' policy redeemer scriptContext = - applyMintingPolicyScript - (mkContext scriptContext) + applyArguments policy - (mkRedeemer redeemer) + [ toData $ mkRedeemer redeemer + , toData scriptContext + ] applyValidator' :: ( PlutusTx.ToData datum , PlutusTx.ToData redeemer ) => - Validator -> + Script -> datum -> redeemer -> ScriptContext -> Script applyValidator' validator datum redeemer scriptContext = - applyValidator - (mkContext scriptContext) + applyArguments validator - (mkDatum datum) - (mkRedeemer redeemer) + [ toData $ mkDatum datum + , toData $ mkRedeemer redeemer + , toData scriptContext + ] -- | Check that a policy script succeeds, given a name and arguments. policySucceedsWith :: (PlutusTx.ToData redeemer) => String -> - MintingPolicy -> + Script -> redeemer -> ScriptContext -> SpecificationTree @@ -229,7 +226,7 @@ policySucceedsWith tag = policyFailsWith :: (PlutusTx.ToData redeemer) => String -> - MintingPolicy -> + Script -> redeemer -> ScriptContext -> SpecificationTree @@ -242,7 +239,7 @@ validatorSucceedsWith :: , PlutusTx.ToData redeemer ) => String -> - Validator -> + Script -> datum -> redeemer -> ScriptContext -> @@ -256,7 +253,7 @@ validatorFailsWith :: , PlutusTx.ToData redeemer ) => String -> - Validator -> + Script -> datum -> redeemer -> ScriptContext -> @@ -269,7 +266,7 @@ effectSucceedsWith :: ( PlutusTx.ToData datum ) => String -> - Validator -> + Script -> datum -> ScriptContext -> SpecificationTree @@ -280,7 +277,7 @@ effectFailsWith :: ( PlutusTx.ToData datum ) => String -> - Validator -> + Script -> datum -> ScriptContext -> SpecificationTree @@ -293,7 +290,7 @@ testValidator :: -- | Is this test case expected to succeed? Bool -> String -> - Validator -> + Script -> datum -> redeemer -> ScriptContext -> @@ -310,7 +307,7 @@ testPolicy :: -- | Is this test case expected to succeed? Bool -> String -> - MintingPolicy -> + Script -> redeemer -> ScriptContext -> SpecificationTree @@ -318,3 +315,11 @@ testPolicy isValid = if isValid then policySucceedsWith else policyFailsWith + +-------------------------------------------------------------------------------- + +applyArguments :: Script -> [PLC.Data] -> Script +applyArguments (Script p) args = + let termArgs = fmap (PLC.mkConstant ()) args + applied t = PLC.mkIterApp () t termArgs + in Script $ over UPLC.progTerm applied p diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index ba6230d..41fb3fe 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -57,7 +57,6 @@ import PlutusLedgerApi.V2 ( ScriptContext, ScriptHash (ScriptHash), TxOutRef, - ValidatorHash (ValidatorHash), ) import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins qualified as PlutusTx @@ -157,8 +156,8 @@ userCredentials :: [Credential] userCredentials = PubKeyCredential <$> pubKeyHashes -- | An infinite list of *valid* validator hashes. -validatorHashes :: [ValidatorHash] -validatorHashes = ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes +validatorHashes :: [ScriptHash] +validatorHashes = ScriptHash . PlutusTx.toBuiltin <$> blake2b_224Hashes -- | An infinite list of *valid* script credentials. scriptCredentials :: [Credential] diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 2050a28..5d0b560 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -27,8 +27,9 @@ import Agora.Governor ( ) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.Utils (ptaggedSymbolValueOf) -import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash) +import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V2 ( + PScriptHash, PScriptPurpose (PSpending), PTxOutRef, PValidator, @@ -43,9 +44,9 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust) import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.ScriptContext ( pisScriptAddress, + pscriptHashFromAddress, ptryFromOutputDatum, ptryFromRedeemer, - pvalidatorHashFromAddress, ) import Plutarch.Extra.Tagged (PTagged) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) @@ -150,7 +151,7 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum -} mutateGovernorValidator :: ClosedTerm - ( PValidatorHash + ( PScriptHash :--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator @@ -194,12 +195,12 @@ mutateGovernorValidator = , ptraceIfFalse "Can only modify the pinned governor" $ inputF.outRef #== effectDatumF.governorRef , ptraceIfFalse "Governor validator run" $ - let inputValidatorHash = + let inputScriptHash = pfromJust - #$ pvalidatorHashFromAddress + #$ pscriptHashFromAddress #$ pfield @"address" # inputF.resolved - in inputValidatorHash #== govValidatorHash + in inputScriptHash #== govValidatorHash ] in isGovernorInput ) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index bbe92a0..928993c 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -43,11 +43,12 @@ import Agora.Stake ( ) import Agora.Utils (ptaggedSymbolValueOf, ptoScottEncodingT, puntag) import Data.Function (on) -import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash) +import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap qualified as AssocMap import Plutarch.Api.V2 ( PMintingPolicy, + PScriptHash, PScriptPurpose (PMinting, PSpending), PTxOut, PTxOutRef, @@ -67,7 +68,6 @@ import Plutarch.Extra.ScriptContext ( pscriptHashToTokenName, ptryFromDatumHash, ptryFromOutputDatum, - pvalidatorHashFromAddress, pvalueSpent, ) import Plutarch.Extra.Tagged (PTagged) @@ -264,7 +264,7 @@ governorPolicy = governorValidator :: -- | Lazy precompiled scripts. ClosedTerm - ( PValidatorHash + ( PScriptHash :--> PTagged StakeSTTag PAssetClassData :--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol @@ -272,7 +272,7 @@ governorValidator :: :--> PValidator ) governorValidator = - plam $ \proposalValidatorHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do + plam $ \proposalScriptHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do ctxF <- pletAllC ctx txInfo <- pletC $ pfromData ctxF.txInfo txInfoF <- @@ -317,7 +317,7 @@ governorValidator = foldl1 (#&&) [ ptraceIfFalse "Own by governor validator" $ - ((#==) `on` (pvalidatorHashFromAddress #)) + ((#==) `on` (pscriptHashFromAddress #)) outputF.address governorInputF.address , ptraceIfFalse "Has governor ST" $ @@ -345,8 +345,8 @@ governorValidator = plam $ flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> let isProposalUTxO = - (pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address) - #== proposalValidatorHash + (pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address) + #== proposalScriptHash #&& passetClassValueOf # pstClass # txOutF.value @@ -500,82 +500,83 @@ governorValidator = -- The effects of the winner outcome. effectGroup <- pletC $ ptryLookup # finalResultTag #$ proposalInputDatumF.effects - let -- For a given output, check if it contains a single valid GAT. - getReceiverScriptHash = - plam - ( \output -> unTermCont $ do - outputF <- pletFieldsC @'["address", "datum", "value"] output + let + -- For a given output, check if it contains a single valid GAT. + getReceiverScriptHash = + plam + ( \output -> unTermCont $ do + outputF <- pletFieldsC @'["address", "datum", "value"] output - let atAmount = - ptaggedSymbolValueOf - # atSymbol - # outputF.value + let atAmount = + ptaggedSymbolValueOf + # atSymbol + # outputF.value - handleAuthorityUTxO = - do - receiverScriptHash <- - pletC $ - passertPJust - # "GAT receiver should be a script" - #$ pscriptHashFromAddress - # outputF.address + handleAuthorityUTxO = + do + receiverScriptHash <- + pletC $ + passertPJust + # "GAT receiver should be a script" + #$ pscriptHashFromAddress + # outputF.address - effect <- - pletAllC $ - passertPJust - # "Receiver should be in the effect group" - #$ AssocMap.plookup - # receiverScriptHash - # effectGroup + effect <- + pletAllC $ + passertPJust + # "Receiver should be in the effect group" + #$ AssocMap.plookup + # receiverScriptHash + # effectGroup - let tagToken = - pmaybeData - # pconstant "" - # plam (pscriptHashToTokenName . pfromData) - # effect.scriptHash - gatAssetClass = passetClass # puntag atSymbol # tagToken - valueGATCorrect = - passetClassValueOf - # gatAssetClass - # outputF.value - #== 1 + let tagToken = + pmaybeData + # pconstant "" + # plam (pscriptHashToTokenName . pfromData) + # effect.scriptHash + gatAssetClass = passetClass # puntag atSymbol # tagToken + valueGATCorrect = + passetClassValueOf + # gatAssetClass + # outputF.value + #== 1 - let hasCorrectDatum = - effect.datumHash #== ptryFromDatumHash # outputF.datum + let hasCorrectDatum = + effect.datumHash #== ptryFromDatumHash # outputF.datum - pguardC "Authority output valid" $ - foldr1 - (#&&) - [ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output - , ptraceIfFalse "Correct datum" hasCorrectDatum - , ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect - ] + pguardC "Authority output valid" $ + foldr1 + (#&&) + [ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output + , ptraceIfFalse "Correct datum" hasCorrectDatum + , ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect + ] - pure $ pjust # receiverScriptHash + pure $ pjust # receiverScriptHash - pmatchC - ( pcompareBy - # pfromOrd - # atAmount - # 1 - ) - >>= \case - -- atAmount == 1 - PEQ -> handleAuthorityUTxO - -- atAmount < 1 - PLT -> pure pnothing - -- atAmount > 1 - PGT -> pure $ ptraceError "More than one GAT in one UTxO" - ) + pmatchC + ( pcompareBy + # pfromOrd + # atAmount + # 1 + ) + >>= \case + -- atAmount == 1 + PEQ -> handleAuthorityUTxO + -- atAmount < 1 + PLT -> pure pnothing + -- atAmount > 1 + PGT -> pure $ ptraceError "More than one GAT in one UTxO" + ) - -- The sorted hashes of all the GAT receivers. - actualReceivers = - psort - #$ pmapMaybe @PList - # getReceiverScriptHash - # pfromData txInfoF.outputs + -- The sorted hashes of all the GAT receivers. + actualReceivers = + psort + #$ pmapMaybe @PList + # getReceiverScriptHash + # pfromData txInfoF.outputs - expectedReceivers = pkeys @PList # effectGroup + expectedReceivers = pkeys @PList # effectGroup -- This check ensures that it's impossible to send more than one GATs -- to a validator in the winning effect group. diff --git a/agora/Agora/Linker.hs b/agora/Agora/Linker.hs index aa17905..7f57520 100644 --- a/agora/Agora/Linker.hs +++ b/agora/Agora/Linker.hs @@ -7,14 +7,12 @@ import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag, import Data.Aeson qualified as Aeson import Data.Map (fromList) import Data.Tagged (Tagged (Tagged)) -import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) +import Plutarch.Api.V1 (scriptHash) import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) -import Plutarch.Extra.ScriptContext (validatorHashToTokenName) -import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash) +import Plutarch.Extra.ScriptContext (scriptHashToTokenName) +import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), ScriptHash, TxOutRef, getScriptHash) import Ply ( ScriptRole (MintingPolicyRole, ValidatorRole), - toMintingPolicy, - toValidator, (#), ) import ScriptExport.ScriptInfo ( @@ -23,6 +21,7 @@ import ScriptExport.ScriptInfo ( fetchTS, getParam, toRoledScript, + toScript, ) import Prelude hiding ((#)) @@ -54,7 +53,7 @@ linker = do govVal <- fetchTS @ValidatorRole - @'[ ValidatorHash + @'[ ScriptHash , Tagged StakeSTTag AssetClass , Tagged GovernorSTTag CurrencySymbol , Tagged ProposalSTTag CurrencySymbol @@ -110,7 +109,7 @@ linker = do mutateGovVal <- fetchTS @ValidatorRole - @'[ ValidatorHash + @'[ ScriptHash , Tagged GovernorSTTag CurrencySymbol , Tagged AuthorityTokenTag CurrencySymbol ] @@ -126,16 +125,13 @@ linker = do # Tagged gstSymbol # Tagged pstSymbol # Tagged atSymbol - gstSymbol = - mintingPolicySymbol $ - toMintingPolicy - govPol' + gstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript govPol' gstAssetClass = AssetClass gstSymbol "" - govValHash = validatorHash $ toValidator govVal' + govValHash = scriptHash $ toScript govVal' atPol' = atkPol # Tagged gstAssetClass - atSymbol = mintingPolicySymbol $ toMintingPolicy atPol' + atSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript atPol' propPol' = prpPol # Tagged gstAssetClass propVal' = @@ -144,8 +140,8 @@ linker = do # Tagged gstSymbol # Tagged pstSymbol # governor.maximumCosigners - propValHash = validatorHash $ toValidator propVal' - pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol' + propValHash = scriptHash $ toScript propVal' + pstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript propPol' pstAssetClass = AssetClass pstSymbol "" stakPol' = stkPol # governor.gtClassRef @@ -154,9 +150,9 @@ linker = do # Tagged sstSymbol # Tagged pstAssetClass # governor.gtClassRef - sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol' + sstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript stakPol' stakValTokenName = - validatorHashToTokenName $ validatorHash $ toValidator stakVal' + scriptHashToTokenName $ scriptHash $ toScript stakVal' sstAssetClass = AssetClass sstSymbol stakValTokenName treaVal' = treVal # Tagged atSymbol diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index b84f549..71ee430 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -53,7 +53,7 @@ import Agora.SafeMoney (GTTag) import Data.Map.Strict qualified as StrictMap import Data.Tagged (Tagged) import Generics.SOP qualified as SOP -import Plutarch.Api.V1 (PCredential, PMap, PValidatorHash) +import Plutarch.Api.V1 (PCredential, PMap) import Plutarch.Api.V1.AssocMap qualified as PAssocMap import Plutarch.Api.V2 ( KeyGuarantees (Sorted), @@ -88,7 +88,7 @@ import Plutarch.Lift ( PUnsafeLiftDecl (type PLifted), ) import Plutarch.Orphans () -import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash) +import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash) import PlutusTx qualified -------------------------------------------------------------------------------- @@ -315,7 +315,7 @@ data ProposalEffectMetadata = ProposalEffectMetadata via (ProductIsData ProposalEffectMetadata) -- | @since 1.0.0 -type ProposalEffectGroup = StrictMap.Map ValidatorHash ProposalEffectMetadata +type ProposalEffectGroup = StrictMap.Map ScriptHash ProposalEffectMetadata {- | Haskell-level datum for Proposal scripts. @@ -695,7 +695,7 @@ instance PTryFrom PData (PAsData PProposalEffectMetadata) type PProposalEffectGroup = PMap 'Sorted - PValidatorHash + PScriptHash PProposalEffectMetadata {- | Plutarch-level version of 'ProposalDatum'. diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 32be0d3..f92b550 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -71,8 +71,8 @@ import Plutarch.Extra.Ord (pfromOrdBy, pinsertUniqueBy, psort) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.ScriptContext ( pfindTxInByTxOutRef, + pscriptHashFromAddress, ptryFromOutputDatum, - pvalidatorHashFromAddress, ) import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Tagged (PTagged) @@ -285,7 +285,7 @@ proposalValidator = foldl1 (#&&) [ ptraceIfFalse "Own by proposal validator" $ - ((#==) `on` (pvalidatorHashFromAddress #)) + ((#==) `on` (pscriptHashFromAddress #)) outputF.address proposalInputF.address , ptraceIfFalse "Has proposal ST" $ @@ -523,39 +523,40 @@ proposalValidator = pguardC "Vote option should be valid" $ pisJust #$ plookup # voteFor # voteMap - let -- The amount of new votes should be the 'stakedAmount'. - -- Update the vote counter of the proposal, and leave other stuff as is. - expectedNewVotes = - pcon $ - PProposalVotes $ - pupdate - # plam - ( \votes -> - pcon $ PJust $ votes + pto totalStakeAmount - ) - # voteFor - # pto (pfromData proposalInputDatumF.votes) + let + -- The amount of new votes should be the 'stakedAmount'. + -- Update the vote counter of the proposal, and leave other stuff as is. + expectedNewVotes = + pcon $ + PProposalVotes $ + pupdate + # plam + ( \votes -> + pcon $ PJust $ votes + pto totalStakeAmount + ) + # voteFor + # pto (pfromData proposalInputDatumF.votes) - expectedProposalOut = - mkRecordConstr - PProposalDatum - ( #proposalId - .= proposalInputDatumF.proposalId - .& #effects - .= proposalInputDatumF.effects - .& #status - .= proposalInputDatumF.status - .& #cosigners - .= proposalInputDatumF.cosigners - .& #thresholds - .= proposalInputDatumF.thresholds - .& #votes - .= pdata expectedNewVotes - .& #timingConfig - .= proposalInputDatumF.timingConfig - .& #startingTime - .= proposalInputDatumF.startingTime - ) + expectedProposalOut = + mkRecordConstr + PProposalDatum + ( #proposalId + .= proposalInputDatumF.proposalId + .& #effects + .= proposalInputDatumF.effects + .& #status + .= proposalInputDatumF.status + .& #cosigners + .= proposalInputDatumF.cosigners + .& #thresholds + .= proposalInputDatumF.thresholds + .& #votes + .= pdata expectedNewVotes + .& #timingConfig + .= proposalInputDatumF.timingConfig + .& #startingTime + .= proposalInputDatumF.startingTime + ) pguardC "Output proposal should be valid" $ proposalOutputDatum #== expectedProposalOut @@ -615,34 +616,36 @@ proposalValidator = pguardC "Proposal output correct" $ pif shouldUpdateVotes - ( let -- Remove votes and leave other parts of the proposal as it. - expectedProposalOut = - mkRecordConstr - PProposalDatum - ( #proposalId - .= proposalInputDatumF.proposalId - .& #effects - .= proposalInputDatumF.effects - .& #status - .= proposalInputDatumF.status - .& #cosigners - .= proposalInputDatumF.cosigners - .& #thresholds - .= proposalInputDatumF.thresholds - .& #votes - .= expectedVotes - .& #timingConfig - .= proposalInputDatumF.timingConfig - .& #startingTime - .= proposalInputDatumF.startingTime - ) - in foldl1 - (#&&) - [ ptraceIfFalse "Votes changed" $ - pnot #$ expectedVotes #== proposalInputDatumF.votes - , ptraceIfFalse "Proposal update correct" $ - expectedProposalOut #== proposalOutputDatum - ] + ( let + -- Remove votes and leave other parts of the proposal as it. + expectedProposalOut = + mkRecordConstr + PProposalDatum + ( #proposalId + .= proposalInputDatumF.proposalId + .& #effects + .= proposalInputDatumF.effects + .& #status + .= proposalInputDatumF.status + .& #cosigners + .= proposalInputDatumF.cosigners + .& #thresholds + .= proposalInputDatumF.thresholds + .& #votes + .= expectedVotes + .& #timingConfig + .= proposalInputDatumF.timingConfig + .& #startingTime + .= proposalInputDatumF.startingTime + ) + in + foldl1 + (#&&) + [ ptraceIfFalse "Votes changed" $ + pnot #$ expectedVotes #== proposalInputDatumF.votes + , ptraceIfFalse "Proposal update correct" $ + expectedProposalOut #== proposalOutputDatum + ] ) -- No change to the proposal is allowed. ( ptraceIfFalse "Proposal unchanged" $ diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 270eea3..d546a5d 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -90,9 +90,9 @@ import Plutarch.Extra.Maybe ( import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd) import Plutarch.Extra.ScriptContext ( pfindTxInByTxOutRef, + pscriptHashFromAddress, + pscriptHashToTokenName, ptryFromOutputDatum, - pvalidatorHashFromAddress, - pvalidatorHashToTokenName, pvalueSpent, ) import Plutarch.Extra.Tagged (PTagged) @@ -122,7 +122,7 @@ import Prelude hiding (Num ((+))) - Check that exactly one state thread is minted. - Check that an output exists with a state thread and a valid datum. - Check that no state thread is an input. - - assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ValidatorHash'@ + - assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ScriptHash'@ of the script that we pay to. === For burning: @@ -290,14 +290,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass = # (pfield @"_0" # stakeInputRef) # txInfoF.inputs - stakeValidatorHash <- + stakeScriptHash <- pletC $ pfromJust - #$ pvalidatorHashFromAddress + #$ pscriptHashFromAddress #$ pfield @"address" # validatedInput - let sstName = pvalidatorHashToTokenName stakeValidatorHash + let sstName = pscriptHashToTokenName stakeScriptHash sstClass <- pletC $ passetClass # puntag sstSymbol # sstName @@ -321,11 +321,11 @@ mkStakeValidator impl sstSymbol pstClass gtClass = PEQ -> let ownerValidatoHash = pfromJust - #$ pvalidatorHashFromAddress + #$ pscriptHashFromAddress # txOutF.address isOwnedByStakeValidator = - ownerValidatoHash #== stakeValidatorHash + ownerValidatoHash #== stakeScriptHash datum = ptrace "Resolve stake datum" $ diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index c589ed5..1f50e50 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -8,7 +8,7 @@ Description: Plutarch utility functions that should be upstreamed or don't belon Plutarch utility functions that should be upstreamed or don't belong anywhere else. -} module Agora.Utils ( - validatorHashToAddress, + scriptHashToAddress, pstringIntercalate, punwords, pisNothing, @@ -33,15 +33,15 @@ import Plutarch.Unsafe (punsafeDowncast) import PlutusLedgerApi.V2 ( Address (Address), Credential (ScriptCredential), - ValidatorHash, + ScriptHash, ) -{- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'. +{- | Create an 'Address' from a given 'ScriptHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'. - @since 0.1.0 + @since 1.0.0 -} -validatorHashToAddress :: ValidatorHash -> Address -validatorHashToAddress vh = Address (ScriptCredential vh) Nothing +scriptHashToAddress :: ScriptHash -> Address +scriptHashToAddress vh = Address (ScriptCredential vh) Nothing -- | @since 1.0.0 pstringIntercalate :: diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..23a3612 --- /dev/null +++ b/default.nix @@ -0,0 +1,3 @@ +{ + imports = [ ./flake-module.nix ]; +} diff --git a/flake-module.nix b/flake-module.nix new file mode 100644 index 0000000..390b43b --- /dev/null +++ b/flake-module.nix @@ -0,0 +1,28 @@ +{ self, ... }: +{ + perSystem = { config, pkgs', self', inputs, system, ... }: + let + pkgs = import self.inputs.nixpkgs { + inherit system; + }; + in + { + onchain.default = { + src = ./.; + ghc = { + version = "ghc923"; + }; + shell = { }; + enableBuildChecks = true; + extraHackageDeps = [ + "${self.inputs.plutarch-numeric}" + "${self.inputs.plutarch-quickcheck}" + "${self.inputs.plutarch-context-builder}" + "${self.inputs.liqwid-plutarch-extra}" + "${self.inputs.liqwid-script-export}" + "${self.inputs.liqwid-script-export.inputs.ply}/ply-core" + "${self.inputs.liqwid-script-export.inputs.ply}/ply-plutarch" + ]; + }; + }; +} diff --git a/flake.nix b/flake.nix index a669865..d9b8ed1 100644 --- a/flake.nix +++ b/flake.nix @@ -1,173 +1,46 @@ { description = "agora"; - inputs = { - nixpkgs.follows = "plutarch/nixpkgs"; - nixpkgs-latest.url = "github:NixOS/nixpkgs"; - # temporary fix for nix versions that have the transitive follows bug - # see https://github.com/NixOS/nix/issues/6013 - nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; - nixpkgs-2205 = { url = "github:NixOS/nixpkgs/nixos-22.05"; }; - - haskell-nix-extra-hackage.follows = "plutarch/haskell-nix-extra-hackage"; - haskell-nix.follows = "plutarch/haskell-nix"; - iohk-nix.follows = "plutarch/iohk-nix"; - haskell-language-server.follows = "plutarch/haskell-language-server"; - - # Plutarch and its friends - plutarch = { - url = "github:Plutonomicon/plutarch-plutus?ref=master"; - - inputs.emanote.follows = - "plutarch/haskell-nix/nixpkgs-unstable"; - inputs.nixpkgs.follows = - "plutarch/haskell-nix/nixpkgs-unstable"; - }; - ply = { - url = "github:mlabs-haskell/ply?ref=master"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.plutarch.follows = "plutarch"; - }; - plutarch-numeric = { - url = "github:Liqwid-Labs/plutarch-numeric?ref=main"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.nixpkgs-latest.follows = "nixpkgs-latest"; - inputs.nixpkgs-2111.follows = "nixpkgs-2111"; - inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.haskell-language-server.follows = "haskell-language-server"; - inputs.plutarch.follows = "plutarch"; - }; - liqwid-plutarch-extra = { - url = "github:Liqwid-Labs/liqwid-plutarch-extra?ref=main"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.nixpkgs-latest.follows = "nixpkgs-latest"; - inputs.nixpkgs-2111.follows = "nixpkgs-2111"; - inputs.nixpkgs-2205.follows = "nixpkgs-2205"; - inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.haskell-language-server.follows = "haskell-language-server"; - inputs.plutarch.follows = "plutarch"; - inputs.plutarch-quickcheck.follows = "plutarch-quickcheck"; - inputs.plutarch-numeric.follows = "plutarch-numeric"; - inputs.plutarch-context-builder.follows = "plutarch-context-builder"; - inputs.ply.follows = "ply"; - }; - plutarch-quickcheck = { - url = "github:liqwid-labs/plutarch-quickcheck?ref=main"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.nixpkgs-latest.follows = "nixpkgs-latest"; - inputs.nixpkgs-2111.follows = "nixpkgs-2111"; - inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.haskell-language-server.follows = "haskell-language-server"; - inputs.plutarch.follows = "plutarch"; - }; - plutarch-context-builder = { - url = "github:Liqwid-Labs/plutarch-context-builder?ref=main"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.nixpkgs-latest.follows = "nixpkgs-latest"; - inputs.nixpkgs-2111.follows = "nixpkgs-2111"; - inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.haskell-language-server.follows = "haskell-language-server"; - inputs.plutarch.follows = "plutarch"; - }; - liqwid-script-export = { - url = "github:Liqwid-Labs/liqwid-script-export?ref=main"; - inputs.nixpkgs.follows = "nixpkgs"; - inputs.nixpkgs-latest.follows = "nixpkgs-latest"; - inputs.nixpkgs-2111.follows = "nixpkgs-2111"; - inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage"; - inputs.haskell-nix.follows = "haskell-nix"; - inputs.iohk-nix.follows = "iohk-nix"; - inputs.haskell-language-server.follows = "haskell-language-server"; - inputs.plutarch.follows = "plutarch"; - inputs.ply.follows = "ply"; - inputs.plutarch-numeric.follows = "plutarch-numeric"; - inputs.liqwid-plutarch-extra.follows = "liqwid-plutarch-extra"; - }; - # Dependencies need addChecks, which was removed after this commit - liqwid-nix = { - url = "github:Liqwid-Labs/liqwid-nix"; - inputs.nixpkgs-2205.follows = "nixpkgs-2205"; - }; + nixConfig = { + extra-experimental-features = [ "nix-command" "flakes" "ca-derivations" ]; + extra-substituters = [ "https://cache.iog.io" "https://public-plutonomicon.cachix.org" "https://mlabs.cachix.org" ]; + extra-trusted-public-keys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "public-plutonomicon.cachix.org-1:3AKJMhCLn32gri1drGuaZmFrmnue+KkKrhhubQk/CWc=" ]; + allow-import-from-derivation = "true"; + bash-prompt = "\\[\\e[0m\\][\\[\\e[0;2m\\]liqwid-nix \\e[0;5m\\]2.0 \\[\\e[0;93m\\]\\w\\[\\e[0m\\]]\\[\\e[0m\\]$ \\[\\e[0m\\]"; + max-jobs = "auto"; + auto-optimise-store = "true"; }; - outputs = inputs@{ liqwid-nix, ... }: - let - benchCheckOverlay = self: super: { - toFlake = - let - inherit (self) inputs perSystem pkgsFor'; - flake = super.toFlake or { }; - name = "benchCheck"; - in - flake // { - checks = perSystem (system: - flake.checks.${system} // { - ${name} = - let - pkgs' = pkgsFor' system; - bench = flake.packages.${system}."agora:bench:agora-bench"; - in - pkgs'.runCommand name - { - nativeBuildInputs = [ pkgs'.diffutils ]; - } '' - export LC_CTYPE=C.UTF-8 - export LC_ALL=C.UTF-8 - export LANG=C.UTF-8 - cd ${inputs.self} - ${bench}/bin/agora-bench | diff bench.csv - \ - || (echo "bench.csv is outdated"; exit 1) - mkdir "$out" - ''; - }); - }; - }; - in - (liqwid-nix.buildProject - { - inherit inputs; - src = ./.; - } - [ - liqwid-nix.haskellProject - liqwid-nix.plutarchProject - (liqwid-nix.addDependencies [ - "${inputs.plutarch-numeric}" - "${inputs.plutarch-quickcheck}" - "${inputs.plutarch-context-builder}" - "${inputs.liqwid-plutarch-extra}" - "${inputs.liqwid-script-export}" - "${inputs.liqwid-script-export.inputs.ply}/ply-core" - "${inputs.liqwid-script-export.inputs.ply}/ply-plutarch" - ]) - (liqwid-nix.enableFormatCheck [ - "-XQuasiQuotes" - "-XTemplateHaskell" - "-XTypeApplications" - "-XImportQualifiedPost" - "-XPatternSynonyms" - "-XOverloadedRecordDot" - ]) - liqwid-nix.enableLintCheck - liqwid-nix.enableCabalFormatCheck - liqwid-nix.enableNixFormatCheck - liqwid-nix.addBuildChecks - liqwid-nix.addCommonRunScripts - (liqwid-nix.addCommandLineTools (pkgs: _: [ - pkgs.haskellPackages.hasktags - ])) - benchCheckOverlay - ] - ).toFlake; + inputs = { + nixpkgs.follows = "liqwid-nix/nixpkgs"; + nixpkgs-latest.url = "github:NixOS/nixpkgs"; + + liqwid-nix = { + url = "github:Liqwid-Labs/liqwid-nix/liqwid-nix-2.0"; + inputs.nixpkgs-latest.follows = "nixpkgs-latest"; + }; + + ply.url = "github:emiflake/ply?ref=emiflake/add-missing-instance"; + plutarch-numeric.url = "github:Liqwid-Labs/plutarch-numeric/emiflake/liqwid-nix-2.0"; + plutarch-numeric.inputs.ply.follows = "ply"; + liqwid-plutarch-extra.url = "github:Liqwid-Labs/liqwid-plutarch-extra/emiflake/liqwid-nix-2.0"; + liqwid-plutarch-extra.inputs.ply.follows = "ply"; + plutarch-quickcheck.url = "github:liqwid-labs/plutarch-quickcheck/emiflake/liqwid-nix-2.0"; + plutarch-quickcheck.inputs.ply.follows = "ply"; + plutarch-context-builder.url = "github:Liqwid-Labs/plutarch-context-builder/emiflake/liqwid-nix-2.0"; + plutarch-context-builder.inputs.ply.follows = "ply"; + liqwid-script-export.url = "github:Liqwid-Labs/liqwid-script-export/emiflake/liqwid-nix-2.0"; + liqwid-script-export.inputs.ply.follows = "ply"; + }; + + outputs = { self, liqwid-nix, flake-parts, ... }: + flake-parts.lib.mkFlake { inherit self; } { + imports = [ + liqwid-nix.onchain + liqwid-nix.run + ./. + ]; + systems = [ "x86_64-linux" "aarch64-darwin" "x86_64-darwin" "aarch64-linux" ]; + perSystem = { config, self', inputs', pkgs, system, ... }: { }; + }; }