From 3b94062dbb08e566b45f31dcde29dbe35131bc7f Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 15 Apr 2022 12:43:59 +0800 Subject: [PATCH 001/107] modify `GovernorRedeemer` and `Governor` * add `MutateDatum` redeemer * add `datumNFT` to `Governor` so that we can identify the datum * Lift `GovernorDatum` and `GovernorRedeemer` --- agora/Agora/Governor.hs | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 24f52ad..6adf126 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -20,17 +20,35 @@ module Agora.Governor ( governorValidator, ) where +-------------------------------------------------------------------------------- + +import GHC.Generics qualified as GHC + +-------------------------------------------------------------------------------- + import Agora.Proposal (ProposalId, ProposalThresholds) + +-------------------------------------------------------------------------------- + +import Plutarch (popaque) import Plutarch.Api.V1 (PMintingPolicy, PValidator) import PlutusTx qualified +-------------------------------------------------------------------------------- + +import Plutus.V1.Ledger.Value (AssetClass) +import PlutusTx qualified + +-------------------------------------------------------------------------------- + -- | Datum for the Governor script. data GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. , nextProposalId :: ProposalId -- ^ What tag the next proposal will get upon creating. - } + } + deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] @@ -46,12 +64,23 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs + -- | Allow effects to mutate the datum + | MutateDatum + deriving stock (Show, GHC.Generic) -PlutusTx.makeIsDataIndexed ''GovernorRedeemer [('CreateProposal, 0), ('MintGATs, 1)] +PlutusTx.makeIsDataIndexed + ''GovernorRedeemer + [('CreateProposal,0) + ,('MintGATs, 1) + ,('MutateDatum, 2) + ] -- | Parameters for creating Governor scripts. data Governor - = Governor + = Governor { + -- | NFT that identifies the governor datum + datumNFT :: AssetClass + } -------------------------------------------------------------------------------- From 60001f45f20e87fa9904673809d4b1a74892ab06 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 15 Apr 2022 13:02:57 +0800 Subject: [PATCH 002/107] add corresponding plutarch-level redeemer and datum * lift them as well --- agora/Agora/Governor.hs | 47 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 6adf126..693d27c 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -14,6 +14,7 @@ module Agora.Governor ( Governor (..), -- * Plutarch-land + PGovernorDatum (..), -- * Scripts governorPolicy, @@ -23,16 +24,22 @@ module Agora.Governor ( -------------------------------------------------------------------------------- import GHC.Generics qualified as GHC +import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.Proposal (ProposalId, ProposalThresholds) +import Agora.Proposal (ProposalId, ProposalThresholds, PProposalThresholds, PProposalId) -------------------------------------------------------------------------------- import Plutarch (popaque) import Plutarch.Api.V1 (PMintingPolicy, PValidator) -import PlutusTx qualified +import Plutarch.DataRepr ( + DerivePConstantViaData (..), + PDataFields, + PIsDataReprInstances (PIsDataReprInstances), + ) +import Plutarch.Lift (PUnsafeLiftDecl (..)) -------------------------------------------------------------------------------- @@ -84,6 +91,42 @@ data Governor -------------------------------------------------------------------------------- +-- | Plutarch-level datum for the Governor script. + +newtype PGovernorDatum (s::S)= PGovernorDatum { getGovernorDatum :: + Term s (PDataRecord '[ + "proposalThresholds" ':= PProposalThresholds, + "nextProposalId" ':= PProposalId + ]) +} + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields) + via PIsDataReprInstances PGovernorDatum + +instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum +deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) + +-- | Plutarch-level version of 'GovernorRedeemer' + +data PGovernorRedeemer (s :: S) = + PCreateProposal (Term s (PDataRecord '[])) + | PMintGATs (Term s (PDataRecord '[])) + | PMutateDatum (Term s (PDataRecord '[])) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData) + via PIsDataReprInstances PGovernorRedeemer + +instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer +deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) + +-------------------------------------------------------------------------------- + -- | Policy for Governors. governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy _ = From 872b4d60fce85a687a821d28983b45284c187c07 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 15 Apr 2022 13:11:48 +0800 Subject: [PATCH 003/107] export `PGovernorRedeemer` --- agora/Agora/Governor.hs | 54 +++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 26 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 693d27c..e96700f 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -15,6 +15,7 @@ module Agora.Governor ( -- * Plutarch-land PGovernorDatum (..), + PGovernorRedeemer (..), -- * Scripts governorPolicy, @@ -28,7 +29,7 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.Proposal (ProposalId, ProposalThresholds, PProposalThresholds, PProposalId) +import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds) -------------------------------------------------------------------------------- @@ -54,7 +55,7 @@ data GovernorDatum = GovernorDatum -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. , nextProposalId :: ProposalId -- ^ What tag the next proposal will get upon creating. - } + } deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] @@ -71,38 +72,40 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs - -- | Allow effects to mutate the datum - | MutateDatum + | -- | Allow effects to mutate the datum + MutateDatum deriving stock (Show, GHC.Generic) -PlutusTx.makeIsDataIndexed - ''GovernorRedeemer - [('CreateProposal,0) - ,('MintGATs, 1) - ,('MutateDatum, 2) +PlutusTx.makeIsDataIndexed + ''GovernorRedeemer + [ ('CreateProposal, 0) + , ('MintGATs, 1) + , ('MutateDatum, 2) ] -- | Parameters for creating Governor scripts. -data Governor - = Governor { - -- | NFT that identifies the governor datum - datumNFT :: AssetClass +data Governor = Governor + { datumNFT :: AssetClass + -- ^ NFT that identifies the governor datum } -------------------------------------------------------------------------------- -- | Plutarch-level datum for the Governor script. - -newtype PGovernorDatum (s::S)= PGovernorDatum { getGovernorDatum :: - Term s (PDataRecord '[ - "proposalThresholds" ':= PProposalThresholds, - "nextProposalId" ':= PProposalId - ]) -} +newtype PGovernorDatum (s :: S) = PGovernorDatum + { getGovernorDatum :: + Term + s + ( PDataRecord + '[ "proposalThresholds" ':= PProposalThresholds + , "nextProposalId" ':= PProposalId + ] + ) + } deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) - deriving + deriving (PlutusType, PIsData, PDataFields) via PIsDataReprInstances PGovernorDatum @@ -110,16 +113,15 @@ instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = Gove deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) -- | Plutarch-level version of 'GovernorRedeemer' - -data PGovernorRedeemer (s :: S) = - PCreateProposal (Term s (PDataRecord '[])) +data PGovernorRedeemer (s :: S) + = PCreateProposal (Term s (PDataRecord '[])) | PMintGATs (Term s (PDataRecord '[])) | PMutateDatum (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) + deriving + (PlutusType, PIsData) via PIsDataReprInstances PGovernorRedeemer instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer From cd1f137c15afd438dfcbbb3488a141b577a1a39f Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 15 Apr 2022 17:58:37 +0800 Subject: [PATCH 004/107] check that the datum nft always stays at the governor address --- agora/Agora/Governor.hs | 59 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 52 insertions(+), 7 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index e96700f..3a14281 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -30,20 +30,23 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds) +import Agora.Utils (findOutputsToAddress, passert, passetClassValueOf', pfindTxInByTxOutRef) -------------------------------------------------------------------------------- import Plutarch (popaque) -import Plutarch.Api.V1 (PMintingPolicy, PValidator) +import Plutarch.Api.V1 (PMaybeData (PDJust), PMintingPolicy, PScriptPurpose (PSpending), PValidator, PValue) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift (PUnsafeLiftDecl (..)) +import Plutarch.Monadic qualified as P -------------------------------------------------------------------------------- +import Plutarch.Unsafe (punsafeCoerce) import Plutus.V1.Ledger.Value (AssetClass) import PlutusTx qualified @@ -72,7 +75,7 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs - | -- | Allow effects to mutate the datum + | -- | Allows effects to mutate the datum. MutateDatum deriving stock (Show, GHC.Generic) @@ -86,7 +89,7 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor { datumNFT :: AssetClass - -- ^ NFT that identifies the governor datum + -- ^ NFT that identifies the governor datum. } -------------------------------------------------------------------------------- @@ -112,7 +115,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) --- | Plutarch-level version of 'GovernorRedeemer' +-- | Plutarch-level version of 'GovernorRedeemer'. data PGovernorRedeemer (s :: S) = PCreateProposal (Term s (PDataRecord '[])) | PMintGATs (Term s (PDataRecord '[])) @@ -137,6 +140,48 @@ governorPolicy _ = -- | Validator for Governors. governorValidator :: Governor -> ClosedTerm PValidator -governorValidator _ = - plam $ \_datum _redeemer _ctx' -> P.do - popaque (pconstant ()) +governorValidator params = + plam $ \_datum' redeemer' ctx' -> P.do + -- TODO: use `PTryFrom` + redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' + ctx <- pletFields @'["txInfo", "purpose"] ctx' + + txInfo <- plet $ pfromData $ ctx.txInfo + + PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose + let txOutRef = pfromData txOutRef' + + PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo + ownInput <- pletFields @'["address", "value", "datumHash"] ownInput' + selfAddress <- plet $ pfromData $ ownInput.address + + let ownInputDatumNFTAmount = datumNFTValueOf # ownInput.value + passert "own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1 + + ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress + passert "exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 + + ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs + let ownOuputDatumNFTAmount = datumNFTValueOf # ownOutput.value + passert "datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 + passert "output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash + + -- datum <- plet $ pfromData @PGovernorDatum $ punsafeCoerce datum' + + case redeemer of + PCreateProposal _ -> P.do + perror + _ -> perror + where + datumNFTValueOf :: Term s (PValue :--> PInteger) + datumNFTValueOf = passetClassValueOf' params.datumNFT + +pisDJust :: Term s (PMaybeData a :--> PBool) +pisDJust = phoistAcyclic $ + plam $ \x -> + pmatch + x + ( \case + PDJust _ -> pconstant True + _ -> pconstant False + ) From 5e54861cd07d81651f586d7f2b4cf4c8a0c37ddf Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 15 Apr 2022 18:34:51 +0800 Subject: [PATCH 005/107] handle proposal creation * check proposal id --- agora/Agora/Governor.hs | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 3a14281..eeee2f0 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -30,7 +30,7 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds) -import Agora.Utils (findOutputsToAddress, passert, passetClassValueOf', pfindTxInByTxOutRef) +import Agora.Utils (findOutputsToAddress, passert, passetClassValueOf', pfindTxInByTxOutRef, findTxOutDatum) -------------------------------------------------------------------------------- @@ -141,7 +141,7 @@ governorPolicy _ = -- | Validator for Governors. governorValidator :: Governor -> ClosedTerm PValidator governorValidator params = - plam $ \_datum' redeemer' ctx' -> P.do + plam $ \datum' redeemer' ctx' -> P.do -- TODO: use `PTryFrom` redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -153,11 +153,14 @@ governorValidator params = PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo ownInput <- pletFields @'["address", "value", "datumHash"] ownInput' - selfAddress <- plet $ pfromData $ ownInput.address + let selfAddress = pfromData $ ownInput.address + + PJust (((pfromData @PGovernorDatum) . punsafeCoerce) -> oldDatum') <- pmatch $ findTxOutDatum # txInfo # ownInput' + oldDatum <- pletFields @'["proposalThresholds", "nextProposalId"] oldDatum' let ownInputDatumNFTAmount = datumNFTValueOf # ownInput.value passert "own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1 - + ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress passert "exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 @@ -166,12 +169,19 @@ governorValidator params = passert "datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 passert "output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash - -- datum <- plet $ pfromData @PGovernorDatum $ punsafeCoerce datum' + let newDatum' = pfromData @PGovernorDatum $ punsafeCoerce datum' + newDatum <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' case redeemer of PCreateProposal _ -> P.do - perror - _ -> perror + -- TODO: deriving a PNum instance for PProposalId + let oldPid = pto $ pfromData $ oldDatum.nextProposalId + newPid = pto $ pfromData $ newDatum.nextProposalId + passert "proposal id should be advanced by 1" $ oldPid + 1 #== newPid + + ptraceError "not implemented yet" + PMintGATs _ -> perror + PMutateDatum _ -> perror where datumNFTValueOf :: Term s (PValue :--> PInteger) datumNFTValueOf = passetClassValueOf' params.datumNFT @@ -184,4 +194,4 @@ pisDJust = phoistAcyclic $ ( \case PDJust _ -> pconstant True _ -> pconstant False - ) + ) \ No newline at end of file From 7d644c383ba93153d865c7a01b261021353680c1 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 16 Apr 2022 13:56:39 +0800 Subject: [PATCH 006/107] rename redeemer `MutateDatum` to `MutateParams` --- agora/Agora/Governor.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index eeee2f0..d3c8f51 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -68,6 +68,8 @@ PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] 1. The gating of Proposal creation. 2. The gating of minting authority tokens. + + Parameters of the governor can also be mutated by an effect. -} data GovernorRedeemer = -- | Checks that a proposal was created lawfully, and allows it. @@ -75,15 +77,15 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs - | -- | Allows effects to mutate the datum. - MutateDatum + | -- | Allows effects to mutate the parameters. + MutateParams deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorRedeemer [ ('CreateProposal, 0) , ('MintGATs, 1) - , ('MutateDatum, 2) + , ('MutateParams, 2) ] -- | Parameters for creating Governor scripts. @@ -119,7 +121,7 @@ deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PCo data PGovernorRedeemer (s :: S) = PCreateProposal (Term s (PDataRecord '[])) | PMintGATs (Term s (PDataRecord '[])) - | PMutateDatum (Term s (PDataRecord '[])) + | PMutateParams (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) @@ -181,7 +183,7 @@ governorValidator params = ptraceError "not implemented yet" PMintGATs _ -> perror - PMutateDatum _ -> perror + PMutateParams _ -> perror where datumNFTValueOf :: Term s (PValue :--> PInteger) datumNFTValueOf = passetClassValueOf' params.datumNFT From 1a17abccd6b92023bd6e658e6237e0d55872331d Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 16 Apr 2022 18:27:30 +0800 Subject: [PATCH 007/107] add `pisDJust` util function the counterpart of `pisJust`, for type `PMaybeData` --- agora/Agora/Utils.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 7c71c36..9241769 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -29,6 +29,7 @@ module Agora.Utils ( pkeysEqual, pnub, pisUniq, + pisDJust, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -357,6 +358,17 @@ pisUniq = #&& (self # xs) ) (const $ pcon PTrue) + +-- | Yield True if a given PMaybeData is of form PDJust _. +pisDJust :: Term s (PMaybeData a :--> PBool) +pisDJust = phoistAcyclic $ + plam $ \x -> + pmatch + x + ( \case + PDJust _ -> pconstant True + _ -> pconstant False + ) -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed From 4b5875923c075e249e31d8361c01c3518ddc2fb7 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 16 Apr 2022 18:49:25 +0800 Subject: [PATCH 008/107] handle effects that mutate params of the governor --- agora/Agora/Governor.hs | 110 +++++++++++++++++++++++++++++----------- 1 file changed, 79 insertions(+), 31 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index d3c8f51..3b7cc25 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -29,13 +29,34 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.Proposal (PProposalId, PProposalThresholds, ProposalId, ProposalThresholds) -import Agora.Utils (findOutputsToAddress, passert, passetClassValueOf', pfindTxInByTxOutRef, findTxOutDatum) +import Agora.AuthorityToken (authorityTokensValidIn) +import Agora.Proposal ( + PProposalId, + PProposalThresholds, + ProposalId, + ProposalThresholds, + ) +import Agora.Utils ( + allInputs, + findOutputsToAddress, + findTxOutDatum, + passert, + passetClassValueOf', + pfindTxInByTxOutRef, + pisDJust, + psymbolValueOf, + ) -------------------------------------------------------------------------------- import Plutarch (popaque) -import Plutarch.Api.V1 (PMaybeData (PDJust), PMintingPolicy, PScriptPurpose (PSpending), PValidator, PValue) +import Plutarch.Api.V1 ( + PCurrencySymbol, + PMintingPolicy, + PScriptPurpose (PSpending), + PValidator, + PValue, + ) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -43,11 +64,11 @@ import Plutarch.DataRepr ( ) import Plutarch.Lift (PUnsafeLiftDecl (..)) import Plutarch.Monadic qualified as P +import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutarch.Unsafe (punsafeCoerce) -import Plutus.V1.Ledger.Value (AssetClass) +import Plutus.V1.Ledger.Value (AssetClass, CurrencySymbol) import PlutusTx qualified -------------------------------------------------------------------------------- @@ -68,7 +89,7 @@ PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] 1. The gating of Proposal creation. 2. The gating of minting authority tokens. - + Parameters of the governor can also be mutated by an effect. -} data GovernorRedeemer @@ -92,6 +113,8 @@ PlutusTx.makeIsDataIndexed data Governor = Governor { datumNFT :: AssetClass -- ^ NFT that identifies the governor datum. + , gatSymbol :: CurrencySymbol + -- ^ The symbol of Governance Authority Token } -------------------------------------------------------------------------------- @@ -156,44 +179,69 @@ governorValidator params = PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo ownInput <- pletFields @'["address", "value", "datumHash"] ownInput' let selfAddress = pfromData $ ownInput.address - - PJust (((pfromData @PGovernorDatum) . punsafeCoerce) -> oldDatum') <- pmatch $ findTxOutDatum # txInfo # ownInput' - oldDatum <- pletFields @'["proposalThresholds", "nextProposalId"] oldDatum' + + PJust oldDatum'' <- pmatch $ findTxOutDatum # txInfo # ownInput' + oldDatum' <- plet $ pto oldDatum'' + let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce oldDatum' + oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' let ownInputDatumNFTAmount = datumNFTValueOf # ownInput.value - passert "own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1 - + passert "Own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1 + ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress - passert "exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 + passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs let ownOuputDatumNFTAmount = datumNFTValueOf # ownOutput.value - passert "datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 - passert "output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash + passert "Datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 + passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash + -- TODO: use `PTryFrom` and reject bad datum let newDatum' = pfromData @PGovernorDatum $ punsafeCoerce datum' - newDatum <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' + newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' + + mint <- plet $ pfromData $ pfield @"mint" # txInfo + mint' <- plet $ pto $ pto $ pto $ mint case redeemer of PCreateProposal _ -> P.do + -- check that nothing is minted + passert "Nothing should be minted" $ plength # mint' #== 0 + + -- check proposal id +1 -- TODO: deriving a PNum instance for PProposalId - let oldPid = pto $ pfromData $ oldDatum.nextProposalId - newPid = pto $ pfromData $ newDatum.nextProposalId - passert "proposal id should be advanced by 1" $ oldPid + 1 #== newPid - - ptraceError "not implemented yet" - PMintGATs _ -> perror - PMutateParams _ -> perror + let oldPid = pto $ pfromData $ oldParams.nextProposalId + newPid = pto $ pfromData $ newParams.nextProposalId + passert "Proposal id should be advanced by 1" $ + oldPid + 1 #== newPid + + -- TODO: waiting for impl of proposal + ptraceError "Not implemented yet" + PMintGATs _ -> P.do + -- check datum is not changed + passert "Datum should not be changed" $ oldDatum' #== datum' + + -- check exactly one(?) authority token is minted + + -- TODO: waiting for impl of proposal + ptraceError "Not implemented yet" + PMutateParams _ -> P.do + -- check that input has exactly one GAT and will be burnt + let gatAmount = psymbolValueOf # gatS # mint + passert "One GAT should be burnt" $ gatAmount #== -1 + + -- nothing should be minted/burnt other than GAT + passert "No token should be minted/burnt other than GAT" $ plength # mint' #== 1 + + -- check that GAT is tagged by the address + passert "all input GATs are valid" $ + allInputs @PUnit # txInfo #$ plam $ \txOut _ _ _ -> + authorityTokensValidIn # gatS # txOut + + popaque $ pconstant () where datumNFTValueOf :: Term s (PValue :--> PInteger) datumNFTValueOf = passetClassValueOf' params.datumNFT -pisDJust :: Term s (PMaybeData a :--> PBool) -pisDJust = phoistAcyclic $ - plam $ \x -> - pmatch - x - ( \case - PDJust _ -> pconstant True - _ -> pconstant False - ) \ No newline at end of file + gatS :: Term s PCurrencySymbol + gatS = pconstant params.gatSymbol From 4c770abce640903a76c4f5bad6d3140a0e60bb0b Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 16 Apr 2022 23:04:22 +0800 Subject: [PATCH 009/107] get next proposal id from `pnextProposalId` --- agora/Agora/Governor.hs | 8 +++----- agora/Agora/Proposal.hs | 8 ++++++++ 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 3b7cc25..17809d0 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -35,6 +35,7 @@ import Agora.Proposal ( PProposalThresholds, ProposalId, ProposalThresholds, + pnextProposalId ) import Agora.Utils ( allInputs, @@ -208,12 +209,9 @@ governorValidator params = -- check that nothing is minted passert "Nothing should be minted" $ plength # mint' #== 0 - -- check proposal id +1 - -- TODO: deriving a PNum instance for PProposalId - let oldPid = pto $ pfromData $ oldParams.nextProposalId - newPid = pto $ pfromData $ newParams.nextProposalId + -- check that proposal is advanced passert "Proposal id should be advanced by 1" $ - oldPid + 1 #== newPid + pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId -- TODO: waiting for impl of proposal ptraceError "Not implemented yet" diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index c5e0068..751b4c0 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -30,6 +30,9 @@ module Agora.Proposal ( -- * Plutarch helpers proposalDatumValid, + + -- * Utils + pnextProposalId ) where import GHC.Generics qualified as GHC @@ -434,3 +437,8 @@ proposalDatumValid proposal = , ptraceIfFalse "Proposal has fewer cosigners than the limit" $ plength # (pfromData datum.cosigners) #<= pconstant proposal.maximumCosigners , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ pkeysEqual # datum.effects # pto (pfromData datum.votes) ] + +-------------------------------------------------------------------------------- + +pnextProposalId :: Term s (PProposalId :--> PProposalId) +pnextProposalId = phoistAcyclic $ plam $ \(pto -> id) -> pcon $ PProposalId $ id + 1 From 5adde420f3bd2848d0a1389904386543443d0ae3 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sun, 17 Apr 2022 12:07:06 +0800 Subject: [PATCH 010/107] apply naming suggestions from Emily and Seungheon * `pid` -> `id` * `MutateParams` -> `MutateGovernor` --- agora/Agora/Governor.hs | 8 ++++---- agora/Agora/Proposal.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 17809d0..d86f49a 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -100,14 +100,14 @@ data GovernorRedeemer -- and allows minting GATs for each effect script. MintGATs | -- | Allows effects to mutate the parameters. - MutateParams + MutateMutateGovernor deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorRedeemer [ ('CreateProposal, 0) , ('MintGATs, 1) - , ('MutateParams, 2) + , ('MutateMutateGovernor, 2) ] -- | Parameters for creating Governor scripts. @@ -145,7 +145,7 @@ deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PCo data PGovernorRedeemer (s :: S) = PCreateProposal (Term s (PDataRecord '[])) | PMintGATs (Term s (PDataRecord '[])) - | PMutateParams (Term s (PDataRecord '[])) + | PMutateGovernor (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic) deriving anyclass (PIsDataRepr) @@ -223,7 +223,7 @@ governorValidator params = -- TODO: waiting for impl of proposal ptraceError "Not implemented yet" - PMutateParams _ -> P.do + PMutateGovernor _ -> P.do -- check that input has exactly one GAT and will be burnt let gatAmount = psymbolValueOf # gatS # mint passert "One GAT should be burnt" $ gatAmount #== -1 diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 751b4c0..cb058a2 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -441,4 +441,4 @@ proposalDatumValid proposal = -------------------------------------------------------------------------------- pnextProposalId :: Term s (PProposalId :--> PProposalId) -pnextProposalId = phoistAcyclic $ plam $ \(pto -> id) -> pcon $ PProposalId $ id + 1 +pnextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 From 6e0373c6e507485e995f4e5112ed599ddfffb36b Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 19 Apr 2022 12:12:46 +0800 Subject: [PATCH 011/107] apply hlint suggestions; fix the ci --- agora/Agora/Governor.hs | 4 ++-- agora/Agora/Proposal.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index d86f49a..57c30c9 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -35,7 +35,7 @@ import Agora.Proposal ( PProposalThresholds, ProposalId, ProposalThresholds, - pnextProposalId + pnextProposalId, ) import Agora.Utils ( allInputs, @@ -202,7 +202,7 @@ governorValidator params = newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' mint <- plet $ pfromData $ pfield @"mint" # txInfo - mint' <- plet $ pto $ pto $ pto $ mint + mint' <- plet $ pto $ pto $ pto mint case redeemer of PCreateProposal _ -> P.do diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index cb058a2..f8d36e9 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -32,7 +32,7 @@ module Agora.Proposal ( proposalDatumValid, -- * Utils - pnextProposalId + pnextProposalId, ) where import GHC.Generics qualified as GHC From c562f6ae87c95dbf771506abda32a869e81314c1 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 19 Apr 2022 17:16:42 +0800 Subject: [PATCH 012/107] implement governor state token minting policy * parameterize the policy and the validator with a utxo --- agora/Agora/Governor.hs | 63 +++++++++++++++++++++++++++++++++++------ agora/Agora/Utils.hs | 17 +++++++++++ 2 files changed, 72 insertions(+), 8 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 57c30c9..6b0297d 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -12,6 +12,7 @@ module Agora.Governor ( GovernorDatum (..), GovernorRedeemer (..), Governor (..), + governorStateTokenName, -- * Plutarch-land PGovernorDatum (..), @@ -20,6 +21,9 @@ module Agora.Governor ( -- * Scripts governorPolicy, governorValidator, + + -- * Utilities + governorStateTokenAssetClass, ) where -------------------------------------------------------------------------------- @@ -42,9 +46,12 @@ import Agora.Utils ( findOutputsToAddress, findTxOutDatum, passert, + passetClassValueOf, passetClassValueOf', pfindTxInByTxOutRef, pisDJust, + pisUxtoSpent, + pownCurrencySymbol, psymbolValueOf, ) @@ -57,7 +64,10 @@ import Plutarch.Api.V1 ( PScriptPurpose (PSpending), PValidator, PValue, + mintingPolicySymbol, + mkMintingPolicy, ) +import Plutarch.Api.V1.Extra (pownMintValue) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -69,7 +79,8 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Value (AssetClass, CurrencySymbol) +import Plutus.V1.Ledger.Api (MintingPolicy, TxOutRef) +import Plutus.V1.Ledger.Value (AssetClass (..), CurrencySymbol, TokenName (..)) import PlutusTx qualified -------------------------------------------------------------------------------- @@ -112,12 +123,15 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor - { datumNFT :: AssetClass - -- ^ NFT that identifies the governor datum. + { stORef :: TxOutRef + -- ^ The state token that identifies the governor datum will be minted using this utxo. , gatSymbol :: CurrencySymbol - -- ^ The symbol of Governance Authority Token + -- ^ The symbol of the Governance Authority Token. } +governorStateTokenName :: TokenName +governorStateTokenName = TokenName "" + -------------------------------------------------------------------------------- -- | Plutarch-level datum for the Governor script. @@ -158,10 +172,32 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc -------------------------------------------------------------------------------- --- | Policy for Governors. +{- | Policy for Governors. + This policy mints a state token for the 'governorValidator'. + It will check: + + - The utxo specified in the Governor parameter is spent. + - Only one token is minted. + - Ensure the token name is "". +-} governorPolicy :: Governor -> ClosedTerm PMintingPolicy -governorPolicy _ = - plam $ \_redeemer _ctx' -> P.do +governorPolicy params = + plam $ \_ ctx' -> P.do + ctx <- pletFields @'["txInfo", "purpose"] ctx' + let oref = pconstant params.stORef + ownSymbol = pownCurrencySymbol # ctx' + + mintValue <- plet $ pownMintValue # ctx' + + passert "Referenced utxo should be spent" $ pisUxtoSpent # oref # ctx.txInfo + + passert "Exactly one token should be minted" $ + psymbolValueOf # ownSymbol # mintValue #== 1 + #&& passetClassValueOf # ownSymbol # pconstant governorStateTokenName # mintValue #== 1 + + passert "Nothing is minted other than the state token" $ + (plength #$ pto $ pto $ pto mintValue) #== 1 + popaque (pconstant ()) -- | Validator for Governors. @@ -239,7 +275,18 @@ governorValidator params = popaque $ pconstant () where datumNFTValueOf :: Term s (PValue :--> PInteger) - datumNFTValueOf = passetClassValueOf' params.datumNFT + datumNFTValueOf = passetClassValueOf' $ governorStateTokenAssetClass params gatS :: Term s PCurrencySymbol gatS = pconstant params.gatSymbol + +-------------------------------------------------------------------------------- + +governorStateTokenAssetClass :: Governor -> AssetClass +governorStateTokenAssetClass gov = AssetClass (symbol, governorStateTokenName) + where + policy :: MintingPolicy + policy = mkMintingPolicy $ governorPolicy gov + + symbol :: CurrencySymbol + symbol = mintingPolicySymbol policy diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 9241769..8b3b85b 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -30,6 +30,8 @@ module Agora.Utils ( pnub, pisUniq, pisDJust, + pownCurrencySymbol, + pisUxtoSpent, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -66,6 +68,8 @@ import Plutarch.Api.V1 ( PMintingPolicy, PPubKeyHash, PTokenName (PTokenName), + PScriptContext, + PScriptPurpose (PMinting), PTuple, PTxInInfo (PTxInInfo), PTxInfo, @@ -370,6 +374,19 @@ pisDJust = phoistAcyclic $ _ -> pconstant False ) +-- | The 'CurrencySymbol' of the current minting policy. +pownCurrencySymbol :: Term s (PScriptContext :--> PCurrencySymbol) +pownCurrencySymbol = phoistAcyclic $ + plam $ \ctx -> P.do + PMinting m <- pmatch $ pfield @"purpose" # ctx + pfield @"_0" # m + +-- | Determines if a given utxo is spent. +pisUxtoSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) +pisUxtoSpent = phoistAcyclic $ + plam $ \oref info -> P.do + pisJust #$ pfindTxInByTxOutRef # oref # info + -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed All of these functions are quite inefficient. From 70a5b8ca18ec062a9ab07cff35cd9e7f73b3e473 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 19 Apr 2022 22:18:25 +0800 Subject: [PATCH 013/107] convert all "datum NFT" to "state token" in the messages in order to avoid confusion --- agora/Agora/Governor.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 6b0297d..4838e7c 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -222,15 +222,15 @@ governorValidator params = let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce oldDatum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' - let ownInputDatumNFTAmount = datumNFTValueOf # ownInput.value - passert "Own input should have exactly one datum NFT" $ ownInputDatumNFTAmount #== 1 + let ownInputDatumNFTAmount = stateTokenValueOf # ownInput.value + passert "Own input should have exactly one state token" $ ownInputDatumNFTAmount #== 1 ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs - let ownOuputDatumNFTAmount = datumNFTValueOf # ownOutput.value - passert "Datum NFT should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 + let ownOuputDatumNFTAmount = stateTokenValueOf # ownOutput.value + passert "State token should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash -- TODO: use `PTryFrom` and reject bad datum @@ -274,8 +274,11 @@ governorValidator params = popaque $ pconstant () where - datumNFTValueOf :: Term s (PValue :--> PInteger) - datumNFTValueOf = passetClassValueOf' $ governorStateTokenAssetClass params + stateTokenAssetClass :: AssetClass + stateTokenAssetClass = governorStateTokenAssetClass params + + stateTokenValueOf :: Term s (PValue :--> PInteger) + stateTokenValueOf = passetClassValueOf' stateTokenAssetClass gatS :: Term s PCurrencySymbol gatS = pconstant params.gatSymbol From 0e397d2a897e8a967827c1e94385b7a7f4de8b6a Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 19 Apr 2022 22:35:42 +0800 Subject: [PATCH 014/107] add doc string for `governorValidator` and `pnextProposalId` --- agora/Agora/Governor.hs | 23 +++++++++++++++++++++-- agora/Agora/Proposal.hs | 2 +- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 4838e7c..3ca8269 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -124,7 +124,7 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor { stORef :: TxOutRef - -- ^ The state token that identifies the governor datum will be minted using this utxo. + -- ^ An utxo, which will be spent to mint the state token for the governor validator. , gatSymbol :: CurrencySymbol -- ^ The symbol of the Governance Authority Token. } @@ -200,7 +200,26 @@ governorPolicy params = popaque (pconstant ()) --- | Validator for Governors. +{- Validator for Governors. + + A state token, minted by 'governorPolicy' is used to identify the datum utxo. + + No matter what redeemer it receives, it will always check: + - The utxo which has the state token must be spent. + - The state token always stays at the script address. + - The utxo which holds the state token, has a well well-formed 'GovernorDatum' datum. + + For 'CreateProposal' redeemer, it will check: + - Exactly one proposal token is minted. + - The datum which is corresponding to the proposal token must be correct. + - Proposal id in the governor datum must be advanced. + + TODO: PMintGATs + + For 'PMutateGovernor', it will check: + - A GAT is burnt. + - Said GAT must be tagged by the effect that is spending it. +-} governorValidator :: Governor -> ClosedTerm PValidator governorValidator params = plam $ \datum' redeemer' ctx' -> P.do diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index f8d36e9..ef50e33 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -439,6 +439,6 @@ proposalDatumValid proposal = ] -------------------------------------------------------------------------------- - +-- | Get next proposal id. pnextProposalId :: Term s (PProposalId :--> PProposalId) pnextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 From 175d4aa31976082bb9f94d65f3813357d46ac424 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Wed, 20 Apr 2022 12:47:59 +0800 Subject: [PATCH 015/107] handle proposal creation --- agora/Agora/Governor.hs | 133 +++++++++++++++++++++++++++++++++------- agora/Agora/Utils.hs | 32 ++++++++++ 2 files changed, 143 insertions(+), 22 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 3ca8269..0f99de1 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -35,16 +35,22 @@ import Generics.SOP (Generic, I (I)) import Agora.AuthorityToken (authorityTokensValidIn) import Agora.Proposal ( + PProposalDatum, PProposalId, + PProposalStatus (PDraft), PProposalThresholds, + Proposal (..), ProposalId, ProposalThresholds, pnextProposalId, + proposalPolicy, + proposalValidator, ) import Agora.Utils ( allInputs, findOutputsToAddress, - findTxOutDatum, + hasOnlyOneTokenOfCurrencySymbol, + mustFindDatum', passert, passetClassValueOf, passetClassValueOf', @@ -66,6 +72,8 @@ import Plutarch.Api.V1 ( PValue, mintingPolicySymbol, mkMintingPolicy, + mkValidator, + validatorHash, ) import Plutarch.Api.V1.Extra (pownMintValue) import Plutarch.DataRepr ( @@ -79,8 +87,20 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api (MintingPolicy, TxOutRef) -import Plutus.V1.Ledger.Value (AssetClass (..), CurrencySymbol, TokenName (..)) +import Plutarch.Builtin (pforgetData) +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (ScriptCredential), + CurrencySymbol (..), + MintingPolicy, + TxOutRef, + Validator, + ValidatorHash, + ) +import Plutus.V1.Ledger.Value ( + AssetClass (..), + TokenName (..), + ) import PlutusTx qualified -------------------------------------------------------------------------------- @@ -210,8 +230,10 @@ governorPolicy params = - The utxo which holds the state token, has a well well-formed 'GovernorDatum' datum. For 'CreateProposal' redeemer, it will check: - - Exactly one proposal token is minted. - - The datum which is corresponding to the proposal token must be correct. + - Exactly one proposal state token is minted. + - Exactly one utxo should be sent to the proposal validator. + - The utxo must contain the proposal state token. + - The datum of said utxo must be correct. - Proposal id in the governor datum must be advanced. TODO: PMintGATs @@ -223,7 +245,7 @@ governorPolicy params = governorValidator :: Governor -> ClosedTerm PValidator governorValidator params = plam $ \datum' redeemer' ctx' -> P.do - -- TODO: use `PTryFrom` + -- TODO: use ptryFrom redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -233,27 +255,30 @@ governorValidator params = let txOutRef = pfromData txOutRef' PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo - ownInput <- pletFields @'["address", "value", "datumHash"] ownInput' + ownInput <- pletFields @'["address", "value"] ownInput' let selfAddress = pfromData $ ownInput.address - PJust oldDatum'' <- pmatch $ findTxOutDatum # txInfo # ownInput' - oldDatum' <- plet $ pto oldDatum'' - let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce oldDatum' + -- TODO: use ptryFrom + let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce datum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' let ownInputDatumNFTAmount = stateTokenValueOf # ownInput.value - passert "Own input should have exactly one state token" $ ownInputDatumNFTAmount #== 1 + passert "Own input should have exactly one state token" $ + ownInputDatumNFTAmount #== 1 ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress - passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 + passert "Exactly one utxo should be sent to the governor" $ + plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs let ownOuputDatumNFTAmount = stateTokenValueOf # ownOutput.value - passert "State token should stay at governor's address" $ ownOuputDatumNFTAmount #== 1 - passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash + passert "State token should stay at governor's address" $ + ownOuputDatumNFTAmount #== 1 + passert "Output utxo to governor should have datum" $ + pisDJust # ownOutput.datumHash -- TODO: use `PTryFrom` and reject bad datum - let newDatum' = pfromData @PGovernorDatum $ punsafeCoerce datum' + newDatum' <- plet $ mustFindDatum' @PGovernorDatum # ownOutput.datumHash # ctx.txInfo newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' mint <- plet $ pfromData $ pfield @"mint" # txInfo @@ -261,18 +286,59 @@ governorValidator params = case redeemer of PCreateProposal _ -> P.do - -- check that nothing is minted - passert "Nothing should be minted" $ plength # mint' #== 0 - -- check that proposal is advanced passert "Proposal id should be advanced by 1" $ pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId - -- TODO: waiting for impl of proposal + -- check that exactly one proposal token is minted + pps <- plet $ pconstant proposalSymbol + passert "Exactly one proposal token must be minted" $ + hasOnlyOneTokenOfCurrencySymbol # pps # mint + + outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress + passert "Exactly one utxo should be sent to the proposal validator" $ + plength # outputs #== 1 + + output <- pletFields @'["value", "datumHash"] $ phead # outputs + passert "The proposal state token must be sent to the proposal validator" $ + psymbolValueOf # pconstant proposalSymbol # output.value #== 1 + + passert "The utxo paid to the proposal validator must have datum" $ + pisDJust # output.datumHash + + let proposalDatum' = + mustFindDatum' @PProposalDatum + # output.datumHash + # ctx.txInfo + + proposalParams <- + pletFields + @'["id", "status", "cosigners", "thresholds", "votes"] + proposalDatum' + + passert "Invalid proposal id in proposal parameters" $ + proposalParams.id #== oldParams.nextProposalId + + passert "Invalid thresholds in proposal parameters" $ + proposalParams.thresholds #== oldParams.proposalThresholds + + passert "Initial proposal votes should be zero" $ + pnull #$ pto $ pto $ pfromData proposalParams.votes + + passert "Initial proposal status should be Draft" $ P.do + s <- pmatch $ proposalParams.status + case s of + PDraft _ -> pconstant True + _ -> pconstant False + + passert "Initial proposal cosigners should be empty" $ + pnull #$ pfromData proposalParams.cosigners + ptraceError "Not implemented yet" PMintGATs _ -> P.do -- check datum is not changed - passert "Datum should not be changed" $ oldDatum' #== datum' + passert "Datum should not be changed" $ + (pforgetData $ pdata newDatum') #== datum' -- check exactly one(?) authority token is minted @@ -281,10 +347,12 @@ governorValidator params = PMutateGovernor _ -> P.do -- check that input has exactly one GAT and will be burnt let gatAmount = psymbolValueOf # gatS # mint - passert "One GAT should be burnt" $ gatAmount #== -1 + passert "One GAT should be burnt" $ + gatAmount #== -1 -- nothing should be minted/burnt other than GAT - passert "No token should be minted/burnt other than GAT" $ plength # mint' #== 1 + passert "No token should be minted/burnt other than GAT" $ + plength # mint' #== 1 -- check that GAT is tagged by the address passert "all input GATs are valid" $ @@ -296,6 +364,27 @@ governorValidator params = stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params + proposalParams :: Proposal + proposalParams = + Proposal + { governorSTAssetClass = stateTokenAssetClass + } + + proposalSymbol :: CurrencySymbol + proposalSymbol = mintingPolicySymbol policy + where + policy :: MintingPolicy + policy = mkMintingPolicy $ proposalPolicy proposalParams + + proposalValidatorAddress :: Address + proposalValidatorAddress = Address (ScriptCredential hash) Nothing + where + hash :: ValidatorHash + hash = validatorHash validator + + validator :: Validator + validator = mkValidator $ proposalValidator proposalParams + stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 8b3b85b..13c3eb6 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -44,6 +44,9 @@ module Agora.Utils ( validatorHashToTokenName, pvalidatorHashToTokenName, getMintingPolicySymbol, + hasOnlyOneTokenOfAssetClass', + hasOnlyOneTokenOfCurrencySymbol, + mustFindDatum', ) where -------------------------------------------------------------------------------- @@ -518,3 +521,32 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh)) -- | Get the CurrencySymbol of a PMintingPolicy. getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v + +hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) +hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ + plam $ \vs -> P.do + let ps = pconstant as + + psymbolValueOf # ps # vs #== 1 + #&& passetClassValueOf' ac # vs #== 1 + #&& (plength #$ pto $ pto $ pto vs) #== 1 + +hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) +hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ + plam $ \cs vs -> P.do + psymbolValueOf # cs # vs #== 1 + #&& (plength #$ pto $ pto $ pto vs) #== 1 + +{- Find datum, in an unsafe manner. + + FIXME: reimplement using 'ptryFrom'. +-} +mustFindDatum' :: + forall (datum :: PType). + PIsData datum => + forall s. Term s (PMaybeData PDatumHash :--> PTxInfo :--> datum) +mustFindDatum' = phoistAcyclic $ + plam $ \mdh info -> P.do + PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh + PJust dt <- pmatch $ pfindDatum # dh # info + pfromData $ punsafeCoerce dt From dfbbb4aea3b6458dc47cc5e5db69da6dd6264f95 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Wed, 20 Apr 2022 12:55:43 +0800 Subject: [PATCH 016/107] plet proposal symbol; clean up stuff a little bit --- agora/Agora/Governor.hs | 39 +++++++++++++++------------------------ agora/Agora/Proposal.hs | 1 + agora/Agora/Utils.hs | 5 +++++ 3 files changed, 21 insertions(+), 24 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 0f99de1..999f67c 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -33,7 +33,7 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.AuthorityToken (authorityTokensValidIn) +import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.Proposal ( PProposalDatum, PProposalId, @@ -47,7 +47,6 @@ import Agora.Proposal ( proposalValidator, ) import Agora.Utils ( - allInputs, findOutputsToAddress, hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', @@ -59,6 +58,7 @@ import Agora.Utils ( pisUxtoSpent, pownCurrencySymbol, psymbolValueOf, + containsSingleCurrencySymbol ) -------------------------------------------------------------------------------- @@ -216,7 +216,7 @@ governorPolicy params = #&& passetClassValueOf # ownSymbol # pconstant governorStateTokenName # mintValue #== 1 passert "Nothing is minted other than the state token" $ - (plength #$ pto $ pto $ pto mintValue) #== 1 + containsSingleCurrencySymbol # mintValue popaque (pconstant ()) @@ -282,18 +282,16 @@ governorValidator params = newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' mint <- plet $ pfromData $ pfield @"mint" # txInfo - mint' <- plet $ pto $ pto $ pto mint case redeemer of PCreateProposal _ -> P.do - -- check that proposal is advanced + pSym <- plet $ pconstant proposalSymbol + passert "Proposal id should be advanced by 1" $ pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId - -- check that exactly one proposal token is minted - pps <- plet $ pconstant proposalSymbol passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pps # mint + hasOnlyOneTokenOfCurrencySymbol # pSym # mint outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress passert "Exactly one utxo should be sent to the proposal validator" $ @@ -301,7 +299,7 @@ governorValidator params = output <- pletFields @'["value", "datumHash"] $ phead # outputs passert "The proposal state token must be sent to the proposal validator" $ - psymbolValueOf # pconstant proposalSymbol # output.value #== 1 + psymbolValueOf # pSym # output.value #== 1 passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash @@ -334,32 +332,25 @@ governorValidator params = passert "Initial proposal cosigners should be empty" $ pnull #$ pfromData proposalParams.cosigners + -- TODO: proposal impl not done yet ptraceError "Not implemented yet" PMintGATs _ -> P.do -- check datum is not changed passert "Datum should not be changed" $ (pforgetData $ pdata newDatum') #== datum' + -- TODO: any need to check the proposal datum here? + -- check exactly one(?) authority token is minted -- TODO: waiting for impl of proposal ptraceError "Not implemented yet" PMutateGovernor _ -> P.do - -- check that input has exactly one GAT and will be burnt - let gatAmount = psymbolValueOf # gatS # mint - passert "One GAT should be burnt" $ - gatAmount #== -1 - - -- nothing should be minted/burnt other than GAT passert "No token should be minted/burnt other than GAT" $ - plength # mint' #== 1 + containsSingleCurrencySymbol # mint + + popaque $ singleAuthorityTokenBurned gatSym ctx.txInfo mint - -- check that GAT is tagged by the address - passert "all input GATs are valid" $ - allInputs @PUnit # txInfo #$ plam $ \txOut _ _ _ -> - authorityTokensValidIn # gatS # txOut - - popaque $ pconstant () where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -388,8 +379,8 @@ governorValidator params = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - gatS :: Term s PCurrencySymbol - gatS = pconstant params.gatSymbol + gatSym :: Term s PCurrencySymbol + gatSym = pconstant params.gatSymbol -------------------------------------------------------------------------------- diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index ef50e33..7a01b5e 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -439,6 +439,7 @@ proposalDatumValid proposal = ] -------------------------------------------------------------------------------- + -- | Get next proposal id. pnextProposalId :: Term s (PProposalId :--> PProposalId) pnextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 13c3eb6..bdff4f2 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -47,6 +47,7 @@ module Agora.Utils ( hasOnlyOneTokenOfAssetClass', hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', + containsSingleCurrencySymbol ) where -------------------------------------------------------------------------------- @@ -550,3 +551,7 @@ mustFindDatum' = phoistAcyclic $ PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh PJust dt <- pmatch $ pfindDatum # dh # info pfromData $ punsafeCoerce dt + +containsSingleCurrencySymbol :: Term s (PValue :--> PBool) +containsSingleCurrencySymbol = phoistAcyclic $ plam $ \v -> P.do + (plength #$ pto $ pto $ pto v) #== 1 \ No newline at end of file From b282795efe52c5d30f968e5815288d6915fb532a Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 20 Apr 2022 16:45:25 +0800 Subject: [PATCH 017/107] make `authorityTokenPolicy` a `ClosedTerm PMintingPolicy` --- agora/Agora/Governor.hs | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 999f67c..d05a2b9 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -33,7 +33,11 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.AuthorityToken (singleAuthorityTokenBurned) +import Agora.AuthorityToken ( + AuthorityToken (..), + authorityTokenPolicy, + singleAuthorityTokenBurned, + ) import Agora.Proposal ( PProposalDatum, PProposalId, @@ -47,6 +51,7 @@ import Agora.Proposal ( proposalValidator, ) import Agora.Utils ( + containsSingleCurrencySymbol, findOutputsToAddress, hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', @@ -58,7 +63,6 @@ import Agora.Utils ( pisUxtoSpent, pownCurrencySymbol, psymbolValueOf, - containsSingleCurrencySymbol ) -------------------------------------------------------------------------------- @@ -348,9 +352,8 @@ governorValidator params = PMutateGovernor _ -> P.do passert "No token should be minted/burnt other than GAT" $ containsSingleCurrencySymbol # mint - - popaque $ singleAuthorityTokenBurned gatSym ctx.txInfo mint + popaque $ singleAuthorityTokenBurned gatSym ctx.txInfo mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -379,6 +382,17 @@ governorValidator params = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass + authorityTokenParams :: AuthorityToken + authorityTokenParams = + AuthorityToken + { authority = stateTokenAssetClass + } + + authorityTokenSymbol :: CurrencySymbol + authorityTokenSymbol = undefined + where + policy = authorityTokenPolicy authorityTokenParams + gatSym :: Term s PCurrencySymbol gatSym = pconstant params.gatSymbol From 920286f65616c775d61465a2a2e7975a8c0cce26 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 20 Apr 2022 16:48:09 +0800 Subject: [PATCH 018/107] calculate GAT's symbol based on gov parameters --- agora/Agora/AuthorityToken.hs | 11 +++++------ agora/Agora/Governor.hs | 12 ++++-------- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 241ad13..456f7f2 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -21,12 +21,14 @@ import Plutarch.Api.V1 ( PTxInInfo (PTxInInfo), PTxInfo (..), PTxOut (..), + PMintingPolicy ) import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) import Prelude @@ -39,7 +41,6 @@ import Agora.Utils ( psymbolValueOf, ptokenSpent, ) -import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) -------------------------------------------------------------------------------- @@ -121,9 +122,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = P.do ] -- | Policy given 'AuthorityToken' params. -authorityTokenPolicy :: - AuthorityToken -> - Term s (PData :--> PScriptContext :--> PUnit) +authorityTokenPolicy :: AuthorityToken -> ClosedTerm PMintingPolicy authorityTokenPolicy params = plam $ \_redeemer ctx' -> pmatch ctx' $ \(PScriptContext ctx') -> P.do @@ -149,6 +148,6 @@ authorityTokenPolicy params = authorityTokensValidIn # ownSymbol # txOut - pconstant () + popaque $ pconstant () ) - (pconstant ()) + (popaque $ pconstant ()) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index d05a2b9..c9b626e 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -149,8 +149,6 @@ PlutusTx.makeIsDataIndexed data Governor = Governor { stORef :: TxOutRef -- ^ An utxo, which will be spent to mint the state token for the governor validator. - , gatSymbol :: CurrencySymbol - -- ^ The symbol of the Governance Authority Token. } governorStateTokenName :: TokenName @@ -353,7 +351,7 @@ governorValidator params = passert "No token should be minted/burnt other than GAT" $ containsSingleCurrencySymbol # mint - popaque $ singleAuthorityTokenBurned gatSym ctx.txInfo mint + popaque $ singleAuthorityTokenBurned (pconstant authorityTokenSymbol) ctx.txInfo mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -389,12 +387,10 @@ governorValidator params = } authorityTokenSymbol :: CurrencySymbol - authorityTokenSymbol = undefined + authorityTokenSymbol = mintingPolicySymbol policy where - policy = authorityTokenPolicy authorityTokenParams - - gatSym :: Term s PCurrencySymbol - gatSym = pconstant params.gatSymbol + policy :: MintingPolicy + policy = mkMintingPolicy $ authorityTokenPolicy authorityTokenParams -------------------------------------------------------------------------------- From 5a7c1dd16d4b31b8bdfbca837509c3f50a2b64cc Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 20 Apr 2022 16:55:17 +0800 Subject: [PATCH 019/107] getting start with GAT minting validation --- agora/Agora/Governor.hs | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index c9b626e..94ec4f8 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -69,7 +69,7 @@ import Agora.Utils ( import Plutarch (popaque) import Plutarch.Api.V1 ( - PCurrencySymbol, + PCurrencySymbol (PCurrencySymbol), PMintingPolicy, PScriptPurpose (PSpending), PValidator, @@ -238,7 +238,11 @@ governorPolicy params = - The datum of said utxo must be correct. - Proposal id in the governor datum must be advanced. - TODO: PMintGATs + For 'MintGATs' redeemer, it will check: + - State datum is not changed. + - Exactly one GAT is minted. + - The GAT is properly tagged. (Should we do this?) + - The GAT is sent to the appropraite effect. (Should we do this?) For 'PMutateGovernor', it will check: - A GAT is burnt. @@ -337,10 +341,16 @@ governorValidator params = -- TODO: proposal impl not done yet ptraceError "Not implemented yet" PMintGATs _ -> P.do - -- check datum is not changed passert "Datum should not be changed" $ + -- FIXME: There should be a better way to do this (pforgetData $ pdata newDatum') #== datum' + passert "Exactly one GAT should be minted" $ + hasOnlyOneTokenOfCurrencySymbol # pGATSym # mint + + passert "No token should be minted other than GAT" $ + containsSingleCurrencySymbol # mint + -- TODO: any need to check the proposal datum here? -- check exactly one(?) authority token is minted @@ -348,10 +358,10 @@ governorValidator params = -- TODO: waiting for impl of proposal ptraceError "Not implemented yet" PMutateGovernor _ -> P.do - passert "No token should be minted/burnt other than GAT" $ + passert "No token should be burnt other than GAT" $ containsSingleCurrencySymbol # mint - popaque $ singleAuthorityTokenBurned (pconstant authorityTokenSymbol) ctx.txInfo mint + popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -392,6 +402,9 @@ governorValidator params = policy :: MintingPolicy policy = mkMintingPolicy $ authorityTokenPolicy authorityTokenParams + pGATSym :: Term s PCurrencySymbol + pGATSym = phoistAcyclic $ pconstant authorityTokenSymbol + -------------------------------------------------------------------------------- governorStateTokenAssetClass :: Governor -> AssetClass From 455bd3e01c3c88b5ac61437e13b5f1bab4df848c Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 20 Apr 2022 16:56:07 +0800 Subject: [PATCH 020/107] remove redundant imports --- agora/Agora/Governor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 94ec4f8..853b41b 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -69,7 +69,7 @@ import Agora.Utils ( import Plutarch (popaque) import Plutarch.Api.V1 ( - PCurrencySymbol (PCurrencySymbol), + PCurrencySymbol, PMintingPolicy, PScriptPurpose (PSpending), PValidator, From 7c4ae9313a2ed4231506abadfded1d8605e5d4c3 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 20 Apr 2022 23:29:47 +0800 Subject: [PATCH 021/107] add validation logic for GAT minting; add doc string for `MintGATs` --- agora/Agora/AuthorityToken.hs | 2 +- agora/Agora/Governor.hs | 144 +++++++++++++++++++++++++++------- agora/Agora/Utils.hs | 7 +- 3 files changed, 122 insertions(+), 31 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 456f7f2..d18321d 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -16,12 +16,12 @@ import Plutarch.Api.V1 ( PAddress (..), PCredential (..), PCurrencySymbol (..), + PMintingPolicy, PScriptContext (..), PScriptPurpose (..), PTxInInfo (PTxInInfo), PTxInfo (..), PTxOut (..), - PMintingPolicy ) import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.Value (PValue (PValue)) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 853b41b..153df65 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -36,6 +36,7 @@ import Generics.SOP (Generic, I (I)) import Agora.AuthorityToken ( AuthorityToken (..), authorityTokenPolicy, + authorityTokensValidIn, singleAuthorityTokenBurned, ) import Agora.Proposal ( @@ -43,10 +44,12 @@ import Agora.Proposal ( PProposalId, PProposalStatus (PDraft), PProposalThresholds, + PResultTag, Proposal (..), ProposalId, ProposalThresholds, pnextProposalId, + proposalDatumValid, proposalPolicy, proposalValidator, ) @@ -61,18 +64,24 @@ import Agora.Utils ( pfindTxInByTxOutRef, pisDJust, pisUxtoSpent, + plookup, pownCurrencySymbol, psymbolValueOf, + scriptHashFromAddress, ) -------------------------------------------------------------------------------- import Plutarch (popaque) import Plutarch.Api.V1 ( + PAddress, PCurrencySymbol, + PDatumHash, + PMaybeData (PDJust), PMintingPolicy, PScriptPurpose (PSpending), PValidator, + PValidatorHash, PValue, mintingPolicySymbol, mkMintingPolicy, @@ -91,7 +100,7 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutarch.Builtin (pforgetData) +import Plutarch.Builtin (PBuiltinMap, pforgetData) import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -240,11 +249,12 @@ governorPolicy params = For 'MintGATs' redeemer, it will check: - State datum is not changed. - - Exactly one GAT is minted. - - The GAT is properly tagged. (Should we do this?) - - The GAT is sent to the appropraite effect. (Should we do this?) + - Exactly one proposal is being processed. + - Mint one GAT for every effect. + - The GATs is properly tagged. (Should we do this?) + - The GATs are sent to the appropraite effects. (Should we do this?) - For 'PMutateGovernor', it will check: + For 'MutateGovernor', it will check: - A GAT is burnt. - Said GAT must be tagged by the effect that is spending it. -} @@ -255,12 +265,13 @@ governorValidator params = redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' ctx <- pletFields @'["txInfo", "purpose"] ctx' - txInfo <- plet $ pfromData $ ctx.txInfo + txInfo' <- plet $ pfromData $ ctx.txInfo + txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose let txOutRef = pfromData txOutRef' - PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo + PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' ownInput <- pletFields @'["address", "value"] ownInput' let selfAddress = pfromData $ ownInput.address @@ -272,7 +283,7 @@ governorValidator params = passert "Own input should have exactly one state token" $ ownInputDatumNFTAmount #== 1 - ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress + ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 @@ -287,17 +298,13 @@ governorValidator params = newDatum' <- plet $ mustFindDatum' @PGovernorDatum # ownOutput.datumHash # ctx.txInfo newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' - mint <- plet $ pfromData $ pfield @"mint" # txInfo - case redeemer of PCreateProposal _ -> P.do - pSym <- plet $ pconstant proposalSymbol - passert "Proposal id should be advanced by 1" $ pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pSym # mint + hasOnlyOneTokenOfCurrencySymbol # pProposalSym # txInfo.mint outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress passert "Exactly one utxo should be sent to the proposal validator" $ @@ -305,7 +312,7 @@ governorValidator params = output <- pletFields @'["value", "datumHash"] $ phead # outputs passert "The proposal state token must be sent to the proposal validator" $ - psymbolValueOf # pSym # output.value #== 1 + psymbolValueOf # pProposalSym # output.value #== 1 passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash @@ -335,8 +342,8 @@ governorValidator params = PDraft _ -> pconstant True _ -> pconstant False - passert "Initial proposal cosigners should be empty" $ - pnull #$ pfromData proposalParams.cosigners + passert "Proposal datum must be valid" $ + proposalDatumValid # proposalDatum' -- TODO: proposal impl not done yet ptraceError "Not implemented yet" @@ -345,23 +352,95 @@ governorValidator params = -- FIXME: There should be a better way to do this (pforgetData $ pdata newDatum') #== datum' - passert "Exactly one GAT should be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pGATSym # mint - - passert "No token should be minted other than GAT" $ - containsSingleCurrencySymbol # mint - -- TODO: any need to check the proposal datum here? - -- check exactly one(?) authority token is minted + inputsWithProposalStateToken <- + plet $ + pfilter + # ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) -> + 0 #< psymbolValueOf # pProposalSym # value + ) + #$ pfromData txInfo.inputs - -- TODO: waiting for impl of proposal - ptraceError "Not implemented yet" + passert "One proposal at a time" $ + plength # inputsWithProposalStateToken #== 1 + + proposalInputTxOut <- + pletFields @'["address", "value", "datumHash"] $ + pfield @"resolved" #$ phead # inputsWithProposalStateToken + + proposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash # txInfo' + + passert "Proposal datum must be valid" $ + proposalDatumValid # proposalDatum' + + proposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] proposalDatum' + + let effects' :: Term _ (PBuiltinMap PResultTag (PBuiltinMap PValidatorHash PDatumHash)) + effects' = punsafeCoerce proposalDatum.effects + + effectMapList <- + plet $ + pfoldr + # ( plam $ \m l -> P.do + let theMap = pfromData $ psndBuiltin # m + pconcat # theMap # l + ) + # pcon PNil + # effects' + + gatCount <- plet $ plength # effectMapList + + passert "Required amount of GATs should be minted" $ + psymbolValueOf # pProposalSym # txInfo.mint #== gatCount + + passert "No token should be minted other than GAT" $ + containsSingleCurrencySymbol # txInfo.mint + + outputsWithGAT <- + plet $ + pfilter + # ( plam $ \((pfield @"value" #) -> value) -> + 0 #< psymbolValueOf # pGATSym # value + ) + #$ pfromData txInfo.outputs + + passert "Minted GAT amount should equal to amount of output GAT" $ + plength # outputsWithGAT #== gatCount + + passert "All GAT must be properly tagged" $ + pall + # ( plam $ \(pfromData -> outInfo) -> + authorityTokensValidIn # pGATSym # outInfo + ) + # outputsWithGAT + + popaque $ + pfoldr + # ( plam $ \(pfromData -> outputInfo') _ -> P.do + outputInfo <- pletFields @'["address", "datumHash"] $ outputInfo' + passert "GAT must be properly tagged" $ authorityTokensValidIn # pGATSym # outputInfo' + passert "Output to the effect should have datum" $ pisDJust # outputInfo.datumHash + PDJust ((pfield @"_0" #) -> datumHash) <- pmatch outputInfo.datumHash + let scriptHash = scriptHashFromAddress' # outputInfo.address + expectedDatumHash' <- pmatch $ plookup # (pdata scriptHash) # effectMapList + case expectedDatumHash' of + PJust expectedDatumHash -> + passert "An unexpected datum hash is found sent to the effect" $ + datumHash #== expectedDatumHash + _ -> passert "A GAT is not sent to an effect" $ pconstant False + pconstant () + ) + # pconstant () + # outputsWithGAT + + -- TODO: check proposal votes and timing + -- TODO: waiting for impl of proposal PMutateGovernor _ -> P.do passert "No token should be burnt other than GAT" $ - containsSingleCurrencySymbol # mint + containsSingleCurrencySymbol # txInfo.mint - popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo mint + popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -378,6 +457,9 @@ governorValidator params = policy :: MintingPolicy policy = mkMintingPolicy $ proposalPolicy proposalParams + pProposalSym :: Term s PCurrencySymbol + pProposalSym = phoistAcyclic $ pconstant proposalSymbol + proposalValidatorAddress :: Address proposalValidatorAddress = Address (ScriptCredential hash) Nothing where @@ -405,6 +487,14 @@ governorValidator params = pGATSym :: Term s PCurrencySymbol pGATSym = phoistAcyclic $ pconstant authorityTokenSymbol + scriptHashFromAddress' :: Term s (PAddress :--> PValidatorHash) + scriptHashFromAddress' = phoistAcyclic $ + plam $ \addr -> P.do + mh <- pmatch $ scriptHashFromAddress # addr + case mh of + PJust vh -> vh + _ -> ptraceError "Not a valid validator address" + -------------------------------------------------------------------------------- governorStateTokenAssetClass :: Governor -> AssetClass diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index bdff4f2..ecb9bd6 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -47,7 +47,7 @@ module Agora.Utils ( hasOnlyOneTokenOfAssetClass', hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', - containsSingleCurrencySymbol + containsSingleCurrencySymbol, ) where -------------------------------------------------------------------------------- @@ -553,5 +553,6 @@ mustFindDatum' = phoistAcyclic $ pfromData $ punsafeCoerce dt containsSingleCurrencySymbol :: Term s (PValue :--> PBool) -containsSingleCurrencySymbol = phoistAcyclic $ plam $ \v -> P.do - (plength #$ pto $ pto $ pto v) #== 1 \ No newline at end of file +containsSingleCurrencySymbol = phoistAcyclic $ + plam $ \v -> P.do + (plength #$ pto $ pto $ pto v) #== 1 From ed465b114c3b77ad473f9942502f1ba2829ece94 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 13:30:07 +0800 Subject: [PATCH 022/107] allow other components to know the assetclass of GST --- agora/Agora/Governor.hs | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 153df65..f3d5b60 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -24,6 +24,7 @@ module Agora.Governor ( -- * Utilities governorStateTokenAssetClass, + authorityTokenSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -472,20 +473,8 @@ governorValidator params = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - authorityTokenParams :: AuthorityToken - authorityTokenParams = - AuthorityToken - { authority = stateTokenAssetClass - } - - authorityTokenSymbol :: CurrencySymbol - authorityTokenSymbol = mintingPolicySymbol policy - where - policy :: MintingPolicy - policy = mkMintingPolicy $ authorityTokenPolicy authorityTokenParams - pGATSym :: Term s PCurrencySymbol - pGATSym = phoistAcyclic $ pconstant authorityTokenSymbol + pGATSym = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor params scriptHashFromAddress' :: Term s (PAddress :--> PValidatorHash) scriptHashFromAddress' = phoistAcyclic $ @@ -505,3 +494,9 @@ governorStateTokenAssetClass gov = AssetClass (symbol, governorStateTokenName) symbol :: CurrencySymbol symbol = mintingPolicySymbol policy + +authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol +authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy + where + params = AuthorityToken $ governorStateTokenAssetClass gov + policy = mkMintingPolicy $ authorityTokenPolicy params From 6daebba41459d4f1666b581842393c84e35602cb Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 16:33:59 +0800 Subject: [PATCH 023/107] add `mustBePJust` and `mustBePDJust` util functions --- agora/Agora/Governor.hs | 95 +++++++++++++++++++---------------------- agora/Agora/Utils.hs | 14 ++++++ 2 files changed, 59 insertions(+), 50 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index f3d5b60..5f78302 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -45,7 +45,8 @@ import Agora.Proposal ( PProposalId, PProposalStatus (PDraft), PProposalThresholds, - PResultTag, + PProposalVotes (PProposalVotes), + PResultTag (PResultTag), Proposal (..), ProposalId, ProposalThresholds, @@ -58,14 +59,16 @@ import Agora.Utils ( containsSingleCurrencySymbol, findOutputsToAddress, hasOnlyOneTokenOfCurrencySymbol, + mustBePDJust, + mustBePJust, mustFindDatum', passert, passetClassValueOf, passetClassValueOf', + pfindDatum, pfindTxInByTxOutRef, pisDJust, pisUxtoSpent, - plookup, pownCurrencySymbol, psymbolValueOf, scriptHashFromAddress, @@ -102,6 +105,7 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- import Plutarch.Builtin (PBuiltinMap, pforgetData) +import Plutarch.Map.Extra (plookup, plookup') import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -334,14 +338,14 @@ governorValidator params = passert "Invalid thresholds in proposal parameters" $ proposalParams.thresholds #== oldParams.proposalThresholds - passert "Initial proposal votes should be zero" $ - pnull #$ pto $ pto $ pfromData proposalParams.votes + -- passert "Initial proposal votes should be empty" $ + -- pnull #$ pto $ pto $ pfromData proposalParams.votes - passert "Initial proposal status should be Draft" $ P.do - s <- pmatch $ proposalParams.status - case s of - PDraft _ -> pconstant True - _ -> pconstant False + -- passert "Initial proposal status should be Draft" $ P.do + -- s <- pmatch $ proposalParams.status + -- case s of + -- PDraft _ -> pconstant True + -- _ -> pconstant False passert "Proposal datum must be valid" $ proposalDatumValid # proposalDatum' @@ -377,20 +381,17 @@ governorValidator params = proposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] proposalDatum' - let effects' :: Term _ (PBuiltinMap PResultTag (PBuiltinMap PValidatorHash PDatumHash)) - effects' = punsafeCoerce proposalDatum.effects + PProposalVotes votes' <- pmatch $ pfromData proposalDatum.votes + votes <- plet votes' - effectMapList <- - plet $ - pfoldr - # ( plam $ \m l -> P.do - let theMap = pfromData $ psndBuiltin # m - pconcat # theMap # l - ) - # pcon PNil - # effects' + let yesVotes = plookup' # pyesResultTag # votes + noVotes = plookup' # pnoResultTag # votes + -- TODO: check thresholds here + finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag - gatCount <- plet $ plength # effectMapList + effects <- plet $ plookup' # finalResultTag #$ proposalDatum.effects + + gatCount <- plet $ plength #$ pto $ pto effects passert "Required amount of GATs should be minted" $ psymbolValueOf # pProposalSym # txInfo.mint #== gatCount @@ -405,34 +406,30 @@ governorValidator params = 0 #< psymbolValueOf # pGATSym # value ) #$ pfromData txInfo.outputs - passert "Minted GAT amount should equal to amount of output GAT" $ plength # outputsWithGAT #== gatCount - passert "All GAT must be properly tagged" $ - pall - # ( plam $ \(pfromData -> outInfo) -> - authorityTokensValidIn # pGATSym # outInfo - ) - # outputsWithGAT - popaque $ pfoldr - # ( plam $ \(pfromData -> outputInfo') _ -> P.do - outputInfo <- pletFields @'["address", "datumHash"] $ outputInfo' - passert "GAT must be properly tagged" $ authorityTokensValidIn # pGATSym # outputInfo' - passert "Output to the effect should have datum" $ pisDJust # outputInfo.datumHash - PDJust ((pfield @"_0" #) -> datumHash) <- pmatch outputInfo.datumHash - let scriptHash = scriptHashFromAddress' # outputInfo.address - expectedDatumHash' <- pmatch $ plookup # (pdata scriptHash) # effectMapList - case expectedDatumHash' of - PJust expectedDatumHash -> - passert "An unexpected datum hash is found sent to the effect" $ - datumHash #== expectedDatumHash - _ -> passert "A GAT is not sent to an effect" $ pconstant False - pconstant () + # ( plam $ \(pfromData -> output') _ -> P.do + output <- pletFields @'["address", "datumHash"] $ output' + + let scriptHash = + mustBePJust # "GAT receiver is not a script" + #$ scriptHashFromAddress # output.address + datumHash = + mustBePDJust # "Output to effect should have datum" + #$ output.datumHash + + expectedDatumHash = + mustBePJust # "Receiver is not in effect list" + #$ plookup # scriptHash # effects + + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pGATSym # output' + passert "Unexpected datum" $ datumHash #== expectedDatumHash + (pconstant ()) ) - # pconstant () + # (pconstant ()) # outputsWithGAT -- TODO: check proposal votes and timing @@ -476,13 +473,11 @@ governorValidator params = pGATSym :: Term s PCurrencySymbol pGATSym = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor params - scriptHashFromAddress' :: Term s (PAddress :--> PValidatorHash) - scriptHashFromAddress' = phoistAcyclic $ - plam $ \addr -> P.do - mh <- pmatch $ scriptHashFromAddress # addr - case mh of - PJust vh -> vh - _ -> ptraceError "Not a valid validator address" + pyesResultTag :: Term s PResultTag + pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 + + pnoResultTag :: Term s PResultTag + pnoResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 0 -------------------------------------------------------------------------------- diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index ecb9bd6..373abee 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -48,6 +48,8 @@ module Agora.Utils ( hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', containsSingleCurrencySymbol, + mustBePJust, + mustBePDJust, ) where -------------------------------------------------------------------------------- @@ -556,3 +558,15 @@ containsSingleCurrencySymbol :: Term s (PValue :--> PBool) containsSingleCurrencySymbol = phoistAcyclic $ plam $ \v -> P.do (plength #$ pto $ pto $ pto v) #== 1 + +mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a) +mustBePJust = phoistAcyclic $ + plam $ \emsg mv' -> pmatch mv' $ \case + PJust v -> v + _ -> ptraceError emsg + +mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a) +mustBePDJust = phoistAcyclic $ + plam $ \emsg mv' -> pmatch mv' $ \case + PDJust ((pfield @"_0" #) -> v) -> v + _ -> ptraceError emsg \ No newline at end of file From 3f871123b7b8ed790a45b0237610f600ffd1fdc1 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 16:56:56 +0800 Subject: [PATCH 024/107] correct validation logic for proposals * simplify using newly added util functions * check vote thresholds * Anything else to check here? --- agora/Agora/Governor.hs | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 5f78302..2b22ecf 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -43,7 +43,6 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PDraft), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -65,7 +64,6 @@ import Agora.Utils ( passert, passetClassValueOf, passetClassValueOf', - pfindDatum, pfindTxInByTxOutRef, pisDJust, pisUxtoSpent, @@ -78,21 +76,17 @@ import Agora.Utils ( import Plutarch (popaque) import Plutarch.Api.V1 ( - PAddress, PCurrencySymbol, - PDatumHash, - PMaybeData (PDJust), PMintingPolicy, PScriptPurpose (PSpending), PValidator, - PValidatorHash, PValue, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash, ) -import Plutarch.Api.V1.Extra (pownMintValue) +import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf, pownMintValue) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -104,8 +98,9 @@ import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- -import Plutarch.Builtin (PBuiltinMap, pforgetData) +import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra (plookup, plookup') +import Plutarch.SafeMoney (puntag) import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -255,6 +250,7 @@ governorPolicy params = For 'MintGATs' redeemer, it will check: - State datum is not changed. - Exactly one proposal is being processed. + - Select the right effect group. - Mint one GAT for every effect. - The GATs is properly tagged. (Should we do this?) - The GATs are sent to the appropraite effects. (Should we do this?) @@ -381,13 +377,20 @@ governorValidator params = proposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] proposalDatum' + -- TODO: something else to check here? + PProposalVotes votes' <- pmatch $ pfromData proposalDatum.votes votes <- plet votes' - let yesVotes = plookup' # pyesResultTag # votes + let minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalDatum.thresholds + + yesVotes = plookup' # pyesResultTag # votes noVotes = plookup' # pnoResultTag # votes - -- TODO: check thresholds here - finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag + biggerVotes = pif (yesVotes #< noVotes) noVotes yesVotes + + passert "Votes should be more than mininum votes" $ minimumVotes #< biggerVotes + + let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag effects <- plet $ plookup' # finalResultTag #$ proposalDatum.effects @@ -420,7 +423,7 @@ governorValidator params = datumHash = mustBePDJust # "Output to effect should have datum" #$ output.datumHash - + expectedDatumHash = mustBePJust # "Receiver is not in effect list" #$ plookup # scriptHash # effects @@ -432,7 +435,6 @@ governorValidator params = # (pconstant ()) # outputsWithGAT - -- TODO: check proposal votes and timing -- TODO: waiting for impl of proposal PMutateGovernor _ -> P.do passert "No token should be burnt other than GAT" $ From f1f0405e98cbabc34d4b89f4fe636026dbc2ccb1 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Thu, 21 Apr 2022 18:49:06 +0800 Subject: [PATCH 025/107] check input/output proposal status while minting GATs --- agora/Agora/Governor.hs | 56 ++++++++++++++++++++++++++++++++--------- 1 file changed, 44 insertions(+), 12 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 2b22ecf..67dd203 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -43,6 +43,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, + PProposalStatus (PFinished, PLocked), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -69,6 +70,7 @@ import Agora.Utils ( pisUxtoSpent, pownCurrencySymbol, psymbolValueOf, + pvalueSpent, scriptHashFromAddress, ) @@ -318,7 +320,7 @@ governorValidator params = passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash - let proposalDatum' = + let inputProposalDatum' = mustFindDatum' @PProposalDatum # output.datumHash # ctx.txInfo @@ -326,7 +328,7 @@ governorValidator params = proposalParams <- pletFields @'["id", "status", "cosigners", "thresholds", "votes"] - proposalDatum' + inputProposalDatum' passert "Invalid proposal id in proposal parameters" $ proposalParams.id #== oldParams.nextProposalId @@ -344,7 +346,7 @@ governorValidator params = -- _ -> pconstant False passert "Proposal datum must be valid" $ - proposalDatumValid # proposalDatum' + proposalDatumValid # inputProposalDatum' -- TODO: proposal impl not done yet ptraceError "Not implemented yet" @@ -353,36 +355,66 @@ governorValidator params = -- FIXME: There should be a better way to do this (pforgetData $ pdata newDatum') #== datum' - -- TODO: any need to check the proposal datum here? - inputsWithProposalStateToken <- plet $ pfilter # ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) -> - 0 #< psymbolValueOf # pProposalSym # value + psymbolValueOf # pProposalSym # value #== 1 ) #$ pfromData txInfo.inputs + outputsWithProposalStateToken <- + plet $ + pfilter + # ( plam $ \((pfield @"value" #) -> value) -> + psymbolValueOf # pProposalSym # value #== 1 + ) + #$ pfromData txInfo.outputs + passert "One proposal at a time" $ plength # inputsWithProposalStateToken #== 1 + #&& (psymbolValueOf # pProposalSym #$ pvalueSpent # txInfo') #== 1 proposalInputTxOut <- pletFields @'["address", "value", "datumHash"] $ pfield @"resolved" #$ phead # inputsWithProposalStateToken + proposalOutputTxOut <- + pletFields @'["address", "value", "datumHash"] $ + phead # outputsWithProposalStateToken - proposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash # txInfo' + inputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash # txInfo' + outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalOutputTxOut.datumHash # txInfo' passert "Proposal datum must be valid" $ - proposalDatumValid # proposalDatum' + proposalDatumValid # inputProposalDatum' #&& proposalDatumValid # outputProposalDatum' - proposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] proposalDatum' + inputProposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' + + let isInputLocked = pmatch (pfromData inputProposalDatum.status) $ \case + PLocked _ -> pconstant False + _ -> pconstant False + + passert "Input proposal status must be locked" $ isInputLocked + + let fields = + pdcons @"id" # inputProposalDatum.id + #$ pdcons @"effects" # inputProposalDatum.effects + #$ pdcons @"status" # (pdata $ pcon $ PFinished pdnil) + #$ pdcons @"cosigners" # inputProposalDatum.cosigners + #$ pdcons @"thresholds" # inputProposalDatum.thresholds + #$ pdcons @"votes" # inputProposalDatum.votes # pdnil + + expectedOutputDatum = pforgetData $ pdata fields + + passert "Unexpected output proposal datum" $ + (pforgetData $ pdata outputProposalDatum') #== expectedOutputDatum -- TODO: something else to check here? - PProposalVotes votes' <- pmatch $ pfromData proposalDatum.votes + PProposalVotes votes' <- pmatch $ pfromData inputProposalDatum.votes votes <- plet votes' - let minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalDatum.thresholds + let minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds yesVotes = plookup' # pyesResultTag # votes noVotes = plookup' # pnoResultTag # votes @@ -392,7 +424,7 @@ governorValidator params = let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag - effects <- plet $ plookup' # finalResultTag #$ proposalDatum.effects + effects <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects gatCount <- plet $ plength #$ pto $ pto effects From 6f1c6f0aeffddac9da7efddef4658ea7292296d5 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 21:52:04 +0800 Subject: [PATCH 026/107] ensure that the proposal state token is sent back --- agora/Agora/Governor.hs | 66 +++++++++++++++++++++++++++-------------- 1 file changed, 43 insertions(+), 23 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 67dd203..5abd2ce 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -78,6 +78,7 @@ import Agora.Utils ( import Plutarch (popaque) import Plutarch.Api.V1 ( + PAddress, PCurrencySymbol, PMintingPolicy, PScriptPurpose (PSpending), @@ -88,7 +89,11 @@ import Plutarch.Api.V1 ( mkValidator, validatorHash, ) -import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf, pownMintValue) +import Plutarch.Api.V1.Extra ( + passetClass, + passetClassValueOf, + pownMintValue, + ) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -307,15 +312,15 @@ governorValidator params = pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pProposalSym # txInfo.mint + hasOnlyOneTokenOfCurrencySymbol # pproposalSym # txInfo.mint - outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress + outputs <- plet $ findOutputsToAddress # ctx.txInfo # pproposalValidatorAddress passert "Exactly one utxo should be sent to the proposal validator" $ plength # outputs #== 1 output <- pletFields @'["value", "datumHash"] $ phead # outputs passert "The proposal state token must be sent to the proposal validator" $ - psymbolValueOf # pProposalSym # output.value #== 1 + psymbolValueOf # pproposalSym # output.value #== 1 passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash @@ -359,7 +364,7 @@ governorValidator params = plet $ pfilter # ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) -> - psymbolValueOf # pProposalSym # value #== 1 + psymbolValueOf # pproposalSym # value #== 1 ) #$ pfromData txInfo.inputs @@ -367,28 +372,42 @@ governorValidator params = plet $ pfilter # ( plam $ \((pfield @"value" #) -> value) -> - psymbolValueOf # pProposalSym # value #== 1 + psymbolValueOf # pproposalSym # value #== 1 ) #$ pfromData txInfo.outputs passert "One proposal at a time" $ plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # pProposalSym #$ pvalueSpent # txInfo') #== 1 + #&& (psymbolValueOf # pproposalSym #$ pvalueSpent # txInfo') #== 1 proposalInputTxOut <- pletFields @'["address", "value", "datumHash"] $ pfield @"resolved" #$ phead # inputsWithProposalStateToken proposalOutputTxOut <- - pletFields @'["address", "value", "datumHash"] $ + pletFields @'["datumHash", "address"] $ phead # outputsWithProposalStateToken - inputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash # txInfo' - outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalOutputTxOut.datumHash # txInfo' + passert "Proposal state token must be sent back to the proposal validator" $ + proposalOutputTxOut.address #== pdata pproposalValidatorAddress + + inputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # proposalInputTxOut.datumHash + # txInfo' + outputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # proposalOutputTxOut.datumHash + # txInfo' passert "Proposal datum must be valid" $ - proposalDatumValid # inputProposalDatum' #&& proposalDatumValid # outputProposalDatum' + proposalDatumValid # inputProposalDatum' + #&& proposalDatumValid # outputProposalDatum' - inputProposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' + inputProposalDatum <- + pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] + inputProposalDatum' let isInputLocked = pmatch (pfromData inputProposalDatum.status) $ \case PLocked _ -> pconstant False @@ -409,7 +428,7 @@ governorValidator params = passert "Unexpected output proposal datum" $ (pforgetData $ pdata outputProposalDatum') #== expectedOutputDatum - -- TODO: something else to check here? + -- TODO: anything else to check here? PProposalVotes votes' <- pmatch $ pfromData inputProposalDatum.votes votes <- plet votes' @@ -429,7 +448,7 @@ governorValidator params = gatCount <- plet $ plength #$ pto $ pto effects passert "Required amount of GATs should be minted" $ - psymbolValueOf # pProposalSym # txInfo.mint #== gatCount + psymbolValueOf # pproposalSym # txInfo.mint #== gatCount passert "No token should be minted other than GAT" $ containsSingleCurrencySymbol # txInfo.mint @@ -438,7 +457,7 @@ governorValidator params = plet $ pfilter # ( plam $ \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pGATSym # value + 0 #< psymbolValueOf # pgatSym # value ) #$ pfromData txInfo.outputs passert "Minted GAT amount should equal to amount of output GAT" $ @@ -460,19 +479,17 @@ governorValidator params = mustBePJust # "Receiver is not in effect list" #$ plookup # scriptHash # effects - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pGATSym # output' + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' passert "Unexpected datum" $ datumHash #== expectedDatumHash (pconstant ()) ) # (pconstant ()) # outputsWithGAT - - -- TODO: waiting for impl of proposal PMutateGovernor _ -> P.do passert "No token should be burnt other than GAT" $ containsSingleCurrencySymbol # txInfo.mint - popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo txInfo.mint + popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params @@ -489,8 +506,8 @@ governorValidator params = policy :: MintingPolicy policy = mkMintingPolicy $ proposalPolicy proposalParams - pProposalSym :: Term s PCurrencySymbol - pProposalSym = phoistAcyclic $ pconstant proposalSymbol + pproposalSym :: Term s PCurrencySymbol + pproposalSym = phoistAcyclic $ pconstant proposalSymbol proposalValidatorAddress :: Address proposalValidatorAddress = Address (ScriptCredential hash) Nothing @@ -501,11 +518,14 @@ governorValidator params = validator :: Validator validator = mkValidator $ proposalValidator proposalParams + pproposalValidatorAddress :: Term s PAddress + pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress + stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - pGATSym :: Term s PCurrencySymbol - pGATSym = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor params + pgatSym :: Term s PCurrencySymbol + pgatSym = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor params pyesResultTag :: Term s PResultTag pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 From 529525f5c8d02585ab21fd4aae090c97e0135823 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:01:44 +0800 Subject: [PATCH 027/107] some error message improvement --- agora/Agora/Governor.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 5abd2ce..e60b3c7 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -356,7 +356,7 @@ governorValidator params = -- TODO: proposal impl not done yet ptraceError "Not implemented yet" PMintGATs _ -> P.do - passert "Datum should not be changed" $ + passert "Governor state should not be changed" $ -- FIXME: There should be a better way to do this (pforgetData $ pdata newDatum') #== datum' @@ -376,7 +376,7 @@ governorValidator params = ) #$ pfromData txInfo.outputs - passert "One proposal at a time" $ + passert "The governor can only process one proposal at a time" $ plength # inputsWithProposalStateToken #== 1 #&& (psymbolValueOf # pproposalSym #$ pvalueSpent # txInfo') #== 1 @@ -413,7 +413,7 @@ governorValidator params = PLocked _ -> pconstant False _ -> pconstant False - passert "Input proposal status must be locked" $ isInputLocked + passert "Proposal must be in locked state in order to execute effects" $ isInputLocked let fields = pdcons @"id" # inputProposalDatum.id @@ -439,7 +439,7 @@ governorValidator params = noVotes = plookup' # pnoResultTag # votes biggerVotes = pif (yesVotes #< noVotes) noVotes yesVotes - passert "Votes should be more than mininum votes" $ minimumVotes #< biggerVotes + passert "Number of votes doesn't meet the minimum requirement" $ minimumVotes #< biggerVotes let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag @@ -460,7 +460,8 @@ governorValidator params = 0 #< psymbolValueOf # pgatSym # value ) #$ pfromData txInfo.outputs - passert "Minted GAT amount should equal to amount of output GAT" $ + + passert "Output GATs is more than minted GATs" $ plength # outputsWithGAT #== gatCount popaque $ @@ -476,7 +477,7 @@ governorValidator params = #$ output.datumHash expectedDatumHash = - mustBePJust # "Receiver is not in effect list" + mustBePJust # "Receiver is not in the effect list" #$ plookup # scriptHash # effects passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' From be05643f13e6902f9f7bc1eef4021923dda7b4fe Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:07:15 +0800 Subject: [PATCH 028/107] add executable state for the proposal --- agora/Agora/Proposal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 7a01b5e..52b199d 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -303,6 +303,7 @@ data PProposalStatus (s :: S) PDraft (Term s (PDataRecord '[])) | PVotingReady (Term s (PDataRecord '[])) | PLocked (Term s (PDataRecord '[])) + | PExecutable (Term s (PDataRecord '[])) | PFinished (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic) From 8da0a1b0160395cc3416da6564186a00ea1459dd Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:08:37 +0800 Subject: [PATCH 029/107] ensure the proposal is in executable state while minting GATs --- agora/Agora/Governor.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index e60b3c7..52db026 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -43,7 +43,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PFinished, PLocked), + PProposalStatus (PFinished, PExecutable), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -409,11 +409,11 @@ governorValidator params = pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' - let isInputLocked = pmatch (pfromData inputProposalDatum.status) $ \case - PLocked _ -> pconstant False + let isExecutable = pmatch (pfromData inputProposalDatum.status) $ \case + PExecutable _ -> pconstant True _ -> pconstant False - passert "Proposal must be in locked state in order to execute effects" $ isInputLocked + passert "Proposal must be in executable state in order to execute effects" $ isExecutable let fields = pdcons @"id" # inputProposalDatum.id @@ -439,7 +439,8 @@ governorValidator params = noVotes = plookup' # pnoResultTag # votes biggerVotes = pif (yesVotes #< noVotes) noVotes yesVotes - passert "Number of votes doesn't meet the minimum requirement" $ minimumVotes #< biggerVotes + passert "Number of votes doesn't meet the minimum requirement" $ + minimumVotes #< biggerVotes let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag From 7c50b10309e5afd98e102f2ba7a19be4709c711d Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:15:48 +0800 Subject: [PATCH 030/107] allow GST has a custom name --- agora/Agora/Governor.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 52db026..fa06ce7 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -12,7 +12,6 @@ module Agora.Governor ( GovernorDatum (..), GovernorRedeemer (..), Governor (..), - governorStateTokenName, -- * Plutarch-land PGovernorDatum (..), @@ -163,13 +162,11 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor - { stORef :: TxOutRef + { stORef :: TxOutRef, -- ^ An utxo, which will be spent to mint the state token for the governor validator. + stName :: TokenName } -governorStateTokenName :: TokenName -governorStateTokenName = TokenName "" - -------------------------------------------------------------------------------- -- | Plutarch-level datum for the Governor script. @@ -216,7 +213,7 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc - The utxo specified in the Governor parameter is spent. - Only one token is minted. - - Ensure the token name is "". + - Ensure the token name is 'stName'. -} governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy params = @@ -224,6 +221,7 @@ governorPolicy params = ctx <- pletFields @'["txInfo", "purpose"] ctx' let oref = pconstant params.stORef ownSymbol = pownCurrencySymbol # ctx' + ownAssetClass = passetClass # ownSymbol # pconstant params.stName mintValue <- plet $ pownMintValue # ctx' @@ -538,7 +536,7 @@ governorValidator params = -------------------------------------------------------------------------------- governorStateTokenAssetClass :: Governor -> AssetClass -governorStateTokenAssetClass gov = AssetClass (symbol, governorStateTokenName) +governorStateTokenAssetClass gov = AssetClass (symbol, gov.stName) where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov From aba2bb7bd005b4d9f987d66c916039ae555eecb5 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:22:49 +0800 Subject: [PATCH 031/107] remove all unnecessary mint only one kind of token checks --- agora/Agora/Governor.hs | 41 ++++++++++++++++------------------------- 1 file changed, 16 insertions(+), 25 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index fa06ce7..912c4be 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -42,7 +42,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PFinished, PExecutable), + PProposalStatus (PExecutable, PFinished), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -55,7 +55,6 @@ import Agora.Proposal ( proposalValidator, ) import Agora.Utils ( - containsSingleCurrencySymbol, findOutputsToAddress, hasOnlyOneTokenOfCurrencySymbol, mustBePDJust, @@ -162,9 +161,9 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor - { stORef :: TxOutRef, + { stORef :: TxOutRef -- ^ An utxo, which will be spent to mint the state token for the governor validator. - stName :: TokenName + , stName :: TokenName } -------------------------------------------------------------------------------- @@ -231,9 +230,6 @@ governorPolicy params = psymbolValueOf # ownSymbol # mintValue #== 1 #&& passetClassValueOf # ownSymbol # pconstant governorStateTokenName # mintValue #== 1 - passert "Nothing is minted other than the state token" $ - containsSingleCurrencySymbol # mintValue - popaque (pconstant ()) {- Validator for Governors. @@ -323,24 +319,28 @@ governorValidator params = passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash - let inputProposalDatum' = - mustFindDatum' @PProposalDatum - # output.datumHash - # ctx.txInfo + outputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # output.datumHash + # ctx.txInfo + + passert "Proposal datum must be valid" $ + proposalDatumValid # outputProposalDatum' proposalParams <- pletFields @'["id", "status", "cosigners", "thresholds", "votes"] - inputProposalDatum' + outputProposalDatum' - passert "Invalid proposal id in proposal parameters" $ + passert "Invalid proposal id in proposal datum" $ proposalParams.id #== oldParams.nextProposalId - passert "Invalid thresholds in proposal parameters" $ + passert "Invalid thresholds in proposal datum" $ proposalParams.thresholds #== oldParams.proposalThresholds - -- passert "Initial proposal votes should be empty" $ - -- pnull #$ pto $ pto $ pfromData proposalParams.votes + passert "Initial proposal votes should be empty" $ + pnull #$ pto $ pto $ pfromData proposalParams.votes -- passert "Initial proposal status should be Draft" $ P.do -- s <- pmatch $ proposalParams.status @@ -348,9 +348,6 @@ governorValidator params = -- PDraft _ -> pconstant True -- _ -> pconstant False - passert "Proposal datum must be valid" $ - proposalDatumValid # inputProposalDatum' - -- TODO: proposal impl not done yet ptraceError "Not implemented yet" PMintGATs _ -> P.do @@ -449,9 +446,6 @@ governorValidator params = passert "Required amount of GATs should be minted" $ psymbolValueOf # pproposalSym # txInfo.mint #== gatCount - passert "No token should be minted other than GAT" $ - containsSingleCurrencySymbol # txInfo.mint - outputsWithGAT <- plet $ pfilter @@ -486,9 +480,6 @@ governorValidator params = # (pconstant ()) # outputsWithGAT PMutateGovernor _ -> P.do - passert "No token should be burnt other than GAT" $ - containsSingleCurrencySymbol # txInfo.mint - popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass From 2b0027f4e4c80a4164d32d04ff3f1b70c2ac1bd9 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 22:33:27 +0800 Subject: [PATCH 032/107] check proposal state is draft while creating a proposal --- agora/Agora/Governor.hs | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 912c4be..c187c56 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -42,7 +42,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PExecutable, PFinished), + PProposalStatus (PExecutable, PFinished, PVotingReady, PDraft), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -328,28 +328,29 @@ governorValidator params = passert "Proposal datum must be valid" $ proposalDatumValid # outputProposalDatum' - proposalParams <- + proposalDatum <- pletFields @'["id", "status", "cosigners", "thresholds", "votes"] outputProposalDatum' passert "Invalid proposal id in proposal datum" $ - proposalParams.id #== oldParams.nextProposalId + proposalDatum.id #== oldParams.nextProposalId passert "Invalid thresholds in proposal datum" $ - proposalParams.thresholds #== oldParams.proposalThresholds + proposalDatum.thresholds #== oldParams.proposalThresholds passert "Initial proposal votes should be empty" $ - pnull #$ pto $ pto $ pfromData proposalParams.votes + pnull #$ pto $ pto $ pfromData proposalDatum.votes - -- passert "Initial proposal status should be Draft" $ P.do - -- s <- pmatch $ proposalParams.status - -- case s of - -- PDraft _ -> pconstant True - -- _ -> pconstant False + -- TODO: should we check cosigners here? - -- TODO: proposal impl not done yet - ptraceError "Not implemented yet" + let isProposalDraft = pmatch (pfromData proposalDatum.status) $ \case + PDraft _ -> pconstant True + _ -> pconstant False + + passert "Proposal state should be draft" $ isProposalDraft + + popaque $ pconstant () PMintGATs _ -> P.do passert "Governor state should not be changed" $ -- FIXME: There should be a better way to do this @@ -404,11 +405,11 @@ governorValidator params = pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' - let isExecutable = pmatch (pfromData inputProposalDatum.status) $ \case + let isProposalExecutable = pmatch (pfromData inputProposalDatum.status) $ \case PExecutable _ -> pconstant True _ -> pconstant False - passert "Proposal must be in executable state in order to execute effects" $ isExecutable + passert "Proposal must be in executable state in order to execute effects" $ isProposalExecutable let fields = pdcons @"id" # inputProposalDatum.id @@ -485,8 +486,8 @@ governorValidator params = stateTokenAssetClass :: AssetClass stateTokenAssetClass = governorStateTokenAssetClass params - proposalParams :: Proposal - proposalParams = + proposalDatum :: Proposal + proposalDatum = Proposal { governorSTAssetClass = stateTokenAssetClass } @@ -495,7 +496,7 @@ governorValidator params = proposalSymbol = mintingPolicySymbol policy where policy :: MintingPolicy - policy = mkMintingPolicy $ proposalPolicy proposalParams + policy = mkMintingPolicy $ proposalPolicy proposalDatum pproposalSym :: Term s PCurrencySymbol pproposalSym = phoistAcyclic $ pconstant proposalSymbol @@ -507,7 +508,7 @@ governorValidator params = hash = validatorHash validator validator :: Validator - validator = mkValidator $ proposalValidator proposalParams + validator = mkValidator $ proposalValidator proposalDatum pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress From 9eed91ff611dae81d3ee344adc4914d9506a50e6 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 23:11:38 +0800 Subject: [PATCH 033/107] update doc string for the 'governorValidator' --- agora/Agora/Governor.hs | 66 +++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 32 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index c187c56..128f762 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -42,7 +42,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PExecutable, PFinished, PVotingReady, PDraft), + PProposalStatus (PExecutable, PFinished, PDraft), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -159,11 +159,15 @@ PlutusTx.makeIsDataIndexed , ('MutateMutateGovernor, 2) ] --- | Parameters for creating Governor scripts. +{- | Parameters for creating Governor scripts. + + Governance State Token, aka GST, is an NFT which idetifies the governance state utxo. +-} data Governor = Governor - { stORef :: TxOutRef - -- ^ An utxo, which will be spent to mint the state token for the governor validator. - , stName :: TokenName + { gstORef :: TxOutRef + -- ^ Referenced utxo will be spent to mint the GST + , gstName :: TokenName + -- ^ Name of the GST token } -------------------------------------------------------------------------------- @@ -207,20 +211,19 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc -------------------------------------------------------------------------------- {- | Policy for Governors. - This policy mints a state token for the 'governorValidator'. - It will check: + This policy mints a GST. It perform the following checks: - The utxo specified in the Governor parameter is spent. - Only one token is minted. - - Ensure the token name is 'stName'. + - Ensure the token name is 'gstName'. -} governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy params = plam $ \_ ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' - let oref = pconstant params.stORef + let oref = pconstant params.gstORef ownSymbol = pownCurrencySymbol # ctx' - ownAssetClass = passetClass # ownSymbol # pconstant params.stName + ownAssetClass = passetClass # ownSymbol # pconstant params.gstName mintValue <- plet $ pownMintValue # ctx' @@ -234,31 +237,29 @@ governorPolicy params = {- Validator for Governors. - A state token, minted by 'governorPolicy' is used to identify the datum utxo. - No matter what redeemer it receives, it will always check: - - The utxo which has the state token must be spent. - - The state token always stays at the script address. - - The utxo which holds the state token, has a well well-formed 'GovernorDatum' datum. + - The utxo which has the GST must be spent. + - The GST always stays at the script address. + - The state utxo has a valid 'GovernorDatum' datum. - For 'CreateProposal' redeemer, it will check: - - Exactly one proposal state token is minted. - - Exactly one utxo should be sent to the proposal validator. - - The utxo must contain the proposal state token. - - The datum of said utxo must be correct. - - Proposal id in the governor datum must be advanced. + For 'CreateProposal' redeemers, it will check: + - Governance state 'nextProposalId' must be advanced. + - Exactly one proposal state token is minted, or rather, only one proposal is created. + - Exactly one utxo should be sent to the proposal validator. This utxo must contain the proposal state token, and has a valid datum of type 'ProposalDatum'. + - Said proposal copies its id and thresholds from the governor, is in draft state, and has zero votes. - For 'MintGATs' redeemer, it will check: - - State datum is not changed. - - Exactly one proposal is being processed. - - Select the right effect group. - - Mint one GAT for every effect. - - The GATs is properly tagged. (Should we do this?) - - The GATs are sent to the appropraite effects. (Should we do this?) + For 'MintGATs' redeemers, it will check: + - Governance state datum is not changed. + - Exactly one proposal(the input proposal) is being processed. + - The input proposal must be in executable state and have required amount of votes. + - An appropriate effect group is selected to be executed. + - A valid GAT is minted and sent to every effect, + - Exactly one utxo should be sent back to the proposal validator. This utxo must contain the proposal state token, and also has a valid datum of type 'ProposalDatum'(the output proposal). + - Said output proposal's status should be `Finished`. Other than that, nothing should be changed compare to the input proposal. - For 'MutateGovernor', it will check: - - A GAT is burnt. - - Said GAT must be tagged by the effect that is spending it. + For 'MutateGovernors' redeemers, it will check: + - Exactly one GAT is burnt. + - Said GAT must be valid. -} governorValidator :: Governor -> ClosedTerm PValidator governorValidator params = @@ -411,6 +412,7 @@ governorValidator params = passert "Proposal must be in executable state in order to execute effects" $ isProposalExecutable + -- TODO: not sure if I did the right thing, can't use haskell level constructor here let fields = pdcons @"id" # inputProposalDatum.id #$ pdcons @"effects" # inputProposalDatum.effects @@ -528,7 +530,7 @@ governorValidator params = -------------------------------------------------------------------------------- governorStateTokenAssetClass :: Governor -> AssetClass -governorStateTokenAssetClass gov = AssetClass (symbol, gov.stName) +governorStateTokenAssetClass gov = AssetClass (symbol, gov.gstName) where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov From d7b171ff908e9c06d898995e44e9e56c227cd2d4 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 23:15:16 +0800 Subject: [PATCH 034/107] yeet `containsSingleCurrencySymbol`; clean things up --- agora/Agora/Governor.hs | 32 ++++++++++++++++++-------------- agora/Agora/Utils.hs | 8 +------- 2 files changed, 19 insertions(+), 21 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 128f762..716ec46 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -42,7 +42,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum, PProposalId, - PProposalStatus (PExecutable, PFinished, PDraft), + PProposalStatus (PDraft, PExecutable, PFinished), PProposalThresholds, PProposalVotes (PProposalVotes), PResultTag (PResultTag), @@ -159,7 +159,7 @@ PlutusTx.makeIsDataIndexed , ('MutateMutateGovernor, 2) ] -{- | Parameters for creating Governor scripts. +{- | Parameters for creating Governor scripts. Governance State Token, aka GST, is an NFT which idetifies the governance state utxo. -} @@ -253,7 +253,7 @@ governorPolicy params = - Exactly one proposal(the input proposal) is being processed. - The input proposal must be in executable state and have required amount of votes. - An appropriate effect group is selected to be executed. - - A valid GAT is minted and sent to every effect, + - A valid GAT is minted and sent to every effect, - Exactly one utxo should be sent back to the proposal validator. This utxo must contain the proposal state token, and also has a valid datum of type 'ProposalDatum'(the output proposal). - Said output proposal's status should be `Finished`. Other than that, nothing should be changed compare to the input proposal. @@ -347,9 +347,9 @@ governorValidator params = let isProposalDraft = pmatch (pfromData proposalDatum.status) $ \case PDraft _ -> pconstant True - _ -> pconstant False + _ -> pconstant False - passert "Proposal state should be draft" $ isProposalDraft + passert "Proposal state should be draft" isProposalDraft popaque $ pconstant () PMintGATs _ -> P.do @@ -360,7 +360,8 @@ governorValidator params = inputsWithProposalStateToken <- plet $ pfilter - # ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) -> + # plam + ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> psymbolValueOf # pproposalSym # value #== 1 ) #$ pfromData txInfo.inputs @@ -368,7 +369,8 @@ governorValidator params = outputsWithProposalStateToken <- plet $ pfilter - # ( plam $ \((pfield @"value" #) -> value) -> + # plam + ( \((pfield @"value" #) -> value) -> psymbolValueOf # pproposalSym # value #== 1 ) #$ pfromData txInfo.outputs @@ -410,13 +412,13 @@ governorValidator params = PExecutable _ -> pconstant True _ -> pconstant False - passert "Proposal must be in executable state in order to execute effects" $ isProposalExecutable + passert "Proposal must be in executable state in order to execute effects" isProposalExecutable -- TODO: not sure if I did the right thing, can't use haskell level constructor here let fields = pdcons @"id" # inputProposalDatum.id #$ pdcons @"effects" # inputProposalDatum.effects - #$ pdcons @"status" # (pdata $ pcon $ PFinished pdnil) + #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) #$ pdcons @"cosigners" # inputProposalDatum.cosigners #$ pdcons @"thresholds" # inputProposalDatum.thresholds #$ pdcons @"votes" # inputProposalDatum.votes # pdnil @@ -424,7 +426,7 @@ governorValidator params = expectedOutputDatum = pforgetData $ pdata fields passert "Unexpected output proposal datum" $ - (pforgetData $ pdata outputProposalDatum') #== expectedOutputDatum + pforgetData (pdata outputProposalDatum') #== expectedOutputDatum -- TODO: anything else to check here? @@ -452,7 +454,8 @@ governorValidator params = outputsWithGAT <- plet $ pfilter - # ( plam $ \((pfield @"value" #) -> value) -> + # plam + ( \((pfield @"value" #) -> value) -> 0 #< psymbolValueOf # pgatSym # value ) #$ pfromData txInfo.outputs @@ -462,7 +465,8 @@ governorValidator params = popaque $ pfoldr - # ( plam $ \(pfromData -> output') _ -> P.do + # plam + ( \(pfromData -> output') _ -> P.do output <- pletFields @'["address", "datumHash"] $ output' let scriptHash = @@ -478,9 +482,9 @@ governorValidator params = passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' passert "Unexpected datum" $ datumHash #== expectedDatumHash - (pconstant ()) + pconstant () ) - # (pconstant ()) + # pconstant () # outputsWithGAT PMutateGovernor _ -> P.do popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 373abee..3c610a0 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -47,7 +47,6 @@ module Agora.Utils ( hasOnlyOneTokenOfAssetClass', hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', - containsSingleCurrencySymbol, mustBePJust, mustBePDJust, ) where @@ -554,11 +553,6 @@ mustFindDatum' = phoistAcyclic $ PJust dt <- pmatch $ pfindDatum # dh # info pfromData $ punsafeCoerce dt -containsSingleCurrencySymbol :: Term s (PValue :--> PBool) -containsSingleCurrencySymbol = phoistAcyclic $ - plam $ \v -> P.do - (plength #$ pto $ pto $ pto v) #== 1 - mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a) mustBePJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case @@ -569,4 +563,4 @@ mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :-- mustBePDJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case PDJust ((pfield @"_0" #) -> v) -> v - _ -> ptraceError emsg \ No newline at end of file + _ -> ptraceError emsg From 4ec55eb81ae980dae61823643f5a26fd388d6856 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 21 Apr 2022 23:34:04 +0800 Subject: [PATCH 035/107] fix missing documentation for `governorValidator` --- agora/Agora/Governor.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 716ec46..1388594 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -22,8 +22,8 @@ module Agora.Governor ( governorValidator, -- * Utilities - governorStateTokenAssetClass, - authorityTokenSymbolFromGovernor, + gstAssetClass, + gatSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -235,7 +235,7 @@ governorPolicy params = popaque (pconstant ()) -{- Validator for Governors. +{- | Validator for Governors. No matter what redeemer it receives, it will always check: - The utxo which has the GST must be spent. @@ -490,7 +490,7 @@ governorValidator params = popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass - stateTokenAssetClass = governorStateTokenAssetClass params + stateTokenAssetClass = gstAssetClass params proposalDatum :: Proposal proposalDatum = @@ -523,7 +523,7 @@ governorValidator params = stateTokenValueOf = passetClassValueOf' stateTokenAssetClass pgatSym :: Term s PCurrencySymbol - pgatSym = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor params + pgatSym = phoistAcyclic $ pconstant $ gatSymbolFromGovernor params pyesResultTag :: Term s PResultTag pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 @@ -533,8 +533,8 @@ governorValidator params = -------------------------------------------------------------------------------- -governorStateTokenAssetClass :: Governor -> AssetClass -governorStateTokenAssetClass gov = AssetClass (symbol, gov.gstName) +gstAssetClass :: Governor -> AssetClass +gstAssetClass gov = AssetClass (symbol, gov.gstName) where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov @@ -542,8 +542,8 @@ governorStateTokenAssetClass gov = AssetClass (symbol, gov.gstName) symbol :: CurrencySymbol symbol = mintingPolicySymbol policy -authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol -authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy +gatSymbolFromGovernor :: Governor -> CurrencySymbol +gatSymbolFromGovernor gov = mintingPolicySymbol policy where - params = AuthorityToken $ governorStateTokenAssetClass gov + params = AuthorityToken $ gstAssetClass gov policy = mkMintingPolicy $ authorityTokenPolicy params From 3ba0abb1799b253c426c91ba66c724dfe6320fc1 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 22 Apr 2022 13:54:03 +0800 Subject: [PATCH 036/107] consistent naming --- agora/Agora/Governor.hs | 47 ++++++++++++++++++----------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 1388594..20d66d4 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -23,7 +23,6 @@ module Agora.Governor ( -- * Utilities gstAssetClass, - gatSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -112,8 +111,6 @@ import Plutus.V1.Ledger.Api ( CurrencySymbol (..), MintingPolicy, TxOutRef, - Validator, - ValidatorHash, ) import Plutus.V1.Ledger.Value ( AssetClass (..), @@ -218,12 +215,12 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc - Ensure the token name is 'gstName'. -} governorPolicy :: Governor -> ClosedTerm PMintingPolicy -governorPolicy params = +governorPolicy gov = plam $ \_ ctx' -> P.do ctx <- pletFields @'["txInfo", "purpose"] ctx' - let oref = pconstant params.gstORef + let oref = pconstant gov.gstORef ownSymbol = pownCurrencySymbol # ctx' - ownAssetClass = passetClass # ownSymbol # pconstant params.gstName + ownAssetClass = passetClass # ownSymbol # pconstant gov.gstName mintValue <- plet $ pownMintValue # ctx' @@ -262,7 +259,7 @@ governorPolicy params = - Said GAT must be valid. -} governorValidator :: Governor -> ClosedTerm PValidator -governorValidator params = +governorValidator gov = plam $ \datum' redeemer' ctx' -> P.do -- TODO: use ptryFrom redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' @@ -307,7 +304,7 @@ governorValidator params = pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pproposalSym # txInfo.mint + hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint outputs <- plet $ findOutputsToAddress # ctx.txInfo # pproposalValidatorAddress passert "Exactly one utxo should be sent to the proposal validator" $ @@ -315,7 +312,7 @@ governorValidator params = output <- pletFields @'["value", "datumHash"] $ phead # outputs passert "The proposal state token must be sent to the proposal validator" $ - psymbolValueOf # pproposalSym # output.value #== 1 + psymbolValueOf # pproposalSymbol # output.value #== 1 passert "The utxo paid to the proposal validator must have datum" $ pisDJust # output.datumHash @@ -362,7 +359,7 @@ governorValidator params = pfilter # plam ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> - psymbolValueOf # pproposalSym # value #== 1 + psymbolValueOf # pproposalSymbol # value #== 1 ) #$ pfromData txInfo.inputs @@ -371,13 +368,13 @@ governorValidator params = pfilter # plam ( \((pfield @"value" #) -> value) -> - psymbolValueOf # pproposalSym # value #== 1 + psymbolValueOf # pproposalSymbol # value #== 1 ) #$ pfromData txInfo.outputs passert "The governor can only process one proposal at a time" $ plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # pproposalSym #$ pvalueSpent # txInfo') #== 1 + #&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 proposalInputTxOut <- pletFields @'["address", "value", "datumHash"] $ @@ -449,7 +446,7 @@ governorValidator params = gatCount <- plet $ plength #$ pto $ pto effects passert "Required amount of GATs should be minted" $ - psymbolValueOf # pproposalSym # txInfo.mint #== gatCount + psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount outputsWithGAT <- plet $ @@ -490,7 +487,7 @@ governorValidator params = popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass - stateTokenAssetClass = gstAssetClass params + stateTokenAssetClass = gstAssetClass gov proposalDatum :: Proposal proposalDatum = @@ -501,19 +498,15 @@ governorValidator params = proposalSymbol :: CurrencySymbol proposalSymbol = mintingPolicySymbol policy where - policy :: MintingPolicy policy = mkMintingPolicy $ proposalPolicy proposalDatum - pproposalSym :: Term s PCurrencySymbol - pproposalSym = phoistAcyclic $ pconstant proposalSymbol + pproposalSymbol :: Term s PCurrencySymbol + pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol proposalValidatorAddress :: Address proposalValidatorAddress = Address (ScriptCredential hash) Nothing where - hash :: ValidatorHash hash = validatorHash validator - - validator :: Validator validator = mkValidator $ proposalValidator proposalDatum pproposalValidatorAddress :: Term s PAddress @@ -522,8 +515,14 @@ governorValidator params = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass + gatSymbol :: CurrencySymbol + gatSymbol = mintingPolicySymbol policy + where + at = AuthorityToken $ gstAssetClass gov + policy = mkMintingPolicy $ authorityTokenPolicy at + pgatSym :: Term s PCurrencySymbol - pgatSym = phoistAcyclic $ pconstant $ gatSymbolFromGovernor params + pgatSym = phoistAcyclic $ pconstant $ gatSymbol pyesResultTag :: Term s PResultTag pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 @@ -541,9 +540,3 @@ gstAssetClass gov = AssetClass (symbol, gov.gstName) symbol :: CurrencySymbol symbol = mintingPolicySymbol policy - -gatSymbolFromGovernor :: Governor -> CurrencySymbol -gatSymbolFromGovernor gov = mintingPolicySymbol policy - where - params = AuthorityToken $ gstAssetClass gov - policy = mkMintingPolicy $ authorityTokenPolicy params From 1e965a73637a481cf7b06edcff1cba70a9b45c8a Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 22 Apr 2022 14:42:00 +0800 Subject: [PATCH 037/107] fix compilation erros; format && lint Co-authored-by: Emily Martins --- agora/Agora/Governor.hs | 11 ++++------- agora/Agora/Proposal.hs | 4 ++-- agora/Agora/Utils.hs | 3 +++ 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 20d66d4..46807ca 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -87,8 +87,6 @@ import Plutarch.Api.V1 ( validatorHash, ) import Plutarch.Api.V1.Extra ( - passetClass, - passetClassValueOf, pownMintValue, ) import Plutarch.DataRepr ( @@ -220,7 +218,6 @@ governorPolicy gov = ctx <- pletFields @'["txInfo", "purpose"] ctx' let oref = pconstant gov.gstORef ownSymbol = pownCurrencySymbol # ctx' - ownAssetClass = passetClass # ownSymbol # pconstant gov.gstName mintValue <- plet $ pownMintValue # ctx' @@ -228,7 +225,7 @@ governorPolicy gov = passert "Exactly one token should be minted" $ psymbolValueOf # ownSymbol # mintValue #== 1 - #&& passetClassValueOf # ownSymbol # pconstant governorStateTokenName # mintValue #== 1 + #&& passetClassValueOf # ownSymbol # pconstant gov.gstName # mintValue #== 1 popaque (pconstant ()) @@ -515,14 +512,14 @@ governorValidator gov = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - gatSymbol :: CurrencySymbol - gatSymbol = mintingPolicySymbol policy + gatSymbol :: CurrencySymbol + gatSymbol = mintingPolicySymbol policy where at = AuthorityToken $ gstAssetClass gov policy = mkMintingPolicy $ authorityTokenPolicy at pgatSym :: Term s PCurrencySymbol - pgatSym = phoistAcyclic $ pconstant $ gatSymbol + pgatSym = phoistAcyclic $ pconstant gatSymbol pyesResultTag :: Term s PResultTag pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 52b199d..ffca57a 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -178,10 +178,10 @@ emptyVotesFor = ProposalVotes . AssocMap.mapWithKey (const . const 0) data ProposalDatum = ProposalDatum { proposalId :: ProposalId -- ^ Identification of the proposal. - , -- TODO: could we encode this more efficiently? + -- TODO: could we encode this more efficiently? -- This is shaped this way for future proofing. -- See https://github.com/Liqwid-Labs/agora/issues/39 - effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)] + , effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)] -- ^ Effect lookup table. First by result, then by effect hash. , status :: ProposalStatus -- ^ The status the proposal is in. diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 3c610a0..9d4ca86 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -510,6 +510,7 @@ findTxOutDatum = phoistAcyclic $ PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # datums _ -> pcon PNothing +<<<<<<< HEAD {- | Safely convert a 'PValidatorHash' into a 'PTokenName'. This can be useful for tagging tokens for extra safety. -} @@ -524,6 +525,8 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh)) getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v +======= +>>>>>>> 93fe9ca (fix compilation erros; format && lint) hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ plam $ \vs -> P.do From ab0151cbd2adb1d52fbfbb7aeab903523cdf358b Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 22 Apr 2022 18:44:42 +0800 Subject: [PATCH 038/107] expose util function `gatSymbol` --- agora/Agora/Governor.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 46807ca..33cd410 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -23,6 +23,7 @@ module Agora.Governor ( -- * Utilities gstAssetClass, + gatSymbol, ) where -------------------------------------------------------------------------------- @@ -97,12 +98,12 @@ import Plutarch.DataRepr ( import Plutarch.Lift (PUnsafeLiftDecl (..)) import Plutarch.Monadic qualified as P import Plutarch.Unsafe (punsafeCoerce) - --------------------------------------------------------------------------------- - import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra (plookup, plookup') import Plutarch.SafeMoney (puntag) + +-------------------------------------------------------------------------------- + import Plutus.V1.Ledger.Api ( Address (Address), Credential (ScriptCredential), @@ -512,14 +513,8 @@ governorValidator gov = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - gatSymbol :: CurrencySymbol - gatSymbol = mintingPolicySymbol policy - where - at = AuthorityToken $ gstAssetClass gov - policy = mkMintingPolicy $ authorityTokenPolicy at - pgatSym :: Term s PCurrencySymbol - pgatSym = phoistAcyclic $ pconstant gatSymbol + pgatSym = phoistAcyclic $ pconstant $ gatSymbol gov pyesResultTag :: Term s PResultTag pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 @@ -537,3 +532,9 @@ gstAssetClass gov = AssetClass (symbol, gov.gstName) symbol :: CurrencySymbol symbol = mintingPolicySymbol policy + +gatSymbol :: Governor -> CurrencySymbol +gatSymbol gov = mintingPolicySymbol policy + where + at = AuthorityToken $ gstAssetClass gov + policy = mkMintingPolicy $ authorityTokenPolicy at \ No newline at end of file From cda1edeffc3833530a5d43203b7c28262385c2e1 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 23 Apr 2022 00:04:35 +0800 Subject: [PATCH 039/107] rewrite the doc for governor components ... also explain what GST is --- agora.cabal | 3 + agora/Agora/Governor.hs | 149 +++++++++++++++++++++++++++++----------- 2 files changed, 112 insertions(+), 40 deletions(-) diff --git a/agora.cabal b/agora.cabal index b55630b..9edb978 100644 --- a/agora.cabal +++ b/agora.cabal @@ -159,7 +159,10 @@ test-suite agora-test hs-source-dirs: agora-test other-modules: Spec.AuthorityToken +<<<<<<< HEAD Spec.Effect.TreasuryWithdrawal +======= +>>>>>>> 0f1b4f3 (rewrite the doc for governor components) Spec.Model.MultiSig Spec.Proposal Spec.Sample.Effect.TreasuryWithdrawal diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 33cd410..cda7d68 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -2,12 +2,15 @@ {- | Module : Agora.Governor -Maintainer : emi@haskell.fyi +Maintainer : chfanghr@gmail.com Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} module Agora.Governor ( + -- * GST + -- $gst + -- * Haskell-land GovernorDatum (..), GovernorRedeemer (..), @@ -90,17 +93,17 @@ import Plutarch.Api.V1 ( import Plutarch.Api.V1.Extra ( pownMintValue, ) +import Plutarch.Builtin (pforgetData) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift (PUnsafeLiftDecl (..)) -import Plutarch.Monadic qualified as P -import Plutarch.Unsafe (punsafeCoerce) -import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra (plookup, plookup') +import Plutarch.Monadic qualified as P import Plutarch.SafeMoney (puntag) +import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- @@ -119,7 +122,17 @@ import PlutusTx qualified -------------------------------------------------------------------------------- --- | Datum for the Governor script. +{- $gst + Governance state token, aka. GST, it's a NFT that identifies an UTXO that carries the state datum of the Governance script. + + This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. + + The 'governorValidator' ensures that exactly one GST stays at the address of itself forever. +-} + +-------------------------------------------------------------------------------- + +-- | State datum for the Governor script. data GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. @@ -145,25 +158,22 @@ data GovernorRedeemer -- and allows minting GATs for each effect script. MintGATs | -- | Allows effects to mutate the parameters. - MutateMutateGovernor + MutateGovernor deriving stock (Show, GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorRedeemer [ ('CreateProposal, 0) , ('MintGATs, 1) - , ('MutateMutateGovernor, 2) + , ('MutateGovernor, 2) ] -{- | Parameters for creating Governor scripts. - - Governance State Token, aka GST, is an NFT which idetifies the governance state utxo. --} +-- | Parameters for creating Governor scripts. data Governor = Governor { gstORef :: TxOutRef - -- ^ Referenced utxo will be spent to mint the GST + -- ^ Referenced utxo will be spent to mint the GST. , gstName :: TokenName - -- ^ Name of the GST token + -- ^ Name of the GST token. } -------------------------------------------------------------------------------- @@ -206,23 +216,27 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc -------------------------------------------------------------------------------- -{- | Policy for Governors. - This policy mints a GST. It perform the following checks: +{- | Policy for minting GSTs. - - The utxo specified in the Governor parameter is spent. - - Only one token is minted. + This policy perform the following checks: + + - The UTXO referenced in the parameter is spent in the transaction. + - Exactly one GST is minted. - Ensure the token name is 'gstName'. + + NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator. + We /can't/ really check this in the policy, otherwise we create a cyclic reference issue. -} governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy gov = plam $ \_ ctx' -> P.do - ctx <- pletFields @'["txInfo", "purpose"] ctx' let oref = pconstant gov.gstORef ownSymbol = pownCurrencySymbol # ctx' mintValue <- plet $ pownMintValue # ctx' - passert "Referenced utxo should be spent" $ pisUxtoSpent # oref # ctx.txInfo + passert "Referenced utxo should be spent" $ + pisUxtoSpent # oref #$ pfield @"txInfo" # ctx' passert "Exactly one token should be minted" $ psymbolValueOf # ownSymbol # mintValue #== 1 @@ -232,29 +246,78 @@ governorPolicy gov = {- | Validator for Governors. - No matter what redeemer it receives, it will always check: - - The utxo which has the GST must be spent. - - The GST always stays at the script address. - - The state utxo has a valid 'GovernorDatum' datum. +== Common checks - For 'CreateProposal' redeemers, it will check: - - Governance state 'nextProposalId' must be advanced. - - Exactly one proposal state token is minted, or rather, only one proposal is created. - - Exactly one utxo should be sent to the proposal validator. This utxo must contain the proposal state token, and has a valid datum of type 'ProposalDatum'. - - Said proposal copies its id and thresholds from the governor, is in draft state, and has zero votes. +The validator always ensures: - For 'MintGATs' redeemers, it will check: - - Governance state datum is not changed. - - Exactly one proposal(the input proposal) is being processed. - - The input proposal must be in executable state and have required amount of votes. - - An appropriate effect group is selected to be executed. - - A valid GAT is minted and sent to every effect, - - Exactly one utxo should be sent back to the proposal validator. This utxo must contain the proposal state token, and also has a valid datum of type 'ProposalDatum'(the output proposal). - - Said output proposal's status should be `Finished`. Other than that, nothing should be changed compare to the input proposal. + - The UTXO which holds the GST must be spent. + - The GST always stays at the validator's address. + - The new state UTXO has a valid datum of type 'GovernorDatum'. - For 'MutateGovernors' redeemers, it will check: - - Exactly one GAT is burnt. - - Said GAT must be valid. +== Creating a Proposal + +When the redeemer is 'CreateProposal', the script will check: + +- For governor's state datum: + + * 'nextProposalId' is advanced. + * Nothing is changed other that that. + +- Exactly one new proposal state token is minted. +- Exactly one UTXO is sent to the proposal validator, this UTXO must: + + * Hold the newly minted proposal state token. + * Have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must: + + - Copy its id and thresholds from the governor's state. + - Have status set to 'Proposal.Draft'. + - Have zero votes. + - TODO: should we check cosigners? + +== Minting GATs + +When the redeemer is 'MintGATs', the script will check: + +- Governor's state is not changed. +- Exactly only one proposal is in the inputs. Let's call this the /input proposal/. +- The proposal is in the 'Proposal.Executable' state. + +NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs. + +=== Effect Group Selection + +Currently a proposal can two or more than two options to vote on, + meaning that it can conatinas two or more effect groups, + according to [#39](https://github.com/Liqwid-Labs/agora/issues/39). + +Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. + This is checked by 'Proposal.proposalDatumValid'. + +The script will look at the the 'Proposal.votes' to determine which group has the highest votes, + said group shoud be executed. + +During the process, minimum votes requirement will also be enforced. + +Next, the script will: + +- Ensure that for every effect in the said effect group, + exactly one valid GAT is minted and sent to the effect. +- The amount of GAT minted in the transaction should be equal to the number of effects. +- A new UTXO is sent to the proposal validator, this UTXO should: + + * Include the one proposal state token. + * Have a valid datum of type 'Proposal.ProposalDatum'. + This datum should be as same as the one of the input proposal, + except its status should be 'Proposal.Finished'. + +== Changing the State + +Redeemer 'MutateGovernor' allows the state datum to be changed by an external effect. + +In this case, the script will check + +- Exactly one GAT is burnt in the transaction. +- Said GAT is tagged by the effect. -} governorValidator :: Governor -> ClosedTerm PValidator governorValidator gov = @@ -301,6 +364,8 @@ governorValidator gov = passert "Proposal id should be advanced by 1" $ pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId + -- TODO: check other fields of the state datum + passert "Exactly one proposal token must be minted" $ hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint @@ -425,6 +490,8 @@ governorValidator gov = -- TODO: anything else to check here? + -- TODO: support more than two effect group. + PProposalVotes votes' <- pmatch $ pfromData inputProposalDatum.votes votes <- plet votes' @@ -524,6 +591,7 @@ governorValidator gov = -------------------------------------------------------------------------------- +-- | Get the assetclass of GST from governor parameters. gstAssetClass :: Governor -> AssetClass gstAssetClass gov = AssetClass (symbol, gov.gstName) where @@ -533,8 +601,9 @@ gstAssetClass gov = AssetClass (symbol, gov.gstName) symbol :: CurrencySymbol symbol = mintingPolicySymbol policy +-- | Get the currency symbol of GAT from governor parameters. gatSymbol :: Governor -> CurrencySymbol gatSymbol gov = mintingPolicySymbol policy where at = AuthorityToken $ gstAssetClass gov - policy = mkMintingPolicy $ authorityTokenPolicy at \ No newline at end of file + policy = mkMintingPolicy $ authorityTokenPolicy at From 18dce71f72d44bcfcc3c207a2312f2e0cfd599b8 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 23 Apr 2022 16:21:23 +0800 Subject: [PATCH 040/107] doc string for util functions --- agora.cabal | 3 --- agora/Agora/Utils.hs | 13 +++++++++---- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/agora.cabal b/agora.cabal index 9edb978..b55630b 100644 --- a/agora.cabal +++ b/agora.cabal @@ -159,10 +159,7 @@ test-suite agora-test hs-source-dirs: agora-test other-modules: Spec.AuthorityToken -<<<<<<< HEAD Spec.Effect.TreasuryWithdrawal -======= ->>>>>>> 0f1b4f3 (rewrite the doc for governor components) Spec.Model.MultiSig Spec.Proposal Spec.Sample.Effect.TreasuryWithdrawal diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 9d4ca86..9eb0945 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -510,7 +510,6 @@ findTxOutDatum = phoistAcyclic $ PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # datums _ -> pcon PNothing -<<<<<<< HEAD {- | Safely convert a 'PValidatorHash' into a 'PTokenName'. This can be useful for tagging tokens for extra safety. -} @@ -525,8 +524,7 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh)) getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v -======= ->>>>>>> 93fe9ca (fix compilation erros; format && lint) +-- | The entire value only contains one token of the specific assetclass. hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ plam $ \vs -> P.do @@ -536,13 +534,14 @@ hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ #&& passetClassValueOf' ac # vs #== 1 #&& (plength #$ pto $ pto $ pto vs) #== 1 +-- | The entire value only contains one token of the specific currency symbol. hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ plam $ \cs vs -> P.do psymbolValueOf # cs # vs #== 1 #&& (plength #$ pto $ pto $ pto vs) #== 1 -{- Find datum, in an unsafe manner. +{- Find datum given a maybe datum hash, in an unsafe manner. FIXME: reimplement using 'ptryFrom'. -} @@ -556,12 +555,18 @@ mustFindDatum' = phoistAcyclic $ PJust dt <- pmatch $ pfindDatum # dh # info pfromData $ punsafeCoerce dt +{- | Extract the value stored in a PMaybe container. + If there's no value, throw an error with the given message. +-} mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a) mustBePJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case PJust v -> v _ -> ptraceError emsg +{- | Extract the value stored in a PMaybeData container. + If there's no value, throw an error with the given message. +-} mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a) mustBePDJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case From ba1996244855a2940b2f1730ce1d9206ea50197e Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 23 Apr 2022 18:16:02 +0800 Subject: [PATCH 041/107] support more than two effect groups/vote outcomes --- agora/Agora/Governor.hs | 113 +++++++++++++++++++++++----------------- 1 file changed, 65 insertions(+), 48 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index cda7d68..70dea8b 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -47,8 +47,6 @@ import Agora.Proposal ( PProposalId, PProposalStatus (PDraft, PExecutable, PFinished), PProposalThresholds, - PProposalVotes (PProposalVotes), - PResultTag (PResultTag), Proposal (..), ProposalId, ProposalThresholds, @@ -68,6 +66,7 @@ import Agora.Utils ( passetClassValueOf', pfindTxInByTxOutRef, pisDJust, + pisJust, pisUxtoSpent, pownCurrencySymbol, psymbolValueOf, @@ -81,9 +80,13 @@ import Plutarch (popaque) import Plutarch.Api.V1 ( PAddress, PCurrencySymbol, + PDatumHash, + PMap, PMintingPolicy, PScriptPurpose (PSpending), + PTxOut, PValidator, + PValidatorHash, PValue, mintingPolicySymbol, mkMintingPolicy, @@ -286,27 +289,27 @@ NOTE: The input proposal is found by looking for the UTXO with a proposal state === Effect Group Selection -Currently a proposal can two or more than two options to vote on, - meaning that it can conatinas two or more effect groups, +Currently a proposal can two or more than two options to vote on, + meaning that it can conatinas two or more effect groups, according to [#39](https://github.com/Liqwid-Labs/agora/issues/39). -Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. +Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. This is checked by 'Proposal.proposalDatumValid'. -The script will look at the the 'Proposal.votes' to determine which group has the highest votes, +The script will look at the the 'Proposal.votes' to determine which group has the highest votes, said group shoud be executed. During the process, minimum votes requirement will also be enforced. Next, the script will: -- Ensure that for every effect in the said effect group, +- Ensure that for every effect in the said effect group, exactly one valid GAT is minted and sent to the effect. - The amount of GAT minted in the transaction should be equal to the number of effects. - A new UTXO is sent to the proposal validator, this UTXO should: * Include the one proposal state token. - * Have a valid datum of type 'Proposal.ProposalDatum'. + * Have a valid datum of type 'Proposal.ProposalDatum'. This datum should be as same as the one of the input proposal, except its status should be 'Proposal.Finished'. @@ -490,25 +493,36 @@ governorValidator gov = -- TODO: anything else to check here? - -- TODO: support more than two effect group. + let highestVoteFolder = + phoistAcyclic $ + plam + ( \pair last' -> + pif + (pisJust # last') + ( P.do + PJust last <- pmatch last' + let lastHighestVote = pfromData $ psndBuiltin # last + thisVote = pfromData $ psndBuiltin # pair + pif (lastHighestVote #< thisVote) (pcon $ PJust pair) last' + ) + (pcon $ PJust pair) + ) - PProposalVotes votes' <- pmatch $ pfromData inputProposalDatum.votes - votes <- plet votes' + winner' = + pfoldr # highestVoteFolder # (pcon $ PNothing) #$ pto $ pto $ pfromData inputProposalDatum.votes - let minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds + winner <- plet $ mustBePJust # "Empty votes" # winner' - yesVotes = plookup' # pyesResultTag # votes - noVotes = plookup' # pnoResultTag # votes - biggerVotes = pif (yesVotes #< noVotes) noVotes yesVotes + let highestVote = pfromData $ psndBuiltin # winner + minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds - passert "Number of votes doesn't meet the minimum requirement" $ - minimumVotes #< biggerVotes + passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote - let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag + let finalResultTag = pfromData $ pfstBuiltin # winner - effects <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects + effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects - gatCount <- plet $ plength #$ pto $ pto effects + gatCount <- plet $ plength #$ pto $ pto effectGroup passert "Required amount of GATs should be minted" $ psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount @@ -516,36 +530,45 @@ governorValidator gov = outputsWithGAT <- plet $ pfilter - # plam - ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSym # value + # ( phoistAcyclic $ + plam + ( \((pfield @"value" #) -> value) -> + 0 #< psymbolValueOf # pgatSym # value + ) ) #$ pfromData txInfo.outputs passert "Output GATs is more than minted GATs" $ plength # outputsWithGAT #== gatCount + let gatOutputValidator' :: Term s ((PMap PValidatorHash PDatumHash) :--> (PAsData PTxOut) :--> PUnit :--> PUnit) + gatOutputValidator' = + phoistAcyclic $ + plam + ( \effects (pfromData -> output') _ -> P.do + output <- pletFields @'["address", "datumHash"] $ output' + + let scriptHash = + mustBePJust # "GAT receiver is not a script" + #$ scriptHashFromAddress # output.address + datumHash = + mustBePDJust # "Output to effect should have datum" + #$ output.datumHash + + expectedDatumHash = + mustBePJust # "Receiver is not in the effect list" + #$ plookup # scriptHash # effects + + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' + passert "Unexpected datum" $ datumHash #== expectedDatumHash + pconstant () + ) + + gatOutputValidator = gatOutputValidator' # effectGroup + popaque $ pfoldr - # plam - ( \(pfromData -> output') _ -> P.do - output <- pletFields @'["address", "datumHash"] $ output' - - let scriptHash = - mustBePJust # "GAT receiver is not a script" - #$ scriptHashFromAddress # output.address - datumHash = - mustBePDJust # "Output to effect should have datum" - #$ output.datumHash - - expectedDatumHash = - mustBePJust # "Receiver is not in the effect list" - #$ plookup # scriptHash # effects - - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' - passert "Unexpected datum" $ datumHash #== expectedDatumHash - pconstant () - ) + # gatOutputValidator # pconstant () # outputsWithGAT PMutateGovernor _ -> P.do @@ -583,12 +606,6 @@ governorValidator gov = pgatSym :: Term s PCurrencySymbol pgatSym = phoistAcyclic $ pconstant $ gatSymbol gov - pyesResultTag :: Term s PResultTag - pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1 - - pnoResultTag :: Term s PResultTag - pnoResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 0 - -------------------------------------------------------------------------------- -- | Get the assetclass of GST from governor parameters. From 430f5ba427a6601908fdf16c4d0a8ccd89c784b9 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 23 Apr 2022 18:40:24 +0800 Subject: [PATCH 042/107] properly check state datum when creat a proposal --- agora/Agora/Governor.hs | 52 +++++++++++++++++++++++++---------------- 1 file changed, 32 insertions(+), 20 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 70dea8b..49bd9f0 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -43,7 +43,7 @@ import Agora.AuthorityToken ( singleAuthorityTokenBurned, ) import Agora.Proposal ( - PProposalDatum, + PProposalDatum (..), PProposalId, PProposalStatus (PDraft, PExecutable, PFinished), PProposalThresholds, @@ -64,6 +64,7 @@ import Agora.Utils ( passert, passetClassValueOf, passetClassValueOf', + pfindDatum, pfindTxInByTxOutRef, pisDJust, pisJust, @@ -358,16 +359,28 @@ governorValidator gov = passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash - -- TODO: use `PTryFrom` and reject bad datum - newDatum' <- plet $ mustFindDatum' @PGovernorDatum # ownOutput.datumHash # ctx.txInfo - newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum' + let outputGovernorStateDatumHash = mustBePDJust # "Output governor state datum hash not found" # ownOutput.datumHash + + newDatumData <- + plet $ + pforgetData $ + pdata $ + mustBePJust # "Ouput governor state datum not found" + #$ pfindDatum # outputGovernorStateDatumHash # txInfo' case redeemer of PCreateProposal _ -> P.do - passert "Proposal id should be advanced by 1" $ - pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId + let expectedNextProposalId = pnextProposalId # oldParams.nextProposalId - -- TODO: check other fields of the state datum + expectedNewDatum :: Term _ PGovernorDatum + expectedNewDatum = + pcon $ + PGovernorDatum $ + pdcons @"proposalThresholds" # oldParams.proposalThresholds + #$ pdcons @"nextProposalId" # pdata expectedNextProposalId # pdnil + + passert "Unexpected governor state datum" $ + newDatumData #== (pforgetData $ pdata $ expectedNewDatum) passert "Exactly one proposal token must be minted" $ hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint @@ -416,9 +429,7 @@ governorValidator gov = popaque $ pconstant () PMintGATs _ -> P.do - passert "Governor state should not be changed" $ - -- FIXME: There should be a better way to do this - (pforgetData $ pdata newDatum') #== datum' + passert "Governor state should not be changed" $ newDatumData #== datum' inputsWithProposalStateToken <- plet $ @@ -477,16 +488,17 @@ governorValidator gov = passert "Proposal must be in executable state in order to execute effects" isProposalExecutable - -- TODO: not sure if I did the right thing, can't use haskell level constructor here - let fields = - pdcons @"id" # inputProposalDatum.id - #$ pdcons @"effects" # inputProposalDatum.effects - #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) - #$ pdcons @"cosigners" # inputProposalDatum.cosigners - #$ pdcons @"thresholds" # inputProposalDatum.thresholds - #$ pdcons @"votes" # inputProposalDatum.votes # pdnil - - expectedOutputDatum = pforgetData $ pdata fields + let expectedOutputDatum = + pforgetData $ + pdata $ + pcon $ + PProposalDatum $ + pdcons @"id" # inputProposalDatum.id + #$ pdcons @"effects" # inputProposalDatum.effects + #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) + #$ pdcons @"cosigners" # inputProposalDatum.cosigners + #$ pdcons @"thresholds" # inputProposalDatum.thresholds + #$ pdcons @"votes" # inputProposalDatum.votes # pdnil passert "Unexpected output proposal datum" $ pforgetData (pdata outputProposalDatum') #== expectedOutputDatum From 03c8009e277a2648c5fd11eaffcc68125c4ba4ac Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 23 Apr 2022 18:46:38 +0800 Subject: [PATCH 043/107] clean up; apply hlint suggestions; format --- agora/Agora/Governor.hs | 20 ++++++++++---------- agora/Agora/Utils.hs | 4 ++-- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 49bd9f0..4e24194 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -371,8 +371,6 @@ governorValidator gov = case redeemer of PCreateProposal _ -> P.do let expectedNextProposalId = pnextProposalId # oldParams.nextProposalId - - expectedNewDatum :: Term _ PGovernorDatum expectedNewDatum = pcon $ PGovernorDatum $ @@ -380,7 +378,7 @@ governorValidator gov = #$ pdcons @"nextProposalId" # pdata expectedNextProposalId # pdnil passert "Unexpected governor state datum" $ - newDatumData #== (pforgetData $ pdata $ expectedNewDatum) + newDatumData #== pforgetData (pdata expectedNewDatum) passert "Exactly one proposal token must be minted" $ hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint @@ -520,8 +518,10 @@ governorValidator gov = (pcon $ PJust pair) ) + votesList = pto $ pto $ pfromData inputProposalDatum.votes + winner' = - pfoldr # highestVoteFolder # (pcon $ PNothing) #$ pto $ pto $ pfromData inputProposalDatum.votes + pfoldr # highestVoteFolder # (pcon PNothing) # votesList winner <- plet $ mustBePJust # "Empty votes" # winner' @@ -542,13 +542,13 @@ governorValidator gov = outputsWithGAT <- plet $ pfilter - # ( phoistAcyclic $ - plam - ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSym # value - ) + # phoistAcyclic + ( plam + ( \((pfield @"value" #) -> value) -> + 0 #< psymbolValueOf # pgatSym # value + ) ) - #$ pfromData txInfo.outputs + # pfromData txInfo.outputs passert "Output GATs is more than minted GATs" $ plength # outputsWithGAT #== gatCount diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 9eb0945..fddd440 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -555,7 +555,7 @@ mustFindDatum' = phoistAcyclic $ PJust dt <- pmatch $ pfindDatum # dh # info pfromData $ punsafeCoerce dt -{- | Extract the value stored in a PMaybe container. +{- | Extract the value stored in a PMaybe container. If there's no value, throw an error with the given message. -} mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a) @@ -564,7 +564,7 @@ mustBePJust = phoistAcyclic $ PJust v -> v _ -> ptraceError emsg -{- | Extract the value stored in a PMaybeData container. +{- | Extract the value stored in a PMaybeData container. If there's no value, throw an error with the given message. -} mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a) From 3dacc932cae9908990c06ed1cf52057ce57aa7aa Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 25 Apr 2022 19:35:14 +0800 Subject: [PATCH 044/107] fix some typos :) --- agora/Agora/Governor.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 4e24194..1cf9c64 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -127,7 +127,7 @@ import PlutusTx qualified -------------------------------------------------------------------------------- {- $gst - Governance state token, aka. GST, it's a NFT that identifies an UTXO that carries the state datum of the Governance script. + Governance state token, aka. GST, is an NFT that identifies an UTXO that carries the state datum of the Governance script. This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. @@ -290,8 +290,8 @@ NOTE: The input proposal is found by looking for the UTXO with a proposal state === Effect Group Selection -Currently a proposal can two or more than two options to vote on, - meaning that it can conatinas two or more effect groups, +Currently a proposal can have two or more than two options to vote on, + meaning that it can contains two or more effect groups, according to [#39](https://github.com/Liqwid-Labs/agora/issues/39). Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. From fdbafcce8989e7025b9b2adae8c2801d3932a724 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 25 Apr 2022 19:37:42 +0800 Subject: [PATCH 045/107] apply naming suggestions by @emiflake --- agora/Agora/Governor.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 1cf9c64..6b3c888 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -174,7 +174,7 @@ PlutusTx.makeIsDataIndexed -- | Parameters for creating Governor scripts. data Governor = Governor - { gstORef :: TxOutRef + { gstOutRef :: TxOutRef -- ^ Referenced utxo will be spent to mint the GST. , gstName :: TokenName -- ^ Name of the GST token. @@ -234,7 +234,7 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy gov = plam $ \_ ctx' -> P.do - let oref = pconstant gov.gstORef + let oref = pconstant gov.gstOutRef ownSymbol = pownCurrencySymbol # ctx' mintValue <- plet $ pownMintValue # ctx' From a8249fdd4a5fc767dedd1424305ea903c8e0a07c Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 25 Apr 2022 19:46:40 +0800 Subject: [PATCH 046/107] simplify code Co-authored-by: Emily Martins --- agora/Agora/Governor.hs | 17 +++++------------ agora/Agora/Utils.hs | 3 +-- 2 files changed, 6 insertions(+), 14 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 6b3c888..73858c8 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -45,7 +45,7 @@ import Agora.AuthorityToken ( import Agora.Proposal ( PProposalDatum (..), PProposalId, - PProposalStatus (PDraft, PExecutable, PFinished), + PProposalStatus (PFinished), PProposalThresholds, Proposal (..), ProposalId, @@ -53,7 +53,7 @@ import Agora.Proposal ( pnextProposalId, proposalDatumValid, proposalPolicy, - proposalValidator, + proposalValidator,ProposalStatus (Draft, Executable) ) import Agora.Utils ( findOutputsToAddress, @@ -419,11 +419,7 @@ governorValidator gov = -- TODO: should we check cosigners here? - let isProposalDraft = pmatch (pfromData proposalDatum.status) $ \case - PDraft _ -> pconstant True - _ -> pconstant False - - passert "Proposal state should be draft" isProposalDraft + passert "Proposal state should be draft" $ proposalDatum.status #== pconstantData Draft popaque $ pconstant () PMintGATs _ -> P.do @@ -480,11 +476,8 @@ governorValidator gov = pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' - let isProposalExecutable = pmatch (pfromData inputProposalDatum.status) $ \case - PExecutable _ -> pconstant True - _ -> pconstant False - - passert "Proposal must be in executable state in order to execute effects" isProposalExecutable + passert "Proposal must be in executable state in order to execute effects" $ + inputProposalDatum.status #== pconstantData Executable let expectedOutputDatum = pforgetData $ diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index fddd440..b46cba4 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -530,9 +530,8 @@ hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ plam $ \vs -> P.do let ps = pconstant as - psymbolValueOf # ps # vs #== 1 + hasOnlyOneTokenOfCurrencySymbol # ps # vs #&& passetClassValueOf' ac # vs #== 1 - #&& (plength #$ pto $ pto $ pto vs) #== 1 -- | The entire value only contains one token of the specific currency symbol. hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) From ce52bce9fdb315b7ff3aab983bd7a41a8e825b9d Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 26 Apr 2022 14:33:33 +0800 Subject: [PATCH 047/107] ensure that the token name of GST is empty --- agora/Agora/Governor.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 73858c8..ef5ba5f 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -120,7 +120,6 @@ import Plutus.V1.Ledger.Api ( ) import Plutus.V1.Ledger.Value ( AssetClass (..), - TokenName (..), ) import PlutusTx qualified @@ -176,8 +175,6 @@ PlutusTx.makeIsDataIndexed data Governor = Governor { gstOutRef :: TxOutRef -- ^ Referenced utxo will be spent to mint the GST. - , gstName :: TokenName - -- ^ Name of the GST token. } -------------------------------------------------------------------------------- @@ -226,7 +223,7 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc - The UTXO referenced in the parameter is spent in the transaction. - Exactly one GST is minted. - - Ensure the token name is 'gstName'. + - Ensure the token name is empty. NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator. We /can't/ really check this in the policy, otherwise we create a cyclic reference issue. @@ -244,7 +241,7 @@ governorPolicy gov = passert "Exactly one token should be minted" $ psymbolValueOf # ownSymbol # mintValue #== 1 - #&& passetClassValueOf # ownSymbol # pconstant gov.gstName # mintValue #== 1 + #&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 popaque (pconstant ()) @@ -615,7 +612,7 @@ governorValidator gov = -- | Get the assetclass of GST from governor parameters. gstAssetClass :: Governor -> AssetClass -gstAssetClass gov = AssetClass (symbol, gov.gstName) +gstAssetClass gov = AssetClass (symbol, "") where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov From 342bedfdd8f119524926efddb1669cdbe6dd6b55 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 26 Apr 2022 14:41:27 +0800 Subject: [PATCH 048/107] naming --- agora/Agora/Governor.hs | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index ef5ba5f..e95d734 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -341,18 +341,18 @@ governorValidator gov = let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce datum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' - let ownInputDatumNFTAmount = stateTokenValueOf # ownInput.value + let ownInputGSTAmount = stateTokenValueOf # ownInput.value passert "Own input should have exactly one state token" $ - ownInputDatumNFTAmount #== 1 + ownInputGSTAmount #== 1 ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs - let ownOuputDatumNFTAmount = stateTokenValueOf # ownOutput.value + let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value passert "State token should stay at governor's address" $ - ownOuputDatumNFTAmount #== 1 + ownOuputGSTAmount #== 1 passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash @@ -400,23 +400,23 @@ governorValidator gov = passert "Proposal datum must be valid" $ proposalDatumValid # outputProposalDatum' - proposalDatum <- + outputProposalDatum <- pletFields @'["id", "status", "cosigners", "thresholds", "votes"] outputProposalDatum' passert "Invalid proposal id in proposal datum" $ - proposalDatum.id #== oldParams.nextProposalId + outputProposalDatum.id #== oldParams.nextProposalId passert "Invalid thresholds in proposal datum" $ - proposalDatum.thresholds #== oldParams.proposalThresholds + outputProposalDatum.thresholds #== oldParams.proposalThresholds passert "Initial proposal votes should be empty" $ - pnull #$ pto $ pto $ pfromData proposalDatum.votes + pnull #$ pto $ pto $ pfromData outputProposalDatum.votes -- TODO: should we check cosigners here? - passert "Proposal state should be draft" $ proposalDatum.status #== pconstantData Draft + passert "Proposal state should be draft" $ outputProposalDatum.status #== pconstantData Draft popaque $ pconstant () PMintGATs _ -> P.do @@ -476,7 +476,7 @@ governorValidator gov = passert "Proposal must be in executable state in order to execute effects" $ inputProposalDatum.status #== pconstantData Executable - let expectedOutputDatum = + let expectedOutputProposalDatum = pforgetData $ pdata $ pcon $ @@ -489,7 +489,7 @@ governorValidator gov = #$ pdcons @"votes" # inputProposalDatum.votes # pdnil passert "Unexpected output proposal datum" $ - pforgetData (pdata outputProposalDatum') #== expectedOutputDatum + pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum -- TODO: anything else to check here? @@ -535,7 +535,7 @@ governorValidator gov = # phoistAcyclic ( plam ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSym # value + 0 #< psymbolValueOf # pgatSymbol # value ) ) # pfromData txInfo.outputs @@ -561,7 +561,7 @@ governorValidator gov = mustBePJust # "Receiver is not in the effect list" #$ plookup # scriptHash # effects - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' passert "Unexpected datum" $ datumHash #== expectedDatumHash pconstant () ) @@ -574,13 +574,13 @@ governorValidator gov = # pconstant () # outputsWithGAT PMutateGovernor _ -> P.do - popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint + popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint where stateTokenAssetClass :: AssetClass stateTokenAssetClass = gstAssetClass gov - proposalDatum :: Proposal - proposalDatum = + proposalParameters :: Proposal + proposalParameters = Proposal { governorSTAssetClass = stateTokenAssetClass } @@ -588,7 +588,7 @@ governorValidator gov = proposalSymbol :: CurrencySymbol proposalSymbol = mintingPolicySymbol policy where - policy = mkMintingPolicy $ proposalPolicy proposalDatum + policy = mkMintingPolicy $ proposalPolicy proposalParameters pproposalSymbol :: Term s PCurrencySymbol pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol @@ -597,7 +597,7 @@ governorValidator gov = proposalValidatorAddress = Address (ScriptCredential hash) Nothing where hash = validatorHash validator - validator = mkValidator $ proposalValidator proposalDatum + validator = mkValidator $ proposalValidator proposalParameters pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress @@ -605,8 +605,8 @@ governorValidator gov = stateTokenValueOf :: Term s (PValue :--> PInteger) stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - pgatSym :: Term s PCurrencySymbol - pgatSym = phoistAcyclic $ pconstant $ gatSymbol gov + pgatSymbol :: Term s PCurrencySymbol + pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov -------------------------------------------------------------------------------- From 6647fdf7e67ac1bd81143d63a9a04a26b06ab197 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 26 Apr 2022 17:22:10 +0800 Subject: [PATCH 049/107] allow multiple outputs to the proposal validator ... upon creation of the proposal. Don't know if this is intended or not. --- agora/Agora/Governor.hs | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index e95d734..f0ab2e8 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -49,11 +49,12 @@ import Agora.Proposal ( PProposalThresholds, Proposal (..), ProposalId, + ProposalStatus (Draft, Executable), ProposalThresholds, pnextProposalId, proposalDatumValid, proposalPolicy, - proposalValidator,ProposalStatus (Draft, Executable) + proposalValidator, ) import Agora.Utils ( findOutputsToAddress, @@ -380,21 +381,32 @@ governorValidator gov = passert "Exactly one proposal token must be minted" $ hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint - outputs <- plet $ findOutputsToAddress # ctx.txInfo # pproposalValidatorAddress - passert "Exactly one utxo should be sent to the proposal validator" $ - plength # outputs #== 1 + filteredOutputs <- + plet $ + pfilter + # ( phoistAcyclic $ + plam + ( \txOut' -> P.do + txOut <- pletFields @'["address", "value"] txOut' - output <- pletFields @'["value", "datumHash"] $ phead # outputs - passert "The proposal state token must be sent to the proposal validator" $ - psymbolValueOf # pproposalSymbol # output.value #== 1 + txOut.address #== pdata pproposalValidatorAddress + #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 + ) + ) + # pfromData txInfo.outputs + + passert "Exactly one utxo with proposal state token should be sent to the proposal validator" $ + plength # filteredOutputs #== 1 + + outputDatumHash <- plet $ pfield @"datumHash" #$ phead # filteredOutputs passert "The utxo paid to the proposal validator must have datum" $ - pisDJust # output.datumHash + pisDJust # outputDatumHash outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum - # output.datumHash + # outputDatumHash # ctx.txInfo passert "Proposal datum must be valid" $ @@ -473,8 +485,8 @@ governorValidator gov = pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' - passert "Proposal must be in executable state in order to execute effects" $ - inputProposalDatum.status #== pconstantData Executable + passert "Proposal must be in executable state in order to execute effects" $ + inputProposalDatum.status #== pconstantData Executable let expectedOutputProposalDatum = pforgetData $ From 5ee0a404354dcc5aec331d3406716c3e47d817b8 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 26 Apr 2022 19:41:04 +0800 Subject: [PATCH 050/107] check stake upon the creation of a proposal ...documentation is updated as well --- agora/Agora/Governor.hs | 198 +++++++++++++++++++++++++++++++++++----- agora/Agora/Utils.hs | 10 +- 2 files changed, 182 insertions(+), 26 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index f0ab2e8..9084d53 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -47,6 +47,7 @@ import Agora.Proposal ( PProposalId, PProposalStatus (PFinished), PProposalThresholds, + PResultTag, Proposal (..), ProposalId, ProposalStatus (Draft, Executable), @@ -56,6 +57,14 @@ import Agora.Proposal ( proposalPolicy, proposalValidator, ) +import Agora.SafeMoney (GTTag) +import Agora.Stake ( + PProposalLock (..), + PStakeDatum (..), + Stake (..), + stakePolicy, + stakeValidator, + ) import Agora.Utils ( findOutputsToAddress, hasOnlyOneTokenOfCurrencySymbol, @@ -72,6 +81,7 @@ import Agora.Utils ( pisUxtoSpent, pownCurrencySymbol, psymbolValueOf, + ptxSignedBy, pvalueSpent, scriptHashFromAddress, ) @@ -105,9 +115,9 @@ import Plutarch.DataRepr ( PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift (PUnsafeLiftDecl (..)) -import Plutarch.Map.Extra (plookup, plookup') +import Plutarch.Map.Extra (pkeys, plookup, plookup') import Plutarch.Monadic qualified as P -import Plutarch.SafeMoney (puntag) +import Plutarch.SafeMoney (PDiscrete, Tagged (..), puntag, pvalueDiscrete) import Plutarch.Unsafe (punsafeCoerce) -------------------------------------------------------------------------------- @@ -176,6 +186,7 @@ PlutusTx.makeIsDataIndexed data Governor = Governor { gstOutRef :: TxOutRef -- ^ Referenced utxo will be spent to mint the GST. + , gtClassRef :: Tagged GTTag AssetClass } -------------------------------------------------------------------------------- @@ -265,16 +276,25 @@ When the redeemer is 'CreateProposal', the script will check: * 'nextProposalId' is advanced. * Nothing is changed other that that. +- Exactly one stake (the "input stake") must be provided in the input: + * At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction. + * The transaction must be signed by the stake owner. + - Exactly one new proposal state token is minted. -- Exactly one UTXO is sent to the proposal validator, this UTXO must: +- An UTXO which holds the newly minted proposal state token is sent to the proposal validator. + This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must: - * Hold the newly minted proposal state token. - * Have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must: + * Copy its id and thresholds from the governor's state. + * Have status set to 'Proposal.Draft'. + * Have zero votes. + * Have exactly one cosigner - the stake owner - - Copy its id and thresholds from the governor's state. - - Have status set to 'Proposal.Draft'. - - Have zero votes. - - TODO: should we check cosigners? +- An UTXO which holds the stake state token is sent back to the stake validator. + This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum': + + * The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed, + comparing to the input stake. + * The new proposal locks must be appended to the 'Agora.Stake.lockedBy'. == Minting GATs @@ -331,6 +351,10 @@ governorValidator gov = txInfo' <- plet $ pfromData $ ctx.txInfo txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' + datums <- plet $ pfromData $ pfield @"data" # txInfo' + + valueSpent <- plet $ pvalueSpent # txInfo' + PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose let txOutRef = pfromData txOutRef' @@ -381,7 +405,48 @@ governorValidator gov = passert "Exactly one proposal token must be minted" $ hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint - filteredOutputs <- + -- + + inputsFromStakeValidatorWithStateToken <- + plet $ + pfilter + # ( phoistAcyclic $ + plam + ( \((pfield @"resolved" #) -> txOut') -> P.do + txOut <- pletFields @'["address", "value"] txOut' + + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + ) + ) + # pfromData txInfo.inputs + + passert "Exactly one input from the stake validator" $ + plength # inputsFromStakeValidatorWithStateToken #== 1 + + stakeInputDatumHash <- + plet $ + pfield @"datumHash" + #$ pfield @"resolved" + #$ phead # inputsFromStakeValidatorWithStateToken + + passert "Stake input must have datum" $ + pisDJust # stakeInputDatumHash + + let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums + + stakeInputDatum <- + pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' + + passert "Required amount of stake GT should be spent" $ + stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) + + passert "Tx should be signed by the stake owner" $ + ptxSignedBy # txInfo' # stakeInputDatum.owner + + -- + + outputsToProposalValidatorWithStateToken <- plet $ pfilter # ( phoistAcyclic $ @@ -395,10 +460,10 @@ governorValidator gov = ) # pfromData txInfo.outputs - passert "Exactly one utxo with proposal state token should be sent to the proposal validator" $ - plength # filteredOutputs #== 1 + passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ + plength # outputsToProposalValidatorWithStateToken #== 1 - outputDatumHash <- plet $ pfield @"datumHash" #$ phead # filteredOutputs + outputDatumHash <- plet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken passert "The utxo paid to the proposal validator must have datum" $ pisDJust # outputDatumHash @@ -407,7 +472,7 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # outputDatumHash - # ctx.txInfo + # datums passert "Proposal datum must be valid" $ proposalDatumValid # outputProposalDatum' @@ -426,9 +491,75 @@ governorValidator gov = passert "Initial proposal votes should be empty" $ pnull #$ pto $ pto $ pfromData outputProposalDatum.votes - -- TODO: should we check cosigners here? + passert "Proposal state should be draft" $ + outputProposalDatum.status #== pconstantData Draft - passert "Proposal state should be draft" $ outputProposalDatum.status #== pconstantData Draft + passert "Proposal should have only one cosigner" $ + plength # pfromData outputProposalDatum.cosigners #== 1 + + let cosigner = phead # pfromData outputProposalDatum.cosigners + + passert "Cosigner should be the stake owner" $ + pdata stakeInputDatum.owner #== cosigner + + -- + + outputToStakeValidatorWithStateToken <- + plet $ + pfilter + # ( phoistAcyclic $ + plam + ( \(txOut') -> P.do + txOut <- pletFields @'["address", "value"] txOut' + + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + ) + ) + # pfromData txInfo.outputs + + passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ + plength # outputToStakeValidatorWithStateToken #== 1 + + let stakeOutputDatumHash' = + pfield @"datumHash" + #$ pfromData + $ phead # outputToStakeValidatorWithStateToken + + stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputDatumHash' + + stakeOutputDatum = + pforgetData $ + pdata $ + mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' + + let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes + + mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) + mkProposalLock = + phoistAcyclic $ + plam + ( \pid rt' -> + let fields = + pdcons @"vote" # rt' + #$ pdcons @"proposalTag" # pdata pid # pdnil + in pdata $ pcon $ PProposalLock fields + ) + + expectedProposalLocks = + pconcat # stakeInputDatum.lockedBy + #$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults + + expectedOutputDatum = + pforgetData $ + pdata $ + pcon $ + PStakeDatum $ + pdcons @"stakedAmount" # pdata stakeInputDatum.stakedAmount + #$ pdcons @"owner" # pdata stakeInputDatum.owner + #$ pdcons @"lockedBy" # pdata expectedProposalLocks # pdnil + + passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum popaque $ pconstant () PMintGATs _ -> P.do @@ -470,12 +601,12 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash - # txInfo' + # datums outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalOutputTxOut.datumHash - # txInfo' + # datums passert "Proposal datum must be valid" $ proposalDatumValid # inputProposalDatum' @@ -591,8 +722,8 @@ governorValidator gov = stateTokenAssetClass :: AssetClass stateTokenAssetClass = gstAssetClass gov - proposalParameters :: Proposal - proposalParameters = + outputProposalDatum :: Proposal + outputProposalDatum = Proposal { governorSTAssetClass = stateTokenAssetClass } @@ -600,7 +731,7 @@ governorValidator gov = proposalSymbol :: CurrencySymbol proposalSymbol = mintingPolicySymbol policy where - policy = mkMintingPolicy $ proposalPolicy proposalParameters + policy = mkMintingPolicy $ proposalPolicy outputProposalDatum pproposalSymbol :: Term s PCurrencySymbol pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol @@ -609,7 +740,7 @@ governorValidator gov = proposalValidatorAddress = Address (ScriptCredential hash) Nothing where hash = validatorHash validator - validator = mkValidator $ proposalValidator proposalParameters + validator = mkValidator $ proposalValidator outputProposalDatum pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress @@ -620,6 +751,29 @@ governorValidator gov = pgatSymbol :: Term s PCurrencySymbol pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov + stakeParameters :: Stake + stakeParameters = Stake gov.gtClassRef + + stakeValidatorAddress :: Address + stakeValidatorAddress = Address (ScriptCredential hash) Nothing + where + validator = mkValidator $ stakeValidator stakeParameters + hash = validatorHash validator + + stakeStateSymbol :: CurrencySymbol + stakeStateSymbol = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ stakePolicy stakeParameters + + pstakeValidatorAddress :: Term s PAddress + pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress + + pstakeStateSymbol :: Term s PCurrencySymbol + pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol + + pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) + pgtValueOf = pvalueDiscrete gov.gtClassRef + -------------------------------------------------------------------------------- -- | Get the assetclass of GST from governor parameters. diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index b46cba4..f2f5d16 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -547,12 +547,14 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ mustFindDatum' :: forall (datum :: PType). PIsData datum => - forall s. Term s (PMaybeData PDatumHash :--> PTxInfo :--> datum) + forall s. Term s (PMaybeData PDatumHash :--> + (PBuiltinList (PAsData (PTuple PDatumHash PDatum))) + :--> datum) mustFindDatum' = phoistAcyclic $ - plam $ \mdh info -> P.do + plam $ \mdh datums -> P.do PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh - PJust dt <- pmatch $ pfindDatum # dh # info - pfromData $ punsafeCoerce dt + PJust dt <- pmatch $ plookupTuple # dh # datums + punsafeCoerce dt {- | Extract the value stored in a PMaybe container. If there's no value, throw an error with the given message. From d3b5f6c41692c7f748e982d2655352434fe67d78 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 26 Apr 2022 20:00:29 +0800 Subject: [PATCH 051/107] apply hlint suggestions; format --- agora/Agora/Governor.hs | 41 +++++++++++++++++++---------------------- agora/Agora/Utils.hs | 12 ++++++++---- 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 9084d53..812c6ed 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -410,14 +410,13 @@ governorValidator gov = inputsFromStakeValidatorWithStateToken <- plet $ pfilter - # ( phoistAcyclic $ - plam - ( \((pfield @"resolved" #) -> txOut') -> P.do - txOut <- pletFields @'["address", "value"] txOut' + # phoistAcyclic + ( plam $ + \((pfield @"resolved" #) -> txOut') -> P.do + txOut <- pletFields @'["address", "value"] txOut' - txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 - ) + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 ) # pfromData txInfo.inputs @@ -449,14 +448,13 @@ governorValidator gov = outputsToProposalValidatorWithStateToken <- plet $ pfilter - # ( phoistAcyclic $ - plam - ( \txOut' -> P.do - txOut <- pletFields @'["address", "value"] txOut' + # phoistAcyclic + ( plam $ + \txOut' -> P.do + txOut <- pletFields @'["address", "value"] txOut' - txOut.address #== pdata pproposalValidatorAddress - #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 - ) + txOut.address #== pdata pproposalValidatorAddress + #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -507,14 +505,13 @@ governorValidator gov = outputToStakeValidatorWithStateToken <- plet $ pfilter - # ( phoistAcyclic $ - plam - ( \(txOut') -> P.do - txOut <- pletFields @'["address", "value"] txOut' + # phoistAcyclic + ( plam $ + \txOut' -> P.do + txOut <- pletFields @'["address", "value"] txOut' - txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 - ) + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -654,7 +651,7 @@ governorValidator gov = votesList = pto $ pto $ pfromData inputProposalDatum.votes winner' = - pfoldr # highestVoteFolder # (pcon PNothing) # votesList + pfoldr # highestVoteFolder # pcon PNothing # votesList winner <- plet $ mustBePJust # "Empty votes" # winner' diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index f2f5d16..563015b 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -530,7 +530,7 @@ hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ plam $ \vs -> P.do let ps = pconstant as - hasOnlyOneTokenOfCurrencySymbol # ps # vs + hasOnlyOneTokenOfCurrencySymbol # ps # vs #&& passetClassValueOf' ac # vs #== 1 -- | The entire value only contains one token of the specific currency symbol. @@ -547,9 +547,13 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ mustFindDatum' :: forall (datum :: PType). PIsData datum => - forall s. Term s (PMaybeData PDatumHash :--> - (PBuiltinList (PAsData (PTuple PDatumHash PDatum))) - :--> datum) + forall s. + Term + s + ( PMaybeData PDatumHash + :--> (PBuiltinList (PAsData (PTuple PDatumHash PDatum))) + :--> datum + ) mustFindDatum' = phoistAcyclic $ plam $ \mdh datums -> P.do PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh From 067d69d8f65970f0f6456d660ec1bea9f6be2a38 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Tue, 26 Apr 2022 22:41:08 +0800 Subject: [PATCH 052/107] remove redundant checks in `hasOnlyOneTokenOfAssetClass'` --- agora/Agora/Utils.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 563015b..83fbdb2 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -526,12 +526,8 @@ getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v -- | The entire value only contains one token of the specific assetclass. hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) -hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $ - plam $ \vs -> P.do - let ps = pconstant as - - hasOnlyOneTokenOfCurrencySymbol # ps # vs - #&& passetClassValueOf' ac # vs #== 1 +hasOnlyOneTokenOfAssetClass' ac = phoistAcyclic $ + plam $ \vs -> passetClassValueOf' ac # vs #== 1 -- | The entire value only contains one token of the specific currency symbol. hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) From c7bfe116d5b80480822a2d2abc92270931aa2c14 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 27 Apr 2022 16:23:35 +0800 Subject: [PATCH 053/107] remove executable state of the proposal revert 45a09e8 and 8ffc430 --- agora/Agora/Governor.hs | 6 +++--- agora/Agora/Proposal.hs | 1 - 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 812c6ed..da057a9 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -50,7 +50,7 @@ import Agora.Proposal ( PResultTag, Proposal (..), ProposalId, - ProposalStatus (Draft, Executable), + ProposalStatus (Draft, Locked), ProposalThresholds, pnextProposalId, proposalDatumValid, @@ -613,8 +613,8 @@ governorValidator gov = pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' - passert "Proposal must be in executable state in order to execute effects" $ - inputProposalDatum.status #== pconstantData Executable + passert "Proposal must be in locked(executable) state in order to execute effects" $ + inputProposalDatum.status #== pconstantData Locked let expectedOutputProposalDatum = pforgetData $ diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index ffca57a..db97f7a 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -303,7 +303,6 @@ data PProposalStatus (s :: S) PDraft (Term s (PDataRecord '[])) | PVotingReady (Term s (PDataRecord '[])) | PLocked (Term s (PDataRecord '[])) - | PExecutable (Term s (PDataRecord '[])) | PFinished (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic) From c1976b86fcb95236856546d58560387589911601 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 28 Apr 2022 17:20:21 +0800 Subject: [PATCH 054/107] fix typos/grammar/docstrings, suggested by @jhodgdev Co-authored-by: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> --- agora/Agora/Governor.hs | 8 ++++---- agora/Agora/Utils.hs | 6 ++++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index da057a9..1d4fcf9 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -2,7 +2,7 @@ {- | Module : Agora.Governor -Maintainer : chfanghr@gmail.com +Maintainer : connor@mlabs.city Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. @@ -137,7 +137,7 @@ import PlutusTx qualified -------------------------------------------------------------------------------- {- $gst - Governance state token, aka. GST, is an NFT that identifies an UTXO that carries the state datum of the Governance script. + Governance state token, aka. GST, is an NFT that identifies a UTXO that carries the state datum of the Governance script. This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. @@ -773,7 +773,7 @@ governorValidator gov = -------------------------------------------------------------------------------- --- | Get the assetclass of GST from governor parameters. +-- | Get the 'AssetClass' of GST from 'Governor'. gstAssetClass :: Governor -> AssetClass gstAssetClass gov = AssetClass (symbol, "") where @@ -783,7 +783,7 @@ gstAssetClass gov = AssetClass (symbol, "") symbol :: CurrencySymbol symbol = mintingPolicySymbol policy --- | Get the currency symbol of GAT from governor parameters. +-- | Get the `CurrencySymbol` of GAT from 'Governor'. gatSymbol :: Governor -> CurrencySymbol gatSymbol gov = mintingPolicySymbol policy where diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 83fbdb2..3ea3fb4 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -380,13 +380,15 @@ pisDJust = phoistAcyclic $ ) -- | The 'CurrencySymbol' of the current minting policy. +-- FIXME: Yeet/reimplement this function, since passing the whole script context is highly inefficient. pownCurrencySymbol :: Term s (PScriptContext :--> PCurrencySymbol) pownCurrencySymbol = phoistAcyclic $ plam $ \ctx -> P.do PMinting m <- pmatch $ pfield @"purpose" # ctx pfield @"_0" # m --- | Determines if a given utxo is spent. +-- | Determines if a given UTXO is spent. +-- TODO: no need to pass the whole TxInfo here. pisUxtoSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) pisUxtoSpent = phoistAcyclic $ plam $ \oref info -> P.do @@ -529,7 +531,7 @@ hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) hasOnlyOneTokenOfAssetClass' ac = phoistAcyclic $ plam $ \vs -> passetClassValueOf' ac # vs #== 1 --- | The entire value only contains one token of the specific currency symbol. +-- | The entire value only contains one token of the given currency symbol. hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ plam $ \cs vs -> P.do From c3a10f8bbdae383749a9c0ad05ddc41a5e3d1015 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 28 Apr 2022 17:31:34 +0800 Subject: [PATCH 055/107] move `pgetNextProposalId` from `Proposal` module to `Governor` module --- agora/Agora/Governor.hs | 10 +++++++--- agora/Agora/Proposal.hs | 9 --------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 1d4fcf9..ea34a5d 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -27,6 +27,7 @@ module Agora.Governor ( -- * Utilities gstAssetClass, gatSymbol, + pgetNextProposalId ) where -------------------------------------------------------------------------------- @@ -44,7 +45,7 @@ import Agora.AuthorityToken ( ) import Agora.Proposal ( PProposalDatum (..), - PProposalId, + PProposalId(..), PProposalStatus (PFinished), PProposalThresholds, PResultTag, @@ -52,7 +53,6 @@ import Agora.Proposal ( ProposalId, ProposalStatus (Draft, Locked), ProposalThresholds, - pnextProposalId, proposalDatumValid, proposalPolicy, proposalValidator, @@ -392,7 +392,7 @@ governorValidator gov = case redeemer of PCreateProposal _ -> P.do - let expectedNextProposalId = pnextProposalId # oldParams.nextProposalId + let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId expectedNewDatum = pcon $ PGovernorDatum $ @@ -789,3 +789,7 @@ gatSymbol gov = mintingPolicySymbol policy where at = AuthorityToken $ gstAssetClass gov policy = mkMintingPolicy $ authorityTokenPolicy at + +-- | Get next proposal id. +pgetNextProposalId :: Term s (PProposalId :--> PProposalId) +pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index db97f7a..f57e5e4 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -30,9 +30,6 @@ module Agora.Proposal ( -- * Plutarch helpers proposalDatumValid, - - -- * Utils - pnextProposalId, ) where import GHC.Generics qualified as GHC @@ -437,9 +434,3 @@ proposalDatumValid proposal = , ptraceIfFalse "Proposal has fewer cosigners than the limit" $ plength # (pfromData datum.cosigners) #<= pconstant proposal.maximumCosigners , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ pkeysEqual # datum.effects # pto (pfromData datum.votes) ] - --------------------------------------------------------------------------------- - --- | Get next proposal id. -pnextProposalId :: Term s (PProposalId :--> PProposalId) -pnextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 From 9c79585c7cadf6b781fe66d4c4cf88316337976a Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 28 Apr 2022 17:44:18 +0800 Subject: [PATCH 056/107] get rid of `pownCurrencySymbol` --- agora/Agora/Governor.hs | 10 +++++----- agora/Agora/Utils.hs | 15 +++------------ 2 files changed, 8 insertions(+), 17 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index ea34a5d..facb2bd 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -78,8 +78,7 @@ import Agora.Utils ( pfindTxInByTxOutRef, pisDJust, pisJust, - pisUxtoSpent, - pownCurrencySymbol, + pisUTXOSpent, psymbolValueOf, ptxSignedBy, pvalueSpent, @@ -95,7 +94,7 @@ import Plutarch.Api.V1 ( PDatumHash, PMap, PMintingPolicy, - PScriptPurpose (PSpending), + PScriptPurpose (PSpending, PMinting), PTxOut, PValidator, PValidatorHash, @@ -244,12 +243,13 @@ governorPolicy :: Governor -> ClosedTerm PMintingPolicy governorPolicy gov = plam $ \_ ctx' -> P.do let oref = pconstant gov.gstOutRef - ownSymbol = pownCurrencySymbol # ctx' + + PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') mintValue <- plet $ pownMintValue # ctx' passert "Referenced utxo should be spent" $ - pisUxtoSpent # oref #$ pfield @"txInfo" # ctx' + pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' passert "Exactly one token should be minted" $ psymbolValueOf # ownSymbol # mintValue #== 1 diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 3ea3fb4..2ad5d86 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -30,8 +30,7 @@ module Agora.Utils ( pnub, pisUniq, pisDJust, - pownCurrencySymbol, - pisUxtoSpent, + pisUTXOSpent, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -379,18 +378,10 @@ pisDJust = phoistAcyclic $ _ -> pconstant False ) --- | The 'CurrencySymbol' of the current minting policy. --- FIXME: Yeet/reimplement this function, since passing the whole script context is highly inefficient. -pownCurrencySymbol :: Term s (PScriptContext :--> PCurrencySymbol) -pownCurrencySymbol = phoistAcyclic $ - plam $ \ctx -> P.do - PMinting m <- pmatch $ pfield @"purpose" # ctx - pfield @"_0" # m - -- | Determines if a given UTXO is spent. -- TODO: no need to pass the whole TxInfo here. -pisUxtoSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) -pisUxtoSpent = phoistAcyclic $ +pisUTXOSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) +pisUTXOSpent = phoistAcyclic $ plam $ \oref info -> P.do pisJust #$ pfindTxInByTxOutRef # oref # info From d0b70d5b433cb73b0d763a31f78d897115033232 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 17:03:59 +0800 Subject: [PATCH 057/107] add `PTryFrom` instances for `PGovernorDatum` and `PGovernorDatum` --- agora/Agora/Governor.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index facb2bd..10e4131 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -32,6 +32,7 @@ module Agora.Governor ( -------------------------------------------------------------------------------- +import Control.Applicative (Const) import GHC.Generics qualified as GHC import Generics.SOP (Generic, I (I)) @@ -118,6 +119,7 @@ import Plutarch.Map.Extra (pkeys, plookup, plookup') import Plutarch.Monadic qualified as P import Plutarch.SafeMoney (PDiscrete, Tagged (..), puntag, pvalueDiscrete) import Plutarch.Unsafe (punsafeCoerce) +import Plutarch.TryFrom(PTryFrom(..)) -------------------------------------------------------------------------------- @@ -211,6 +213,14 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) + +-- FIXME: derive this via 'PIsDataReprInstances' +-- Blocked by: PProposalThresholds +instance PTryFrom PData (PAsData PGovernorDatum) where + type PTryFromExcess PData (PAsData PGovernorDatum) = Const () + + ptryFrom' d k = k (punsafeCoerce d , ()) + -- | Plutarch-level version of 'GovernorRedeemer'. data PGovernorRedeemer (s :: S) = PCreateProposal (Term s (PDataRecord '[])) @@ -226,6 +236,8 @@ data PGovernorRedeemer (s :: S) instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) +deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer) + -------------------------------------------------------------------------------- {- | Policy for minting GSTs. From 1e2b20dfefd0aad425853137d2b4d2cb899bd6d7 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 17:22:44 +0800 Subject: [PATCH 058/107] reimplement `mustFindDatum'` with `PTryFrom` --- agora/Agora/Governor.hs | 10 ++++------ agora/Agora/Utils.hs | 14 ++++++-------- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 10e4131..8839868 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -119,7 +119,7 @@ import Plutarch.Map.Extra (pkeys, plookup, plookup') import Plutarch.Monadic qualified as P import Plutarch.SafeMoney (PDiscrete, Tagged (..), puntag, pvalueDiscrete) import Plutarch.Unsafe (punsafeCoerce) -import Plutarch.TryFrom(PTryFrom(..)) +import Plutarch.TryFrom(PTryFrom(..), ptryFrom) -------------------------------------------------------------------------------- @@ -356,8 +356,7 @@ In this case, the script will check governorValidator :: Governor -> ClosedTerm PValidator governorValidator gov = plam $ \datum' redeemer' ctx' -> P.do - -- TODO: use ptryFrom - redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer' + (pfromData -> redeemer, _) <- ptryFrom redeemer' ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet $ pfromData $ ctx.txInfo @@ -374,8 +373,7 @@ governorValidator gov = ownInput <- pletFields @'["address", "value"] ownInput' let selfAddress = pfromData $ ownInput.address - -- TODO: use ptryFrom - let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce datum' + (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' let ownInputGSTAmount = stateTokenValueOf # ownInput.value @@ -402,7 +400,7 @@ governorValidator gov = mustBePJust # "Ouput governor state datum not found" #$ pfindDatum # outputGovernorStateDatumHash # txInfo' - case redeemer of + pmatch redeemer $ \case PCreateProposal _ -> P.do let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId expectedNewDatum = diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 2ad5d86..a1b88b3 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -529,13 +529,10 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ psymbolValueOf # cs # vs #== 1 #&& (plength #$ pto $ pto $ pto vs) #== 1 -{- Find datum given a maybe datum hash, in an unsafe manner. - - FIXME: reimplement using 'ptryFrom'. --} +-- | Find datum given a maybe datum hash mustFindDatum' :: forall (datum :: PType). - PIsData datum => + (PIsData datum, PTryFrom PData (PAsData datum))=> forall s. Term s @@ -545,9 +542,10 @@ mustFindDatum' :: ) mustFindDatum' = phoistAcyclic $ plam $ \mdh datums -> P.do - PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh - PJust dt <- pmatch $ plookupTuple # dh # datums - punsafeCoerce dt + let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh + dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums + (d, _ ) <- ptryFrom $ pforgetData $ pdata dt + pfromData d {- | Extract the value stored in a PMaybe container. If there's no value, throw an error with the given message. From 0e6369030edec7b4e331cd94f2457b7547e8abb9 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 17:25:17 +0800 Subject: [PATCH 059/107] remove `hasOnlyOneTokenOfAssetClass'` --- agora/Agora/Utils.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index a1b88b3..34a47fc 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -43,7 +43,6 @@ module Agora.Utils ( validatorHashToTokenName, pvalidatorHashToTokenName, getMintingPolicySymbol, - hasOnlyOneTokenOfAssetClass', hasOnlyOneTokenOfCurrencySymbol, mustFindDatum', mustBePJust, @@ -517,11 +516,6 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh)) getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v --- | The entire value only contains one token of the specific assetclass. -hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool) -hasOnlyOneTokenOfAssetClass' ac = phoistAcyclic $ - plam $ \vs -> passetClassValueOf' ac # vs #== 1 - -- | The entire value only contains one token of the given currency symbol. hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool) hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ From fb6f2085c678d38ef87a32e13c88fff0ff9e91f2 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 17:52:44 +0800 Subject: [PATCH 060/107] move governor scripts from `Agora.Governor` to `Agora.Governor.Scripts` --- agora.cabal | 1 + agora/Agora/Governor.hs | 672 +----------------------------- agora/Agora/Governor/Scripts.hs | 700 ++++++++++++++++++++++++++++++++ 3 files changed, 707 insertions(+), 666 deletions(-) create mode 100644 agora/Agora/Governor/Scripts.hs diff --git a/agora.cabal b/agora.cabal index b55630b..74738ec 100644 --- a/agora.cabal +++ b/agora.cabal @@ -127,6 +127,7 @@ library Agora.Effect.NoOp Agora.Effect.TreasuryWithdrawal Agora.Governor + Agora.Governor.Scripts Agora.MultiSig Agora.Proposal Agora.Proposal.Scripts diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 8839868..bd3b375 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -8,9 +8,6 @@ Description: Governor entity scripts acting as authority of entire system. Governor entity scripts acting as authority of entire system. -} module Agora.Governor ( - -- * GST - -- $gst - -- * Haskell-land GovernorDatum (..), GovernorRedeemer (..), @@ -19,15 +16,6 @@ module Agora.Governor ( -- * Plutarch-land PGovernorDatum (..), PGovernorRedeemer (..), - - -- * Scripts - governorPolicy, - governorValidator, - - -- * Utilities - gstAssetClass, - gatSymbol, - pgetNextProposalId ) where -------------------------------------------------------------------------------- @@ -38,115 +26,34 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- -import Agora.AuthorityToken ( - AuthorityToken (..), - authorityTokenPolicy, - authorityTokensValidIn, - singleAuthorityTokenBurned, - ) import Agora.Proposal ( - PProposalDatum (..), - PProposalId(..), - PProposalStatus (PFinished), + PProposalId , PProposalThresholds, - PResultTag, - Proposal (..), ProposalId, - ProposalStatus (Draft, Locked), ProposalThresholds, - proposalDatumValid, - proposalPolicy, - proposalValidator, ) import Agora.SafeMoney (GTTag) -import Agora.Stake ( - PProposalLock (..), - PStakeDatum (..), - Stake (..), - stakePolicy, - stakeValidator, - ) -import Agora.Utils ( - findOutputsToAddress, - hasOnlyOneTokenOfCurrencySymbol, - mustBePDJust, - mustBePJust, - mustFindDatum', - passert, - passetClassValueOf, - passetClassValueOf', - pfindDatum, - pfindTxInByTxOutRef, - pisDJust, - pisJust, - pisUTXOSpent, - psymbolValueOf, - ptxSignedBy, - pvalueSpent, - scriptHashFromAddress, - ) -------------------------------------------------------------------------------- -import Plutarch (popaque) -import Plutarch.Api.V1 ( - PAddress, - PCurrencySymbol, - PDatumHash, - PMap, - PMintingPolicy, - PScriptPurpose (PSpending, PMinting), - PTxOut, - PValidator, - PValidatorHash, - PValue, - mintingPolicySymbol, - mkMintingPolicy, - mkValidator, - validatorHash, - ) -import Plutarch.Api.V1.Extra ( - pownMintValue, - ) -import Plutarch.Builtin (pforgetData) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift (PUnsafeLiftDecl (..)) -import Plutarch.Map.Extra (pkeys, plookup, plookup') -import Plutarch.Monadic qualified as P -import Plutarch.SafeMoney (PDiscrete, Tagged (..), puntag, pvalueDiscrete) +import Plutarch.SafeMoney (Tagged (..)) +import Plutarch.TryFrom (PTryFrom (..)) import Plutarch.Unsafe (punsafeCoerce) -import Plutarch.TryFrom(PTryFrom(..), ptryFrom) -------------------------------------------------------------------------------- -import Plutus.V1.Ledger.Api ( - Address (Address), - Credential (ScriptCredential), - CurrencySymbol (..), - MintingPolicy, - TxOutRef, - ) -import Plutus.V1.Ledger.Value ( - AssetClass (..), - ) +import Plutus.V1.Ledger.Api (TxOutRef) +import Plutus.V1.Ledger.Value (AssetClass (..)) import PlutusTx qualified -------------------------------------------------------------------------------- -{- $gst - Governance state token, aka. GST, is an NFT that identifies a UTXO that carries the state datum of the Governance script. - - This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. - - The 'governorValidator' ensures that exactly one GST stays at the address of itself forever. --} - --------------------------------------------------------------------------------- - -- | State datum for the Governor script. data GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds @@ -213,13 +120,12 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) - -- FIXME: derive this via 'PIsDataReprInstances' -- Blocked by: PProposalThresholds instance PTryFrom PData (PAsData PGovernorDatum) where type PTryFromExcess PData (PAsData PGovernorDatum) = Const () - ptryFrom' d k = k (punsafeCoerce d , ()) + ptryFrom' d k = k (punsafeCoerce d, ()) -- | Plutarch-level version of 'GovernorRedeemer'. data PGovernorRedeemer (s :: S) @@ -237,569 +143,3 @@ instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer) - --------------------------------------------------------------------------------- - -{- | Policy for minting GSTs. - - This policy perform the following checks: - - - The UTXO referenced in the parameter is spent in the transaction. - - Exactly one GST is minted. - - Ensure the token name is empty. - - NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator. - We /can't/ really check this in the policy, otherwise we create a cyclic reference issue. --} -governorPolicy :: Governor -> ClosedTerm PMintingPolicy -governorPolicy gov = - plam $ \_ ctx' -> P.do - let oref = pconstant gov.gstOutRef - - PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') - - mintValue <- plet $ pownMintValue # ctx' - - passert "Referenced utxo should be spent" $ - pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' - - passert "Exactly one token should be minted" $ - psymbolValueOf # ownSymbol # mintValue #== 1 - #&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 - - popaque (pconstant ()) - -{- | Validator for Governors. - -== Common checks - -The validator always ensures: - - - The UTXO which holds the GST must be spent. - - The GST always stays at the validator's address. - - The new state UTXO has a valid datum of type 'GovernorDatum'. - -== Creating a Proposal - -When the redeemer is 'CreateProposal', the script will check: - -- For governor's state datum: - - * 'nextProposalId' is advanced. - * Nothing is changed other that that. - -- Exactly one stake (the "input stake") must be provided in the input: - * At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction. - * The transaction must be signed by the stake owner. - -- Exactly one new proposal state token is minted. -- An UTXO which holds the newly minted proposal state token is sent to the proposal validator. - This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must: - - * Copy its id and thresholds from the governor's state. - * Have status set to 'Proposal.Draft'. - * Have zero votes. - * Have exactly one cosigner - the stake owner - -- An UTXO which holds the stake state token is sent back to the stake validator. - This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum': - - * The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed, - comparing to the input stake. - * The new proposal locks must be appended to the 'Agora.Stake.lockedBy'. - -== Minting GATs - -When the redeemer is 'MintGATs', the script will check: - -- Governor's state is not changed. -- Exactly only one proposal is in the inputs. Let's call this the /input proposal/. -- The proposal is in the 'Proposal.Executable' state. - -NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs. - -=== Effect Group Selection - -Currently a proposal can have two or more than two options to vote on, - meaning that it can contains two or more effect groups, - according to [#39](https://github.com/Liqwid-Labs/agora/issues/39). - -Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. - This is checked by 'Proposal.proposalDatumValid'. - -The script will look at the the 'Proposal.votes' to determine which group has the highest votes, - said group shoud be executed. - -During the process, minimum votes requirement will also be enforced. - -Next, the script will: - -- Ensure that for every effect in the said effect group, - exactly one valid GAT is minted and sent to the effect. -- The amount of GAT minted in the transaction should be equal to the number of effects. -- A new UTXO is sent to the proposal validator, this UTXO should: - - * Include the one proposal state token. - * Have a valid datum of type 'Proposal.ProposalDatum'. - This datum should be as same as the one of the input proposal, - except its status should be 'Proposal.Finished'. - -== Changing the State - -Redeemer 'MutateGovernor' allows the state datum to be changed by an external effect. - -In this case, the script will check - -- Exactly one GAT is burnt in the transaction. -- Said GAT is tagged by the effect. --} -governorValidator :: Governor -> ClosedTerm PValidator -governorValidator gov = - plam $ \datum' redeemer' ctx' -> P.do - (pfromData -> redeemer, _) <- ptryFrom redeemer' - ctx <- pletFields @'["txInfo", "purpose"] ctx' - - txInfo' <- plet $ pfromData $ ctx.txInfo - txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' - - datums <- plet $ pfromData $ pfield @"data" # txInfo' - - valueSpent <- plet $ pvalueSpent # txInfo' - - PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose - let txOutRef = pfromData txOutRef' - - PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' - ownInput <- pletFields @'["address", "value"] ownInput' - let selfAddress = pfromData $ ownInput.address - - (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' - oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' - - let ownInputGSTAmount = stateTokenValueOf # ownInput.value - passert "Own input should have exactly one state token" $ - ownInputGSTAmount #== 1 - - ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress - passert "Exactly one utxo should be sent to the governor" $ - plength # ownOutputs #== 1 - - ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs - let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value - passert "State token should stay at governor's address" $ - ownOuputGSTAmount #== 1 - passert "Output utxo to governor should have datum" $ - pisDJust # ownOutput.datumHash - - let outputGovernorStateDatumHash = mustBePDJust # "Output governor state datum hash not found" # ownOutput.datumHash - - newDatumData <- - plet $ - pforgetData $ - pdata $ - mustBePJust # "Ouput governor state datum not found" - #$ pfindDatum # outputGovernorStateDatumHash # txInfo' - - pmatch redeemer $ \case - PCreateProposal _ -> P.do - let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId - expectedNewDatum = - pcon $ - PGovernorDatum $ - pdcons @"proposalThresholds" # oldParams.proposalThresholds - #$ pdcons @"nextProposalId" # pdata expectedNextProposalId # pdnil - - passert "Unexpected governor state datum" $ - newDatumData #== pforgetData (pdata expectedNewDatum) - - passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint - - -- - - inputsFromStakeValidatorWithStateToken <- - plet $ - pfilter - # phoistAcyclic - ( plam $ - \((pfield @"resolved" #) -> txOut') -> P.do - txOut <- pletFields @'["address", "value"] txOut' - - txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 - ) - # pfromData txInfo.inputs - - passert "Exactly one input from the stake validator" $ - plength # inputsFromStakeValidatorWithStateToken #== 1 - - stakeInputDatumHash <- - plet $ - pfield @"datumHash" - #$ pfield @"resolved" - #$ phead # inputsFromStakeValidatorWithStateToken - - passert "Stake input must have datum" $ - pisDJust # stakeInputDatumHash - - let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums - - stakeInputDatum <- - pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' - - passert "Required amount of stake GT should be spent" $ - stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) - - passert "Tx should be signed by the stake owner" $ - ptxSignedBy # txInfo' # stakeInputDatum.owner - - -- - - outputsToProposalValidatorWithStateToken <- - plet $ - pfilter - # phoistAcyclic - ( plam $ - \txOut' -> P.do - txOut <- pletFields @'["address", "value"] txOut' - - txOut.address #== pdata pproposalValidatorAddress - #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 - ) - # pfromData txInfo.outputs - - passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ - plength # outputsToProposalValidatorWithStateToken #== 1 - - outputDatumHash <- plet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken - - passert "The utxo paid to the proposal validator must have datum" $ - pisDJust # outputDatumHash - - outputProposalDatum' <- - plet $ - mustFindDatum' @PProposalDatum - # outputDatumHash - # datums - - passert "Proposal datum must be valid" $ - proposalDatumValid # outputProposalDatum' - - outputProposalDatum <- - pletFields - @'["id", "status", "cosigners", "thresholds", "votes"] - outputProposalDatum' - - passert "Invalid proposal id in proposal datum" $ - outputProposalDatum.id #== oldParams.nextProposalId - - passert "Invalid thresholds in proposal datum" $ - outputProposalDatum.thresholds #== oldParams.proposalThresholds - - passert "Initial proposal votes should be empty" $ - pnull #$ pto $ pto $ pfromData outputProposalDatum.votes - - passert "Proposal state should be draft" $ - outputProposalDatum.status #== pconstantData Draft - - passert "Proposal should have only one cosigner" $ - plength # pfromData outputProposalDatum.cosigners #== 1 - - let cosigner = phead # pfromData outputProposalDatum.cosigners - - passert "Cosigner should be the stake owner" $ - pdata stakeInputDatum.owner #== cosigner - - -- - - outputToStakeValidatorWithStateToken <- - plet $ - pfilter - # phoistAcyclic - ( plam $ - \txOut' -> P.do - txOut <- pletFields @'["address", "value"] txOut' - - txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 - ) - # pfromData txInfo.outputs - - passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ - plength # outputToStakeValidatorWithStateToken #== 1 - - let stakeOutputDatumHash' = - pfield @"datumHash" - #$ pfromData - $ phead # outputToStakeValidatorWithStateToken - - stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputDatumHash' - - stakeOutputDatum = - pforgetData $ - pdata $ - mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' - - let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes - - mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) - mkProposalLock = - phoistAcyclic $ - plam - ( \pid rt' -> - let fields = - pdcons @"vote" # rt' - #$ pdcons @"proposalTag" # pdata pid # pdnil - in pdata $ pcon $ PProposalLock fields - ) - - expectedProposalLocks = - pconcat # stakeInputDatum.lockedBy - #$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults - - expectedOutputDatum = - pforgetData $ - pdata $ - pcon $ - PStakeDatum $ - pdcons @"stakedAmount" # pdata stakeInputDatum.stakedAmount - #$ pdcons @"owner" # pdata stakeInputDatum.owner - #$ pdcons @"lockedBy" # pdata expectedProposalLocks # pdnil - - passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum - - popaque $ pconstant () - PMintGATs _ -> P.do - passert "Governor state should not be changed" $ newDatumData #== datum' - - inputsWithProposalStateToken <- - plet $ - pfilter - # plam - ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 - ) - #$ pfromData txInfo.inputs - - outputsWithProposalStateToken <- - plet $ - pfilter - # plam - ( \((pfield @"value" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 - ) - #$ pfromData txInfo.outputs - - passert "The governor can only process one proposal at a time" $ - plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 - - proposalInputTxOut <- - pletFields @'["address", "value", "datumHash"] $ - pfield @"resolved" #$ phead # inputsWithProposalStateToken - proposalOutputTxOut <- - pletFields @'["datumHash", "address"] $ - phead # outputsWithProposalStateToken - - passert "Proposal state token must be sent back to the proposal validator" $ - proposalOutputTxOut.address #== pdata pproposalValidatorAddress - - inputProposalDatum' <- - plet $ - mustFindDatum' @PProposalDatum - # proposalInputTxOut.datumHash - # datums - outputProposalDatum' <- - plet $ - mustFindDatum' @PProposalDatum - # proposalOutputTxOut.datumHash - # datums - - passert "Proposal datum must be valid" $ - proposalDatumValid # inputProposalDatum' - #&& proposalDatumValid # outputProposalDatum' - - inputProposalDatum <- - pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] - inputProposalDatum' - - passert "Proposal must be in locked(executable) state in order to execute effects" $ - inputProposalDatum.status #== pconstantData Locked - - let expectedOutputProposalDatum = - pforgetData $ - pdata $ - pcon $ - PProposalDatum $ - pdcons @"id" # inputProposalDatum.id - #$ pdcons @"effects" # inputProposalDatum.effects - #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) - #$ pdcons @"cosigners" # inputProposalDatum.cosigners - #$ pdcons @"thresholds" # inputProposalDatum.thresholds - #$ pdcons @"votes" # inputProposalDatum.votes # pdnil - - passert "Unexpected output proposal datum" $ - pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum - - -- TODO: anything else to check here? - - let highestVoteFolder = - phoistAcyclic $ - plam - ( \pair last' -> - pif - (pisJust # last') - ( P.do - PJust last <- pmatch last' - let lastHighestVote = pfromData $ psndBuiltin # last - thisVote = pfromData $ psndBuiltin # pair - pif (lastHighestVote #< thisVote) (pcon $ PJust pair) last' - ) - (pcon $ PJust pair) - ) - - votesList = pto $ pto $ pfromData inputProposalDatum.votes - - winner' = - pfoldr # highestVoteFolder # pcon PNothing # votesList - - winner <- plet $ mustBePJust # "Empty votes" # winner' - - let highestVote = pfromData $ psndBuiltin # winner - minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds - - passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote - - let finalResultTag = pfromData $ pfstBuiltin # winner - - effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects - - gatCount <- plet $ plength #$ pto $ pto effectGroup - - passert "Required amount of GATs should be minted" $ - psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount - - outputsWithGAT <- - plet $ - pfilter - # phoistAcyclic - ( plam - ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSymbol # value - ) - ) - # pfromData txInfo.outputs - - passert "Output GATs is more than minted GATs" $ - plength # outputsWithGAT #== gatCount - - let gatOutputValidator' :: Term s ((PMap PValidatorHash PDatumHash) :--> (PAsData PTxOut) :--> PUnit :--> PUnit) - gatOutputValidator' = - phoistAcyclic $ - plam - ( \effects (pfromData -> output') _ -> P.do - output <- pletFields @'["address", "datumHash"] $ output' - - let scriptHash = - mustBePJust # "GAT receiver is not a script" - #$ scriptHashFromAddress # output.address - datumHash = - mustBePDJust # "Output to effect should have datum" - #$ output.datumHash - - expectedDatumHash = - mustBePJust # "Receiver is not in the effect list" - #$ plookup # scriptHash # effects - - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' - passert "Unexpected datum" $ datumHash #== expectedDatumHash - pconstant () - ) - - gatOutputValidator = gatOutputValidator' # effectGroup - - popaque $ - pfoldr - # gatOutputValidator - # pconstant () - # outputsWithGAT - PMutateGovernor _ -> P.do - popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint - where - stateTokenAssetClass :: AssetClass - stateTokenAssetClass = gstAssetClass gov - - outputProposalDatum :: Proposal - outputProposalDatum = - Proposal - { governorSTAssetClass = stateTokenAssetClass - } - - proposalSymbol :: CurrencySymbol - proposalSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ proposalPolicy outputProposalDatum - - pproposalSymbol :: Term s PCurrencySymbol - pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol - - proposalValidatorAddress :: Address - proposalValidatorAddress = Address (ScriptCredential hash) Nothing - where - hash = validatorHash validator - validator = mkValidator $ proposalValidator outputProposalDatum - - pproposalValidatorAddress :: Term s PAddress - pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress - - stateTokenValueOf :: Term s (PValue :--> PInteger) - stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - - pgatSymbol :: Term s PCurrencySymbol - pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov - - stakeParameters :: Stake - stakeParameters = Stake gov.gtClassRef - - stakeValidatorAddress :: Address - stakeValidatorAddress = Address (ScriptCredential hash) Nothing - where - validator = mkValidator $ stakeValidator stakeParameters - hash = validatorHash validator - - stakeStateSymbol :: CurrencySymbol - stakeStateSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ stakePolicy stakeParameters - - pstakeValidatorAddress :: Term s PAddress - pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress - - pstakeStateSymbol :: Term s PCurrencySymbol - pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol - - pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) - pgtValueOf = pvalueDiscrete gov.gtClassRef - --------------------------------------------------------------------------------- - --- | Get the 'AssetClass' of GST from 'Governor'. -gstAssetClass :: Governor -> AssetClass -gstAssetClass gov = AssetClass (symbol, "") - where - policy :: MintingPolicy - policy = mkMintingPolicy $ governorPolicy gov - - symbol :: CurrencySymbol - symbol = mintingPolicySymbol policy - --- | Get the `CurrencySymbol` of GAT from 'Governor'. -gatSymbol :: Governor -> CurrencySymbol -gatSymbol gov = mintingPolicySymbol policy - where - at = AuthorityToken $ gstAssetClass gov - policy = mkMintingPolicy $ authorityTokenPolicy at - --- | Get next proposal id. -pgetNextProposalId :: Term s (PProposalId :--> PProposalId) -pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs new file mode 100644 index 0000000..91cd640 --- /dev/null +++ b/agora/Agora/Governor/Scripts.hs @@ -0,0 +1,700 @@ +{- | +Module : Agora.Governor.Scripts +Maintainer : connor@mlabs.city +Description: Plutus scripts for Governors. + +Plutus scripts for Governors. +-} +module Agora.Governor.Scripts ( + -- * GST + -- $gst + + -- * Scripts + governorPolicy, + governorValidator, + + -- * Utilities + gstAssetClass, + gatSymbol, + pgetNextProposalId, +) where + +import Agora.Governor ( + Governor (gstOutRef, gtClassRef), + PGovernorDatum (PGovernorDatum), + PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), + ) + +-------------------------------------------------------------------------------- + +import Agora.AuthorityToken ( + AuthorityToken (..), + authorityTokenPolicy, + authorityTokensValidIn, + singleAuthorityTokenBurned, + ) +import Agora.Proposal ( + PProposalDatum (..), + PProposalId (..), + PProposalStatus (PFinished), + PResultTag, + Proposal (..), + ProposalStatus (Draft, Locked), + proposalDatumValid, + proposalPolicy, + proposalValidator, + ) +import Agora.SafeMoney (GTTag) +import Agora.Stake ( + PProposalLock (..), + PStakeDatum (..), + Stake (..), + stakePolicy, + stakeValidator, + ) +import Agora.Utils ( + findOutputsToAddress, + hasOnlyOneTokenOfCurrencySymbol, + mustBePDJust, + mustBePJust, + mustFindDatum', + passert, + passetClassValueOf, + passetClassValueOf', + pfindDatum, + pfindTxInByTxOutRef, + pisDJust, + pisJust, + pisUTXOSpent, + psymbolValueOf, + ptxSignedBy, + pvalueSpent, + scriptHashFromAddress, + ) + +-------------------------------------------------------------------------------- + +import Plutarch (popaque) +import Plutarch.Api.V1 ( + PAddress, + PCurrencySymbol, + PDatumHash, + PMap, + PMintingPolicy, + PScriptPurpose (PMinting, PSpending), + PTxOut, + PValidator, + PValidatorHash, + PValue, + mintingPolicySymbol, + mkMintingPolicy, + mkValidator, + validatorHash, + ) +import Plutarch.Api.V1.Extra ( + pownMintValue, + ) +import Plutarch.Builtin (pforgetData) +import Plutarch.Map.Extra ( + pkeys, + plookup, + plookup', + ) +import Plutarch.Monadic qualified as P +import Plutarch.SafeMoney ( + PDiscrete, + puntag, + pvalueDiscrete, + ) +import Plutarch.TryFrom (ptryFrom) + +-------------------------------------------------------------------------------- + +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (ScriptCredential), + CurrencySymbol (..), + MintingPolicy, + ) +import Plutus.V1.Ledger.Value ( + AssetClass (..), + ) + +-------------------------------------------------------------------------------- + +{- $gst + Governance state token, aka. GST, is an NFT that identifies a UTXO that + carries the state datum of the Governance script. + + This token is minted by a one-shot monetary policy 'governorPolicy', + meaning that the token has guaranteed uniqueness. + + The 'governorValidator' ensures that exactly one GST stays + at the address of itself forever. +-} + +-------------------------------------------------------------------------------- + +{- | Policy for minting GSTs. + + This policy perform the following checks: + + - The UTXO referenced in the parameter is spent in the transaction. + - Exactly one GST is minted. + - Ensure the token name is empty. + + NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator. + We /can't/ really check this in the policy, otherwise we create a cyclic reference issue. +-} +governorPolicy :: Governor -> ClosedTerm PMintingPolicy +governorPolicy gov = + plam $ \_ ctx' -> P.do + let oref = pconstant gov.gstOutRef + + PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') + + mintValue <- plet $ pownMintValue # ctx' + + passert "Referenced utxo should be spent" $ + pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' + + passert "Exactly one token should be minted" $ + psymbolValueOf # ownSymbol # mintValue #== 1 + #&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 + + popaque (pconstant ()) + +{- | Validator for Governors. + + == Common checks + + The validator always ensures: + + - The UTXO which holds the GST must be spent. + - The GST always stays at the validator's address. + - The new state UTXO has a valid datum of type 'GovernorDatum'. + + == Creating a Proposal + + When the redeemer is 'CreateProposal', the script will check: + + - For governor's state datum: + + * 'nextProposalId' is advanced. + * Nothing is changed other that that. + + - Exactly one stake (the "input stake") must be provided in the input: + * At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction. + * The transaction must be signed by the stake owner. + + - Exactly one new proposal state token is minted. + - An UTXO which holds the newly minted proposal state token is sent to the proposal validator. + This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must: + + * Copy its id and thresholds from the governor's state. + * Have status set to 'Proposal.Draft'. + * Have zero votes. + * Have exactly one cosigner - the stake owner + + - An UTXO which holds the stake state token is sent back to the stake validator. + This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum': + + * The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed, + comparing to the input stake. + * The new proposal locks must be appended to the 'Agora.Stake.lockedBy'. + + == Minting GATs + + When the redeemer is 'MintGATs', the script will check: + + - Governor's state is not changed. + - Exactly only one proposal is in the inputs. Let's call this the /input proposal/. + - The proposal is in the 'Proposal.Executable' state. + + NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs. + + === Effect Group Selection + + Currently a proposal can have two or more than two options to vote on, + meaning that it can contains two or more effect groups, + according to [#39](https://github.com/Liqwid-Labs/agora/issues/39). + + Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same. + This is checked by 'Proposal.proposalDatumValid'. + + The script will look at the the 'Proposal.votes' to determine which group has the highest votes, + said group shoud be executed. + + During the process, minimum votes requirement will also be enforced. + + Next, the script will: + + - Ensure that for every effect in the said effect group, + exactly one valid GAT is minted and sent to the effect. + - The amount of GAT minted in the transaction should be equal to the number of effects. + - A new UTXO is sent to the proposal validator, this UTXO should: + + * Include the one proposal state token. + * Have a valid datum of type 'Proposal.ProposalDatum'. + This datum should be as same as the one of the input proposal, + except its status should be 'Proposal.Finished'. + + == Changing the State + + Redeemer 'MutateGovernor' allows the state datum to be changed by an external effect. + + In this case, the script will check + + - Exactly one GAT is burnt in the transaction. + - Said GAT is tagged by the effect. +-} +governorValidator :: Governor -> ClosedTerm PValidator +governorValidator gov = + plam $ \datum' redeemer' ctx' -> P.do + (pfromData -> redeemer, _) <- ptryFrom redeemer' + ctx <- pletFields @'["txInfo", "purpose"] ctx' + + txInfo' <- plet $ pfromData $ ctx.txInfo + txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' + + datums <- plet $ pfromData $ pfield @"data" # txInfo' + + valueSpent <- plet $ pvalueSpent # txInfo' + + PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose + let txOutRef = pfromData txOutRef' + + PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' + ownInput <- pletFields @'["address", "value"] ownInput' + let selfAddress = pfromData $ ownInput.address + + (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' + oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' + + let ownInputGSTAmount = stateTokenValueOf # ownInput.value + passert "Own input should have exactly one state token" $ + ownInputGSTAmount #== 1 + + ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress + passert "Exactly one utxo should be sent to the governor" $ + plength # ownOutputs #== 1 + + ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs + let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value + passert "State token should stay at governor's address" $ + ownOuputGSTAmount #== 1 + passert "Output utxo to governor should have datum" $ + pisDJust # ownOutput.datumHash + + let outputGovernorStateDatumHash = mustBePDJust # "Output governor state datum hash not found" # ownOutput.datumHash + + newDatumData <- + plet $ + pforgetData $ + pdata $ + mustBePJust # "Ouput governor state datum not found" + #$ pfindDatum # outputGovernorStateDatumHash # txInfo' + + pmatch redeemer $ \case + PCreateProposal _ -> P.do + let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId + expectedNewDatum = + pcon $ + PGovernorDatum $ + pdcons @"proposalThresholds" # oldParams.proposalThresholds + #$ pdcons @"nextProposalId" # pdata expectedNextProposalId # pdnil + + passert "Unexpected governor state datum" $ + newDatumData #== pforgetData (pdata expectedNewDatum) + + passert "Exactly one proposal token must be minted" $ + hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint + + -- + + inputsFromStakeValidatorWithStateToken <- + plet $ + pfilter + # phoistAcyclic + ( plam $ + \((pfield @"resolved" #) -> txOut') -> P.do + txOut <- pletFields @'["address", "value"] txOut' + + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + ) + # pfromData txInfo.inputs + + passert "Exactly one input from the stake validator" $ + plength # inputsFromStakeValidatorWithStateToken #== 1 + + stakeInputDatumHash <- + plet $ + pfield @"datumHash" + #$ pfield @"resolved" + #$ phead # inputsFromStakeValidatorWithStateToken + + passert "Stake input must have datum" $ + pisDJust # stakeInputDatumHash + + let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums + + stakeInputDatum <- + pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' + + passert "Required amount of stake GT should be spent" $ + stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) + + passert "Tx should be signed by the stake owner" $ + ptxSignedBy # txInfo' # stakeInputDatum.owner + + -- + + outputsToProposalValidatorWithStateToken <- + plet $ + pfilter + # phoistAcyclic + ( plam $ + \txOut' -> P.do + txOut <- pletFields @'["address", "value"] txOut' + + txOut.address #== pdata pproposalValidatorAddress + #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 + ) + # pfromData txInfo.outputs + + passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ + plength # outputsToProposalValidatorWithStateToken #== 1 + + outputDatumHash <- plet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken + + passert "The utxo paid to the proposal validator must have datum" $ + pisDJust # outputDatumHash + + outputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # outputDatumHash + # datums + + passert "Proposal datum must be valid" $ + proposalDatumValid # outputProposalDatum' + + outputProposalDatum <- + pletFields + @'["id", "status", "cosigners", "thresholds", "votes"] + outputProposalDatum' + + passert "Invalid proposal id in proposal datum" $ + outputProposalDatum.id #== oldParams.nextProposalId + + passert "Invalid thresholds in proposal datum" $ + outputProposalDatum.thresholds #== oldParams.proposalThresholds + + passert "Initial proposal votes should be empty" $ + pnull #$ pto $ pto $ pfromData outputProposalDatum.votes + + passert "Proposal state should be draft" $ + outputProposalDatum.status #== pconstantData Draft + + passert "Proposal should have only one cosigner" $ + plength # pfromData outputProposalDatum.cosigners #== 1 + + let cosigner = phead # pfromData outputProposalDatum.cosigners + + passert "Cosigner should be the stake owner" $ + pdata stakeInputDatum.owner #== cosigner + + -- + + outputToStakeValidatorWithStateToken <- + plet $ + pfilter + # phoistAcyclic + ( plam $ + \txOut' -> P.do + txOut <- pletFields @'["address", "value"] txOut' + + txOut.address #== pdata pstakeValidatorAddress + #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + ) + # pfromData txInfo.outputs + + passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ + plength # outputToStakeValidatorWithStateToken #== 1 + + let stakeOutputDatumHash' = + pfield @"datumHash" + #$ pfromData + $ phead # outputToStakeValidatorWithStateToken + + stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputDatumHash' + + stakeOutputDatum = + pforgetData $ + pdata $ + mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' + + let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes + + mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) + mkProposalLock = + phoistAcyclic $ + plam + ( \pid rt' -> + let fields = + pdcons @"vote" # rt' + #$ pdcons @"proposalTag" # pdata pid # pdnil + in pdata $ pcon $ PProposalLock fields + ) + + expectedProposalLocks = + pconcat # stakeInputDatum.lockedBy + #$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults + + expectedOutputDatum = + pforgetData $ + pdata $ + pcon $ + PStakeDatum $ + pdcons @"stakedAmount" # pdata stakeInputDatum.stakedAmount + #$ pdcons @"owner" # pdata stakeInputDatum.owner + #$ pdcons @"lockedBy" # pdata expectedProposalLocks # pdnil + + passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum + + popaque $ pconstant () + PMintGATs _ -> P.do + passert "Governor state should not be changed" $ newDatumData #== datum' + + inputsWithProposalStateToken <- + plet $ + pfilter + # plam + ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> + psymbolValueOf # pproposalSymbol # value #== 1 + ) + #$ pfromData txInfo.inputs + + outputsWithProposalStateToken <- + plet $ + pfilter + # plam + ( \((pfield @"value" #) -> value) -> + psymbolValueOf # pproposalSymbol # value #== 1 + ) + #$ pfromData txInfo.outputs + + passert "The governor can only process one proposal at a time" $ + plength # inputsWithProposalStateToken #== 1 + #&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 + + proposalInputTxOut <- + pletFields @'["address", "value", "datumHash"] $ + pfield @"resolved" #$ phead # inputsWithProposalStateToken + proposalOutputTxOut <- + pletFields @'["datumHash", "address"] $ + phead # outputsWithProposalStateToken + + passert "Proposal state token must be sent back to the proposal validator" $ + proposalOutputTxOut.address #== pdata pproposalValidatorAddress + + inputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # proposalInputTxOut.datumHash + # datums + outputProposalDatum' <- + plet $ + mustFindDatum' @PProposalDatum + # proposalOutputTxOut.datumHash + # datums + + passert "Proposal datum must be valid" $ + proposalDatumValid # inputProposalDatum' + #&& proposalDatumValid # outputProposalDatum' + + inputProposalDatum <- + pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] + inputProposalDatum' + + passert "Proposal must be in locked(executable) state in order to execute effects" $ + inputProposalDatum.status #== pconstantData Locked + + let expectedOutputProposalDatum = + pforgetData $ + pdata $ + pcon $ + PProposalDatum $ + pdcons @"id" # inputProposalDatum.id + #$ pdcons @"effects" # inputProposalDatum.effects + #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) + #$ pdcons @"cosigners" # inputProposalDatum.cosigners + #$ pdcons @"thresholds" # inputProposalDatum.thresholds + #$ pdcons @"votes" # inputProposalDatum.votes # pdnil + + passert "Unexpected output proposal datum" $ + pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum + + -- TODO: anything else to check here? + + let highestVoteFolder = + phoistAcyclic $ + plam + ( \pair last' -> + pif + (pisJust # last') + ( P.do + PJust last <- pmatch last' + let lastHighestVote = pfromData $ psndBuiltin # last + thisVote = pfromData $ psndBuiltin # pair + pif (lastHighestVote #< thisVote) (pcon $ PJust pair) last' + ) + (pcon $ PJust pair) + ) + + votesList = pto $ pto $ pfromData inputProposalDatum.votes + + winner' = + pfoldr # highestVoteFolder # pcon PNothing # votesList + + winner <- plet $ mustBePJust # "Empty votes" # winner' + + let highestVote = pfromData $ psndBuiltin # winner + minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds + + passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote + + let finalResultTag = pfromData $ pfstBuiltin # winner + + effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects + + gatCount <- plet $ plength #$ pto $ pto effectGroup + + passert "Required amount of GATs should be minted" $ + psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount + + outputsWithGAT <- + plet $ + pfilter + # phoistAcyclic + ( plam + ( \((pfield @"value" #) -> value) -> + 0 #< psymbolValueOf # pgatSymbol # value + ) + ) + # pfromData txInfo.outputs + + passert "Output GATs is more than minted GATs" $ + plength # outputsWithGAT #== gatCount + + let gatOutputValidator' :: Term s ((PMap PValidatorHash PDatumHash) :--> (PAsData PTxOut) :--> PUnit :--> PUnit) + gatOutputValidator' = + phoistAcyclic $ + plam + ( \effects (pfromData -> output') _ -> P.do + output <- pletFields @'["address", "datumHash"] $ output' + + let scriptHash = + mustBePJust # "GAT receiver is not a script" + #$ scriptHashFromAddress # output.address + datumHash = + mustBePDJust # "Output to effect should have datum" + #$ output.datumHash + + expectedDatumHash = + mustBePJust # "Receiver is not in the effect list" + #$ plookup # scriptHash # effects + + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' + passert "Unexpected datum" $ datumHash #== expectedDatumHash + pconstant () + ) + + gatOutputValidator = gatOutputValidator' # effectGroup + + popaque $ + pfoldr + # gatOutputValidator + # pconstant () + # outputsWithGAT + PMutateGovernor _ -> P.do + popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint + where + stateTokenAssetClass :: AssetClass + stateTokenAssetClass = gstAssetClass gov + + outputProposalDatum :: Proposal + outputProposalDatum = + Proposal + { governorSTAssetClass = stateTokenAssetClass + } + + proposalSymbol :: CurrencySymbol + proposalSymbol = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ proposalPolicy outputProposalDatum + + pproposalSymbol :: Term s PCurrencySymbol + pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol + + proposalValidatorAddress :: Address + proposalValidatorAddress = Address (ScriptCredential hash) Nothing + where + hash = validatorHash validator + validator = mkValidator $ proposalValidator outputProposalDatum + + pproposalValidatorAddress :: Term s PAddress + pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress + + stateTokenValueOf :: Term s (PValue :--> PInteger) + stateTokenValueOf = passetClassValueOf' stateTokenAssetClass + + pgatSymbol :: Term s PCurrencySymbol + pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov + + stakeParameters :: Stake + stakeParameters = Stake gov.gtClassRef + + stakeValidatorAddress :: Address + stakeValidatorAddress = Address (ScriptCredential hash) Nothing + where + validator = mkValidator $ stakeValidator stakeParameters + hash = validatorHash validator + + stakeStateSymbol :: CurrencySymbol + stakeStateSymbol = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ stakePolicy stakeParameters + + pstakeValidatorAddress :: Term s PAddress + pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress + + pstakeStateSymbol :: Term s PCurrencySymbol + pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol + + pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) + pgtValueOf = pvalueDiscrete gov.gtClassRef + +-------------------------------------------------------------------------------- + +-- | Get the 'AssetClass' of GST from 'Governor'. +gstAssetClass :: Governor -> AssetClass +gstAssetClass gov = AssetClass (symbol, "") + where + policy :: MintingPolicy + policy = mkMintingPolicy $ governorPolicy gov + + symbol :: CurrencySymbol + symbol = mintingPolicySymbol policy + +-- | Get the `CurrencySymbol` of GAT from 'Governor'. +gatSymbol :: Governor -> CurrencySymbol +gatSymbol gov = mintingPolicySymbol policy + where + at = AuthorityToken $ gstAssetClass gov + policy = mkMintingPolicy $ authorityTokenPolicy at + +-- | Get next proposal id. +pgetNextProposalId :: Term s (PProposalId :--> PProposalId) +pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 From 45d91b5aeb2ad189736fa8d0be9012a2d0d4c0ad Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 21:27:31 +0800 Subject: [PATCH 061/107] fix compilation errors introduced by new util functions ... and export a bunch of bridge functions from the governor --- agora/Agora/AuthorityToken.hs | 2 +- agora/Agora/Governor.hs | 21 ++- agora/Agora/Governor/Scripts.hs | 266 ++++++++++++++++++-------------- agora/Agora/Utils.hs | 27 ++-- 4 files changed, 188 insertions(+), 128 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index d18321d..38f45f4 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -24,11 +24,11 @@ import Plutarch.Api.V1 ( PTxOut (..), ) import Plutarch.Api.V1.AssocMap (PMap (PMap)) +import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) import Prelude diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index bd3b375..57e40f1 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -16,6 +16,9 @@ module Agora.Governor ( -- * Plutarch-land PGovernorDatum (..), PGovernorRedeemer (..), + + -- * Plutus Utilities + pgetNextProposalId, ) where -------------------------------------------------------------------------------- @@ -27,7 +30,7 @@ import Generics.SOP (Generic, I (I)) -------------------------------------------------------------------------------- import Agora.Proposal ( - PProposalId , + PProposalId (..), PProposalThresholds, ProposalId, ProposalThresholds, @@ -41,7 +44,7 @@ import Plutarch.DataRepr ( PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) -import Plutarch.Lift (PUnsafeLiftDecl (..)) +import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.SafeMoney (Tagged (..)) import Plutarch.TryFrom (PTryFrom (..)) import Plutarch.Unsafe (punsafeCoerce) @@ -95,6 +98,10 @@ data Governor = Governor { gstOutRef :: TxOutRef -- ^ Referenced utxo will be spent to mint the GST. , gtClassRef :: Tagged GTTag AssetClass + -- ^ Governance token of the system. + , maximumCosigners :: Integer + -- ^ Arbitrary limit for maximum amount of cosigners on a proposal. + -- See `Agora.Proposal.proposalDatumValid`. } -------------------------------------------------------------------------------- @@ -118,7 +125,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum via PIsDataReprInstances PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum -deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) +deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum) -- FIXME: derive this via 'PIsDataReprInstances' -- Blocked by: PProposalThresholds @@ -140,6 +147,12 @@ data PGovernorRedeemer (s :: S) via PIsDataReprInstances PGovernorRedeemer instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer -deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) +deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer) deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer) + +-------------------------------------------------------------------------------- + +-- | Get next proposal id. +pgetNextProposalId :: Term s (PProposalId :--> PProposalId) +pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 91cd640..ee4a052 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -13,17 +13,21 @@ module Agora.Governor.Scripts ( governorPolicy, governorValidator, - -- * Utilities - gstAssetClass, - gatSymbol, - pgetNextProposalId, + -- * Bridges + governorSTSymbolFromGovernor, + governorSTAssetClassFromGovernor, + atSymbolFromGovernor, + proposalSTAssetClassFromGovernor, + stakeSTSymbolFromGovernor, + stakeFromGovernor, + stakeValidatorHashFromGovernor, + proposalFromGovernor, + proposalValidatorHashFromGovernor, ) where -import Agora.Governor ( - Governor (gstOutRef, gtClassRef), - PGovernorDatum (PGovernorDatum), - PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), - ) +-------------------------------------------------------------------------------- + +import Data.Coerce (coerce) -------------------------------------------------------------------------------- @@ -33,6 +37,12 @@ import Agora.AuthorityToken ( authorityTokensValidIn, singleAuthorityTokenBurned, ) +import Agora.Governor ( + Governor (gstOutRef, gtClassRef, maximumCosigners), + PGovernorDatum (PGovernorDatum), + PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), + pgetNextProposalId, + ) import Agora.Proposal ( PProposalDatum (..), PProposalId (..), @@ -41,6 +51,8 @@ import Agora.Proposal ( Proposal (..), ProposalStatus (Draft, Locked), proposalDatumValid, + ) +import Agora.Proposal.Scripts ( proposalPolicy, proposalValidator, ) @@ -49,6 +61,8 @@ import Agora.Stake ( PProposalLock (..), PStakeDatum (..), Stake (..), + ) +import Agora.Stake.Scripts ( stakePolicy, stakeValidator, ) @@ -59,8 +73,6 @@ import Agora.Utils ( mustBePJust, mustFindDatum', passert, - passetClassValueOf, - passetClassValueOf', pfindDatum, pfindTxInByTxOutRef, pisDJust, @@ -70,11 +82,11 @@ import Agora.Utils ( ptxSignedBy, pvalueSpent, scriptHashFromAddress, + validatorHashToAddress, ) -------------------------------------------------------------------------------- -import Plutarch (popaque) import Plutarch.Api.V1 ( PAddress, PCurrencySymbol, @@ -92,7 +104,8 @@ import Plutarch.Api.V1 ( validatorHash, ) import Plutarch.Api.V1.Extra ( - pownMintValue, + passetClass, + passetClassValueOf, ) import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra ( @@ -104,18 +117,18 @@ import Plutarch.Monadic qualified as P import Plutarch.SafeMoney ( PDiscrete, puntag, - pvalueDiscrete, + pvalueDiscrete', ) import Plutarch.TryFrom (ptryFrom) -------------------------------------------------------------------------------- import Plutus.V1.Ledger.Api ( - Address (Address), - Credential (ScriptCredential), CurrencySymbol (..), MintingPolicy, + TokenName (..), ) +import Plutus.V1.Ledger.Scripts (ValidatorHash (..)) import Plutus.V1.Ledger.Value ( AssetClass (..), ) @@ -123,13 +136,13 @@ import Plutus.V1.Ledger.Value ( -------------------------------------------------------------------------------- {- $gst - Governance state token, aka. GST, is an NFT that identifies a UTXO that + Governance state token, aka. GST, is an NFT that identifies a UTXO that carries the state datum of the Governance script. - This token is minted by a one-shot monetary policy 'governorPolicy', + This token is minted by a one-shot monetary policy 'governorPolicy', meaning that the token has guaranteed uniqueness. - The 'governorValidator' ensures that exactly one GST stays + The 'governorValidator' ensures that exactly one GST stays at the address of itself forever. -} @@ -152,15 +165,17 @@ governorPolicy gov = let oref = pconstant gov.gstOutRef PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') + let ownAssetClass = passetClass # ownSymbol # pconstant "" + txInfo = pfromData $ pfield @"txInfo" # ctx' - mintValue <- plet $ pownMintValue # ctx' + txInfoF <- pletFields @'["mint", "inputs"] txInfo passert "Referenced utxo should be spent" $ - pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' + pisUTXOSpent # oref # txInfoF.inputs passert "Exactly one token should be minted" $ - psymbolValueOf # ownSymbol # mintValue #== 1 - #&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 + psymbolValueOf # ownSymbol # txInfoF.mint #== 1 + #&& passetClassValueOf # txInfoF.mint # ownAssetClass #== 1 popaque (pconstant ()) @@ -255,32 +270,30 @@ governorValidator gov = ctx <- pletFields @'["txInfo", "purpose"] ctx' txInfo' <- plet $ pfromData $ ctx.txInfo - txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' + txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' - datums <- plet $ pfromData $ pfield @"data" # txInfo' - - valueSpent <- plet $ pvalueSpent # txInfo' + valueSpent <- plet $ pvalueSpent # txInfo.inputs PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose let txOutRef = pfromData txOutRef' - PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' + PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo.inputs ownInput <- pletFields @'["address", "value"] ownInput' let selfAddress = pfromData $ ownInput.address (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' - let ownInputGSTAmount = stateTokenValueOf # ownInput.value + let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInput.value passert "Own input should have exactly one state token" $ ownInputGSTAmount #== 1 - ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress + ownOutputs <- plet $ findOutputsToAddress # txInfo.outputs # selfAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs - let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value + let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value passert "State token should stay at governor's address" $ ownOuputGSTAmount #== 1 passert "Output utxo to governor should have datum" $ @@ -293,7 +306,7 @@ governorValidator gov = pforgetData $ pdata $ mustBePJust # "Ouput governor state datum not found" - #$ pfindDatum # outputGovernorStateDatumHash # txInfo' + #$ pfindDatum # outputGovernorStateDatumHash # txInfo.datums pmatch redeemer $ \case PCreateProposal _ -> P.do @@ -308,7 +321,7 @@ governorValidator gov = newDatumData #== pforgetData (pdata expectedNewDatum) passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint + hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfo.mint -- @@ -321,7 +334,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) # pfromData txInfo.inputs @@ -337,7 +350,7 @@ governorValidator gov = passert "Stake input must have datum" $ pisDJust # stakeInputDatumHash - let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums + let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # txInfo.datums stakeInputDatum <- pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' @@ -346,7 +359,7 @@ governorValidator gov = stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) passert "Tx should be signed by the stake owner" $ - ptxSignedBy # txInfo' # stakeInputDatum.owner + ptxSignedBy # txInfo.signatories # stakeInputDatum.owner -- @@ -359,7 +372,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pproposalValidatorAddress - #&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 + #&& psymbolValueOf # ppstSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -375,18 +388,18 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # outputDatumHash - # datums + # txInfo.datums passert "Proposal datum must be valid" $ - proposalDatumValid # outputProposalDatum' + proposalDatumValid' # outputProposalDatum' outputProposalDatum <- pletFields - @'["id", "status", "cosigners", "thresholds", "votes"] + @'["proposalId", "status", "cosigners", "thresholds", "votes"] outputProposalDatum' passert "Invalid proposal id in proposal datum" $ - outputProposalDatum.id #== oldParams.nextProposalId + outputProposalDatum.proposalId #== oldParams.nextProposalId passert "Invalid thresholds in proposal datum" $ outputProposalDatum.thresholds #== oldParams.proposalThresholds @@ -416,7 +429,7 @@ governorValidator gov = txOut <- pletFields @'["address", "value"] txOut' txOut.address #== pdata pstakeValidatorAddress - #&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 + #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) # pfromData txInfo.outputs @@ -433,7 +446,7 @@ governorValidator gov = stakeOutputDatum = pforgetData $ pdata $ - mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' + mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo.datums let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes @@ -450,7 +463,7 @@ governorValidator gov = expectedProposalLocks = pconcat # stakeInputDatum.lockedBy - #$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults + #$ pmap # (mkProposalLock # outputProposalDatum.proposalId) # possibleVoteResults expectedOutputDatum = pforgetData $ @@ -472,7 +485,7 @@ governorValidator gov = pfilter # plam ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 + psymbolValueOf # ppstSymbol # value #== 1 ) #$ pfromData txInfo.inputs @@ -481,13 +494,13 @@ governorValidator gov = pfilter # plam ( \((pfield @"value" #) -> value) -> - psymbolValueOf # pproposalSymbol # value #== 1 + psymbolValueOf # ppstSymbol # value #== 1 ) #$ pfromData txInfo.outputs passert "The governor can only process one proposal at a time" $ plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 + #&& (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfo.inputs) #== 1 proposalInputTxOut <- pletFields @'["address", "value", "datumHash"] $ @@ -503,19 +516,19 @@ governorValidator gov = plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash - # datums + # txInfo.datums outputProposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalOutputTxOut.datumHash - # datums + # txInfo.datums passert "Proposal datum must be valid" $ - proposalDatumValid # inputProposalDatum' - #&& proposalDatumValid # outputProposalDatum' + proposalDatumValid' # inputProposalDatum' + #&& proposalDatumValid' # outputProposalDatum' inputProposalDatum <- - pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] + pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"] inputProposalDatum' passert "Proposal must be in locked(executable) state in order to execute effects" $ @@ -526,7 +539,7 @@ governorValidator gov = pdata $ pcon $ PProposalDatum $ - pdcons @"id" # inputProposalDatum.id + pdcons @"proposalId" # inputProposalDatum.proposalId #$ pdcons @"effects" # inputProposalDatum.effects #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) #$ pdcons @"cosigners" # inputProposalDatum.cosigners @@ -572,7 +585,7 @@ governorValidator gov = gatCount <- plet $ plength #$ pto $ pto effectGroup passert "Required amount of GATs should be minted" $ - psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount + psymbolValueOf # ppstSymbol # txInfo.mint #== gatCount outputsWithGAT <- plet $ @@ -580,7 +593,7 @@ governorValidator gov = # phoistAcyclic ( plam ( \((pfield @"value" #) -> value) -> - 0 #< psymbolValueOf # pgatSymbol # value + 0 #< psymbolValueOf # patSymbol # value ) ) # pfromData txInfo.outputs @@ -606,7 +619,7 @@ governorValidator gov = mustBePJust # "Receiver is not in the effect list" #$ plookup # scriptHash # effects - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' + passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output' passert "Unexpected datum" $ datumHash #== expectedDatumHash pconstant () ) @@ -619,82 +632,111 @@ governorValidator gov = # pconstant () # outputsWithGAT PMutateGovernor _ -> P.do - popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint + popaque $ singleAuthorityTokenBurned patSymbol ctx.txInfo txInfo.mint where - stateTokenAssetClass :: AssetClass - stateTokenAssetClass = gstAssetClass gov + pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) + pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef - outputProposalDatum :: Proposal - outputProposalDatum = - Proposal - { governorSTAssetClass = stateTokenAssetClass - } + patSymbol :: Term s PCurrencySymbol + patSymbol = phoistAcyclic $ pconstant $ atSymbolFromGovernor gov - proposalSymbol :: CurrencySymbol - proposalSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ proposalPolicy outputProposalDatum + ppstSymbol :: Term s PCurrencySymbol + ppstSymbol = + let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov + in phoistAcyclic $ pconstant sym - pproposalSymbol :: Term s PCurrencySymbol - pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol - - proposalValidatorAddress :: Address - proposalValidatorAddress = Address (ScriptCredential hash) Nothing - where - hash = validatorHash validator - validator = mkValidator $ proposalValidator outputProposalDatum + proposalDatumValid' :: Term s (PProposalDatum :--> PBool) + proposalDatumValid' = + let params = proposalFromGovernor gov + in phoistAcyclic $ proposalDatumValid params pproposalValidatorAddress :: Term s PAddress - pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress - - stateTokenValueOf :: Term s (PValue :--> PInteger) - stateTokenValueOf = passetClassValueOf' stateTokenAssetClass - - pgatSymbol :: Term s PCurrencySymbol - pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov - - stakeParameters :: Stake - stakeParameters = Stake gov.gtClassRef - - stakeValidatorAddress :: Address - stakeValidatorAddress = Address (ScriptCredential hash) Nothing - where - validator = mkValidator $ stakeValidator stakeParameters - hash = validatorHash validator - - stakeStateSymbol :: CurrencySymbol - stakeStateSymbol = mintingPolicySymbol policy - where - policy = mkMintingPolicy $ stakePolicy stakeParameters + pproposalValidatorAddress = + let vh = proposalValidatorHashFromGovernor gov + in phoistAcyclic $ pconstant $ validatorHashToAddress vh pstakeValidatorAddress :: Term s PAddress - pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress + pstakeValidatorAddress = + let vh = stakeValidatorHashFromGovernor gov + in phoistAcyclic $ pconstant $ validatorHashToAddress vh - pstakeStateSymbol :: Term s PCurrencySymbol - pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol + psstSymbol :: Term s PCurrencySymbol + psstSymbol = + let sym = stakeSTSymbolFromGovernor gov + in phoistAcyclic $ pconstant sym - pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) - pgtValueOf = pvalueDiscrete gov.gtClassRef + pgstSymbol :: Term s PCurrencySymbol + pgstSymbol = + let sym = governorSTSymbolFromGovernor gov + in phoistAcyclic $ pconstant sym -------------------------------------------------------------------------------- --- | Get the 'AssetClass' of GST from 'Governor'. -gstAssetClass :: Governor -> AssetClass -gstAssetClass gov = AssetClass (symbol, "") +governorSTSymbolFromGovernor :: Governor -> CurrencySymbol +governorSTSymbolFromGovernor gov = mintingPolicySymbol policy where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov +{- | Get the 'AssetClass' of GST from 'Governor'. + TODO: tag GST? +-} +governorSTAssetClassFromGovernor :: Governor -> AssetClass +governorSTAssetClassFromGovernor gov = AssetClass (symbol, "") + where symbol :: CurrencySymbol - symbol = mintingPolicySymbol policy + symbol = governorSTSymbolFromGovernor gov -- | Get the `CurrencySymbol` of GAT from 'Governor'. -gatSymbol :: Governor -> CurrencySymbol -gatSymbol gov = mintingPolicySymbol policy +atSymbolFromGovernor :: Governor -> CurrencySymbol +atSymbolFromGovernor gov = mintingPolicySymbol policy where - at = AuthorityToken $ gstAssetClass gov + at = AuthorityToken $ governorSTAssetClassFromGovernor gov policy = mkMintingPolicy $ authorityTokenPolicy at --- | Get next proposal id. -pgetNextProposalId :: Term s (PProposalId :--> PProposalId) -pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 +proposalSTAssetClassFromGovernor :: Governor -> AssetClass +proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") + where + gstAC = governorSTAssetClassFromGovernor gov + -- JUSTIFICATIONL: the PST policy doesn't care about the following two fields at all. + -- FIXME: refactor PST policy, parameterize it only with GST assetclass or something. + sstAC = AssetClass ("", "") + mc = -1 + params = Proposal gstAC sstAC mc + + policy = mkMintingPolicy $ proposalPolicy params + symbol = mintingPolicySymbol policy + +stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol +stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ stakePolicy gov.gtClassRef + +stakeFromGovernor :: Governor -> Stake +stakeFromGovernor gov = + Stake gov.gtClassRef $ + proposalSTAssetClassFromGovernor gov + +stakeValidatorHashFromGovernor :: Governor -> ValidatorHash +stakeValidatorHashFromGovernor gov = validatorHash validator + where + params = stakeFromGovernor gov + validator = mkValidator $ stakeValidator params + +proposalFromGovernor :: Governor -> Proposal +proposalFromGovernor gov = Proposal gstAC sstAC mc + where + gstAC = governorSTAssetClassFromGovernor gov + mc = gov.maximumCosigners + + sstS = stakeSTSymbolFromGovernor gov + -- The stake state token is tagged with the address which it's sent to. + sstTN :: TokenName + sstTN = coerce $ stakeValidatorHashFromGovernor gov + sstAC = AssetClass (sstS, sstTN) + +proposalValidatorHashFromGovernor :: Governor -> ValidatorHash +proposalValidatorHashFromGovernor gov = validatorHash validator + where + params = proposalFromGovernor gov + validator = mkValidator $ proposalValidator params diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 34a47fc..5e34b55 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -47,6 +47,7 @@ module Agora.Utils ( mustFindDatum', mustBePJust, mustBePDJust, + validatorHashToAddress, ) where -------------------------------------------------------------------------------- @@ -55,6 +56,8 @@ import Plutus.V1.Ledger.Api ( CurrencySymbol, TokenName (..), ValidatorHash (..), + Credential(..), + Address(..), ) import Plutus.V1.Ledger.Value (AssetClass (..)) @@ -71,8 +74,6 @@ import Plutarch.Api.V1 ( PMintingPolicy, PPubKeyHash, PTokenName (PTokenName), - PScriptContext, - PScriptPurpose (PMinting), PTuple, PTxInInfo (PTxInInfo), PTxInfo, @@ -86,7 +87,7 @@ import Plutarch.Api.V1 ( import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf) import Plutarch.Api.V1.Value (PValue (PValue)) -import Plutarch.Builtin (ppairDataBuiltin) +import Plutarch.Builtin (pforgetData, ppairDataBuiltin) import Plutarch.Map.Extra (pkeys) import Plutarch.Monadic qualified as P import Plutarch.TryFrom (PTryFrom, ptryFrom) @@ -365,7 +366,7 @@ pisUniq = #&& (self # xs) ) (const $ pcon PTrue) - + -- | Yield True if a given PMaybeData is of form PDJust _. pisDJust :: Term s (PMaybeData a :--> PBool) pisDJust = phoistAcyclic $ @@ -377,12 +378,13 @@ pisDJust = phoistAcyclic $ _ -> pconstant False ) --- | Determines if a given UTXO is spent. --- TODO: no need to pass the whole TxInfo here. -pisUTXOSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) +{- | Determines if a given UTXO is spent. + TODO: no need to pass the whole TxInfo here. +-} +pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool) pisUTXOSpent = phoistAcyclic $ - plam $ \oref info -> P.do - pisJust #$ pfindTxInByTxOutRef # oref # info + plam $ \oref inputs -> P.do + pisJust #$ pfindTxInByTxOutRef # oref # inputs -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed @@ -526,7 +528,7 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $ -- | Find datum given a maybe datum hash mustFindDatum' :: forall (datum :: PType). - (PIsData datum, PTryFrom PData (PAsData datum))=> + (PIsData datum, PTryFrom PData (PAsData datum)) => forall s. Term s @@ -538,7 +540,7 @@ mustFindDatum' = phoistAcyclic $ plam $ \mdh datums -> P.do let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums - (d, _ ) <- ptryFrom $ pforgetData $ pdata dt + (d, _) <- ptryFrom $ pforgetData $ pdata dt pfromData d {- | Extract the value stored in a PMaybe container. @@ -558,3 +560,6 @@ mustBePDJust = phoistAcyclic $ plam $ \emsg mv' -> pmatch mv' $ \case PDJust ((pfield @"_0" #) -> v) -> v _ -> ptraceError emsg + +validatorHashToAddress :: ValidatorHash -> Address +validatorHashToAddress vh = Address (ScriptCredential vh) Nothing From 2210722c2a404f4bc06b7048b0db8c4125d25cb3 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 21:37:12 +0800 Subject: [PATCH 062/107] apply hlint suggestions --- agora/Agora/Governor/Scripts.hs | 2 +- agora/Agora/Utils.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index ee4a052..96eae9d 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -601,7 +601,7 @@ governorValidator gov = passert "Output GATs is more than minted GATs" $ plength # outputsWithGAT #== gatCount - let gatOutputValidator' :: Term s ((PMap PValidatorHash PDatumHash) :--> (PAsData PTxOut) :--> PUnit :--> PUnit) + let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PUnit :--> PUnit) gatOutputValidator' = phoistAcyclic $ plam diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 5e34b55..705f4d3 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -533,7 +533,7 @@ mustFindDatum' :: Term s ( PMaybeData PDatumHash - :--> (PBuiltinList (PAsData (PTuple PDatumHash PDatum))) + :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> datum ) mustFindDatum' = phoistAcyclic $ From f59cfc3f562304ba6da8ff9f2466443d7512b06e Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 21:50:45 +0800 Subject: [PATCH 063/107] use new utils to construct record --- agora/Agora/Governor/Scripts.hs | 48 ++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 96eae9d..587c5e2 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -56,6 +56,7 @@ import Agora.Proposal.Scripts ( proposalPolicy, proposalValidator, ) +import Agora.Record import Agora.SafeMoney (GTTag) import Agora.Stake ( PProposalLock (..), @@ -312,11 +313,11 @@ governorValidator gov = PCreateProposal _ -> P.do let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId expectedNewDatum = - pcon $ - PGovernorDatum $ - pdcons @"proposalThresholds" # oldParams.proposalThresholds - #$ pdcons @"nextProposalId" # pdata expectedNextProposalId # pdnil - + mkRecordConstr + PGovernorDatum + ( #proposalThresholds .= oldParams.proposalThresholds + .& #nextProposalId .= pdata expectedNextProposalId + ) passert "Unexpected governor state datum" $ newDatumData #== pforgetData (pdata expectedNewDatum) @@ -455,10 +456,11 @@ governorValidator gov = phoistAcyclic $ plam ( \pid rt' -> - let fields = - pdcons @"vote" # rt' - #$ pdcons @"proposalTag" # pdata pid # pdnil - in pdata $ pcon $ PProposalLock fields + pdata $ + mkRecordConstr + PProposalLock + ( #vote .= rt' .& #proposalTag .= pdata pid + ) ) expectedProposalLocks = @@ -468,11 +470,12 @@ governorValidator gov = expectedOutputDatum = pforgetData $ pdata $ - pcon $ - PStakeDatum $ - pdcons @"stakedAmount" # pdata stakeInputDatum.stakedAmount - #$ pdcons @"owner" # pdata stakeInputDatum.owner - #$ pdcons @"lockedBy" # pdata expectedProposalLocks # pdnil + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeInputDatum.stakedAmount + .& #owner .= stakeInputDatum.owner + .& #lockedBy .= pdata expectedProposalLocks + ) passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum @@ -537,14 +540,15 @@ governorValidator gov = let expectedOutputProposalDatum = pforgetData $ pdata $ - pcon $ - PProposalDatum $ - pdcons @"proposalId" # inputProposalDatum.proposalId - #$ pdcons @"effects" # inputProposalDatum.effects - #$ pdcons @"status" # pdata (pcon $ PFinished pdnil) - #$ pdcons @"cosigners" # inputProposalDatum.cosigners - #$ pdcons @"thresholds" # inputProposalDatum.thresholds - #$ pdcons @"votes" # inputProposalDatum.votes # pdnil + mkRecordConstr + PProposalDatum + ( #proposalId .= inputProposalDatum.proposalId + .& #effects .= inputProposalDatum.effects + .& #status .= pdata (pcon $ PFinished pdnil) + .& #cosigners .= inputProposalDatum.cosigners + .& #thresholds .= inputProposalDatum.thresholds + .& #votes .= inputProposalDatum.votes + ) passert "Unexpected output proposal datum" $ pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum From 2aa869b46cbe85751c070c2ffd3e8b3aca2e8fb7 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 22:00:19 +0800 Subject: [PATCH 064/107] fix compilation errors :) --- agora-test/Spec/Sample/Shared.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index bd4957f..24b2e05 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -34,6 +34,8 @@ module Spec.Sample.Shared ( import Agora.Governor ( Governor (Governor), + ) +import Agora.Governor.Scripts ( governorPolicy, governorValidator, ) @@ -61,6 +63,7 @@ import Plutus.V1.Ledger.Api ( CurrencySymbol, MintingPolicy (..), PubKeyHash, + TxOutRef (TxOutRef), ) import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash) import Plutus.V1.Ledger.Value qualified as Value @@ -88,7 +91,15 @@ stakeAddress :: Address stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing governor :: Governor -governor = Governor +governor = Governor oref gt mc + where + oref = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 + gt = + Tagged $ + Value.assetClass + "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" + "LQ" + mc = 6 govPolicy :: MintingPolicy govPolicy = mkMintingPolicy (governorPolicy governor) From 327b2ed24482fe394982f5d1319c5486e53c565a Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 29 Apr 2022 23:11:13 +0800 Subject: [PATCH 065/107] fix a typo --- agora/Agora/Governor/Scripts.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 587c5e2..083bec8 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -702,7 +702,7 @@ proposalSTAssetClassFromGovernor :: Governor -> AssetClass proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") where gstAC = governorSTAssetClassFromGovernor gov - -- JUSTIFICATIONL: the PST policy doesn't care about the following two fields at all. + -- JUSTIFICATION: the PST policy doesn't care about the following two fields at all. -- FIXME: refactor PST policy, parameterize it only with GST assetclass or something. sstAC = AssetClass ("", "") mc = -1 From e50e5d6f364dd27e200289efffd12b03be33b05a Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 30 Apr 2022 18:06:12 +0800 Subject: [PATCH 066/107] parameterize PST policy only with assetclass of GST ...to resolve the cyclic reference between SST and PST --- agora-test/Spec/Sample/Shared.hs | 2 +- agora/Agora/Governor/Scripts.hs | 18 +++++++++--------- agora/Agora/Proposal/Scripts.hs | 10 ++++++---- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 24b2e05..6da1553 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -119,7 +119,7 @@ proposal = } proposalPolicySymbol :: CurrencySymbol -proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal) +proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal.governorSTAssetClass) -- | A sample 'PubKeyHash'. signer :: PubKeyHash diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 083bec8..e0b687e 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -23,6 +23,7 @@ module Agora.Governor.Scripts ( stakeValidatorHashFromGovernor, proposalFromGovernor, proposalValidatorHashFromGovernor, + proposalSTSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -698,18 +699,17 @@ atSymbolFromGovernor gov = mintingPolicySymbol policy at = AuthorityToken $ governorSTAssetClassFromGovernor gov policy = mkMintingPolicy $ authorityTokenPolicy at +proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol +proposalSTSymbolFromGovernor gov = symbol + where + gstAC = governorSTAssetClassFromGovernor gov + policy = mkMintingPolicy $ proposalPolicy gstAC + symbol = mintingPolicySymbol policy + proposalSTAssetClassFromGovernor :: Governor -> AssetClass proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") where - gstAC = governorSTAssetClassFromGovernor gov - -- JUSTIFICATION: the PST policy doesn't care about the following two fields at all. - -- FIXME: refactor PST policy, parameterize it only with GST assetclass or something. - sstAC = AssetClass ("", "") - mc = -1 - params = Proposal gstAC sstAC mc - - policy = mkMintingPolicy $ proposalPolicy params - symbol = mintingPolicySymbol policy + symbol = proposalSTSymbolFromGovernor gov stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 2e7a52d..1ed6643 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -58,8 +58,11 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) - This policy cannot be burned. -} -proposalPolicy :: Proposal -> ClosedTerm PMintingPolicy -proposalPolicy proposal = +proposalPolicy :: + -- | The assetclass of GST, see 'Agora.Governor.Scripts.governorPolicy'. + AssetClass -> + ClosedTerm PMintingPolicy +proposalPolicy (AssetClass (govCs, govTn)) = plam $ \_redeemer ctx' -> P.do PScriptContext ctx' <- pmatch ctx' ctx <- pletFields @'["txInfo", "purpose"] ctx' @@ -69,7 +72,6 @@ proposalPolicy proposal = let inputs = txInfo.inputs mintedValue = pfromData txInfo.mint - AssetClass (govCs, govTn) = proposal.governorSTAssetClass PMinting ownSymbol' <- pmatch $ pfromData ctx.purpose let mintedProposalST = @@ -145,7 +147,7 @@ proposalValidator proposal = ownAddress <- plet $ txOutF.address let stCurrencySymbol = - pconstant $ getMintingPolicySymbol (proposalPolicy proposal) + pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass) valueSpent <- plet $ pvalueSpent # txInfoF.inputs spentST <- plet $ psymbolValueOf # stCurrencySymbol #$ valueSpent let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass From 3c76f6c1acc4657ac3ecb9c39ec11aa133067b11 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 30 Apr 2022 18:13:11 +0800 Subject: [PATCH 067/107] refactor `Spec.Sample.Shared` with bridges --- agora-test/Spec/Proposal.hs | 3 ++- agora-test/Spec/Sample/Shared.hs | 37 +++++++++++--------------------- 2 files changed, 14 insertions(+), 26 deletions(-) diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index bd79762..06583e0 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -12,6 +12,7 @@ module Spec.Proposal (tests) where -------------------------------------------------------------------------------- import Agora.Proposal ( + Proposal (..), ProposalDatum (ProposalDatum), ProposalId (ProposalId), ProposalRedeemer (Cosign), @@ -49,7 +50,7 @@ tests = "policy" [ policySucceedsWith "proposalCreation" - (proposalPolicy Shared.proposal) + (proposalPolicy Shared.proposal.governorSTAssetClass) () Proposal.proposalCreation ] diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 6da1553..f474e28 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -38,22 +38,22 @@ import Agora.Governor ( import Agora.Governor.Scripts ( governorPolicy, governorValidator, + proposalFromGovernor, + proposalSTSymbolFromGovernor, + proposalValidatorHashFromGovernor, + stakeFromGovernor, + stakeSTSymbolFromGovernor, + stakeValidatorHashFromGovernor, ) import Agora.Proposal ( Proposal (..), ProposalThresholds (..), ) -import Agora.Proposal.Scripts ( - proposalPolicy, - proposalValidator, - ) import Agora.Stake (Stake (..)) -import Agora.Stake.Scripts (stakePolicy, stakeValidator) import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, mkValidator, - validatorHash, ) import Plutarch.SafeMoney import Plutus.V1.Ledger.Address (scriptHashAddress) @@ -71,21 +71,13 @@ import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- stake :: Stake -stake = - Stake - { gtClassRef = - Tagged $ - Value.assetClass - "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" - "LQ" - , proposalSTClass = Value.assetClass proposalPolicySymbol "" - } +stake = stakeFromGovernor governor stakeSymbol :: CurrencySymbol -stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef +stakeSymbol = stakeSTSymbolFromGovernor governor stakeValidatorHash :: ValidatorHash -stakeValidatorHash = validatorHash $ mkValidator (stakeValidator stake) +stakeValidatorHash = stakeValidatorHashFromGovernor governor stakeAddress :: Address stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing @@ -111,15 +103,10 @@ govSymbol :: CurrencySymbol govSymbol = mintingPolicySymbol govPolicy proposal :: Proposal -proposal = - Proposal - { governorSTAssetClass = Value.assetClass govSymbol "" - , stakeSTAssetClass = Value.assetClass stakeSymbol "" - , maximumCosigners = 6 - } +proposal = proposalFromGovernor governor proposalPolicySymbol :: CurrencySymbol -proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal.governorSTAssetClass) +proposalPolicySymbol = proposalSTSymbolFromGovernor governor -- | A sample 'PubKeyHash'. signer :: PubKeyHash @@ -130,7 +117,7 @@ signer2 :: PubKeyHash signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192" proposalValidatorHash :: ValidatorHash -proposalValidatorHash = validatorHash (mkValidator $ proposalValidator proposal) +proposalValidatorHash = proposalValidatorHashFromGovernor governor proposalValidatorAddress :: Address proposalValidatorAddress = scriptHashAddress proposalValidatorHash From 7cfd80298ac8e9d97dc515798da19131b1250375 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 30 Apr 2022 19:15:41 +0800 Subject: [PATCH 068/107] add `stakeSTAssetClassFromGovernor` --- agora/Agora/Governor/Scripts.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index e0b687e..74825c3 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -24,14 +24,11 @@ module Agora.Governor.Scripts ( proposalFromGovernor, proposalValidatorHashFromGovernor, proposalSTSymbolFromGovernor, + stakeSTAssetClassFromGovernor, ) where -------------------------------------------------------------------------------- -import Data.Coerce (coerce) - --------------------------------------------------------------------------------- - import Agora.AuthorityToken ( AuthorityToken (..), authorityTokenPolicy, @@ -716,6 +713,15 @@ stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy where policy = mkMintingPolicy $ stakePolicy gov.gtClassRef +stakeSTAssetClassFromGovernor :: Governor -> AssetClass +stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName) + where + symbol = stakeSTSymbolFromGovernor gov + + -- Tag with the address where the token is being sent to. + ValidatorHash hash = stakeValidatorHashFromGovernor gov + tokenName = TokenName hash + stakeFromGovernor :: Governor -> Stake stakeFromGovernor gov = Stake gov.gtClassRef $ @@ -732,12 +738,7 @@ proposalFromGovernor gov = Proposal gstAC sstAC mc where gstAC = governorSTAssetClassFromGovernor gov mc = gov.maximumCosigners - - sstS = stakeSTSymbolFromGovernor gov - -- The stake state token is tagged with the address which it's sent to. - sstTN :: TokenName - sstTN = coerce $ stakeValidatorHashFromGovernor gov - sstAC = AssetClass (sstS, sstTN) + sstAC = stakeSTAssetClassFromGovernor gov proposalValidatorHashFromGovernor :: Governor -> ValidatorHash proposalValidatorHashFromGovernor gov = validatorHash validator From bfebc95ce31280e2d7c196227cdb7932803a3e7a Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 30 Apr 2022 19:24:01 +0800 Subject: [PATCH 069/107] fix broken tests --- agora-test/Spec/Sample/Proposal.hs | 4 ++-- agora-test/Spec/Sample/Shared.hs | 11 +++++++++-- agora-test/Spec/Sample/Stake.hs | 5 +++-- 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/agora-test/Spec/Sample/Proposal.hs b/agora-test/Spec/Sample/Proposal.hs index 6112ec0..fdde141 100644 --- a/agora-test/Spec/Sample/Proposal.hs +++ b/agora-test/Spec/Sample/Proposal.hs @@ -193,7 +193,7 @@ cosignProposal newSigners = mconcat [ Value.singleton "" "" 10_000_000 , Value.assetClassValue (untag stake.gtClassRef) 50_000_000 - , Value.singleton stakeSymbol "" 1 + , Value.assetClassValue stakeAssetClass 1 ] , txOutDatumHash = Just (toDatumHash stakeDatum) } @@ -214,7 +214,7 @@ cosignProposal newSigners = mconcat [ Value.singleton "" "" 10_000_000 , Value.assetClassValue (untag stake.gtClassRef) 50_000_000 - , Value.singleton stakeSymbol "" 1 + , Value.assetClassValue stakeAssetClass 1 ] , txOutDatumHash = Just (toDatumHash stakeDatum) } diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index f474e28..923da45 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -14,9 +14,10 @@ module Spec.Sample.Shared ( -- ** Stake stake, - stakeSymbol, + stakeAssetClass, stakeValidatorHash, stakeAddress, + stakeSymbol, -- ** Governor governor, @@ -42,6 +43,7 @@ import Agora.Governor.Scripts ( proposalSTSymbolFromGovernor, proposalValidatorHashFromGovernor, stakeFromGovernor, + stakeSTAssetClassFromGovernor, stakeSTSymbolFromGovernor, stakeValidatorHashFromGovernor, ) @@ -66,6 +68,7 @@ import Plutus.V1.Ledger.Api ( TxOutRef (TxOutRef), ) import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash) +import Plutus.V1.Ledger.Value (AssetClass) import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- @@ -76,6 +79,9 @@ stake = stakeFromGovernor governor stakeSymbol :: CurrencySymbol stakeSymbol = stakeSTSymbolFromGovernor governor +stakeAssetClass :: AssetClass +stakeAssetClass = stakeSTAssetClassFromGovernor governor + stakeValidatorHash :: ValidatorHash stakeValidatorHash = stakeValidatorHashFromGovernor governor @@ -85,7 +91,8 @@ stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing governor :: Governor governor = Governor oref gt mc where - oref = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 + oref = + TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 gt = Tagged $ Value.assetClass diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-test/Spec/Sample/Stake.hs index 07af063..c80fdea 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-test/Spec/Sample/Stake.hs @@ -7,6 +7,7 @@ This module tests primarily the happy path for Stake creation -} module Spec.Sample.Stake ( stake, + stakeAssetClass, stakeSymbol, validatorHashTN, signer, @@ -60,7 +61,7 @@ validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValid -- | This script context should be a valid transaction. stakeCreation :: ScriptContext stakeCreation = - let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST + let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST datum :: Datum datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer []) in ScriptContext @@ -120,7 +121,7 @@ data DepositWithdrawExample = DepositWithdrawExample -- | Create a ScriptContext that deposits or withdraws, given the config for it. stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext stakeDepositWithdraw config = - let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST + let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST stakeBefore :: StakeDatum stakeBefore = StakeDatum config.startAmount signer [] From 8e1eb328a3e6418753111f5d6601a39d150af7ad Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 30 Apr 2022 19:35:46 +0800 Subject: [PATCH 070/107] add descriptions for available make subcommands --- Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile b/Makefile index 6a3164c..36a13e3 100644 --- a/Makefile +++ b/Makefile @@ -11,6 +11,9 @@ usage: @echo " format -- Format the project" @echo " haddock -- Generate Haddock docs for project" @echo " tag -- Generate CTAGS and ETAGS files for project" + @echo " format_haskell -- Format haskell stuff, including source code and cabal files" + @echo " format_nix -- Format *.nix files only" + @echo " format_check -- Check if all haskell stuff have been formatted correctly" hoogle: pkill hoogle || true From cfac755380910ba712d94cbab8c6eb9ef2ac7b19 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 2 May 2022 18:52:41 +0800 Subject: [PATCH 071/107] ensure GTs are in the stake being checked --- agora/Agora/Governor/Scripts.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 74825c3..d1097df 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -271,8 +271,6 @@ governorValidator gov = txInfo' <- plet $ pfromData $ ctx.txInfo txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' - valueSpent <- plet $ pvalueSpent # txInfo.inputs - PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose let txOutRef = pfromData txOutRef' @@ -340,22 +338,21 @@ governorValidator gov = passert "Exactly one input from the stake validator" $ plength # inputsFromStakeValidatorWithStateToken #== 1 - stakeInputDatumHash <- - plet $ - pfield @"datumHash" - #$ pfield @"resolved" + stakeInput <- + pletFields @'["datumHash", "value"] $ + pfield @"resolved" #$ phead # inputsFromStakeValidatorWithStateToken passert "Stake input must have datum" $ - pisDJust # stakeInputDatumHash + pisDJust # stakeInput.datumHash - let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # txInfo.datums + let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInput.datumHash # txInfo.datums stakeInputDatum <- pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' - passert "Required amount of stake GT should be spent" $ - stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) + passert "Required amount of stake GT should be presented" $ + stakeInputDatum.stakedAmount #== (pgtValueOf # stakeInput.value) passert "Tx should be signed by the stake owner" $ ptxSignedBy # txInfo.signatories # stakeInputDatum.owner @@ -435,12 +432,15 @@ governorValidator gov = passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ plength # outputToStakeValidatorWithStateToken #== 1 - let stakeOutputDatumHash' = - pfield @"datumHash" - #$ pfromData - $ phead # outputToStakeValidatorWithStateToken + stakeOutput <- + pletFields @'["datumHash", "value"] $ + pfromData $ + phead # outputToStakeValidatorWithStateToken - stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputDatumHash' + passert "Staked GTs should be sent back to stake validator" $ + stakeInputDatum.stakedAmount #== (pgtValueOf # stakeOutput.value) + + let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutput.datumHash stakeOutputDatum = pforgetData $ From 62cd50c5cb09ddee1ec23062df52572b0f01bae5 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 2 May 2022 19:06:16 +0800 Subject: [PATCH 072/107] add templates for samples and tests of governor --- agora-test/Spec.hs | 4 ++++ agora-test/Spec/Governor.hs | 15 +++++++++++++++ agora-test/Spec/Sample/Governor.hs | 8 ++++++++ agora.cabal | 2 ++ 4 files changed, 29 insertions(+) create mode 100644 agora-test/Spec/Governor.hs create mode 100644 agora-test/Spec/Sample/Governor.hs diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 22c5b49..31e75b9 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -10,6 +10,7 @@ import Test.Tasty (defaultMain, testGroup) import Spec.AuthorityToken qualified as AuthorityToken import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal +import Spec.Governor qualified as Governor import Spec.Model.MultiSig qualified as MultiSig import Spec.Proposal qualified as Proposal import Spec.Stake qualified as Stake @@ -43,4 +44,7 @@ main = , testGroup "AuthorityToken tests" AuthorityToken.tests + , testGroup + "Governor tests" + Governor.tests ] diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs new file mode 100644 index 0000000..3d567f7 --- /dev/null +++ b/agora-test/Spec/Governor.hs @@ -0,0 +1,15 @@ +{- | +Module : Spec.Governor +Maintainer : connor@mlabs.city +Description: Tests for Governor policy and validator + +Tests for Governor policy and validator +-} +module Spec.Governor (tests) where + +import Test.Tasty (TestTree, testGroup) + +-------------------------------------------------------------------------------- + +tests :: [TestTree] +tests = [] diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs new file mode 100644 index 0000000..28df5ad --- /dev/null +++ b/agora-test/Spec/Sample/Governor.hs @@ -0,0 +1,8 @@ +{- | +Module : Spec.Sample.Governor +Maintainer : connor@mlabs.city +Description: Sample based testing for Governor utxos + +This module tests primarily the happy path for Governor interactions +-} +module Spec.Sample.Governor () where diff --git a/agora.cabal b/agora.cabal index 74738ec..cb2ca3a 100644 --- a/agora.cabal +++ b/agora.cabal @@ -161,9 +161,11 @@ test-suite agora-test other-modules: Spec.AuthorityToken Spec.Effect.TreasuryWithdrawal + Spec.Governor Spec.Model.MultiSig Spec.Proposal Spec.Sample.Effect.TreasuryWithdrawal + Spec.Sample.Governor Spec.Sample.Proposal Spec.Sample.Shared Spec.Sample.Stake From 473deeb08f11258b1d494cf81cbdc2c0640e8e9f Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 3 May 2022 18:38:06 +0800 Subject: [PATCH 073/107] add samples: `proposalCreation`, `mutateState` and `mintGAT` --- agora-test/Spec/Governor.hs | 2 +- agora-test/Spec/Sample/Governor.hs | 448 ++++++++++++++++++++++++++++- agora-test/Spec/Sample/Shared.hs | 38 ++- agora/Agora/Governor.hs | 11 +- agora/Agora/Governor/Scripts.hs | 17 ++ 5 files changed, 510 insertions(+), 6 deletions(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 3d567f7..9999ba5 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -7,7 +7,7 @@ Tests for Governor policy and validator -} module Spec.Governor (tests) where -import Test.Tasty (TestTree, testGroup) +import Test.Tasty (TestTree) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 28df5ad..1dbbfba 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -5,4 +5,450 @@ Description: Sample based testing for Governor utxos This module tests primarily the happy path for Governor interactions -} -module Spec.Sample.Governor () where +module Spec.Sample.Governor (proposalCreation, mutateState, mintGAT) where + +-------------------------------------------------------------------------------- + +import Plutarch.Api.V1 (mkValidator, validatorHash) +import Plutarch.SafeMoney.Tagged + +-------------------------------------------------------------------------------- + +import Plutus.V1.Ledger.Address (scriptHashAddress) +import Plutus.V1.Ledger.Api ( + Address, + Datum (..), + ScriptContext (..), + ScriptPurpose (Spending), + ToData (toBuiltinData), + TokenName (..), + TxInInfo (TxInInfo), + TxInfo (..), + TxOut (..), + TxOutRef (..), + Validator, + ValidatorHash (..), + ) +import Plutus.V1.Ledger.Interval qualified as Interval +import Plutus.V1.Ledger.Scripts (unitDatum) +import Plutus.V1.Ledger.Value ( + AssetClass (..), + ) +import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap + +-------------------------------------------------------------------------------- + +import Agora.Effect.NoOp +import Agora.Governor +import Agora.Proposal +import Agora.Proposal qualified as P +import Agora.Stake + +-------------------------------------------------------------------------------- + +import Spec.Sample.Shared +import Spec.Util (datumPair, toDatumHash) + +-------------------------------------------------------------------------------- + +-- | This script context should be a valid transaction. +proposalCreation :: ScriptContext +proposalCreation = + let pst = Value.singleton proposalPolicySymbol "" 1 + gst = Value.assetClassValue govAssetClass 1 + sst = Value.assetClassValue stakeAssetClass 1 + stackedGTs = 424242424242 + thisProposalId = ProposalId 0 + + --- + + governorInputDatum' :: GovernorDatum + governorInputDatum' = + GovernorDatum + { proposalThresholds = defaultProposalThresholds + , nextProposalId = thisProposalId + } + governorInputDatum :: Datum + governorInputDatum = Datum $ toBuiltinData governorInputDatum' + governorInput :: TxOut + governorInput = + TxOut + { txOutAddress = govValidatorAddress + , txOutValue = gst + , txOutDatumHash = Just (toDatumHash governorInputDatum) + } + + --- + + effects = + AssocMap.fromList + [ (ResultTag 0, []) + , (ResultTag 1, []) + ] + proposalDatum :: Datum + proposalDatum = + Datum + ( toBuiltinData $ + ProposalDatum + { P.proposalId = ProposalId 0 + , effects = effects + , status = Draft + , cosigners = [signer] + , thresholds = defaultProposalThresholds + , votes = emptyVotesFor effects + } + ) + proposalOutput :: TxOut + proposalOutput = + TxOut + { txOutAddress = proposalValidatorAddress + , txOutValue = withMinAda pst + , txOutDatumHash = Just (toDatumHash proposalDatum) + } + + --- + + stakeInputDatum' :: StakeDatum + stakeInputDatum' = + StakeDatum + { stakedAmount = Tagged stackedGTs + , owner = signer + , lockedBy = [] + } + stakeInputDatum :: Datum + stakeInputDatum = Datum $ toBuiltinData stakeInputDatum' + stakeInput :: TxOut + stakeInput = + TxOut + { txOutAddress = stakeAddress + , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs + , txOutDatumHash = Just (toDatumHash stakeInputDatum) + } + + --- + governorOutputDatum' :: GovernorDatum + governorOutputDatum' = governorInputDatum' {nextProposalId = getNextProposalId thisProposalId} + governorOutputDatum :: Datum + governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' + governorOutput :: TxOut + governorOutput = + governorInput + { txOutDatumHash = Just $ toDatumHash governorOutputDatum + , txOutValue = withMinAda gst + } + + --- + + proposalLocks :: [ProposalLock] + proposalLocks = + [ ProposalLock (ResultTag 0) thisProposalId + , ProposalLock (ResultTag 1) thisProposalId + ] + stakeOutputDatum' :: StakeDatum + stakeOutputDatum' = stakeInputDatum' {lockedBy = proposalLocks} + stakeOutputDatum :: Datum + stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum' + stakeOutput :: TxOut + stakeOutput = + stakeInput + { txOutDatumHash = Just $ toDatumHash stakeOutputDatum + , txOutValue = withMinAda sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs + } + + --- + ownInputRef :: TxOutRef + ownInputRef = (TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ TxInInfo + ownInputRef + governorInput + , TxInInfo + (TxOutRef "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f" 1) + stakeInput + ] + , txInfoOutputs = [proposalOutput, governorOutput, stakeOutput] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = pst + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer] + , txInfoData = + datumPair + <$> [ governorInputDatum + , governorOutputDatum + , proposalDatum + , stakeInputDatum + , stakeOutputDatum + ] + , txInfoId = "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a" + } + , scriptContextPurpose = Spending ownInputRef + } + +-- | This script context should be a valid transaction. +mintGAT :: ScriptContext +mintGAT = + let pst = Value.singleton proposalPolicySymbol "" 1 + gst = Value.assetClassValue govAssetClass 1 + gat = Value.assetClassValue atAssetClass 1 + + --- + + mockEffect :: Validator + mockEffect = mkValidator $ noOpValidator "" + mockEffectHash :: ValidatorHash + mockEffectHash = validatorHash mockEffect + mockEffectAddress :: Address + mockEffectAddress = scriptHashAddress mockEffectHash + mockEffectOutputDatum :: Datum + mockEffectOutputDatum = unitDatum + atTokenName :: TokenName + atTokenName = TokenName hash + where + ValidatorHash hash = mockEffectHash + atAssetClass :: AssetClass + atAssetClass = AssetClass (authorityTokenSymbol, atTokenName) + + --- + + governorInputDatum' :: GovernorDatum + governorInputDatum' = + GovernorDatum + { proposalThresholds = defaultProposalThresholds + , nextProposalId = ProposalId 5 + } + governorInputDatum :: Datum + governorInputDatum = Datum $ toBuiltinData governorInputDatum' + governorInput :: TxOut + governorInput = + TxOut + { txOutAddress = govValidatorAddress + , txOutValue = gst + , txOutDatumHash = Just $ toDatumHash governorInputDatum + } + + --- + + effects = + AssocMap.fromList + [ (ResultTag 0, []) + , (ResultTag 1, [(mockEffectHash, toDatumHash mockEffectOutputDatum)]) + ] + proposalVotes :: ProposalVotes + proposalVotes = + ProposalVotes $ + AssocMap.fromList + [ (ResultTag 0, 100) + , (ResultTag 1, 2000) -- The winner + ] + proposalInputDatum' :: ProposalDatum + proposalInputDatum' = + ProposalDatum + { P.proposalId = ProposalId 0 + , effects = effects + , status = Locked + , -- TODO: Any need to check minimun amount of cosigners here? + cosigners = [signer, signer2] + , thresholds = defaultProposalThresholds + , votes = proposalVotes + } + proposalInputDatum :: Datum + proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' + proposalInput :: TxOut + proposalInput = + TxOut + { txOutAddress = proposalValidatorAddress + , txOutValue = pst + , txOutDatumHash = Just (toDatumHash proposalInputDatum) + } + + --- + + governorOutputDatum' :: GovernorDatum + governorOutputDatum' = governorInputDatum' + governorOutputDatum :: Datum + governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' + governorOutput :: TxOut + governorOutput = + governorInput + { txOutDatumHash = Just $ toDatumHash governorOutputDatum + , txOutValue = withMinAda gst + } + + --- + + proposalOutputDatum' :: ProposalDatum + proposalOutputDatum' = proposalInputDatum' {status = Finished} + proposalOutputDatum :: Datum + proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum' + proposalOutput :: TxOut + proposalOutput = + proposalInput + { txOutDatumHash = Just $ toDatumHash proposalOutputDatum + , txOutValue = withMinAda pst + } + + -- + + mockEffectOutput :: TxOut + mockEffectOutput = + TxOut + { txOutAddress = mockEffectAddress + , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum + , txOutValue = withMinAda gat + } + + -- + + ownInputRef :: TxOutRef + ownInputRef = (TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ TxInInfo ownInputRef governorInput + , TxInInfo + (TxOutRef "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7" 1) + proposalInput + ] + , txInfoOutputs = + [ governorOutput + , proposalOutput + , mockEffectOutput + ] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = gat + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer, signer2] + , txInfoData = + datumPair + <$> [ governorInputDatum + , governorOutputDatum + , proposalInputDatum + , proposalOutputDatum + , mockEffectOutputDatum + ] + , txInfoId = "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7" + } + , scriptContextPurpose = Spending ownInputRef + } + +-- | This script context should be a valid transaction. +mutateState :: ScriptContext +mutateState = + let gst = Value.assetClassValue govAssetClass 1 + gat = Value.assetClassValue atAssetClass 1 + burntGAT = Value.assetClassValue atAssetClass (-1) + + --- + + -- TODO: Use the *real* effect, see https://github.com/Liqwid-Labs/agora/pull/62 + + mockEffect :: Validator + mockEffect = mkValidator $ noOpValidator "" + mockEffectHash :: ValidatorHash + mockEffectHash = validatorHash mockEffect + mockEffectAddress :: Address + mockEffectAddress = scriptHashAddress mockEffectHash + atTokenName :: TokenName + atTokenName = TokenName hash + where + ValidatorHash hash = mockEffectHash + atAssetClass :: AssetClass + atAssetClass = AssetClass (authorityTokenSymbol, atTokenName) + + -- + + mockEffectInputDatum :: Datum + mockEffectInputDatum = unitDatum + mockEffectInput :: TxOut + mockEffectInput = + TxOut + { txOutAddress = mockEffectAddress + , txOutValue = gat -- Will be burnt + , txOutDatumHash = Just $ toDatumHash mockEffectInputDatum + } + + -- + + mockEffectOutputDatum :: Datum + mockEffectOutputDatum = mockEffectInputDatum + mockEffectOutput :: TxOut + mockEffectOutput = + mockEffectInput + { txOutValue = minAda + , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum + } + + -- + + governorInputDatum' :: GovernorDatum + governorInputDatum' = + GovernorDatum + { proposalThresholds = defaultProposalThresholds + , nextProposalId = ProposalId 5 + } + governorInputDatum :: Datum + governorInputDatum = Datum $ toBuiltinData governorInputDatum' + governorInput :: TxOut + governorInput = + TxOut + { txOutAddress = govValidatorAddress + , txOutValue = gst + , txOutDatumHash = Just $ toDatumHash governorInputDatum + } + + -- + + governorOutputDatum' :: GovernorDatum + governorOutputDatum' = governorInputDatum' + governorOutputDatum :: Datum + governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' + governorOutput :: TxOut + governorOutput = + governorInput + { txOutDatumHash = Just $ toDatumHash governorOutputDatum + , txOutValue = withMinAda gst + } + + -- + + ownInputRef :: TxOutRef + ownInputRef = (TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ TxInInfo ownInputRef governorInput + , TxInInfo + (TxOutRef "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089" 1) + mockEffectInput + ] + , txInfoOutputs = + [ governorOutput + , mockEffectOutput + ] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = burntGAT + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer, signer2] + , txInfoData = + datumPair + <$> [ governorInputDatum + , governorOutputDatum + , mockEffectInputDatum + , mockEffectOutputDatum + ] + , txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9" + } + , scriptContextPurpose = Spending ownInputRef + } \ No newline at end of file diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 923da45..771299f 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -9,6 +9,8 @@ module Spec.Sample.Shared ( -- * Misc signer, signer2, + minAda, + withMinAda, -- * Components @@ -24,6 +26,9 @@ module Spec.Sample.Shared ( govPolicy, govValidator, govSymbol, + govAssetClass, + govValidatorAddress, + govValidatorHash, -- ** Proposal defaultProposalThresholds, @@ -31,6 +36,10 @@ module Spec.Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, + + -- ** Authority + authorityToken , + authorityTokenSymbol, ) where import Agora.Governor ( @@ -38,14 +47,18 @@ import Agora.Governor ( ) import Agora.Governor.Scripts ( governorPolicy, + governorSTAssetClassFromGovernor, governorValidator, + governorValidatorHash, proposalFromGovernor, proposalSTSymbolFromGovernor, proposalValidatorHashFromGovernor, stakeFromGovernor, stakeSTAssetClassFromGovernor, stakeSTSymbolFromGovernor, - stakeValidatorHashFromGovernor, + stakeValidatorHashFromGovernor, + authorityTokenFromGovernor, + authorityTokenSymbolFromGovernor, ) import Agora.Proposal ( Proposal (..), @@ -66,10 +79,12 @@ import Plutus.V1.Ledger.Api ( MintingPolicy (..), PubKeyHash, TxOutRef (TxOutRef), + Value, ) import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash) import Plutus.V1.Ledger.Value (AssetClass) import Plutus.V1.Ledger.Value qualified as Value +import Agora.AuthorityToken -------------------------------------------------------------------------------- @@ -109,6 +124,15 @@ govValidator = mkValidator (governorValidator governor) govSymbol :: CurrencySymbol govSymbol = mintingPolicySymbol govPolicy +govAssetClass :: AssetClass +govAssetClass = governorSTAssetClassFromGovernor governor + +govValidatorHash :: ValidatorHash +govValidatorHash = governorValidatorHash governor + +govValidatorAddress :: Address +govValidatorAddress = scriptHashAddress govValidatorHash + proposal :: Proposal proposal = proposalFromGovernor governor @@ -136,3 +160,15 @@ defaultProposalThresholds = , create = Tagged 1 , startVoting = Tagged 10 } + +minAda :: Value +minAda = Value.singleton "" "" 10_000_000 + +withMinAda :: Value -> Value +withMinAda v = v <> minAda + +authorityToken :: AuthorityToken +authorityToken = authorityTokenFromGovernor governor + +authorityTokenSymbol :: CurrencySymbol +authorityTokenSymbol = authorityTokenSymbolFromGovernor governor \ No newline at end of file diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 57e40f1..3beafe5 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -17,8 +17,9 @@ module Agora.Governor ( PGovernorDatum (..), PGovernorRedeemer (..), - -- * Plutus Utilities + -- * Utilities pgetNextProposalId, + getNextProposalId, ) where -------------------------------------------------------------------------------- @@ -32,7 +33,7 @@ import Generics.SOP (Generic, I (I)) import Agora.Proposal ( PProposalId (..), PProposalThresholds, - ProposalId, + ProposalId (ProposalId), ProposalThresholds, ) import Agora.SafeMoney (GTTag) @@ -153,6 +154,10 @@ deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom -------------------------------------------------------------------------------- --- | Get next proposal id. +-- | Plutrach version of 'getNextProposalId'. pgetNextProposalId :: Term s (PProposalId :--> PProposalId) pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 + +-- | Get next proposal id. +getNextProposalId :: ProposalId -> ProposalId +getNextProposalId (ProposalId pid) = ProposalId $ pid + 1 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index d1097df..0ed9a9e 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -25,6 +25,9 @@ module Agora.Governor.Scripts ( proposalValidatorHashFromGovernor, proposalSTSymbolFromGovernor, stakeSTAssetClassFromGovernor, + governorValidatorHash, + authorityTokenFromGovernor, + authorityTokenSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -745,3 +748,17 @@ proposalValidatorHashFromGovernor gov = validatorHash validator where params = proposalFromGovernor gov validator = mkValidator $ proposalValidator params + +governorValidatorHash :: Governor -> ValidatorHash +governorValidatorHash gov = validatorHash validator + where + validator = mkValidator $ governorValidator gov + +authorityTokenFromGovernor :: Governor -> AuthorityToken +authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov + +authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol +authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ authorityTokenPolicy params + params = authorityTokenFromGovernor gov \ No newline at end of file From 41da2dd534f02e049ab40f07b7b7fe7a751b3e05 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 3 May 2022 18:51:30 +0800 Subject: [PATCH 074/107] run formatter and linter --- agora-test/Spec/Sample/Governor.hs | 8 ++++---- agora-test/Spec/Sample/Shared.hs | 14 +++++++------- agora/Agora/Governor/Scripts.hs | 2 +- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 1dbbfba..34851ee 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -158,7 +158,7 @@ proposalCreation = --- ownInputRef :: TxOutRef - ownInputRef = (TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1) + ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1 in ScriptContext { scriptContextTxInfo = TxInfo @@ -306,7 +306,7 @@ mintGAT = -- ownInputRef :: TxOutRef - ownInputRef = (TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1) + ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1 in ScriptContext { scriptContextTxInfo = TxInfo @@ -421,7 +421,7 @@ mutateState = -- ownInputRef :: TxOutRef - ownInputRef = (TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1) + ownInputRef = TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1 in ScriptContext { scriptContextTxInfo = TxInfo @@ -451,4 +451,4 @@ mutateState = , txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9" } , scriptContextPurpose = Spending ownInputRef - } \ No newline at end of file + } diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 771299f..9375718 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -38,14 +38,17 @@ module Spec.Sample.Shared ( proposalValidatorAddress, -- ** Authority - authorityToken , + authorityToken, authorityTokenSymbol, ) where +import Agora.AuthorityToken import Agora.Governor ( Governor (Governor), ) import Agora.Governor.Scripts ( + authorityTokenFromGovernor, + authorityTokenSymbolFromGovernor, governorPolicy, governorSTAssetClassFromGovernor, governorValidator, @@ -56,9 +59,7 @@ import Agora.Governor.Scripts ( stakeFromGovernor, stakeSTAssetClassFromGovernor, stakeSTSymbolFromGovernor, - stakeValidatorHashFromGovernor, - authorityTokenFromGovernor, - authorityTokenSymbolFromGovernor, + stakeValidatorHashFromGovernor, ) import Agora.Proposal ( Proposal (..), @@ -84,7 +85,6 @@ import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash) import Plutus.V1.Ledger.Value (AssetClass) import Plutus.V1.Ledger.Value qualified as Value -import Agora.AuthorityToken -------------------------------------------------------------------------------- @@ -170,5 +170,5 @@ withMinAda v = v <> minAda authorityToken :: AuthorityToken authorityToken = authorityTokenFromGovernor governor -authorityTokenSymbol :: CurrencySymbol -authorityTokenSymbol = authorityTokenSymbolFromGovernor governor \ No newline at end of file +authorityTokenSymbol :: CurrencySymbol +authorityTokenSymbol = authorityTokenSymbolFromGovernor governor diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 0ed9a9e..63601dc 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -761,4 +761,4 @@ authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy where policy = mkMintingPolicy $ authorityTokenPolicy params - params = authorityTokenFromGovernor gov \ No newline at end of file + params = authorityTokenFromGovernor gov From 15fd232874bbf54e3bcac5039956dc7626552fa6 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 3 May 2022 19:44:46 +0800 Subject: [PATCH 075/107] check if the UTXO carries a valid datum while minting GST --- agora/Agora/Governor.hs | 28 ++++++++++++++++++++++++++-- agora/Agora/Governor/Scripts.hs | 20 ++++++++++++++++++-- 2 files changed, 44 insertions(+), 4 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 3beafe5..8cf49f9 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -20,6 +20,7 @@ module Agora.Governor ( -- * Utilities pgetNextProposalId, getNextProposalId, + governorDatumValid, ) where -------------------------------------------------------------------------------- @@ -32,7 +33,7 @@ import Generics.SOP (Generic, I (I)) import Agora.Proposal ( PProposalId (..), - PProposalThresholds, + PProposalThresholds (..), ProposalId (ProposalId), ProposalThresholds, ) @@ -46,7 +47,8 @@ import Plutarch.DataRepr ( PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) -import Plutarch.SafeMoney (Tagged (..)) +import Plutarch.Monadic qualified as P +import Plutarch.SafeMoney (Tagged (..), puntag) import Plutarch.TryFrom (PTryFrom (..)) import Plutarch.Unsafe (punsafeCoerce) @@ -161,3 +163,25 @@ pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId -- | Get next proposal id. getNextProposalId :: ProposalId -> ProposalId getNextProposalId (ProposalId pid) = ProposalId $ pid + 1 + +-------------------------------------------------------------------------------- + +governorDatumValid :: Term s (PGovernorDatum :--> PBool) +governorDatumValid = phoistAcyclic $ + plam $ \datum -> P.do + thresholds <- + pletFields @'["execute", "draft", "vote"] $ + pfield @"proposalThresholds" # datum + + execute <- plet $ puntag thresholds.execute + draft <- plet $ puntag thresholds.draft + vote <- plet $ puntag thresholds.vote + + foldr1 + (#&&) + [ ptraceIfFalse "Execute threshold larger than 0" $ 0 #<= execute + , ptraceIfFalse "Draft threshold larger than 0" $ 0 #<= draft + , ptraceIfFalse "Vote threshold larger than 0" $ 0 #<= vote + , ptraceIfFalse "Draft threshold larger than vote threshold" $ draft #<= vote + , ptraceIfFalse "Execute threshold larger than vote threshold" $ vote #< execute + ] diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 63601dc..b131057 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -42,6 +42,7 @@ import Agora.Governor ( Governor (gstOutRef, gtClassRef, maximumCosigners), PGovernorDatum (PGovernorDatum), PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor), + governorDatumValid, pgetNextProposalId, ) import Agora.Proposal ( @@ -157,6 +158,7 @@ import Plutus.V1.Ledger.Value ( - The UTXO referenced in the parameter is spent in the transaction. - Exactly one GST is minted. - Ensure the token name is empty. + - Said UTXO should carry a valid 'Agora.Governor.GovernorDatum'. NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator. We /can't/ really check this in the policy, otherwise we create a cyclic reference issue. @@ -170,7 +172,7 @@ governorPolicy gov = let ownAssetClass = passetClass # ownSymbol # pconstant "" txInfo = pfromData $ pfield @"txInfo" # ctx' - txInfoF <- pletFields @'["mint", "inputs"] txInfo + txInfoF <- pletFields @'["mint", "inputs", "outputs", "datums"] txInfo passert "Referenced utxo should be spent" $ pisUTXOSpent # oref # txInfoF.inputs @@ -179,7 +181,21 @@ governorPolicy gov = psymbolValueOf # ownSymbol # txInfoF.mint #== 1 #&& passetClassValueOf # txInfoF.mint # ownAssetClass #== 1 - popaque (pconstant ()) + govOutput <- + plet $ + mustBePJust + # "Governor output not found" + #$ pfind + # plam + ( \((pfield @"value" #) . pfromData -> value) -> + psymbolValueOf # ownSymbol # value #== 1 + ) + # pfromData txInfoF.outputs + + let datumHash = pfield @"datumHash" # pfromData govOutput + datum = mustFindDatum' @PGovernorDatum # datumHash # txInfoF.datums + + popaque $ governorDatumValid # datum {- | Validator for Governors. From 0f8bc9e9f8db55d76aa5c0c2709021f8e631e024 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 3 May 2022 19:45:49 +0800 Subject: [PATCH 076/107] add subcommand `lint_haskell` to lint haskell code --- Makefile | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Makefile b/Makefile index 36a13e3..c18195c 100644 --- a/Makefile +++ b/Makefile @@ -14,6 +14,7 @@ usage: @echo " format_haskell -- Format haskell stuff, including source code and cabal files" @echo " format_nix -- Format *.nix files only" @echo " format_check -- Check if all haskell stuff have been formatted correctly" + @echo " lint_haskell -- run hlint on all haskell files" hoogle: pkill hoogle || true @@ -37,6 +38,9 @@ format_check: -not -path './haddock/*' \ | xargs fourmolu $(FORMAT_EXTENSIONS) -m check +lint_haskell: + find -name '*.hs' -not -path './dist*/*' -not -path './haddock/*' | xargs hlint + haddock: cabal haddock --haddock-html --haddock-hoogle --builddir=haddock From ac32b7305611622e6ef9f1790568b0eead27cffb Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 4 May 2022 12:57:25 +0800 Subject: [PATCH 077/107] add a sample for GST minting policy --- agora-test/Spec/Sample/Governor.hs | 85 ++++++++++++++++++++++++++++-- agora-test/Spec/Sample/Shared.hs | 7 ++- 2 files changed, 86 insertions(+), 6 deletions(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 34851ee..a840294 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -5,7 +5,12 @@ Description: Sample based testing for Governor utxos This module tests primarily the happy path for Governor interactions -} -module Spec.Sample.Governor (proposalCreation, mutateState, mintGAT) where +module Spec.Sample.Governor ( + proposalCreation, + mutateState, + mintGAT, + mintGST, +) where -------------------------------------------------------------------------------- @@ -16,10 +21,12 @@ import Plutarch.SafeMoney.Tagged import Plutus.V1.Ledger.Address (scriptHashAddress) import Plutus.V1.Ledger.Api ( - Address, + Address (..), + Credential (PubKeyCredential), Datum (..), + PubKeyHash, ScriptContext (..), - ScriptPurpose (Spending), + ScriptPurpose (Minting, Spending), ToData (toBuiltinData), TokenName (..), TxInInfo (TxInInfo), @@ -52,6 +59,76 @@ import Spec.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- +-- | This script context should be a valid transaction. +mintGST :: ScriptContext +mintGST = + let gst = Value.assetClassValue govAssetClass 1 + + --- + + governorOutputDatum' :: GovernorDatum + governorOutputDatum' = + GovernorDatum + { proposalThresholds = defaultProposalThresholds + , nextProposalId = ProposalId 0 + } + governorOutputDatum :: Datum + governorOutputDatum = Datum $ toBuiltinData governorOutputDatum' + governorOutput :: TxOut + governorOutput = + TxOut + { txOutAddress = govValidatorAddress + , txOutValue = withMinAda gst + , txOutDatumHash = Just $ toDatumHash governorOutputDatum + } + + --- + + witness :: PubKeyHash + witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924" + witnessAddress :: Address + witnessAddress = Address (PubKeyCredential witness) Nothing + + --- + + witnessInput :: TxOut + witnessInput = + TxOut + { txOutAddress = witnessAddress + , txOutValue = mempty + , txOutDatumHash = Nothing + } + witnessUTXO :: TxInInfo + witnessUTXO = TxInInfo gstUTXORef witnessInput + + --- + + witnessOutput :: TxOut + witnessOutput = + TxOut + { txOutAddress = witnessAddress + , txOutValue = minAda + , txOutDatumHash = Nothing + } + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ witnessUTXO + ] + , txInfoOutputs = [governorOutput, witnessOutput] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = gst + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [witness] + , txInfoData = [datumPair governorOutputDatum] + , txInfoId = "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4" + } + , scriptContextPurpose = Minting govSymbol + } + -- | This script context should be a valid transaction. proposalCreation :: ScriptContext proposalCreation = @@ -76,7 +153,7 @@ proposalCreation = TxOut { txOutAddress = govValidatorAddress , txOutValue = gst - , txOutDatumHash = Just (toDatumHash governorInputDatum) + , txOutDatumHash = Just $ toDatumHash governorInputDatum } --- diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 9375718..00dc1db 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -29,6 +29,7 @@ module Spec.Sample.Shared ( govAssetClass, govValidatorAddress, govValidatorHash, + gstUTXORef, -- ** Proposal defaultProposalThresholds, @@ -103,11 +104,13 @@ stakeValidatorHash = stakeValidatorHashFromGovernor governor stakeAddress :: Address stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing +gstUTXORef :: TxOutRef +gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 + governor :: Governor governor = Governor oref gt mc where - oref = - TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 + oref = gstUTXORef gt = Tagged $ Value.assetClass From 15d4dd03d98e109ea23277d295ed1448e093eafa Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 4 May 2022 20:08:42 +0800 Subject: [PATCH 078/107] implement merge sort to imporve perf of some utils --- agora/Agora/Proposal/Scripts.hs | 2 +- agora/Agora/Utils.hs | 121 +++++++++++++++++++++++++------- 2 files changed, 98 insertions(+), 25 deletions(-) diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 1ed6643..81bc3c5 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -169,7 +169,7 @@ proposalValidator proposal = newSigs <- plet $ pfield @"newCosigners" # r passert "Cosigners are unique" $ - pisUniq # newSigs + pisUniq # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y) # newSigs passert "Signed by all new cosigners" $ pall # signedBy # newSigs diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 705f4d3..704ada9 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -29,8 +29,11 @@ module Agora.Utils ( pkeysEqual, pnub, pisUniq, + pisUniqOrd, pisDJust, pisUTXOSpent, + pmsort, + pmsortOrd, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -335,37 +338,52 @@ ptokenSpent = {- | True if both maps have exactly the same keys. Using @'#=='@ is not sufficient, because keys returned are not ordered. -} -pkeysEqual :: forall (s :: S) k a b. Term s (PMap k a :--> PMap k b :--> PBool) +pkeysEqual :: (POrd k, PIsData k) => forall (s :: S) a b. Term s (PMap k a :--> PMap k b :--> PBool) pkeysEqual = phoistAcyclic $ plam $ \p q -> P.do pks <- plet $ pkeys # p qks <- plet $ pkeys # q - pall # plam (\pk -> pelem # pk # qks) # pks - #&& pall # plam (\qk -> pelem # qk # pks) # qks --- | / O(n^2) /. Clear out duplicates in a list. The order is not preserved. -pnub :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s (list a :--> list a) -pnub = - phoistAcyclic $ - precList - ( \self x xs -> + pif + (plength # pks #== plength # qks) + ( P.do + let comp = phoistAcyclic $ plam $ \(pfromData -> x) (pfromData -> y) -> x #< y + spks = pmsort # comp # pks + sqks = pmsort # comp # qks + + plistEquals # spks # sqks + ) + (pcon PFalse) + +-- | / O(nlogn) /. Clear out duplicates in a list. The order is not preserved. +pnub :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> list a) +pnub = phoistAcyclic $ + plam $ \comp xs -> P.do + sorted <- plet $ pmsort # comp # xs + pnubOrd # comp # sorted + where + pnubOrd = phoistAcyclic $ pfix #$ plam pnubOrd' + pnubOrd' self comp xs = + pif (pnull # xs) pnil $ P.do + xh <- plet $ phead # xs + xt <- plet $ ptail # xs + + pif (pnull # xt) xs $ P.do + xh' <- plet $ phead # xt pif - (pnot #$ pelem # x # xs) - (pcons # x # (self # xs)) - (self # xs) - ) - (const pnil) + (xh #== xh') + (self # comp # xt) + (pcons # xh #$ self # comp # xt) --- | / O(n^2) /. Check if a list contains no duplicates. -pisUniq :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s (list a :--> PBool) -pisUniq = - phoistAcyclic $ - precList - ( \self x xs -> - (pnot #$ pelem # x # xs) - #&& (self # xs) - ) - (const $ pcon PTrue) +-- | / O(nlogn) /. Check if a list contains no duplicates. +pisUniq :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> PBool) +pisUniq = phoistAcyclic $ + plam $ \comp xs -> + let nubbed = pnub # comp # xs in plength # xs #== plength # nubbed + +-- | List elements should have 'POrd' instance. +pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool) +pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<) -- | Yield True if a given PMaybeData is of form PDJust _. pisDJust :: Term s (PMaybeData a :--> PBool) @@ -386,6 +404,61 @@ pisUTXOSpent = phoistAcyclic $ plam $ \oref inputs -> P.do pisJust #$ pfindTxInByTxOutRef # oref # inputs +-- | Merge two ordered lists together. +pmerge :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a) +pmerge = phoistAcyclic $ pfix #$ plam pmerge' + where + pmerge' self comp a b = + pif (pnull # a) b $ + pif (pnull # b) a $ P.do + ah <- plet $ phead # a + at <- plet $ ptail # a + bh <- plet $ phead # b + bt <- plet $ ptail # b + + pif + (comp # ah # bh) + (pcons # ah #$ self # comp # at # b) + (pcons # bh #$ self # comp # at # bt) + +-- | / O(nlogn) /. Merge sort, bottom-up version. +pmsort :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a) +pmsort = phoistAcyclic $ pfix #$ plam pmsort' + where + pmsort' self comp xs = pif (pnull # xs) pnil $ + pif (pnull #$ ptail # xs) xs $ + pmatch (phalve # xs) $ \(PPair fh sh) -> + let sfh = self # comp # fh + ssh = self # comp # sh + in pmerge # comp # sfh # ssh + +-- | Required list elements have 'POrd' instance. +pmsortOrd :: (POrd a, PIsListLike l a) => Term s (l a :--> l a) +pmsortOrd = phoistAcyclic $ pmsort # comp + where + comp = phoistAcyclic $ plam (#<) + +-- | Split a list in half. +phalve :: (PIsListLike l a) => Term s (l a :--> PPair (l a) (l a)) +phalve = phoistAcyclic $ plam $ \l -> go # l # l + where + go = phoistAcyclic $ pfix #$ plam go' + go' self xs ys = + pif + (pnull # ys) + (pcon $ PPair pnil xs) + ( P.do + yt <- plet $ ptail # ys + + xh <- plet $ phead # xs + xt <- plet $ ptail # xs + + pif (pnull # yt) (pcon $ PPair (psingleton # xh) xt) $ P.do + yt' <- plet $ ptail # yt + pmatch (self # xt # yt') $ \(PPair first last) -> + pcon $ PPair (pcons # xh # first) last + ) + -------------------------------------------------------------------------------- {- Functions which should (probably) not be upstreamed All of these functions are quite inefficient. From 5c7d226a29d355f5d13716437691e136e535b4e7 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 4 May 2022 22:06:42 +0800 Subject: [PATCH 079/107] remove incorrect votes check --- agora/Agora/Governor/Scripts.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index b131057..6e08c49 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -419,9 +419,6 @@ governorValidator gov = passert "Invalid thresholds in proposal datum" $ outputProposalDatum.thresholds #== oldParams.proposalThresholds - passert "Initial proposal votes should be empty" $ - pnull #$ pto $ pto $ pfromData outputProposalDatum.votes - passert "Proposal state should be draft" $ outputProposalDatum.status #== pconstantData Draft From c6a59e076df58d88455c79c516fd92036e83b39c Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 4 May 2022 22:07:46 +0800 Subject: [PATCH 080/107] add proposal creation test --- agora-test/Spec/Governor.hs | 28 ++++++++++++++++++++++++++-- agora-test/Spec/Sample/Governor.hs | 6 +++--- 2 files changed, 29 insertions(+), 5 deletions(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 9999ba5..2661499 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -7,9 +7,33 @@ Tests for Governor policy and validator -} module Spec.Governor (tests) where -import Test.Tasty (TestTree) +import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) +import Agora.Governor.Scripts (governorPolicy, governorValidator) +import Agora.Proposal (ProposalId (..)) +import Spec.Sample.Governor (mintGST, createProposal) +import Spec.Sample.Shared qualified as Shared +import Spec.Util (policySucceedsWith, validatorSucceedsWith) +import Test.Tasty (TestTree, testGroup) -------------------------------------------------------------------------------- tests :: [TestTree] -tests = [] +tests = + [ testGroup + "policy" + [ policySucceedsWith + "GST minting" + (governorPolicy Shared.governor) + () + mintGST + ] + , testGroup + "validator" + [ validatorSucceedsWith + "proposal creation" + (governorValidator Shared.governor) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0)) + (CreateProposal) + createProposal + ] + ] diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index a840294..2326444 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -6,7 +6,7 @@ Description: Sample based testing for Governor utxos This module tests primarily the happy path for Governor interactions -} module Spec.Sample.Governor ( - proposalCreation, + createProposal, mutateState, mintGAT, mintGST, @@ -130,8 +130,8 @@ mintGST = } -- | This script context should be a valid transaction. -proposalCreation :: ScriptContext -proposalCreation = +createProposal :: ScriptContext +createProposal = let pst = Value.singleton proposalPolicySymbol "" 1 gst = Value.assetClassValue govAssetClass 1 sst = Value.assetClassValue stakeAssetClass 1 From a12c9832b89bf8b3d97a444a83fe2675ff6f6361 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 4 May 2022 22:15:30 +0800 Subject: [PATCH 081/107] run formatter and linter --- agora-test/Spec/Governor.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 2661499..797041c 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -10,7 +10,7 @@ module Spec.Governor (tests) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Proposal (ProposalId (..)) -import Spec.Sample.Governor (mintGST, createProposal) +import Spec.Sample.Governor (createProposal, mintGST) import Spec.Sample.Shared qualified as Shared import Spec.Util (policySucceedsWith, validatorSucceedsWith) import Test.Tasty (TestTree, testGroup) @@ -33,7 +33,7 @@ tests = "proposal creation" (governorValidator Shared.governor) (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0)) - (CreateProposal) + CreateProposal createProposal ] ] From c1c4c919a249c6a7621cfca1bfd4c9b8abe48963 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 5 May 2022 19:39:12 +0800 Subject: [PATCH 082/107] add the rest of the tests They won't pass for some reasons, unfortunately. --- agora-test/Spec/Governor.hs | 14 +++++++++++++- agora-test/Spec/Sample/Governor.hs | 6 +++--- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 797041c..10ce7be 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -10,7 +10,7 @@ module Spec.Governor (tests) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Proposal (ProposalId (..)) -import Spec.Sample.Governor (createProposal, mintGST) +import Spec.Sample.Governor (createProposal, mintGATs, mintGST, mutateState) import Spec.Sample.Shared qualified as Shared import Spec.Util (policySucceedsWith, validatorSucceedsWith) import Test.Tasty (TestTree, testGroup) @@ -35,5 +35,17 @@ tests = (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0)) CreateProposal createProposal + , validatorSucceedsWith + "GATs minting" + (governorValidator Shared.governor) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5)) + MintGATs + mintGATs + , validatorSucceedsWith + "mutate governor state" + (governorValidator Shared.governor) + (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5)) + MutateGovernor + mutateState ] ] diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 2326444..b169093 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -8,7 +8,7 @@ This module tests primarily the happy path for Governor interactions module Spec.Sample.Governor ( createProposal, mutateState, - mintGAT, + mintGATs, mintGST, ) where @@ -268,8 +268,8 @@ createProposal = } -- | This script context should be a valid transaction. -mintGAT :: ScriptContext -mintGAT = +mintGATs :: ScriptContext +mintGATs = let pst = Value.singleton proposalPolicySymbol "" 1 gst = Value.assetClassValue govAssetClass 1 gat = Value.assetClassValue atAssetClass 1 From d9a2a467bbb7ea73dda7c85550b4a62bc25e4425 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 5 May 2022 20:15:37 +0800 Subject: [PATCH 083/107] fix seralization issues --- agora-test/Spec/Proposal.hs | 8 ++++---- agora-test/Spec/Sample/Governor.hs | 8 ++++---- agora-test/Spec/Sample/Proposal.hs | 8 ++++---- agora/Agora/Proposal.hs | 2 +- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index 06583e0..ef14b0f 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -65,8 +65,8 @@ tests = { proposalId = ProposalId 0 , effects = AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, []) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) ] , status = Draft , cosigners = [signer] @@ -74,8 +74,8 @@ tests = , votes = emptyVotesFor $ AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, []) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) ] } ) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index b169093..7f3e333 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -160,8 +160,8 @@ createProposal = effects = AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, []) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) ] proposalDatum :: Datum proposalDatum = @@ -313,8 +313,8 @@ mintGATs = effects = AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, [(mockEffectHash, toDatumHash mockEffectOutputDatum)]) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.singleton mockEffectHash $ toDatumHash mockEffectOutputDatum) ] proposalVotes :: ProposalVotes proposalVotes = diff --git a/agora-test/Spec/Sample/Proposal.hs b/agora-test/Spec/Sample/Proposal.hs index fdde141..91749c4 100644 --- a/agora-test/Spec/Sample/Proposal.hs +++ b/agora-test/Spec/Sample/Proposal.hs @@ -60,8 +60,8 @@ proposalCreation = let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST effects = AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, []) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) ] proposalDatum :: Datum proposalDatum = @@ -155,8 +155,8 @@ cosignProposal newSigners = let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST effects = AssocMap.fromList - [ (ResultTag 0, []) - , (ResultTag 1, []) + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) ] proposalBefore :: ProposalDatum proposalBefore = diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index f57e5e4..36928d0 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -178,7 +178,7 @@ data ProposalDatum = ProposalDatum -- TODO: could we encode this more efficiently? -- This is shaped this way for future proofing. -- See https://github.com/Liqwid-Labs/agora/issues/39 - , effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)] + , effects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) -- ^ Effect lookup table. First by result, then by effect hash. , status :: ProposalStatus -- ^ The status the proposal is in. From b653d852656a45e344cc6ae5f6296323b7e8819e Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Thu, 5 May 2022 20:20:55 +0800 Subject: [PATCH 084/107] actually check GAT --- agora/Agora/Governor/Scripts.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 6e08c49..c047144 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -603,7 +603,7 @@ governorValidator gov = gatCount <- plet $ plength #$ pto $ pto effectGroup passert "Required amount of GATs should be minted" $ - psymbolValueOf # ppstSymbol # txInfo.mint #== gatCount + psymbolValueOf # patSymbol # txInfo.mint #== gatCount outputsWithGAT <- plet $ From 38e5611c3f254126d13b625e8e458c2287333150 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 5 May 2022 20:38:10 +0800 Subject: [PATCH 085/107] fix wired issue introduced by `punsafeCoerce` --- agora/Agora/Proposal.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 36928d0..686d060 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -48,7 +48,6 @@ import Agora.SafeMoney (GTTag) import Agora.Utils (pkeysEqual, pnotNull) import Control.Applicative (Const) import Control.Arrow (first) -import Plutarch.Builtin (PBuiltinMap) import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..)) import Plutarch.Lift ( DerivePConstantViaNewtype (..), @@ -415,17 +414,16 @@ proposalDatumValid proposal = plam $ \datum' -> P.do datum <- pletFields @'["effects", "cosigners", "votes"] $ datum' - let effects :: Term _ (PBuiltinMap Agora.Proposal.PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash)) - effects = - -- JUSTIFICATION: - -- @datum.effects : PMap PResultTag (PMap PValidatorHash PDatumHash)@ - -- @PMap PResultTag (PMap PValidatorHash PDatumHash)@ is equivalent to - -- @PBuiltinMap PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash)@ - punsafeCoerce datum.effects - - atLeastOneNegativeResult :: Term _ PBool - atLeastOneNegativeResult = - pany # plam (\pair -> pnull #$ pfromData $ psndBuiltin # pair) # effects + let atLeastOneNegativeResult = + pany + # phoistAcyclic + ( plam $ \m -> + let l :: Term _ (PBuiltinList _) + l = pto $ pfromData $ psndBuiltin # m + in pnull # l + ) + #$ pto + $ pfromData datum.effects foldr1 (#&&) From 2a993ae777484d37044fbc3ae890349815798e53 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 6 May 2022 14:06:27 +0800 Subject: [PATCH 086/107] run linter --- agora/Agora/Utils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 704ada9..6324ba1 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -56,11 +56,11 @@ module Agora.Utils ( -------------------------------------------------------------------------------- import Plutus.V1.Ledger.Api ( + Address (..), + Credential (..), CurrencySymbol, TokenName (..), ValidatorHash (..), - Credential(..), - Address(..), ) import Plutus.V1.Ledger.Value (AssetClass (..)) From e67dd21d0677b9c53cd36a76a9d4246ed0decd5f Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 6 May 2022 17:07:10 +0800 Subject: [PATCH 087/107] use `validatorHashToTokenName` --- agora/Agora/Governor/Scripts.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index c047144..3a8aa1b 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -86,6 +86,7 @@ import Agora.Utils ( pvalueSpent, scriptHashFromAddress, validatorHashToAddress, + validatorHashToTokenName, ) -------------------------------------------------------------------------------- @@ -129,7 +130,6 @@ import Plutarch.TryFrom (ptryFrom) import Plutus.V1.Ledger.Api ( CurrencySymbol (..), MintingPolicy, - TokenName (..), ) import Plutus.V1.Ledger.Scripts (ValidatorHash (..)) import Plutus.V1.Ledger.Value ( @@ -735,8 +735,7 @@ stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName) symbol = stakeSTSymbolFromGovernor gov -- Tag with the address where the token is being sent to. - ValidatorHash hash = stakeValidatorHashFromGovernor gov - tokenName = TokenName hash + tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov stakeFromGovernor :: Governor -> Stake stakeFromGovernor gov = From 057da7510174d8a5b4e235b710dbd90de2943cc0 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 10 May 2022 19:55:41 +0800 Subject: [PATCH 088/107] add someee comments; consistent naming --- agora/Agora/Governor.hs | 14 +- agora/Agora/Governor/Scripts.hs | 367 +++++++++++++++++--------------- agora/Agora/Utils.hs | 2 +- 3 files changed, 208 insertions(+), 175 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 8cf49f9..40d9d96 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -60,7 +60,7 @@ import PlutusTx qualified -------------------------------------------------------------------------------- --- | State datum for the Governor script. +-- | Datum for the Governor script. data GovernorDatum = GovernorDatum { proposalThresholds :: ProposalThresholds -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. @@ -124,7 +124,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum deriving anyclass (Generic) deriving anyclass (PIsDataRepr) deriving - (PlutusType, PIsData, PDataFields) + (PlutusType, PIsData, PDataFields, PEq) via PIsDataReprInstances PGovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum @@ -179,9 +179,9 @@ governorDatumValid = phoistAcyclic $ foldr1 (#&&) - [ ptraceIfFalse "Execute threshold larger than 0" $ 0 #<= execute - , ptraceIfFalse "Draft threshold larger than 0" $ 0 #<= draft - , ptraceIfFalse "Vote threshold larger than 0" $ 0 #<= vote - , ptraceIfFalse "Draft threshold larger than vote threshold" $ draft #<= vote - , ptraceIfFalse "Execute threshold larger than vote threshold" $ vote #< execute + [ ptraceIfFalse "Execute threshold is less than or equal to" $ 0 #<= execute + , ptraceIfFalse "Draft threshold is less than or equal to " $ 0 #<= draft + , ptraceIfFalse "Vote threshold is less than or equal to " $ 0 #<= vote + , ptraceIfFalse "Draft threshold is less than vote threshold" $ draft #<= vote + , ptraceIfFalse "Execute threshold is less than vote threshold" $ vote #< execute ] diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 3a8aa1b..5b42941 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -16,7 +16,6 @@ module Agora.Governor.Scripts ( -- * Bridges governorSTSymbolFromGovernor, governorSTAssetClassFromGovernor, - atSymbolFromGovernor, proposalSTAssetClassFromGovernor, stakeSTSymbolFromGovernor, stakeFromGovernor, @@ -76,12 +75,12 @@ import Agora.Utils ( mustBePJust, mustFindDatum', passert, - pfindDatum, pfindTxInByTxOutRef, pisDJust, pisJust, pisUTXOSpent, psymbolValueOf, + ptryFindDatum, ptxSignedBy, pvalueSpent, scriptHashFromAddress, @@ -111,7 +110,6 @@ import Plutarch.Api.V1.Extra ( passetClass, passetClassValueOf, ) -import Plutarch.Builtin (pforgetData) import Plutarch.Map.Extra ( pkeys, plookup, @@ -285,26 +283,29 @@ governorValidator :: Governor -> ClosedTerm PValidator governorValidator gov = plam $ \datum' redeemer' ctx' -> P.do (pfromData -> redeemer, _) <- ptryFrom redeemer' - ctx <- pletFields @'["txInfo", "purpose"] ctx' + ctxF <- pletFields @'["txInfo", "purpose"] ctx' - txInfo' <- plet $ pfromData $ ctx.txInfo - txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' + txInfo' <- plet $ pfromData $ ctxF.txInfo + txInfoF <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' - PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose - let txOutRef = pfromData txOutRef' + PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- pmatch $ pfromData ctxF.purpose - PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo.inputs - ownInput <- pletFields @'["address", "value"] ownInput' - let selfAddress = pfromData $ ownInput.address + ((pfield @"resolved" #) -> ownInput) <- + plet $ + mustBePJust # "Own input not found" + #$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs + ownInputF <- pletFields @'["address", "value"] ownInput + let ownAddress = pfromData $ ownInputF.address - (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' - oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' + (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFrom datum' + oldGovernorDatumF <- pletFields @'["proposalThresholds", "nextProposalId"] oldGovernorDatum - let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInput.value + -- Check that GST will be returned to the governor. + let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value passert "Own input should have exactly one state token" $ ownInputGSTAmount #== 1 - ownOutputs <- plet $ findOutputsToAddress # txInfo.outputs # selfAddress + ownOutputs <- plet $ findOutputsToAddress # txInfoF.outputs # ownAddress passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1 @@ -312,38 +313,42 @@ governorValidator gov = let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value passert "State token should stay at governor's address" $ ownOuputGSTAmount #== 1 - passert "Output utxo to governor should have datum" $ - pisDJust # ownOutput.datumHash - let outputGovernorStateDatumHash = mustBePDJust # "Output governor state datum hash not found" # ownOutput.datumHash - - newDatumData <- + -- Check that own output have datum of type 'GovernorDatum'. + let outputGovernorStateDatumHash = + mustBePDJust # "Governor output doesn't have datum" # ownOutput.datumHash + newGovernorDatum <- plet $ - pforgetData $ - pdata $ - mustBePJust # "Ouput governor state datum not found" - #$ pfindDatum # outputGovernorStateDatumHash # txInfo.datums + pfromData $ + mustBePJust # "Ouput governor state datum not found" + #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums + passert "New datum is not valid" $ governorDatumValid # newGovernorDatum pmatch redeemer $ \case PCreateProposal _ -> P.do - let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId + -- Check that the transaction advances proposal id. + + let expectedNextProposalId = pgetNextProposalId # oldGovernorDatumF.nextProposalId expectedNewDatum = mkRecordConstr PGovernorDatum - ( #proposalThresholds .= oldParams.proposalThresholds + ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds .& #nextProposalId .= pdata expectedNextProposalId ) passert "Unexpected governor state datum" $ - newDatumData #== pforgetData (pdata expectedNewDatum) + newGovernorDatum #== expectedNewDatum + + -- Check that exactly one proposal token is being minted. passert "Exactly one proposal token must be minted" $ - hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfo.mint + hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfoF.mint - -- + -- Check that a stake is spent to create the propsal, + -- and the value it contains meets the requirement. - inputsFromStakeValidatorWithStateToken <- + stakeInput <- plet $ - pfilter + mustBePJust # "Stake input not found" #$ pfind # phoistAcyclic ( plam $ \((pfield @"resolved" #) -> txOut') -> P.do @@ -352,31 +357,27 @@ governorValidator gov = txOut.address #== pdata pstakeValidatorAddress #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) - # pfromData txInfo.inputs + # pfromData txInfoF.inputs - passert "Exactly one input from the stake validator" $ - plength # inputsFromStakeValidatorWithStateToken #== 1 + stakeInputF <- pletFields @'["datumHash", "value"] $ pfield @"resolved" # stakeInput - stakeInput <- - pletFields @'["datumHash", "value"] $ - pfield @"resolved" - #$ phead # inputsFromStakeValidatorWithStateToken + passert "Stake input doesn't have datum" $ + pisDJust # stakeInputF.datumHash - passert "Stake input must have datum" $ - pisDJust # stakeInput.datumHash + let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums - let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInput.datumHash # txInfo.datums + stakeInputDatumF <- + pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum - stakeInputDatum <- - pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' - - passert "Required amount of stake GT should be presented" $ - stakeInputDatum.stakedAmount #== (pgtValueOf # stakeInput.value) + passert "Required amount of stake GTs should be presented" $ + stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value) + -- TODO: Is this required? passert "Tx should be signed by the stake owner" $ - ptxSignedBy # txInfo.signatories # stakeInputDatum.owner + ptxSignedBy # txInfoF.signatories # stakeInputDatumF.owner - -- + -- Check that the newly minted PST is sent to the proposal validator, + -- and the datum it carries is legal. outputsToProposalValidatorWithStateToken <- plet $ @@ -389,7 +390,7 @@ governorValidator gov = txOut.address #== pdata pproposalValidatorAddress #&& psymbolValueOf # ppstSymbol # txOut.value #== 1 ) - # pfromData txInfo.outputs + # pfromData txInfoF.outputs passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ plength # outputsToProposalValidatorWithStateToken #== 1 @@ -399,42 +400,46 @@ governorValidator gov = passert "The utxo paid to the proposal validator must have datum" $ pisDJust # outputDatumHash - outputProposalDatum' <- + proposalOutputDatum' <- plet $ mustFindDatum' @PProposalDatum # outputDatumHash - # txInfo.datums + # txInfoF.datums passert "Proposal datum must be valid" $ - proposalDatumValid' # outputProposalDatum' + proposalDatumValid' # proposalOutputDatum' - outputProposalDatum <- + proposalOutputDatum <- pletFields @'["proposalId", "status", "cosigners", "thresholds", "votes"] - outputProposalDatum' + proposalOutputDatum' + -- Id and thresholds should be copied from the old governor state datum. passert "Invalid proposal id in proposal datum" $ - outputProposalDatum.proposalId #== oldParams.nextProposalId + proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId passert "Invalid thresholds in proposal datum" $ - outputProposalDatum.thresholds #== oldParams.proposalThresholds + proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds + -- The proposal at this point should be in draft state. passert "Proposal state should be draft" $ - outputProposalDatum.status #== pconstantData Draft + proposalOutputDatum.status #== pconstantData Draft passert "Proposal should have only one cosigner" $ - plength # pfromData outputProposalDatum.cosigners #== 1 + plength # pfromData proposalOutputDatum.cosigners #== 1 - let cosigner = phead # pfromData outputProposalDatum.cosigners + let cosigner = phead # pfromData proposalOutputDatum.cosigners passert "Cosigner should be the stake owner" $ - pdata stakeInputDatum.owner #== cosigner + pdata stakeInputDatumF.owner #== cosigner - -- + -- Check the output stake has been proposly updated. - outputToStakeValidatorWithStateToken <- + stakeOutput <- plet $ - pfilter + mustBePJust + # "Stake output not found" + #$ pfind # phoistAcyclic ( plam $ \txOut' -> P.do @@ -443,27 +448,21 @@ governorValidator gov = txOut.address #== pdata pstakeValidatorAddress #&& psymbolValueOf # psstSymbol # txOut.value #== 1 ) - # pfromData txInfo.outputs + # pfromData txInfoF.outputs - passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ - plength # outputToStakeValidatorWithStateToken #== 1 - - stakeOutput <- - pletFields @'["datumHash", "value"] $ - pfromData $ - phead # outputToStakeValidatorWithStateToken + stakeOutputF <- pletFields @'["datumHash", "value"] $ stakeOutput passert "Staked GTs should be sent back to stake validator" $ - stakeInputDatum.stakedAmount #== (pgtValueOf # stakeOutput.value) + stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value) - let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutput.datumHash + let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputF.datumHash stakeOutputDatum = - pforgetData $ - pdata $ - mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo.datums + mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums - let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes + -- The stake should be locked by the newly created proposal. + + let possibleVoteResults = pkeys #$ pto $ pfromData proposalOutputDatum.votes mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) mkProposalLock = @@ -477,98 +476,103 @@ governorValidator gov = ) ) + -- Append new locks to existing locks expectedProposalLocks = - pconcat # stakeInputDatum.lockedBy - #$ pmap # (mkProposalLock # outputProposalDatum.proposalId) # possibleVoteResults + pconcat # stakeInputDatumF.lockedBy + #$ pmap # (mkProposalLock # proposalOutputDatum.proposalId) # possibleVoteResults - expectedOutputDatum = - pforgetData $ - pdata $ - mkRecordConstr - PStakeDatum - ( #stakedAmount .= stakeInputDatum.stakedAmount - .& #owner .= stakeInputDatum.owner - .& #lockedBy .= pdata expectedProposalLocks - ) + expectedStakeOutputDatum = + pdata $ + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeInputDatumF.stakedAmount + .& #owner .= stakeInputDatumF.owner + .& #lockedBy .= pdata expectedProposalLocks + ) - passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum + passert "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum popaque $ pconstant () + + -------------------------------------------------------------------------- + PMintGATs _ -> P.do - passert "Governor state should not be changed" $ newDatumData #== datum' + passert "Governor state should not be changed" $ newGovernorDatum #== oldGovernorDatum - inputsWithProposalStateToken <- - plet $ - pfilter - # plam - ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> - psymbolValueOf # ppstSymbol # value #== 1 - ) - #$ pfromData txInfo.inputs - - outputsWithProposalStateToken <- - plet $ - pfilter - # plam - ( \((pfield @"value" #) -> value) -> - psymbolValueOf # ppstSymbol # value #== 1 - ) - #$ pfromData txInfo.outputs + -- Filter out proposal inputs and ouputs using PST and the address of proposal validator. passert "The governor can only process one proposal at a time" $ - plength # inputsWithProposalStateToken #== 1 - #&& (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfo.inputs) #== 1 + (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 - proposalInputTxOut <- - pletFields @'["address", "value", "datumHash"] $ - pfield @"resolved" #$ phead # inputsWithProposalStateToken - proposalOutputTxOut <- - pletFields @'["datumHash", "address"] $ - phead # outputsWithProposalStateToken + proposalInputF <- + pletFields @'["datumHash"] $ + pfield @"resolved" + #$ pfromData + $ mustBePJust + # "Proposal input not found" + #$ pfind + # plam + ( \((pfield @"resolved" #) -> txOut) -> P.do + txOutF <- pletFields @'["address", "value"] txOut - passert "Proposal state token must be sent back to the proposal validator" $ - proposalOutputTxOut.address #== pdata pproposalValidatorAddress + psymbolValueOf # ppstSymbol # txOutF.value #== 1 + #&& txOutF.address #== pdata pproposalValidatorAddress + ) + # pfromData txInfoF.inputs - inputProposalDatum' <- + proposalOutputF <- + pletFields @'["datumHash"] $ + mustBePJust # "Proposal output not found" + #$ pfind + # plam + ( \txOut -> P.do + txOutF <- pletFields @'["address", "value"] txOut + psymbolValueOf # ppstSymbol # txOutF.value #== 1 + #&& txOutF.address #== pdata pproposalValidatorAddress + ) + # pfromData txInfoF.outputs + + proposalInputDatum <- plet $ mustFindDatum' @PProposalDatum - # proposalInputTxOut.datumHash - # txInfo.datums - outputProposalDatum' <- + # proposalInputF.datumHash + # txInfoF.datums + proposalOutputDatum <- plet $ mustFindDatum' @PProposalDatum - # proposalOutputTxOut.datumHash - # txInfo.datums + # proposalOutputF.datumHash + # txInfoF.datums passert "Proposal datum must be valid" $ - proposalDatumValid' # inputProposalDatum' - #&& proposalDatumValid' # outputProposalDatum' + proposalDatumValid' # proposalInputDatum + #&& proposalDatumValid' # proposalOutputDatum - inputProposalDatum <- + proposalInputDatumF <- pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"] - inputProposalDatum' + proposalInputDatum + + -- Check that the proposal state is advanced so that a proposal cannot be executed twice. passert "Proposal must be in locked(executable) state in order to execute effects" $ - inputProposalDatum.status #== pconstantData Locked + proposalInputDatumF.status #== pconstantData Locked let expectedOutputProposalDatum = - pforgetData $ - pdata $ - mkRecordConstr - PProposalDatum - ( #proposalId .= inputProposalDatum.proposalId - .& #effects .= inputProposalDatum.effects - .& #status .= pdata (pcon $ PFinished pdnil) - .& #cosigners .= inputProposalDatum.cosigners - .& #thresholds .= inputProposalDatum.thresholds - .& #votes .= inputProposalDatum.votes - ) + mkRecordConstr + PProposalDatum + ( #proposalId .= proposalInputDatumF.proposalId + .& #effects .= proposalInputDatumF.effects + .& #status .= pdata (pcon $ PFinished pdnil) + .& #cosigners .= proposalInputDatumF.cosigners + .& #thresholds .= proposalInputDatumF.thresholds + .& #votes .= proposalInputDatumF.votes + ) passert "Unexpected output proposal datum" $ - pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum + pdata proposalOutputDatum #== pdata expectedOutputProposalDatum -- TODO: anything else to check here? + -- Find the highest votes and the corresponding tag. let highestVoteFolder = phoistAcyclic $ plam @@ -584,27 +588,29 @@ governorValidator gov = (pcon $ PJust pair) ) - votesList = pto $ pto $ pfromData inputProposalDatum.votes + votesList = pto $ pto $ pfromData proposalInputDatumF.votes - winner' = + maybeWinner = pfoldr # highestVoteFolder # pcon PNothing # votesList - winner <- plet $ mustBePJust # "Empty votes" # winner' + winner <- plet $ mustBePJust # "No winning outcome" # maybeWinner let highestVote = pfromData $ psndBuiltin # winner - minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds + minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote let finalResultTag = pfromData $ pfstBuiltin # winner - effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects + -- The effects of the winner outcome. + effectGroup <- plet $ plookup' # finalResultTag #$ proposalInputDatumF.effects gatCount <- plet $ plength #$ pto $ pto effectGroup passert "Required amount of GATs should be minted" $ - psymbolValueOf # patSymbol # txInfo.mint #== gatCount + psymbolValueOf # patSymbol # txInfoF.mint #== gatCount + -- Ensure that every GAT goes to one of the effects in the winner effect group. outputsWithGAT <- plet $ pfilter @@ -614,16 +620,16 @@ governorValidator gov = 0 #< psymbolValueOf # patSymbol # value ) ) - # pfromData txInfo.outputs + # pfromData txInfoF.outputs passert "Output GATs is more than minted GATs" $ plength # outputsWithGAT #== gatCount - let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PUnit :--> PUnit) + let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PBool) gatOutputValidator' = phoistAcyclic $ plam - ( \effects (pfromData -> output') _ -> P.do + ( \effects (pfromData -> output') -> P.do output <- pletFields @'["address", "datumHash"] $ output' let scriptHash = @@ -637,52 +643,72 @@ governorValidator gov = mustBePJust # "Receiver is not in the effect list" #$ plookup # scriptHash # effects - passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output' - passert "Unexpected datum" $ datumHash #== expectedDatumHash - pconstant () + foldr1 + (#&&) + [ ptraceIfFalse "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output' + , ptraceIfFalse "Unexpected datum" $ datumHash #== expectedDatumHash + ] ) gatOutputValidator = gatOutputValidator' # effectGroup popaque $ pfoldr - # gatOutputValidator - # pconstant () - # outputsWithGAT + # plam + ( \txOut r -> + let value = pfield @"value" # txOut + atValue = psymbolValueOf # patSymbol # value + in pif (atValue #== 0) r $ + pif (atValue #== 1) (r #&& gatOutputValidator # txOut) $ pconstant False + ) + # pconstant True + # pfromData txInfoF.outputs + + -------------------------------------------------------------------------- + PMutateGovernor _ -> P.do - popaque $ singleAuthorityTokenBurned patSymbol ctx.txInfo txInfo.mint + -- Check that a GAT is burnt. + popaque $ singleAuthorityTokenBurned patSymbol ctxF.txInfo txInfoF.mint where + -- Get th amount of governance tokens in a value. pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef + -- The currency symbol of authority token. patSymbol :: Term s PCurrencySymbol - patSymbol = phoistAcyclic $ pconstant $ atSymbolFromGovernor gov + patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov + -- The currency symbol of the proposal state token. ppstSymbol :: Term s PCurrencySymbol ppstSymbol = let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov in phoistAcyclic $ pconstant sym + -- Is a proposal state datum valid? proposalDatumValid' :: Term s (PProposalDatum :--> PBool) proposalDatumValid' = let params = proposalFromGovernor gov in phoistAcyclic $ proposalDatumValid params + -- The address of the proposal validator. pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress = let vh = proposalValidatorHashFromGovernor gov in phoistAcyclic $ pconstant $ validatorHashToAddress vh + -- The address of the stake validator. pstakeValidatorAddress :: Term s PAddress pstakeValidatorAddress = let vh = stakeValidatorHashFromGovernor gov in phoistAcyclic $ pconstant $ validatorHashToAddress vh + -- The currency symbol of the stake state token. psstSymbol :: Term s PCurrencySymbol psstSymbol = let sym = stakeSTSymbolFromGovernor gov in phoistAcyclic $ pconstant sym + -- The currency symbol of the governor state token. pgstSymbol :: Term s PCurrencySymbol pgstSymbol = let sym = governorSTSymbolFromGovernor gov @@ -690,28 +716,21 @@ governorValidator gov = -------------------------------------------------------------------------------- +-- | Get the 'CurrencySymbol' of GST. governorSTSymbolFromGovernor :: Governor -> CurrencySymbol governorSTSymbolFromGovernor gov = mintingPolicySymbol policy where policy :: MintingPolicy policy = mkMintingPolicy $ governorPolicy gov -{- | Get the 'AssetClass' of GST from 'Governor'. - TODO: tag GST? --} +-- | Get the 'AssetClass' of GST. governorSTAssetClassFromGovernor :: Governor -> AssetClass governorSTAssetClassFromGovernor gov = AssetClass (symbol, "") where symbol :: CurrencySymbol symbol = governorSTSymbolFromGovernor gov --- | Get the `CurrencySymbol` of GAT from 'Governor'. -atSymbolFromGovernor :: Governor -> CurrencySymbol -atSymbolFromGovernor gov = mintingPolicySymbol policy - where - at = AuthorityToken $ governorSTAssetClassFromGovernor gov - policy = mkMintingPolicy $ authorityTokenPolicy at - +-- | Get the 'CurrencySymbol' of the proposal state token. proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol proposalSTSymbolFromGovernor gov = symbol where @@ -719,16 +738,23 @@ proposalSTSymbolFromGovernor gov = symbol policy = mkMintingPolicy $ proposalPolicy gstAC symbol = mintingPolicySymbol policy +-- | Get the 'AssetClass' of the proposal state token. proposalSTAssetClassFromGovernor :: Governor -> AssetClass proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") where symbol = proposalSTSymbolFromGovernor gov +-- | Get the 'CurrencySymbol' of the stake token/ stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy where policy = mkMintingPolicy $ stakePolicy gov.gtClassRef +{- | Get the 'AssetClass' of the stake token. + + Note that the token is tagged with the hash of the stake validator. + See 'Agora.Stake.Script.stakePolicy'. +-} stakeSTAssetClassFromGovernor :: Governor -> AssetClass stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName) where @@ -737,17 +763,20 @@ stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName) -- Tag with the address where the token is being sent to. tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov +-- | Get the 'Stake' parameter, given the 'Governor' parameter. stakeFromGovernor :: Governor -> Stake stakeFromGovernor gov = Stake gov.gtClassRef $ proposalSTAssetClassFromGovernor gov +-- | Get the hash of 'Agora.Stake.Script.stakePolicy'. stakeValidatorHashFromGovernor :: Governor -> ValidatorHash stakeValidatorHashFromGovernor gov = validatorHash validator where params = stakeFromGovernor gov validator = mkValidator $ stakeValidator params +-- | Get the 'Proposal' parameter, given the 'Governor' parameter. proposalFromGovernor :: Governor -> Proposal proposalFromGovernor gov = Proposal gstAC sstAC mc where @@ -755,20 +784,24 @@ proposalFromGovernor gov = Proposal gstAC sstAC mc mc = gov.maximumCosigners sstAC = stakeSTAssetClassFromGovernor gov +-- | Get the hash of 'Agora.Proposal.proposalPolicy'. proposalValidatorHashFromGovernor :: Governor -> ValidatorHash proposalValidatorHashFromGovernor gov = validatorHash validator where params = proposalFromGovernor gov validator = mkValidator $ proposalValidator params +-- | Get the hash of 'Agora.Proposal.proposalValidator'. governorValidatorHash :: Governor -> ValidatorHash governorValidatorHash gov = validatorHash validator where validator = mkValidator $ governorValidator gov +-- | Get the 'AuthorityToken' parameter given the 'Governor' parameter. authorityTokenFromGovernor :: Governor -> AuthorityToken authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov +-- | Get the 'CurrencySymbol' of the authority token. authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy where diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 6324ba1..b7f6103 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -385,7 +385,7 @@ pisUniq = phoistAcyclic $ pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool) pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<) --- | Yield True if a given PMaybeData is of form PDJust _. +-- | Yield True if a given PMaybeData is of form @'PDJust' _@. pisDJust :: Term s (PMaybeData a :--> PBool) pisDJust = phoistAcyclic $ plam $ \x -> From 710aa14e9a8b4ef2248dc4b3426fa215eb9aefd3 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 10 May 2022 22:13:31 +0800 Subject: [PATCH 089/107] qualified imports --- agora-test/Spec/Sample/Governor.hs | 37 ++++++++++++++++++++++++++---- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 7f3e333..9706361 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -46,15 +46,42 @@ import PlutusTx.AssocMap qualified as AssocMap -------------------------------------------------------------------------------- -import Agora.Effect.NoOp -import Agora.Governor -import Agora.Proposal +import Agora.Effect.NoOp (noOpValidator) +import Agora.Governor (GovernorDatum (..), getNextProposalId) +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (..), + ProposalStatus (..), + ProposalVotes (..), + ResultTag (..), + emptyVotesFor, + ) import Agora.Proposal qualified as P -import Agora.Stake +import Agora.Stake ( + ProposalLock (..), + Stake (..), + StakeDatum (..), + ) -------------------------------------------------------------------------------- -import Spec.Sample.Shared +import Spec.Sample.Shared ( + authorityTokenSymbol, + defaultProposalThresholds, + govAssetClass, + govSymbol, + govValidatorAddress, + gstUTXORef, + minAda, + proposalPolicySymbol, + proposalValidatorAddress, + signer, + signer2, + stake, + stakeAddress, + stakeAssetClass, + withMinAda, + ) import Spec.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- From 28c47178d36500113b358c4e981757729f2c484f Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 15:55:47 +0800 Subject: [PATCH 090/107] Revert "add subcommand `lint_haskell` to lint haskell code" This reverts commit 0f8bc9e9f8db55d76aa5c0c2709021f8e631e024. --- Makefile | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Makefile b/Makefile index c18195c..36a13e3 100644 --- a/Makefile +++ b/Makefile @@ -14,7 +14,6 @@ usage: @echo " format_haskell -- Format haskell stuff, including source code and cabal files" @echo " format_nix -- Format *.nix files only" @echo " format_check -- Check if all haskell stuff have been formatted correctly" - @echo " lint_haskell -- run hlint on all haskell files" hoogle: pkill hoogle || true @@ -38,9 +37,6 @@ format_check: -not -path './haddock/*' \ | xargs fourmolu $(FORMAT_EXTENSIONS) -m check -lint_haskell: - find -name '*.hs' -not -path './dist*/*' -not -path './haddock/*' | xargs hlint - haddock: cabal haddock --haddock-html --haddock-hoogle --builddir=haddock From 7d5805016f2c140aa918fb862860d9b3dc0a2c80 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 16:17:41 +0800 Subject: [PATCH 091/107] add missing phony --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 36a13e3..9696c09 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # This really ought to be `/usr/bin/env bash`, but nix flakes don't like that. SHELL := /bin/sh -.PHONY: hoogle format haddock usage +.PHONY: hoogle format haddock usage format_nix format_haskell format_check usage: @echo "usage: make [OPTIONS]" From f1216889906a01122642381867afad6a9211cded Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 17:31:17 +0800 Subject: [PATCH 092/107] remove `withMinAda` --- agora-test/Spec/Sample/Governor.hs | 17 ++++++++--------- agora-test/Spec/Sample/Shared.hs | 4 ---- 2 files changed, 8 insertions(+), 13 deletions(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 9706361..ac6ec18 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -80,7 +80,6 @@ import Spec.Sample.Shared ( stake, stakeAddress, stakeAssetClass, - withMinAda, ) import Spec.Util (datumPair, toDatumHash) @@ -105,7 +104,7 @@ mintGST = governorOutput = TxOut { txOutAddress = govValidatorAddress - , txOutValue = withMinAda gst + , txOutValue = gst <> minAda , txOutDatumHash = Just $ toDatumHash governorOutputDatum } @@ -207,7 +206,7 @@ createProposal = proposalOutput = TxOut { txOutAddress = proposalValidatorAddress - , txOutValue = withMinAda pst + , txOutValue = pst <> minAda , txOutDatumHash = Just (toDatumHash proposalDatum) } @@ -239,7 +238,7 @@ createProposal = governorOutput = governorInput { txOutDatumHash = Just $ toDatumHash governorOutputDatum - , txOutValue = withMinAda gst + , txOutValue = gst <> minAda } --- @@ -257,7 +256,7 @@ createProposal = stakeOutput = stakeInput { txOutDatumHash = Just $ toDatumHash stakeOutputDatum - , txOutValue = withMinAda sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs + , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda } --- @@ -381,7 +380,7 @@ mintGATs = governorOutput = governorInput { txOutDatumHash = Just $ toDatumHash governorOutputDatum - , txOutValue = withMinAda gst + , txOutValue = gst <> minAda } --- @@ -394,7 +393,7 @@ mintGATs = proposalOutput = proposalInput { txOutDatumHash = Just $ toDatumHash proposalOutputDatum - , txOutValue = withMinAda pst + , txOutValue = pst <> minAda } -- @@ -404,7 +403,7 @@ mintGATs = TxOut { txOutAddress = mockEffectAddress , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum - , txOutValue = withMinAda gat + , txOutValue = gat <> minAda } -- @@ -519,7 +518,7 @@ mutateState = governorOutput = governorInput { txOutDatumHash = Just $ toDatumHash governorOutputDatum - , txOutValue = withMinAda gst + , txOutValue = gst <> minAda } -- diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 00dc1db..1764d56 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -10,7 +10,6 @@ module Spec.Sample.Shared ( signer, signer2, minAda, - withMinAda, -- * Components @@ -167,9 +166,6 @@ defaultProposalThresholds = minAda :: Value minAda = Value.singleton "" "" 10_000_000 -withMinAda :: Value -> Value -withMinAda v = v <> minAda - authorityToken :: AuthorityToken authorityToken = authorityTokenFromGovernor governor From 9cef56084ec1792af911e75328eba9ed16a29033 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 17:43:04 +0800 Subject: [PATCH 093/107] only one signer to execute the effect --- agora-test/Spec/Sample/Governor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index ac6ec18..98a5091 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -543,7 +543,7 @@ mutateState = , txInfoDCert = [] , txInfoWdrl = [] , txInfoValidRange = Interval.always - , txInfoSignatories = [signer, signer2] + , txInfoSignatories = [signer] , txInfoData = datumPair <$> [ governorInputDatum From e63678ef502d2eaa6df2d48533d142515859387f Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 17:50:26 +0800 Subject: [PATCH 094/107] run formatter --- agora-test/Spec/Sample/Shared.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 96f50b9..a7b200b 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -50,8 +50,8 @@ module Spec.Sample.Shared ( wrongEffHash, ) where -import Agora.Effect.NoOp (noOpValidator) import Agora.AuthorityToken +import Agora.Effect.NoOp (noOpValidator) import Agora.Governor ( Governor (Governor), ) @@ -81,7 +81,7 @@ import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, mkValidator, - validatorHash + validatorHash, ) import Plutarch.SafeMoney import Plutus.V1.Ledger.Address (scriptHashAddress) @@ -98,7 +98,7 @@ import Plutus.V1.Ledger.Contexts ( TxOut (..), ) import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash (..)) -import Plutus.V1.Ledger.Value (TokenName, AssetClass) +import Plutus.V1.Ledger.Value (AssetClass, TokenName) import Plutus.V1.Ledger.Value qualified as Value -------------------------------------------------------------------------------- From 28e1adeb22ab5ab8c09681996beda444e843e7a6 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 18:12:29 +0800 Subject: [PATCH 095/107] add some description for the governor spec tests --- agora-test/Spec/Governor.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 10ce7be..0cd2557 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -1,9 +1,15 @@ {- | Module : Spec.Governor Maintainer : connor@mlabs.city -Description: Tests for Governor policy and validator +Description: Tests for Agora governor. -Tests for Governor policy and validator +Thie module exports `tests`, a list of `TestTree`s, which ensure +that Agora's governor component workds as intended. + +Tests should pass when the validator or policy is given one of the +valid script contexts, which are defined in 'Agora.Sample.Governor'. + +TODO: add negative test cases. -} module Spec.Governor (tests) where From 4a74fcc44cfda6e4e8d8d561b69035335c05df13 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 11 May 2022 20:44:57 +0800 Subject: [PATCH 096/107] describe what sample contexts are "valid" for --- agora-test/Spec/Sample/Governor.hs | 99 +++++++++++++++++++++++++----- 1 file changed, 82 insertions(+), 17 deletions(-) diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 98a5091..33c3fdb 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -85,7 +85,23 @@ import Spec.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- --- | This script context should be a valid transaction. +{- | A valid 'ScriptContext' for minting GST. + + - Only the minting policy will be ran in the transaction. + - An arbitrary UTXO is spent to create the token. + + - We call this the "witness" UTXO. + - This UTXO is referenced in the 'Agora.Governor.Governor' parameter + - The minting policy should only be ran once its life time, + cause the GST cannot be minted twice or burnt. + + - The output UTXO must carry a valid 'GovernorDatum'. + - It's worth noticing that the transaction should send the GST to the governor validator, + but unfortunately we can't check it in the policy. The GST will stay at the address of + the governor validator forever once the token is under control of the said validator. + + TODO: tag the output UTXO with the target address. +-} mintGST :: ScriptContext mintGST = let gst = Value.assetClassValue govAssetClass 1 @@ -110,6 +126,7 @@ mintGST = --- + -- TODO: Can the witness be a script? witness :: PubKeyHash witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924" witnessAddress :: Address @@ -117,6 +134,7 @@ mintGST = --- + -- The witness UTXO must be consumed. witnessInput :: TxOut witnessInput = TxOut @@ -126,25 +144,17 @@ mintGST = } witnessUTXO :: TxInInfo witnessUTXO = TxInInfo gstUTXORef witnessInput - - --- - - witnessOutput :: TxOut - witnessOutput = - TxOut - { txOutAddress = witnessAddress - , txOutValue = minAda - , txOutDatumHash = Nothing - } in ScriptContext { scriptContextTxInfo = TxInfo { txInfoInputs = [ witnessUTXO ] - , txInfoOutputs = [governorOutput, witnessOutput] - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = gst + , txInfoOutputs = [governorOutput] + , -- Some ada to cover the transaction fee + txInfoFee = Value.singleton "" "" 2 + , -- Exactly one GST is minted + txInfoMint = gst , txInfoDCert = [] , txInfoWdrl = [] , txInfoValidRange = Interval.always @@ -155,7 +165,33 @@ mintGST = , scriptContextPurpose = Minting govSymbol } --- | This script context should be a valid transaction. +{- | A valid script context to create a proposal. + + Three component will run in the transaction: + TODO: mention redeemers + + - Governor validator + - Stake validator + - Proposal policy + + The components will ensure: + + - The governor state UTXO is spent + + - A new UTXO is paid back to governor validator, which carries the GST. + - The proposal id in the state datum is advanced. + + - A new UTXO is sent to the proposal validator + + - The UTXO contains a newly minted proposal state token. + - It also carries a legal proposal state datum, whose status is set to 'Agora.Proposal.Draft'. + + - A stake is spent to create a proposal + + - The stake owner must sign the transaction. + - The output stake must paid back to the stake validator. + - The output stake is locked by the newly created proposal. +-} createProposal :: ScriptContext createProposal = let pst = Value.singleton proposalPolicySymbol "" 1 @@ -293,7 +329,23 @@ createProposal = , scriptContextPurpose = Spending ownInputRef } --- | This script context should be a valid transaction. +{- This script context should be a valid transaction for minting authority for the effect scrips. + + The following components will run: + + - Governor validator + - Authority policy + - Proposal validator + + There should be only one proposal the transaction. + The validity of the proposal will be checked: + + - It's in 'Agora.Proposal.Locked' state. + - It has a 'winner' effect group, meaning that the votes meet the requirements. + + The system will ensure that for every effect scrips in said effect group, + a newly minted GAT is sent to the corresponding effect, and properly tagged. +-} mintGATs :: ScriptContext mintGATs = let pst = Value.singleton proposalPolicySymbol "" 1 @@ -443,7 +495,20 @@ mintGATs = , scriptContextPurpose = Spending ownInputRef } --- | This script context should be a valid transaction. +{- | A valid script context for changing the state datum of the governor. + + In this case, the following components will run: + + * Governor validator + * Effect script + + The effect script should carry an valid tagged authority token, + and said token will be burnt in the transaction. We use 'noOpValidator' + here as a mock effect, so no actual change is done to the governor state. + TODO: use 'mutateGovernorEffect' as the mock effect in the future. + + The governor will ensure the new governor state is valid. +-} mutateState :: ScriptContext mutateState = let gst = Value.assetClassValue govAssetClass 1 From 9f116dd2cf727edf9e200bf6610f4d6b94c33743 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 12 May 2022 18:55:39 +0800 Subject: [PATCH 097/107] merge #74; add sample and spec of the governor --- .../Sample/Effect/TreasuryWithdrawal.hs | 6 ++-- .../Spec => agora-sample}/Sample/Governor.hs | 6 ++-- .../Spec => agora-sample}/Sample/Proposal.hs | 8 ++--- .../Spec => agora-sample}/Sample/Shared.hs | 4 +-- .../Spec => agora-sample}/Sample/Stake.hs | 8 ++--- .../Spec => agora-sample}/Sample/Treasury.hs | 8 ++--- agora-test/Spec.hs | 4 +++ agora-test/Spec/AuthorityToken.hs | 2 +- agora-test/Spec/Effect/TreasuryWithdrawal.hs | 4 +-- agora-test/Spec/Governor.hs | 6 ++-- agora-test/Spec/Proposal.hs | 8 ++--- agora-test/Spec/Stake.hs | 6 ++-- agora-test/Spec/Treasury.hs | 6 ++-- agora-test/Spec/Utils.hs | 13 +++++++ .../Spec => agora-testlib/Test}/Util.hs | 4 +-- agora.cabal | 34 ++++++++++++++----- 16 files changed, 81 insertions(+), 46 deletions(-) rename {agora-test/Spec => agora-sample}/Sample/Effect/TreasuryWithdrawal.hs (96%) rename {agora-test/Spec => agora-sample}/Sample/Governor.hs (99%) rename {agora-test/Spec => agora-sample}/Sample/Proposal.hs (98%) rename {agora-test/Spec => agora-sample}/Sample/Shared.hs (98%) rename {agora-test/Spec => agora-sample}/Sample/Stake.hs (97%) rename {agora-test/Spec => agora-sample}/Sample/Treasury.hs (97%) create mode 100644 agora-test/Spec/Utils.hs rename {agora-test/Spec => agora-testlib/Test}/Util.hs (99%) diff --git a/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs b/agora-sample/Sample/Effect/TreasuryWithdrawal.hs similarity index 96% rename from agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs rename to agora-sample/Sample/Effect/TreasuryWithdrawal.hs index 81709fe..f698f77 100644 --- a/agora-test/Spec/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-sample/Sample/Effect/TreasuryWithdrawal.hs @@ -1,11 +1,11 @@ {- | -Module : Spec.Sample.Effect.TreasuryWithdrawalEffect +Module : Sample.Effect.TreasuryWithdrawalEffect Maintainer : seungheon.ooh@gmail.com Description: Sample based testing for Treasury Withdrawal Effect -This module provides smaples for Treasury Withdrawal Effect tests. +This module provides samples for Treasury Withdrawal Effect tests. -} -module Spec.Sample.Effect.TreasuryWithdrawal ( +module Sample.Effect.TreasuryWithdrawal ( inputTreasury, inputUser, inputGAT, diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-sample/Sample/Governor.hs similarity index 99% rename from agora-test/Spec/Sample/Governor.hs rename to agora-sample/Sample/Governor.hs index 33c3fdb..d499d39 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -5,7 +5,7 @@ Description: Sample based testing for Governor utxos This module tests primarily the happy path for Governor interactions -} -module Spec.Sample.Governor ( +module Sample.Governor ( createProposal, mutateState, mintGATs, @@ -65,7 +65,7 @@ import Agora.Stake ( -------------------------------------------------------------------------------- -import Spec.Sample.Shared ( +import Sample.Shared ( authorityTokenSymbol, defaultProposalThresholds, govAssetClass, @@ -81,7 +81,7 @@ import Spec.Sample.Shared ( stakeAddress, stakeAssetClass, ) -import Spec.Util (datumPair, toDatumHash) +import Test.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs similarity index 98% rename from agora-test/Spec/Sample/Proposal.hs rename to agora-sample/Sample/Proposal.hs index 91749c4..e778fca 100644 --- a/agora-test/Spec/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -1,11 +1,11 @@ {- | -Module : Spec.Sample.Proposal +Module : Sample.Proposal Maintainer : emi@haskell.fyi Description: Sample based testing for Proposal utxos This module tests primarily the happy path for Proposal interactions -} -module Spec.Sample.Proposal ( +module Sample.Proposal ( -- * Script contexts proposalCreation, cosignProposal, @@ -49,8 +49,8 @@ import Agora.Proposal ( import Agora.Stake (Stake (..), StakeDatum (StakeDatum)) import Plutarch.SafeMoney (Tagged (Tagged), untag) import PlutusTx.AssocMap qualified as AssocMap -import Spec.Sample.Shared -import Spec.Util (datumPair, toDatumHash) +import Sample.Shared +import Test.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-sample/Sample/Shared.hs similarity index 98% rename from agora-test/Spec/Sample/Shared.hs rename to agora-sample/Sample/Shared.hs index a7b200b..c6f40a7 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-sample/Sample/Shared.hs @@ -1,11 +1,11 @@ {- | -Module : Spec.Sample.Shared +Module : Sample.Shared Maintainer : emi@haskell.fyi Description: Shared useful values for creating Samples for testing. Shared useful values for creating Samples for testing. -} -module Spec.Sample.Shared ( +module Sample.Shared ( -- * Misc signer, signer2, diff --git a/agora-test/Spec/Sample/Stake.hs b/agora-sample/Sample/Stake.hs similarity index 97% rename from agora-test/Spec/Sample/Stake.hs rename to agora-sample/Sample/Stake.hs index c80fdea..723af00 100644 --- a/agora-test/Spec/Sample/Stake.hs +++ b/agora-sample/Sample/Stake.hs @@ -1,11 +1,11 @@ {- | -Module : Spec.Sample.Stake +Module : Sample.Stake Maintainer : emi@haskell.fyi Description: Sample based testing for Stake utxos This module tests primarily the happy path for Stake creation -} -module Spec.Sample.Stake ( +module Sample.Stake ( stake, stakeAssetClass, stakeSymbol, @@ -49,8 +49,8 @@ import Agora.SafeMoney (GTTag) import Agora.Stake import Agora.Stake.Scripts (stakeValidator) import Plutarch.SafeMoney -import Spec.Sample.Shared -import Spec.Util (datumPair, toDatumHash) +import Sample.Shared +import Test.Util (datumPair, toDatumHash) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Sample/Treasury.hs b/agora-sample/Sample/Treasury.hs similarity index 97% rename from agora-test/Spec/Sample/Treasury.hs rename to agora-sample/Sample/Treasury.hs index 1cfb02c..41413e4 100644 --- a/agora-test/Spec/Sample/Treasury.hs +++ b/agora-sample/Sample/Treasury.hs @@ -1,14 +1,14 @@ {-# LANGUAGE TemplateHaskell #-} {- | -Module: Spec.Sample.Treasury +Module: Sample.Treasury Description: Sample data for `Spec.Treasury`. Maintainer: jack@mlabs.city This module contains sample data, used in the tests written in `Spec.Treasury`. -} -module Spec.Sample.Treasury ( +module Sample.Treasury ( gatCs, validCtx, treasuryRef, @@ -38,7 +38,7 @@ import Plutus.V1.Ledger.Scripts ( ValidatorHash (ValidatorHash), ) import Plutus.V1.Ledger.Value qualified as Value -import Spec.Sample.Shared ( +import Sample.Shared ( gatCs, gatTn, minAda, @@ -47,7 +47,7 @@ import Spec.Sample.Shared ( treasuryOut, wrongEffHash, ) -import Spec.Util (datumPair) +import Test.Util (datumPair) {- | A `ScriptContext` that should be compatible with treasury transactions. diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 47e50f8..20fef77 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -13,6 +13,7 @@ import Spec.Model.MultiSig qualified as MultiSig import Spec.Proposal qualified as Proposal import Spec.Stake qualified as Stake import Spec.Treasury qualified as Treasury +import Spec.Utils qualified as Utils -- | The Agora test suite. main :: IO () @@ -44,6 +45,9 @@ main = , testGroup "Governor tests" Governor.tests + , testGroup + "Utility functions tests" + Utils.tests , testGroup "Multisig tests" [ testGroup diff --git a/agora-test/Spec/AuthorityToken.hs b/agora-test/Spec/AuthorityToken.hs index da1e371..fdfda03 100644 --- a/agora-test/Spec/AuthorityToken.hs +++ b/agora-test/Spec/AuthorityToken.hs @@ -33,7 +33,7 @@ import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -import Spec.Util (scriptFails, scriptSucceeds) +import Test.Util (scriptFails, scriptSucceeds) currencySymbol :: CurrencySymbol currencySymbol = "deadbeef" diff --git a/agora-test/Spec/Effect/TreasuryWithdrawal.hs b/agora-test/Spec/Effect/TreasuryWithdrawal.hs index 27310d9..a380edb 100644 --- a/agora-test/Spec/Effect/TreasuryWithdrawal.hs +++ b/agora-test/Spec/Effect/TreasuryWithdrawal.hs @@ -12,7 +12,7 @@ import Agora.Effect.TreasuryWithdrawal ( treasuryWithdrawalValidator, ) import Plutus.V1.Ledger.Value qualified as Value -import Spec.Sample.Effect.TreasuryWithdrawal ( +import Sample.Effect.TreasuryWithdrawal ( buildReceiversOutputFromDatum, buildScriptContext, currSymbol, @@ -25,8 +25,8 @@ import Spec.Sample.Effect.TreasuryWithdrawal ( treasuries, users, ) -import Spec.Util (effectFailsWith, effectSucceedsWith) import Test.Tasty (TestTree, testGroup) +import Test.Util (effectFailsWith, effectSucceedsWith) tests :: [TestTree] tests = diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 0cd2557..4a86386 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -16,10 +16,10 @@ module Spec.Governor (tests) where import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..)) import Agora.Governor.Scripts (governorPolicy, governorValidator) import Agora.Proposal (ProposalId (..)) -import Spec.Sample.Governor (createProposal, mintGATs, mintGST, mutateState) -import Spec.Sample.Shared qualified as Shared -import Spec.Util (policySucceedsWith, validatorSucceedsWith) +import Sample.Governor (createProposal, mintGATs, mintGST, mutateState) +import Sample.Shared qualified as Shared import Test.Tasty (TestTree, testGroup) +import Test.Util (policySucceedsWith, validatorSucceedsWith) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs index ef14b0f..cb049ed 100644 --- a/agora-test/Spec/Proposal.hs +++ b/agora-test/Spec/Proposal.hs @@ -35,11 +35,11 @@ import Agora.Stake.Scripts (stakeValidator) import Plutarch.SafeMoney (Tagged (Tagged)) import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..)) import PlutusTx.AssocMap qualified as AssocMap -import Spec.Sample.Proposal qualified as Proposal -import Spec.Sample.Shared (signer, signer2) -import Spec.Sample.Shared qualified as Shared -import Spec.Util (policySucceedsWith, validatorSucceedsWith) +import Sample.Proposal qualified as Proposal +import Sample.Shared (signer, signer2) +import Sample.Shared qualified as Shared import Test.Tasty (TestTree, testGroup) +import Test.Util (policySucceedsWith, validatorSucceedsWith) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 6824b80..3a3eacd 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -24,9 +24,9 @@ import Agora.Stake.Scripts (stakePolicy, stakeValidator) -------------------------------------------------------------------------------- -import Spec.Sample.Stake (DepositWithdrawExample (DepositWithdrawExample, delta, startAmount), signer) -import Spec.Sample.Stake qualified as Stake -import Spec.Util (policyFailsWith, policySucceedsWith, toDatum, validatorFailsWith, validatorSucceedsWith) +import Sample.Stake (DepositWithdrawExample (DepositWithdrawExample, delta, startAmount), signer) +import Sample.Stake qualified as Stake +import Test.Util (policyFailsWith, policySucceedsWith, toDatum, validatorFailsWith, validatorSucceedsWith) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Treasury.hs b/agora-test/Spec/Treasury.hs index dd1044a..0cd139f 100644 --- a/agora-test/Spec/Treasury.hs +++ b/agora-test/Spec/Treasury.hs @@ -37,10 +37,10 @@ import Plutus.V1.Ledger.Credential ( StakingCredential (StakingHash), ) import Plutus.V1.Ledger.Value qualified as Value -import Spec.Sample.Shared ( +import Sample.Shared ( trCredential, ) -import Spec.Sample.Treasury ( +import Sample.Treasury ( gatCs, gatTn, trCtxGATNameNotAddress, @@ -48,8 +48,8 @@ import Spec.Sample.Treasury ( validCtx, walletIn, ) -import Spec.Util (validatorFailsWith, validatorSucceedsWith) import Test.Tasty (TestTree, testGroup) +import Test.Util (validatorFailsWith, validatorSucceedsWith) tests :: [TestTree] tests = diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs new file mode 100644 index 0000000..16e62d9 --- /dev/null +++ b/agora-test/Spec/Utils.hs @@ -0,0 +1,13 @@ +{- | +Module : Spec.Utils +Maintainer : emi@haskell.fyi +Description: Tests for utility functions in 'Agora.Utils'. + +Tests for utility functions in 'Agora.Utils'. +-} +module Spec.Utils (tests) where + +import Test.Tasty (TestTree) + +tests :: [TestTree] +tests = [] diff --git a/agora-test/Spec/Util.hs b/agora-testlib/Test/Util.hs similarity index 99% rename from agora-test/Spec/Util.hs rename to agora-testlib/Test/Util.hs index 31347e1..74e8ac6 100644 --- a/agora-test/Spec/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -1,5 +1,5 @@ {- | -Module : Spec.Util +Module : Test.Util Maintainer : emi@haskell.fyi Description: Utility functions for testing Plutarch scripts with ScriptContext @@ -22,7 +22,7 @@ Utility functions for testing Plutarch scripts with ScriptContext: - 'scriptFails': checks that an arbitrary script `perror`s out. -} -module Spec.Util ( +module Test.Util ( -- * Testing utils scriptSucceeds, scriptFails, diff --git a/agora.cabal b/agora.cabal index 1a74a30..85a1f32 100644 --- a/agora.cabal +++ b/agora.cabal @@ -153,6 +153,27 @@ library pprelude hs-source-dirs: agora default-language: Haskell2010 +library agora-testlib + import: lang, deps, test-deps + exposed-modules: Test.Util + hs-source-dirs: agora-testlib + +library agora-sample + import: lang, deps, test-deps + build-depends: + , agora + , agora-testlib + + exposed-modules: + Sample.Effect.TreasuryWithdrawal + Sample.Governor + Sample.Proposal + Sample.Shared + Sample.Stake + Sample.Treasury + + hs-source-dirs: agora-sample + test-suite agora-test import: lang, deps, test-deps type: exitcode-stdio-1.0 @@ -164,17 +185,14 @@ test-suite agora-test Spec.Governor Spec.Model.MultiSig Spec.Proposal - Spec.Sample.Effect.TreasuryWithdrawal - Spec.Sample.Governor - Spec.Sample.Proposal - Spec.Sample.Shared - Spec.Sample.Stake - Spec.Sample.Treasury Spec.Stake Spec.Treasury - Spec.Util + Spec.Utils - build-depends: agora + build-depends: + , agora + , agora-sample + , agora-testlib benchmark agora-bench import: lang, deps From 107ee51ae94027c5b463ed90faaf1bbb49334706 Mon Sep 17 00:00:00 2001 From: fanghr Date: Thu, 12 May 2022 20:23:13 +0800 Subject: [PATCH 098/107] doc negative test cases as a TODO --- agora-test/Spec/Governor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 4a86386..89c43f8 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -9,7 +9,7 @@ that Agora's governor component workds as intended. Tests should pass when the validator or policy is given one of the valid script contexts, which are defined in 'Agora.Sample.Governor'. -TODO: add negative test cases. +TODO: Add negative test cases, see [#76](https://github.com/Liqwid-Labs/agora/issues/76). -} module Spec.Governor (tests) where From f9acafa1c9bd8278f2f6a2a2865d261400c70190 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 13 May 2022 13:57:54 +0800 Subject: [PATCH 099/107] add missing phony --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 974d8ed..714165f 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # This really ought to be `/usr/bin/env bash`, but nix flakes don't like that. SHELL := /bin/sh -.PHONY: hoogle format haddock usage format_nix format_haskell format_check lint +.PHONY: hoogle format haddock usage tag format_nix format_haskell format_check lint usage: @echo "usage: make [OPTIONS]" From 26614a2e9fcda7ca6e097d939d157fed606e60c4 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 14 May 2022 01:04:16 +0800 Subject: [PATCH 100/107] update purescript bridge --- .../src/Agora/Governor.purs | 29 ++++++++++++------- .../src/Agora/Proposal.purs | 5 ++-- 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/agora-purescript-bridge/src/Agora/Governor.purs b/agora-purescript-bridge/src/Agora/Governor.purs index e8f5384..29172a1 100644 --- a/agora-purescript-bridge/src/Agora/Governor.purs +++ b/agora-purescript-bridge/src/Agora/Governor.purs @@ -4,6 +4,7 @@ module Agora.Governor where import Prelude import Agora.Proposal (ProposalId, ProposalThresholds) +import Agora.SafeMoney (GTTag) import Data.Bounded.Generic (genericBottom, genericTop) import Data.Enum (class Enum) import Data.Enum.Generic (genericPred, genericSucc) @@ -13,6 +14,10 @@ import Data.Lens.Iso.Newtype (_Newtype) import Data.Lens.Record (prop) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) +import Data.Tagged (Tagged) +import GHC.Num.Integer (Integer) +import Plutus.V1.Ledger.Tx (TxOutRef) +import Plutus.V1.Ledger.Value (AssetClass) import Type.Proxy (Proxy(Proxy)) newtype GovernorDatum = GovernorDatum @@ -34,6 +39,7 @@ _GovernorDatum = _Newtype data GovernorRedeemer = CreateProposal | MintGATs + | MutateGovernor derive instance Generic GovernorRedeemer _ @@ -57,21 +63,24 @@ _MintGATs = prism' (const MintGATs) case _ of MintGATs -> Just unit _ -> Nothing +_MutateGovernor :: Prism' GovernorRedeemer Unit +_MutateGovernor = prism' (const MutateGovernor) case _ of + MutateGovernor -> Just unit + _ -> Nothing + -------------------------------------------------------------------------------- -data Governor = Governor +newtype Governor = Governor + { gstOutRef :: TxOutRef + , gtClassRef :: Tagged GTTag AssetClass + , maximumCosigners :: Integer + } derive instance Generic Governor _ -instance Enum Governor where - succ = genericSucc - pred = genericPred - -instance Bounded Governor where - bottom = genericBottom - top = genericTop +derive instance Newtype Governor _ -------------------------------------------------------------------------------- -_Governor :: Iso' Governor Unit -_Governor = iso (const unit) (const Governor) +_Governor :: Iso' Governor {gstOutRef :: TxOutRef, gtClassRef :: Tagged GTTag AssetClass, maximumCosigners :: Integer} +_Governor = _Newtype diff --git a/agora-purescript-bridge/src/Agora/Proposal.purs b/agora-purescript-bridge/src/Agora/Proposal.purs index 317987c..416545e 100644 --- a/agora-purescript-bridge/src/Agora/Proposal.purs +++ b/agora-purescript-bridge/src/Agora/Proposal.purs @@ -14,7 +14,6 @@ import Data.Lens.Record (prop) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.Tagged (Tagged) -import Data.Tuple (Tuple) import GHC.Num.Integer (Integer) import Plutus.V1.Ledger.Crypto (PubKeyHash) import Plutus.V1.Ledger.Scripts (DatumHash, ValidatorHash) @@ -120,7 +119,7 @@ _ProposalVotes = _Newtype newtype ProposalDatum = ProposalDatum { proposalId :: ProposalId - , effects :: Map ResultTag (Array (Tuple ValidatorHash DatumHash)) + , effects :: Map ResultTag (Map ValidatorHash DatumHash) , status :: ProposalStatus , cosigners :: Array PubKeyHash , thresholds :: ProposalThresholds @@ -133,7 +132,7 @@ derive instance Newtype ProposalDatum _ -------------------------------------------------------------------------------- -_ProposalDatum :: Iso' ProposalDatum {proposalId :: ProposalId, effects :: Map ResultTag (Array (Tuple ValidatorHash DatumHash)), status :: ProposalStatus, cosigners :: Array PubKeyHash, thresholds :: ProposalThresholds, votes :: ProposalVotes} +_ProposalDatum :: Iso' ProposalDatum {proposalId :: ProposalId, effects :: Map ResultTag (Map ValidatorHash DatumHash), status :: ProposalStatus, cosigners :: Array PubKeyHash, thresholds :: ProposalThresholds, votes :: ProposalVotes} _ProposalDatum = _Newtype -------------------------------------------------------------------------------- From 9d34b63309c6131950a38a02d09458dc46eacaf0 Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 14 May 2022 17:32:42 +0800 Subject: [PATCH 101/107] `test-deps` already contains `agora` --- agora.cabal | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/agora.cabal b/agora.cabal index eb41a3f..11bb2d7 100644 --- a/agora.cabal +++ b/agora.cabal @@ -163,10 +163,7 @@ library agora-testlib library agora-sample import: lang, deps, test-deps - build-depends: - , agora - , agora-testlib - + build-depends: agora-testlib exposed-modules: Sample.Effect.TreasuryWithdrawal Sample.Governor @@ -193,7 +190,6 @@ test-suite agora-test Spec.Utils build-depends: - , agora , agora-sample , agora-testlib From 06d4fcd428227df2a32ba772cb6617a9f47481eb Mon Sep 17 00:00:00 2001 From: fanghr Date: Sat, 14 May 2022 19:21:33 +0800 Subject: [PATCH 102/107] add tests for `pmsort`, `pmerge` and `phalve` --- agora-test/Spec/Utils.hs | 83 +++++++++++++++++++++++++++++++++++++++- agora.cabal | 1 + agora/Agora/Utils.hs | 4 +- 3 files changed, 86 insertions(+), 2 deletions(-) diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs index 16e62d9..596a6a3 100644 --- a/agora-test/Spec/Utils.hs +++ b/agora-test/Spec/Utils.hs @@ -7,7 +7,88 @@ Tests for utility functions in 'Agora.Utils'. -} module Spec.Utils (tests) where +import Agora.Utils (phalve, pmerge, pmsortOrd, tcmatch) +import Data.List (sort) import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (testProperty) tests :: [TestTree] -tests = [] +tests = + [ testProperty "Merge sort sorts a list properly" prop_msort_sorted + , testProperty "Two sorted lists are merged into one sorted list" prop_pmerge_sorted + , testProperty "Split a list in half as expected" prop_halve_properly + ] + +-------------------------------------------------------------------------------- + +prop_msort_sorted :: [Integer] -> Bool +prop_msort_sorted arr = sort arr == sorted + where + parr :: Term _ (PBuiltinList PInteger) + parr = pconstant arr + + psorted :: Term _ (PBuiltinList PInteger) + psorted = pmsortOrd # parr + + sorted :: [Integer] + sorted = plift psorted + +prop_pmerge_sorted :: ([Integer], [Integer]) -> Bool +prop_pmerge_sorted (a, b) = merge sa sb == merged + where + sa = sort a + sb = sort b + + merge xs [] = xs + merge [] ys = ys + merge sx@(x : xs) sy@(y : ys) + | x <= y = x : merge xs sy + | otherwise = y : merge sx ys + + psa :: Term _ (PBuiltinList PInteger) + psa = pconstant @(PBuiltinList PInteger) sa + psb :: Term _ (PBuiltinList PInteger) + psb = pconstant @(PBuiltinList PInteger) sb + + pmerged :: Term _ (PBuiltinList PInteger) + pmerged = pmerge # plam (#<) # psa # psb + + merged :: [Integer] + merged = plift pmerged + +prop_halve_properly :: [Integer] -> Bool +prop_halve_properly arr = halve arr == halved + where + halve xs = go xs xs + where + go xs [] = ([], xs) + go (x : xs) [_] = ([x], xs) + go (x : xs) (_ : _ : ys) = + let (first, last) = + go xs ys + in (x : first, last) + go [] _ = ([], []) + + parr :: Term _ (PBuiltinList PInteger) + parr = pconstant arr + + ppairFst :: Term _ (PPair a b :--> a) + ppairFst = phoistAcyclic $ + plam $ \p -> unTermCont $ do + PPair x _ <- tcmatch p + return x + + ppairSnd :: Term _ (PPair a b :--> b) + ppairSnd = phoistAcyclic $ + plam $ \p -> unTermCont $ do + PPair _ y <- tcmatch p + return y + + phalved :: Term _ (PPair (PBuiltinList PInteger) (PBuiltinList PInteger)) + phalved = phalve # parr + + halved :: ([Integer], [Integer]) + halved = + let f = plift $ ppairFst # phalved + s = plift $ ppairSnd # phalved + in (f, s) diff --git a/agora.cabal b/agora.cabal index 11bb2d7..c8ce871 100644 --- a/agora.cabal +++ b/agora.cabal @@ -119,6 +119,7 @@ common test-deps , tasty , tasty-hedgehog , tasty-hunit + , tasty-quickcheck common exe-opts ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0 diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 110899c..7ce3bf3 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -56,6 +56,8 @@ module Agora.Utils ( mustBePJust, mustBePDJust, validatorHashToAddress, + pmerge, + phalve, ) where -------------------------------------------------------------------------------- @@ -446,7 +448,7 @@ pmerge = phoistAcyclic $ pfix #$ plam pmerge' pif (comp # ah # bh) (pcons # ah #$ self # comp # at # b) - (pcons # bh #$ self # comp # at # bt) + (pcons # bh #$ self # comp # a # bt) -- | / O(nlogn) /. Merge sort, bottom-up version. pmsort :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a) From 768652deb26d1e9339af8ecd4361a3c54051ef01 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 16 May 2022 18:11:14 +0800 Subject: [PATCH 103/107] docs for utils; refactor tests; rewrite `pnubSortBy` --- agora-test/Spec/Utils.hs | 66 +++++++++-------- agora/Agora/Proposal/Scripts.hs | 7 +- agora/Agora/Utils.hs | 124 +++++++++++++++++++------------- 3 files changed, 111 insertions(+), 86 deletions(-) diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs index 596a6a3..45718de 100644 --- a/agora-test/Spec/Utils.hs +++ b/agora-test/Spec/Utils.hs @@ -7,58 +7,66 @@ Tests for utility functions in 'Agora.Utils'. -} module Spec.Utils (tests) where -import Agora.Utils (phalve, pmerge, pmsortOrd, tcmatch) +import Agora.Utils (phalve, pmergeBy, pmsort) import Data.List (sort) import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (testProperty) tests :: [TestTree] tests = - [ testProperty "Merge sort sorts a list properly" prop_msort_sorted - , testProperty "Two sorted lists are merged into one sorted list" prop_pmerge_sorted - , testProperty "Split a list in half as expected" prop_halve_properly + [ testProperty "Merge sort sorts a list properly" prop_msortSorted + , testProperty "Two sorted lists are merged into one sorted list" prop_pmergeSorted + , testProperty "Split a list in half as expected" prop_halveProperly ] -------------------------------------------------------------------------------- -prop_msort_sorted :: [Integer] -> Bool -prop_msort_sorted arr = sort arr == sorted +prop_msortSorted :: [Integer] -> Bool +prop_msortSorted arr = sorted == expected where - parr :: Term _ (PBuiltinList PInteger) - parr = pconstant arr + -- Expected sorted list, using 'Data.List.sort'. + expected :: [Integer] + expected = sort arr + + -- psorted :: Term _ (PBuiltinList PInteger) - psorted = pmsortOrd # parr + psorted = pmsort # pconstant arr sorted :: [Integer] sorted = plift psorted -prop_pmerge_sorted :: ([Integer], [Integer]) -> Bool -prop_pmerge_sorted (a, b) = merge sa sb == merged +prop_pmergeSorted :: [Integer] -> [Integer] -> Bool +prop_pmergeSorted a b = merged == expected where + -- Sorted list a and b sa = sort a sb = sort b + -- Merge two lists which are assumed to be ordered. + merge :: [Integer] -> [Integer] -> [Integer] merge xs [] = xs merge [] ys = ys merge sx@(x : xs) sy@(y : ys) | x <= y = x : merge xs sy | otherwise = y : merge sx ys - psa :: Term _ (PBuiltinList PInteger) - psa = pconstant @(PBuiltinList PInteger) sa - psb :: Term _ (PBuiltinList PInteger) - psb = pconstant @(PBuiltinList PInteger) sb + expected :: [Integer] + expected = merge sa sb + + -- pmerged :: Term _ (PBuiltinList PInteger) - pmerged = pmerge # plam (#<) # psa # psb + pmerged = pmergeBy # plam (#<) # pconstant sa # pconstant sb merged :: [Integer] merged = plift pmerged -prop_halve_properly :: [Integer] -> Bool -prop_halve_properly arr = halve arr == halved +prop_halveProperly :: [Integer] -> Bool +prop_halveProperly arr = halved == expected where + -- Halve a list. + halve :: [Integer] -> ([Integer], [Integer]) halve xs = go xs xs where go xs [] = ([], xs) @@ -69,26 +77,16 @@ prop_halve_properly arr = halve arr == halved in (x : first, last) go [] _ = ([], []) - parr :: Term _ (PBuiltinList PInteger) - parr = pconstant arr + expected :: ([Integer], [Integer]) + expected = halve arr - ppairFst :: Term _ (PPair a b :--> a) - ppairFst = phoistAcyclic $ - plam $ \p -> unTermCont $ do - PPair x _ <- tcmatch p - return x - - ppairSnd :: Term _ (PPair a b :--> b) - ppairSnd = phoistAcyclic $ - plam $ \p -> unTermCont $ do - PPair _ y <- tcmatch p - return y + -- phalved :: Term _ (PPair (PBuiltinList PInteger) (PBuiltinList PInteger)) - phalved = phalve # parr + phalved = phalve # pconstant arr halved :: ([Integer], [Integer]) halved = - let f = plift $ ppairFst # phalved - s = plift $ ppairSnd # phalved + let f = plift $ pmatch phalved $ \(PPair x _) -> x + s = plift $ pmatch phalved $ \(PPair _ x) -> x in (f, s) diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 57ba4bc..ce2dcbe 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -21,7 +21,7 @@ import Agora.Utils ( anyOutput, findTxOutByTxOutRef, getMintingPolicySymbol, - pisUniq, + pisUniqBy, psymbolValueOf, ptokenSpent, ptxSignedBy, @@ -171,7 +171,10 @@ proposalValidator proposal = newSigs <- tclet $ pfield @"newCosigners" # r tcassert "Cosigners are unique" $ - pisUniq # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y) # newSigs + pisUniqBy + # phoistAcyclic (plam (#==)) + # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y) + # newSigs tcassert "Signed by all new cosigners" $ pall # signedBy # newSigs diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 7ce3bf3..558bc13 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -32,13 +32,14 @@ module Agora.Utils ( pisJust, ptokenSpent, pkeysEqual, - pnub, + pnubSortBy, pisUniq, - pisUniqOrd, + pisUniqBy, pisDJust, pisUTXOSpent, + pmsortBy, pmsort, - pmsortOrd, + pnubSort, -- * Functions which should (probably) not be upstreamed anyOutput, @@ -56,7 +57,7 @@ module Agora.Utils ( mustBePJust, mustBePDJust, validatorHashToAddress, - pmerge, + pmergeBy, phalve, ) where @@ -371,46 +372,67 @@ pkeysEqual = phoistAcyclic $ (plength # pks #== plength # qks) ( unTermCont $ do let comp = phoistAcyclic $ plam $ \(pfromData -> x) (pfromData -> y) -> x #< y - spks = pmsort # comp # pks - sqks = pmsort # comp # qks + spks = pmsortBy # comp # pks + sqks = pmsortBy # comp # qks pure $ plistEquals # spks # sqks ) (pcon PFalse) --- | / O(nlogn) /. Clear out duplicates in a list. The order is not preserved. -pnub :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> list a) -pnub = phoistAcyclic $ - plam $ \comp xs -> unTermCont $ do - sorted <- tclet $ pmsort # comp # xs - pure $ pnubOrd # comp # sorted - where - pnubOrd = phoistAcyclic $ pfix #$ plam pnubOrd' - pnubOrd' self comp xs = - pif (pnull # xs) pnil $ - unTermCont $ do - xh <- tclet $ phead # xs - xt <- tclet $ ptail # xs +-- | / O(nlogn) /. Sort and remove dupicate elements in a list. +pnubSortBy :: + forall list a (s :: S). + (PIsListLike list a) => + Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> list a) +pnubSortBy = phoistAcyclic $ + plam $ \eq comp l -> pif (pnull # l) l $ + unTermCont $ do + sl <- tclet $ pmsortBy # comp # l - pure $ - pif (pnull # xt) xs $ - unTermCont $ do - xh' <- tclet $ phead # xt - pure $ - pif - (xh #== xh') - (self # comp # xt) - (pcons # xh #$ self # comp # xt) + let x = phead # sl + xs = ptail # sl + + return $ pgo # eq # x # xs + where + pgo = phoistAcyclic pfix #$ plam pgo' + pgo' self eq seen l = + pif (pnull # l) (psingleton # seen) $ + unTermCont $ do + x <- tclet $ phead # l + xs <- tclet $ ptail # l + + return $ + pif + (eq # x # seen) + (self # eq # seen # xs) + (pcons # seen #$ self # eq # x # xs) + +-- | Special version of 'pnubSortBy', which requires elements have 'POrd'. +pnubSort :: + forall list a (s :: S). + (PIsListLike list a, POrd a) => + Term s (list a :--> list a) +pnubSort = phoistAcyclic $ pnubSortBy # eq # comp + where + eq = phoistAcyclic $ plam (#==) + comp = phoistAcyclic $ plam (#<) -- | / O(nlogn) /. Check if a list contains no duplicates. -pisUniq :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> PBool) -pisUniq = phoistAcyclic $ - plam $ \comp xs -> - let nubbed = pnub # comp # xs in plength # xs #== plength # nubbed +pisUniqBy :: + forall list a (s :: S). + (PIsListLike list a) => + Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> PBool) +pisUniqBy = phoistAcyclic $ + plam $ \eq comp xs -> + let nubbed = pnubSortBy # eq # comp # xs + in plength # xs #== plength # nubbed --- | List elements should have 'POrd' instance. -pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool) -pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<) +-- | A special case of 'pisUniqBy' which requires elements have 'POrd' instance. +pisUniq :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool) +pisUniq = phoistAcyclic $ pisUniqBy # eq # comp + where + eq = phoistAcyclic $ plam (#==) + comp = phoistAcyclic $ plam (#<) -- | Yield True if a given PMaybeData is of form @'PDJust' _@. pisDJust :: Term s (PMaybeData a :--> PBool) @@ -423,19 +445,17 @@ pisDJust = phoistAcyclic $ _ -> pconstant False ) -{- | Determines if a given UTXO is spent. - TODO: no need to pass the whole TxInfo here. --} +-- | Determines if a given UTXO is spent. pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool) pisUTXOSpent = phoistAcyclic $ plam $ \oref inputs -> P.do pisJust #$ pfindTxInByTxOutRef # oref # inputs --- | Merge two ordered lists together. -pmerge :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a) -pmerge = phoistAcyclic $ pfix #$ plam pmerge' +-- | / O(n) /. Merge two lists which are assumed to be ordered, given a custom comparator. +pmergeBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a) +pmergeBy = phoistAcyclic $ pfix #$ plam pmergeBy' where - pmerge' self comp a b = + pmergeBy' self comp a b = pif (pnull # a) b $ pif (pnull # b) a $ unTermCont $ do @@ -450,20 +470,24 @@ pmerge = phoistAcyclic $ pfix #$ plam pmerge' (pcons # ah #$ self # comp # at # b) (pcons # bh #$ self # comp # a # bt) --- | / O(nlogn) /. Merge sort, bottom-up version. -pmsort :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a) -pmsort = phoistAcyclic $ pfix #$ plam pmsort' +{- | / O(nlogn) /. Merge sort, bottom-up version, given a custom comparator. + + Elements are arranged from lowest to highest, + keeping duplicates in the order they appeared in the input. +-} +pmsortBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a) +pmsortBy = phoistAcyclic $ pfix #$ plam pmsortBy' where - pmsort' self comp xs = pif (pnull # xs) pnil $ + pmsortBy' self comp xs = pif (pnull # xs) pnil $ pif (pnull #$ ptail # xs) xs $ pmatch (phalve # xs) $ \(PPair fh sh) -> let sfh = self # comp # fh ssh = self # comp # sh - in pmerge # comp # sfh # ssh + in pmergeBy # comp # sfh # ssh --- | Required list elements have 'POrd' instance. -pmsortOrd :: (POrd a, PIsListLike l a) => Term s (l a :--> l a) -pmsortOrd = phoistAcyclic $ pmsort # comp +-- | A special case of 'pmsortBy' which requires elements have 'POrd' instance. +pmsort :: (POrd a, PIsListLike l a) => Term s (l a :--> l a) +pmsort = phoistAcyclic $ pmsortBy # comp where comp = phoistAcyclic $ plam (#<) From 65481057197fb7ed25722be8a2fd7dcc312fc555 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 16 May 2022 19:59:11 +0800 Subject: [PATCH 104/107] apply Emily's suggestions --- agora-sample/Sample/Governor.hs | 19 ++++++++----------- agora/Agora/Proposal.hs | 6 +----- 2 files changed, 9 insertions(+), 16 deletions(-) diff --git a/agora-sample/Sample/Governor.hs b/agora-sample/Sample/Governor.hs index d499d39..ff5f0bf 100644 --- a/agora-sample/Sample/Governor.hs +++ b/agora-sample/Sample/Governor.hs @@ -22,9 +22,8 @@ import Plutarch.SafeMoney.Tagged import Plutus.V1.Ledger.Address (scriptHashAddress) import Plutus.V1.Ledger.Api ( Address (..), - Credential (PubKeyCredential), + Credential (ScriptCredential), Datum (..), - PubKeyHash, ScriptContext (..), ScriptPurpose (Minting, Spending), ToData (toBuiltinData), @@ -126,11 +125,10 @@ mintGST = --- - -- TODO: Can the witness be a script? - witness :: PubKeyHash + witness :: ValidatorHash witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924" witnessAddress :: Address - witnessAddress = Address (PubKeyCredential witness) Nothing + witnessAddress = Address (ScriptCredential witness) Nothing --- @@ -142,13 +140,13 @@ mintGST = , txOutValue = mempty , txOutDatumHash = Nothing } - witnessUTXO :: TxInInfo - witnessUTXO = TxInInfo gstUTXORef witnessInput + initialSpend :: TxInInfo + initialSpend = TxInInfo gstUTXORef witnessInput in ScriptContext { scriptContextTxInfo = TxInfo { txInfoInputs = - [ witnessUTXO + [ initialSpend ] , txInfoOutputs = [governorOutput] , -- Some ada to cover the transaction fee @@ -158,7 +156,7 @@ mintGST = , txInfoDCert = [] , txInfoWdrl = [] , txInfoValidRange = Interval.always - , txInfoSignatories = [witness] + , txInfoSignatories = [signer] , txInfoData = [datumPair governorOutputDatum] , txInfoId = "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4" } @@ -407,8 +405,7 @@ mintGATs = { P.proposalId = ProposalId 0 , effects = effects , status = Locked - , -- TODO: Any need to check minimun amount of cosigners here? - cosigners = [signer, signer2] + , cosigners = [signer, signer2] , thresholds = defaultProposalThresholds , votes = proposalVotes } diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index eec4687..794ea0a 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -416,11 +416,7 @@ proposalDatumValid proposal = let atLeastOneNegativeResult = pany # phoistAcyclic - ( plam $ \m -> - let l :: Term _ (PBuiltinList _) - l = pto $ pfromData $ psndBuiltin # m - in pnull # l - ) + (plam $ \m -> pnull #$ pto $ pfromData $ psndBuiltin # m) #$ pto $ pfromData datum.effects From 0c47f0d84dec0d28df24ed11bafbf026fb7fc728 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 16 May 2022 20:23:51 +0800 Subject: [PATCH 105/107] add tests for 'pnubSort' and 'pisUniq' --- agora-test/Spec.hs | 2 +- agora-test/Spec/Utils.hs | 67 ++++++++++++++++++++++++++++++++-------- 2 files changed, 55 insertions(+), 14 deletions(-) diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 20fef77..d2c90f7 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -46,7 +46,7 @@ main = "Governor tests" Governor.tests , testGroup - "Utility functions tests" + "Utility tests" Utils.tests , testGroup "Multisig tests" diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs index 45718de..30c1dd7 100644 --- a/agora-test/Spec/Utils.hs +++ b/agora-test/Spec/Utils.hs @@ -7,37 +7,50 @@ Tests for utility functions in 'Agora.Utils'. -} module Spec.Utils (tests) where -import Agora.Utils (phalve, pmergeBy, pmsort) -import Data.List (sort) +-------------------------------------------------------------------------------- + +import Agora.Utils (phalve, pisUniq, pmergeBy, pmsort, pnubSort) + +-------------------------------------------------------------------------------- + +import Data.List (nub, sort) +import Data.Set as S + +-------------------------------------------------------------------------------- + import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (testProperty) +-------------------------------------------------------------------------------- + tests :: [TestTree] tests = - [ testProperty "Merge sort sorts a list properly" prop_msortSorted - , testProperty "Two sorted lists are merged into one sorted list" prop_pmergeSorted - , testProperty "Split a list in half as expected" prop_halveProperly + [ testProperty "'pmsort' sorts a list properly" prop_msortSorted + , testProperty "'pmerge' merges two sorted lists into one sorted list" prop_mergeSorted + , testProperty "'phalve' splits a list in half as expected" prop_halveProperly + , testProperty "'pnubSort' sorts a list and remove duplicate elements" prop_nubSortProperly + , testProperty "'pisUniq' can tell whether all elements in a list are unique" prop_uniqueList ] -------------------------------------------------------------------------------- prop_msortSorted :: [Integer] -> Bool -prop_msortSorted arr = sorted == expected +prop_msortSorted l = sorted == expected where -- Expected sorted list, using 'Data.List.sort'. expected :: [Integer] - expected = sort arr + expected = sort l -- psorted :: Term _ (PBuiltinList PInteger) - psorted = pmsort # pconstant arr + psorted = pmsort # pconstant l sorted :: [Integer] sorted = plift psorted -prop_pmergeSorted :: [Integer] -> [Integer] -> Bool -prop_pmergeSorted a b = merged == expected +prop_mergeSorted :: [Integer] -> [Integer] -> Bool +prop_mergeSorted a b = merged == expected where -- Sorted list a and b sa = sort a @@ -63,7 +76,7 @@ prop_pmergeSorted a b = merged == expected merged = plift pmerged prop_halveProperly :: [Integer] -> Bool -prop_halveProperly arr = halved == expected +prop_halveProperly l = halved == expected where -- Halve a list. halve :: [Integer] -> ([Integer], [Integer]) @@ -78,15 +91,43 @@ prop_halveProperly arr = halved == expected go [] _ = ([], []) expected :: ([Integer], [Integer]) - expected = halve arr + expected = halve l -- phalved :: Term _ (PPair (PBuiltinList PInteger) (PBuiltinList PInteger)) - phalved = phalve # pconstant arr + phalved = phalve # pconstant l halved :: ([Integer], [Integer]) halved = let f = plift $ pmatch phalved $ \(PPair x _) -> x s = plift $ pmatch phalved $ \(PPair _ x) -> x in (f, s) + +prop_nubSortProperly :: [Integer] -> Bool +prop_nubSortProperly l = nubbed == expected + where + -- Sort and list and then nub it. + expected :: [Integer] + expected = nub $ sort l + + -- + + pnubbed :: Term _ (PBuiltinList PInteger) + pnubbed = pnubSort # pconstant l + + nubbed :: [Integer] + nubbed = plift pnubbed + +prop_uniqueList :: [Integer] -> Bool +prop_uniqueList l = isUnique == expected + where + -- Convert input list to a set. + -- If the set's size equals to list's size, + -- the list only contains unique elements. + expected :: Bool + expected = S.size (S.fromList l) == length l + + -- + + isUnique = plift $ pisUniq # pconstant l From 1ee71d265fc9a4c8a879a1950537faa8d2c6914c Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 16 May 2022 23:11:13 +0800 Subject: [PATCH 106/107] add doc string for prop tests of utils --- agora-test/Spec/Utils.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs index 30c1dd7..6b71ff8 100644 --- a/agora-test/Spec/Utils.hs +++ b/agora-test/Spec/Utils.hs @@ -34,6 +34,7 @@ tests = -------------------------------------------------------------------------------- +-- | Yield true if 'Agora.Utils.pmsort' sorts a given list correctly. prop_msortSorted :: [Integer] -> Bool prop_msortSorted l = sorted == expected where @@ -49,6 +50,7 @@ prop_msortSorted l = sorted == expected sorted :: [Integer] sorted = plift psorted +-- | Yield true if 'Agora.Utils.pmerge' merges two list into a ordered list correctly. prop_mergeSorted :: [Integer] -> [Integer] -> Bool prop_mergeSorted a b = merged == expected where @@ -75,6 +77,9 @@ prop_mergeSorted a b = merged == expected merged :: [Integer] merged = plift pmerged +{- | Yield true if plutarch level 'Agora.Utils.phalve' splits a given list + as its haskell level counterpart does. +-} prop_halveProperly :: [Integer] -> Bool prop_halveProperly l = halved == expected where @@ -104,6 +109,9 @@ prop_halveProperly l = halved == expected s = plift $ pmatch phalved $ \(PPair _ x) -> x in (f, s) +{- | Yield true if 'Agora.Utils.pnubSort' sorts and removes + duplicate elements from a given list. +-} prop_nubSortProperly :: [Integer] -> Bool prop_nubSortProperly l = nubbed == expected where @@ -119,6 +127,9 @@ prop_nubSortProperly l = nubbed == expected nubbed :: [Integer] nubbed = plift pnubbed +{- | Yield true if 'Agora.Utils.isUnique' can correctly determine + whether a given list only contains unique elements or not. +-} prop_uniqueList :: [Integer] -> Bool prop_uniqueList l = isUnique == expected where From 2e1fda6b6a9919bf3291188bfa3b51011a4e2813 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 17 May 2022 18:17:58 +0800 Subject: [PATCH 107/107] rename some props, as @jhodgdev suggested --- agora-test/Spec/Utils.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/agora-test/Spec/Utils.hs b/agora-test/Spec/Utils.hs index 6b71ff8..e255cf2 100644 --- a/agora-test/Spec/Utils.hs +++ b/agora-test/Spec/Utils.hs @@ -25,9 +25,9 @@ import Test.Tasty.QuickCheck (testProperty) tests :: [TestTree] tests = - [ testProperty "'pmsort' sorts a list properly" prop_msortSorted - , testProperty "'pmerge' merges two sorted lists into one sorted list" prop_mergeSorted - , testProperty "'phalve' splits a list in half as expected" prop_halveProperly + [ testProperty "'pmsort' sorts a list properly" prop_msortCorrect + , testProperty "'pmerge' merges two sorted lists into one sorted list" prop_mergeCorrect + , testProperty "'phalve' splits a list in half as expected" prop_halveCorrect , testProperty "'pnubSort' sorts a list and remove duplicate elements" prop_nubSortProperly , testProperty "'pisUniq' can tell whether all elements in a list are unique" prop_uniqueList ] @@ -35,8 +35,8 @@ tests = -------------------------------------------------------------------------------- -- | Yield true if 'Agora.Utils.pmsort' sorts a given list correctly. -prop_msortSorted :: [Integer] -> Bool -prop_msortSorted l = sorted == expected +prop_msortCorrect :: [Integer] -> Bool +prop_msortCorrect l = sorted == expected where -- Expected sorted list, using 'Data.List.sort'. expected :: [Integer] @@ -51,8 +51,8 @@ prop_msortSorted l = sorted == expected sorted = plift psorted -- | Yield true if 'Agora.Utils.pmerge' merges two list into a ordered list correctly. -prop_mergeSorted :: [Integer] -> [Integer] -> Bool -prop_mergeSorted a b = merged == expected +prop_mergeCorrect :: [Integer] -> [Integer] -> Bool +prop_mergeCorrect a b = merged == expected where -- Sorted list a and b sa = sort a @@ -77,11 +77,11 @@ prop_mergeSorted a b = merged == expected merged :: [Integer] merged = plift pmerged -{- | Yield true if plutarch level 'Agora.Utils.phalve' splits a given list - as its haskell level counterpart does. +{- | Yield true if Plutarch level 'Agora.Utils.phalve' splits a given list + as its Haskell level counterpart does. -} -prop_halveProperly :: [Integer] -> Bool -prop_halveProperly l = halved == expected +prop_halveCorrect :: [Integer] -> Bool +prop_halveCorrect l = halved == expected where -- Halve a list. halve :: [Integer] -> ([Integer], [Integer])