diff --git a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs index 7c95bc9..724dca9 100644 --- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs @@ -23,17 +23,13 @@ import Agora.Effect.TreasuryWithdrawal ( TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), treasuryWithdrawalValidator, ) -import Crypto.Hash qualified as Crypto -import Data.ByteArray qualified as BA -import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as C (pack) import Plutarch.Api.V1 (mkValidator, validatorHash) import PlutusLedgerApi.V1 ( Address (Address), Credential (..), CurrencySymbol (CurrencySymbol), DatumHash (DatumHash), - PubKeyHash (PubKeyHash), + PubKeyHash, ScriptContext (..), ScriptPurpose (Spending), TokenName (TokenName), @@ -56,10 +52,10 @@ import PlutusLedgerApi.V1 ( Validator, ValidatorHash (ValidatorHash), Value, - toBuiltin, ) import PlutusLedgerApi.V1.Interval qualified as Interval (always) import PlutusLedgerApi.V1.Value qualified as Value (singleton) +import Test.Util (scriptCredentials, userCredentials) -- | A sample Currency Symbol. currSymbol :: CurrencySymbol @@ -69,16 +65,13 @@ currSymbol = CurrencySymbol "12312099" signer :: PubKeyHash signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" -blake2b_224 :: BS.ByteString -> BS.ByteString -blake2b_224 = BS.pack . BA.unpack . Crypto.hashWith Crypto.Blake2b_224 - -- | List of users who the effect will pay to. users :: [Credential] -users = PubKeyCredential . PubKeyHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer]) +users = userCredentials -- | List of users who the effect will pay to. treasuries :: [Credential] -treasuries = ScriptCredential . ValidatorHash . toBuiltin . blake2b_224 . C.pack . show <$> ([1 ..] :: [Integer]) +treasuries = scriptCredentials inputGAT :: TxInInfo inputGAT = diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index ac85e7f..6d2d6a9 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -8,17 +8,6 @@ This module tests primarily the happy path for Proposal interactions module Sample.Proposal ( -- * Script contexts proposalCreation, - cosignProposal, - proposalRef, - stakeRef, - voteOnProposal, - VotingParameters (..), - advanceProposalSuccess, - advanceProposalFailureTimeout, - TransitionParameters (..), - advanceFinishedProposal, - advanceProposalInsufficientVotes, - advanceProposalWithInvalidOutputStake, ) where import Agora.Governor (GovernorDatum (..)) @@ -27,78 +16,41 @@ import Agora.Proposal ( ProposalDatum (..), ProposalId (..), ProposalStatus (..), - ProposalThresholds (..), - ProposalVotes (..), ResultTag (..), emptyVotesFor, ) -import Agora.Proposal.Time ( - ProposalStartingTime (ProposalStartingTime), - ProposalTimingConfig (..), - ) -import Agora.Stake ( - ProposalLock (ProposalLock), - Stake (..), - StakeDatum (..), - ) import Data.Default.Class (Default (def)) -import Data.Tagged (Tagged (..), untag) import Plutarch.Context ( - BaseBuilder, MintingBuilder, buildMintingUnsafe, - buildTxInfoUnsafe, input, mint, output, script, signedWith, - timeRange, txId, withDatum, - withRefIndex, withTxId, withValue, ) import PlutusLedgerApi.V1 ( - Datum (Datum), - DatumHash, - POSIXTime, - POSIXTimeRange, - PubKeyHash, ScriptContext (..), - ToData (toBuiltinData), - TxInInfo (TxInInfo), - TxInfo (..), - TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), - TxOutRef (..), - ValidatorHash, ) import PlutusLedgerApi.V1.Value qualified as Value ( assetClassValue, singleton, ) import PlutusTx.AssocMap qualified as AssocMap -import Sample.Proposal.Shared (proposalRef, stakeRef) import Sample.Shared ( govValidatorHash, - minAda, proposal, proposalPolicySymbol, proposalStartingTimeFromTimeRange, proposalValidatorHash, signer, - signer2, - stake, - stakeAddress, - stakeAssetClass, - stakeValidatorHash, ) import Test.Util ( closedBoundedInterval, - datumPair, - toDatumHash, - updateMap, ) proposalCreation :: ScriptContext @@ -160,656 +112,3 @@ proposalCreation = . withDatum govAfter ] in buildMintingUnsafe builder - --- | This script context should be a valid transaction. -cosignProposal :: [PubKeyHash] -> TxInfo -cosignProposal newSigners = - let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST - effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - proposalBefore :: ProposalDatum - proposalBefore = - ProposalDatum - { proposalId = ProposalId 0 - , effects = effects - , status = Draft - , cosigners = [signer] - , thresholds = def - , votes = emptyVotesFor effects - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - stakeDatum :: StakeDatum - stakeDatum = StakeDatum (Tagged 50_000_000) signer2 [] - proposalAfter :: ProposalDatum - proposalAfter = proposalBefore {cosigners = newSigners <> proposalBefore.cosigners} - validTimeRange :: POSIXTimeRange - validTimeRange = - closedBoundedInterval - 10 - ((def :: ProposalTimingConfig).draftTime - 10) - builder :: BaseBuilder - builder = - mconcat - [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - , mint st - , mconcat $ signedWith <$> newSigners - , timeRange validTimeRange - , input $ - script proposalValidatorHash - . withValue (st <> Value.singleton "" "" 10_000_000) - . withDatum proposalBefore - . withTxId (txOutRefId proposalRef) - . withRefIndex (txOutRefIdx proposalRef) - , input $ - script stakeValidatorHash - . withValue - ( Value.singleton "" "" 10_000_000 - <> Value.assetClassValue (untag stake.gtClassRef) 50_000_000 - <> Value.assetClassValue stakeAssetClass 1 - ) - . withDatum stakeDatum - . withTxId (txOutRefId stakeRef) - . withRefIndex (txOutRefIdx stakeRef) - , output $ - script proposalValidatorHash - . withValue (st <> Value.singleton "" "" 10_000_000) - . withDatum proposalAfter - , output $ - script stakeValidatorHash - . withValue - ( Value.singleton "" "" 10_000_000 - <> Value.assetClassValue (untag stake.gtClassRef) 50_000_000 - <> Value.assetClassValue stakeAssetClass 1 - ) - . withDatum stakeDatum - ] - in buildTxInfoUnsafe builder - --------------------------------------------------------------------------------- - --- | Parameters for creating a voting transaction. -data VotingParameters = VotingParameters - { voteFor :: ResultTag - -- ^ The outcome the transaction is voting for. - , voteCount :: Integer - -- ^ The count of votes. - } - --- | Create a valid transaction that votes on a propsal, given the parameters. -voteOnProposal :: VotingParameters -> TxInfo -voteOnProposal params = - let pst = Value.singleton proposalPolicySymbol "" 1 - sst = Value.assetClassValue stakeAssetClass 1 - - --- - - stakeOwner = signer - - --- - - effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - - --- - - initialVotes :: AssocMap.Map ResultTag Integer - initialVotes = - AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 4242) - ] - - --- - - proposalInputDatum :: ProposalDatum - proposalInputDatum = - ProposalDatum - { proposalId = ProposalId 42 - , effects = effects - , status = VotingReady - , cosigners = [stakeOwner] - , thresholds = def - , votes = ProposalVotes initialVotes - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - - --- - - existingLocks :: [ProposalLock] - existingLocks = - [ ProposalLock (ResultTag 0) (ProposalId 0) - , ProposalLock (ResultTag 2) (ProposalId 1) - ] - - --- - - stakeInputDatum :: StakeDatum - stakeInputDatum = - StakeDatum - { stakedAmount = Tagged params.voteCount - , owner = stakeOwner - , lockedBy = existingLocks - } - - --- - - updatedVotes :: AssocMap.Map ResultTag Integer - updatedVotes = updateMap (Just . (+ params.voteCount)) params.voteFor initialVotes - - --- - - proposalOutputDatum :: ProposalDatum - proposalOutputDatum = - proposalInputDatum - { votes = ProposalVotes updatedVotes - } - - --- - - -- Off-chain code should do exactly like this: prepend new lock toStatus the list. - updatedLocks :: [ProposalLock] - updatedLocks = ProposalLock params.voteFor proposalInputDatum.proposalId : existingLocks - - --- - - stakeOutputDatum :: StakeDatum - stakeOutputDatum = - stakeInputDatum - { lockedBy = updatedLocks - } - - --- - - validTimeRange = - closedBoundedInterval - ((def :: ProposalTimingConfig).draftTime + 1) - ((def :: ProposalTimingConfig).votingTime - 1) - - builder :: BaseBuilder - builder = - mconcat - [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c" - , signedWith stakeOwner - , timeRange validTimeRange - , input $ - script proposalValidatorHash - . withValue pst - . withDatum proposalInputDatum - . withTxId (txOutRefId proposalRef) - . withRefIndex (txOutRefIdx proposalRef) - , input $ - script stakeValidatorHash - . withValue - ( sst - <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount - <> minAda - ) - . withDatum stakeInputDatum - . withTxId (txOutRefId stakeRef) - . withRefIndex (txOutRefIdx stakeRef) - , output $ - script proposalValidatorHash - . withValue pst - . withDatum proposalOutputDatum - , output $ - script stakeValidatorHash - . withValue - ( sst - <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount - <> minAda - ) - . withDatum stakeOutputDatum - ] - in buildTxInfoUnsafe builder - --------------------------------------------------------------------------------- - --- | Parameters for state transition of proposals. -data TransitionParameters = TransitionParameters - { -- The initial status of the proposal. - initialProposalStatus :: ProposalStatus - , -- The starting time of the proposal. - proposalStartingTime :: ProposalStartingTime - } - --- | Create a 'TxInfo' that update the status of a proposal. -mkTransitionTxInfo :: - -- | Initial state of the proposal. - ProposalStatus -> - -- | Next state of the proposal. - ProposalStatus -> - -- | Effects. - AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) -> - -- | Votes. - ProposalVotes -> - -- | Starting time of the proposal. - ProposalStartingTime -> - -- | Valid time range of the transaction. - POSIXTimeRange -> - -- | Whether to add an unchanged stake or not. - Bool -> - TxInfo -mkTransitionTxInfo from to effects votes startingTime validTime shouldAddUnchangedStake = - let pst = Value.singleton proposalPolicySymbol "" 1 - sst = Value.assetClassValue stakeAssetClass 1 - - proposalInputDatum :: ProposalDatum - proposalInputDatum = - ProposalDatum - { proposalId = ProposalId 0 - , effects = effects - , status = from - , cosigners = [signer] - , thresholds = def - , votes = votes - , timingConfig = def - , startingTime = startingTime - } - - proposalOutputDatum :: ProposalDatum - proposalOutputDatum = - proposalInputDatum - { status = to - } - - stakeOwner = signer - stakedAmount = 200 - - existingLocks :: [ProposalLock] - existingLocks = - [ ProposalLock (ResultTag 0) (ProposalId 0) - , ProposalLock (ResultTag 2) (ProposalId 1) - ] - - stakeInputDatum :: StakeDatum - stakeInputDatum = - StakeDatum - { stakedAmount = Tagged stakedAmount - , owner = stakeOwner - , lockedBy = existingLocks - } - - stakeOutputDatum :: StakeDatum - stakeOutputDatum = stakeInputDatum - - stakeBuilder :: BaseBuilder - stakeBuilder = - if shouldAddUnchangedStake - then - mconcat - [ input $ - script stakeValidatorHash - . withValue sst - . withDatum stakeInputDatum - . withTxId (txOutRefId stakeRef) - , output $ - script stakeValidatorHash - . withValue (sst <> minAda) - . withDatum stakeOutputDatum - ] - else mempty - - builder :: BaseBuilder - builder = - mconcat - [ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" - , signedWith stakeOwner - , timeRange validTime - , input $ - script proposalValidatorHash - . withValue pst - . withDatum proposalInputDatum - . withTxId (txOutRefId proposalRef) - , output $ - script proposalValidatorHash - . withValue (pst <> minAda) - . withDatum proposalOutputDatum - ] - in buildTxInfoUnsafe $ builder <> stakeBuilder - --- | Wrapper around 'advanceProposalSuccess'', with valid stake. -advanceProposalSuccess :: TransitionParameters -> TxInfo -advanceProposalSuccess ps = advanceProposalSuccess' ps True - -{- | Create a valid 'TxInfo' that advances a proposal, given the parameters. - The second parameter determines wherther valid stake should be included. - - Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'. --} -advanceProposalSuccess' :: TransitionParameters -> Bool -> TxInfo -advanceProposalSuccess' params = - let -- Status of the output proposal. - toStatus :: ProposalStatus - toStatus = case params.initialProposalStatus of - Draft -> VotingReady - VotingReady -> Locked - Locked -> Finished - Finished -> error "Cannot advance 'Finished' proposal" - - effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - - emptyVotes@(ProposalVotes emptyVotes') = emptyVotesFor effects - - -- Set the vote count of outcome 0 to @def.countingVoting + 1@, - -- meaning that outcome 0 will be the winner. - outcome0WinningVotes = - ProposalVotes $ - updateMap - (\_ -> Just $ untag (def :: ProposalThresholds).execute + 1) - (ResultTag 0) - emptyVotes' - - votes :: ProposalVotes - votes = case params.initialProposalStatus of - Draft -> emptyVotes - -- With sufficient votes - _ -> outcome0WinningVotes - - proposalStartingTime :: POSIXTime - proposalStartingTime = - let (ProposalStartingTime startingTime) = params.proposalStartingTime - in startingTime - - timeRange :: POSIXTimeRange - timeRange = case params.initialProposalStatus of - -- [S + 1, S + D - 1] - Draft -> - closedBoundedInterval - (proposalStartingTime + 1) - (proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1) - -- [S + D + V + 1, S + D + V + L - 1] - VotingReady -> - closedBoundedInterval - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + 1 - ) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - - 1 - ) - -- [S + D + V + L + 1, S + + D + V + L + E - 1] - Locked -> - closedBoundedInterval - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + 1 - ) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + (def :: ProposalTimingConfig).executingTime - 1 - ) - Finished -> error "Cannot advance 'Finished' proposal" - in mkTransitionTxInfo - params.initialProposalStatus - toStatus - effects - votes - params.proposalStartingTime - timeRange - -{- | Create a valid 'TxInfo' that advances a proposal to failed state, given the parameters. - The reason why the proposal fails is the proposal has ran out of time. - Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'. --} -advanceProposalFailureTimeout :: TransitionParameters -> TxInfo -advanceProposalFailureTimeout params = - let effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - - emptyVotes@(ProposalVotes emptyVotes') = emptyVotesFor effects - - -- Set the vote count of outcome 0 to @def.countingVoting + 1@, - -- meaning that outcome 0 will be the winner. - outcome0WinningVotes = - ProposalVotes $ - updateMap - (\_ -> Just $ untag (def :: ProposalThresholds).vote + 1) - (ResultTag 0) - emptyVotes' - - votes :: ProposalVotes - votes = case params.initialProposalStatus of - Draft -> emptyVotes - -- With sufficient votes - _ -> outcome0WinningVotes - - proposalStartingTime :: POSIXTime - proposalStartingTime = - let (ProposalStartingTime startingTime) = params.proposalStartingTime - in startingTime - - timeRange :: POSIXTimeRange - timeRange = case params.initialProposalStatus of - -- [S + D + 1, S + D + V - 1] - Draft -> - closedBoundedInterval - (proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - 1 - ) - -- [S + D + V + L + 1, S + D + V + L + E -1] - VotingReady -> - closedBoundedInterval - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + 1 - ) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + (def :: ProposalTimingConfig).executingTime - - 1 - ) - -- [S + D + V + L + E + 1, S + D + V + L + E + 100] - Locked -> - closedBoundedInterval - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + (def :: ProposalTimingConfig).executingTime - + 1 - ) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - + (def :: ProposalTimingConfig).executingTime - + 100 - ) - Finished -> error "Cannot advance 'Finished' proposal" - in mkTransitionTxInfo - params.initialProposalStatus - Finished - effects - votes - params.proposalStartingTime - timeRange - True - --- | An invalid 'TxInfo' that tries to advance a 'VotingReady' proposal without sufficient votes. -advanceProposalInsufficientVotes :: TxInfo -advanceProposalInsufficientVotes = - let effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - - -- Insufficient votes. - votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 1) - , (ResultTag 1, 0) - ] - ) - - proposalStartingTime = 0 - - -- Valid time range. - -- [S + D + 1, S + V + 10] - timeRange = - closedBoundedInterval - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + 1 - ) - ( proposalStartingTime - + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - + 10 - ) - in mkTransitionTxInfo - VotingReady - Locked - effects - votes - (ProposalStartingTime proposalStartingTime) - timeRange - True - --- | An invalid 'TxInfo' that tries to advance a 'Finished' proposal. -advanceFinishedProposal :: TxInfo -advanceFinishedProposal = - let effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - - -- Set the vote count of outcome 0 to @def.countingVoting + 1@, - -- meaning that outcome 0 will be the winner. - outcome0WinningVotes = - ProposalVotes $ - AssocMap.fromList - [ (ResultTag 0, untag (def :: ProposalThresholds).vote + 1) - , (ResultTag 1, 0) - ] - - --- - - timeRange = - closedBoundedInterval - ((def :: ProposalTimingConfig).lockingTime + 1) - ((def :: ProposalTimingConfig).executingTime - 1) - in mkTransitionTxInfo - Finished - Finished - effects - outcome0WinningVotes - (ProposalStartingTime 0) - timeRange - True - -{- | An illegal 'TxInfo' that tries to output a changed stake with 'AdvanceProposal'. - From the perspective of stake validator, the transition is totally valid, - so the proposal validator should reject this. --} -advanceProposalWithInvalidOutputStake :: TxInfo -advanceProposalWithInvalidOutputStake = - let templateTxInfo = - advanceProposalSuccess' - TransitionParameters - { initialProposalStatus = VotingReady - , proposalStartingTime = ProposalStartingTime 0 - } - False - - --- - -- Now we create a new lock on an arbitrary stake - - sst = Value.assetClassValue stakeAssetClass 1 - - --- - - stakeOwner = signer - stakedAmount = 200 - - --- - - existingLocks :: [ProposalLock] - existingLocks = - [ ProposalLock (ResultTag 0) (ProposalId 0) - , ProposalLock (ResultTag 2) (ProposalId 1) - ] - - --- - - stakeInputDatum' :: StakeDatum - stakeInputDatum' = - StakeDatum - { stakedAmount = Tagged stakedAmount - , owner = stakeOwner - , lockedBy = existingLocks - } - stakeInputDatum :: Datum - stakeInputDatum = Datum $ toBuiltinData stakeInputDatum' - stakeInput :: TxOut - stakeInput = - TxOut - { txOutAddress = stakeAddress - , txOutValue = - mconcat - [ sst - , Value.assetClassValue (untag stake.gtClassRef) stakedAmount - , minAda - ] - , txOutDatumHash = Just $ toDatumHash stakeInputDatum - } - - --- - - updatedLocks :: [ProposalLock] - updatedLocks = ProposalLock (ResultTag 42) (ProposalId 27) : existingLocks - - --- - - stakeOutputDatum' :: StakeDatum - stakeOutputDatum' = - stakeInputDatum' - { lockedBy = updatedLocks - } - stakeOutputDatum :: Datum - stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum' - stakeOutput :: TxOut - stakeOutput = - stakeInput - { txOutDatumHash = Just $ toDatumHash stakeOutputDatum - } - in templateTxInfo - { txInfoInputs = TxInInfo stakeRef stakeInput : templateTxInfo.txInfoInputs - , txInfoOutputs = stakeOutput : templateTxInfo.txInfoOutputs - , txInfoData = - (datumPair <$> [stakeInputDatum, stakeOutputDatum]) - <> templateTxInfo.txInfoData - , txInfoSignatories = [stakeOwner] - } diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs new file mode 100644 index 0000000..ea3aaed --- /dev/null +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -0,0 +1,509 @@ +module Sample.Proposal.Advance ( + advanceToNextStateInTimeParameters, + advanceToFailedStateDueToTimeoutParameters, + insufficientVotesParameters, + insufficientCosignsParameters, + advanceFromFinishedParameters, + invalidOutputStakeParameters, + mkTestTree, + Parameters (..), +) where + +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (ProposalId), + ProposalRedeemer (AdvanceProposal), + ProposalStatus (..), + ProposalThresholds (..), + ProposalVotes (ProposalVotes), + ResultTag (ResultTag), + emptyVotesFor, + ) +import Agora.Proposal.Scripts (proposalValidator) +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig ( + draftTime, + executingTime, + lockingTime, + votingTime + ), + ) +import Agora.SafeMoney (GTTag) +import Agora.Stake ( + ProposalLock (ProposalLock), + Stake (gtClassRef), + StakeDatum (..), + StakeRedeemer (WitnessStake), + ) +import Agora.Stake.Scripts (stakeValidator) +import Data.Coerce (coerce) +import Data.Default (def) +import Data.List (sort) +import Data.Tagged (Tagged (..), untag) +import Plutarch.Context ( + BaseBuilder, + buildTxInfoUnsafe, + input, + output, + script, + signedWith, + timeRange, + txId, + withDatum, + withOutRef, + withTxId, + withValue, + ) +import PlutusLedgerApi.V1 ( + DatumHash, + POSIXTime, + POSIXTimeRange, + PubKeyHash, + ScriptContext (ScriptContext), + ScriptPurpose (Spending), + TxInfo, + TxOutRef (TxOutRef), + ValidatorHash, + always, + ) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Shared ( + minAda, + proposalPolicySymbol, + proposalValidatorHash, + stake, + stakeAssetClass, + stakeValidatorHash, + ) +import Sample.Shared qualified as Shared +import Test.Specification (SpecificationTree, group) +import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue, updateMap) + +-- | Parameters for state transition of proposals. +data Parameters = Parameters + { fromStatus :: ProposalStatus + -- ^ Initial state of the proposal. + , toStatus :: ProposalStatus + -- ^ Next state of the proposal. + , votes :: ProposalVotes + -- ^ Votes. + , includeAllStakes :: Bool + -- ^ Whether to add an extra cosigner without stake or not. + , validTimeRange :: POSIXTimeRange + -- ^ Valid time range of the transaction. + , alterOutputStakes :: Bool + -- ^ Whether to alter th output stakes or not. + , stakeCount :: Integer + -- ^ The number of stakes. + , signByAllCosigners :: Bool + , perStakeGTs :: Tagged GTTag Integer + } + +--- + +proposalRef :: TxOutRef +proposalRef = TxOutRef proposalTxRef 1 + +mkStakeRef :: Int -> TxOutRef +mkStakeRef = TxOutRef stakeTxRef . (+ 2) . fromIntegral + +--- + +defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) +defEffects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + +emptyVotes :: ProposalVotes +emptyVotes = emptyVotesFor defEffects + +proposalStartingTime :: POSIXTime +proposalStartingTime = 0 + +--- + +mkProposalInputDatum :: Parameters -> ProposalDatum +mkProposalInputDatum ps = + ProposalDatum + { proposalId = ProposalId 0 + , effects = defEffects + , status = ps.fromStatus + , cosigners = mkStakeOwners ps + , thresholds = def + , votes = ps.votes + , timingConfig = def + , startingTime = ProposalStartingTime proposalStartingTime + } + +mkStakeInputDatums :: Parameters -> [StakeDatum] +mkStakeInputDatums ps = + map + ( \pk -> + StakeDatum + { stakedAmount = ps.perStakeGTs + , owner = pk + , lockedBy = existingLocks + } + ) + $ mkStakeOwners ps + where + existingLocks :: [ProposalLock] + existingLocks = + [ ProposalLock (ResultTag 0) (ProposalId 0) + , ProposalLock (ResultTag 2) (ProposalId 1) + ] + +--- + +proposalScriptPurpose :: ScriptPurpose +proposalScriptPurpose = Spending proposalRef + +mkStakeScriptPurpose :: Int -> ScriptPurpose +mkStakeScriptPurpose = Spending . mkStakeRef + +--- + +proposalRedeemer :: ProposalRedeemer +proposalRedeemer = AdvanceProposal + +stakeRedeemer :: StakeRedeemer +stakeRedeemer = WitnessStake + +--- + +mkStakeOwners :: Parameters -> [PubKeyHash] +mkStakeOwners ps = + sort $ + take + (fromIntegral ps.stakeCount) + pubKeyHashes + +--- + +-- | Create a 'TxInfo' that update the status of a proposal. +advance :: + Parameters -> + TxInfo +advance ps = + let pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 + + proposalInputDatum :: ProposalDatum + proposalInputDatum = + mkProposalInputDatum ps + + proposalOutputDatum :: ProposalDatum + proposalOutputDatum = + proposalInputDatum + { status = ps.toStatus + } + + stakeInputDatums :: [StakeDatum] + stakeInputDatums = mkStakeInputDatums ps + + mkStakeOutputDatum :: StakeDatum -> StakeDatum + mkStakeOutputDatum si = + if ps.alterOutputStakes + then + si + { stakedAmount = ps.perStakeGTs + 1 + } + else si + + stakeValue = + let gts = + if ps.perStakeGTs == 0 + then mempty + else + Value.assetClassValue + (untag stake.gtClassRef) + (untag ps.perStakeGTs) + in sortValue $ + sst <> minAda + <> gts + + stakeBuilder :: BaseBuilder + stakeBuilder = + foldMap + ( \(si, idx) -> + let so = mkStakeOutputDatum si + in mconcat @BaseBuilder + [ input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum si + . withOutRef (mkStakeRef idx) + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum so + ] + ) + $ let withIds = zip stakeInputDatums [0 ..] + in if ps.includeAllStakes + then withIds + else [head withIds] + + signBuilder :: BaseBuilder + signBuilder = + let sos = mkStakeOwners ps + in if ps.signByAllCosigners + then foldMap signedWith sos + else signedWith $ head sos + + builder :: BaseBuilder + builder = + mconcat + [ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" + , signBuilder + , timeRange ps.validTimeRange + , input $ + script proposalValidatorHash + . withValue pst + . withDatum proposalInputDatum + . withTxId proposalTxRef + , output $ + script proposalValidatorHash + . withValue (pst <> minAda) + . withDatum proposalOutputDatum + ] + in buildTxInfoUnsafe $ builder <> stakeBuilder + +--- + +mkInTimeTimeRange :: ProposalStatus -> POSIXTimeRange +mkInTimeTimeRange advanceFrom = + case advanceFrom of + -- [S + 1, S + D - 1] + Draft -> + closedBoundedInterval + (proposalStartingTime + 1) + (proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1) + -- [S + D + V + 1, S + D + V + L - 1] + VotingReady -> + closedBoundedInterval + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + 1 + ) + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + - 1 + ) + -- [S + D + V + L + 1, S + + D + V + L + E - 1] + Locked -> + closedBoundedInterval + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + 1 + ) + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + (def :: ProposalTimingConfig).executingTime - 1 + ) + Finished -> error "Cannot advance 'Finished' proposal" + +mkTooLateTimeRange :: ProposalStatus -> POSIXTimeRange +mkTooLateTimeRange advanceFrom = + case advanceFrom of + -- [S + D + 1, S + D + V - 1] + Draft -> + closedBoundedInterval + (proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1) + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime - 1 + ) + -- [S + D + V + L + 1, S + D + V + L + E -1] + VotingReady -> + closedBoundedInterval + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + 1 + ) + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + (def :: ProposalTimingConfig).executingTime + - 1 + ) + -- [S + D + V + L + E + 1, S + D + V + L + E + 100] + Locked -> + closedBoundedInterval + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + (def :: ProposalTimingConfig).executingTime + + 1 + ) + ( proposalStartingTime + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + + (def :: ProposalTimingConfig).executingTime + + 100 + ) + Finished -> error "Cannot advance 'Finished' proposal" + +--- + +getNextState :: ProposalStatus -> ProposalStatus +getNextState = \case + Draft -> VotingReady + VotingReady -> Locked + Locked -> Finished + Finished -> error "Cannot advance 'Finished' proposal" + +--- + +advanceToNextStateInTimeParameters :: Int -> [Parameters] +advanceToNextStateInTimeParameters nCosigners = + map + ( \from -> + let -- Set the vote count of outcome 0 to @def.countingVoting + 1@, + -- meaning that outcome 0 will be the winner. + outcome0WinningVotes = + ProposalVotes $ + updateMap + (\_ -> Just $ untag (def :: ProposalThresholds).execute + 1) + (ResultTag 0) + (coerce emptyVotes) + + votes = case from of + Draft -> emptyVotes + -- With sufficient votes + _ -> outcome0WinningVotes + + includeAllStakes = case from of + Draft -> True + _ -> False + + signByAllCosigners = case from of + Draft -> True + _ -> False + in Parameters + { fromStatus = from + , toStatus = getNextState from + , votes = votes + , includeAllStakes = includeAllStakes + , validTimeRange = mkInTimeTimeRange from + , alterOutputStakes = False + , stakeCount = fromIntegral nCosigners + , signByAllCosigners = signByAllCosigners + , perStakeGTs = + (def :: ProposalThresholds).vote + `div` fromIntegral nCosigners + 1 + } + ) + [Draft, VotingReady, Locked] + +advanceToFailedStateDueToTimeoutParameters :: Int -> [Parameters] +advanceToFailedStateDueToTimeoutParameters nCosigners = + map + ( \from -> + Parameters + { fromStatus = from + , toStatus = Finished + , votes = emptyVotes + , includeAllStakes = False + , validTimeRange = mkTooLateTimeRange from + , alterOutputStakes = False + , stakeCount = fromIntegral nCosigners + , signByAllCosigners = False + , perStakeGTs = 1 + } + ) + [Draft, VotingReady, Locked] + +insufficientVotesParameters :: Parameters +insufficientVotesParameters = + let votes = emptyVotes + from = VotingReady + to = getNextState from + in Parameters + { fromStatus = from + , toStatus = to + , votes = votes + , includeAllStakes = False + , validTimeRange = mkInTimeTimeRange from + , alterOutputStakes = False + , stakeCount = 1 + , signByAllCosigners = True + , perStakeGTs = 20 + } + +insufficientCosignsParameters :: Int -> Parameters +insufficientCosignsParameters nCosigners = + (\ps -> ps {perStakeGTs = 0}) $ + head $ + advanceToNextStateInTimeParameters nCosigners + +advanceFromFinishedParameters :: Parameters +advanceFromFinishedParameters = + Parameters + { fromStatus = Finished + , toStatus = Finished + , votes = emptyVotes + , includeAllStakes = False + , validTimeRange = always + , alterOutputStakes = False + , stakeCount = 1 + , signByAllCosigners = True + , perStakeGTs = 20 + } + +invalidOutputStakeParameters :: Int -> [Parameters] +invalidOutputStakeParameters nCosigners = + (\ps -> ps {alterOutputStakes = True}) + <$> advanceToNextStateInTimeParameters nCosigners + +--- + +mkTestTree :: String -> Parameters -> Bool -> SpecificationTree +mkTestTree name ps isValidForProposalValidator = group name [proposal, stake] + where + txInfo = advance ps + + proposal = + let proposalInputDatum = mkProposalInputDatum ps + in testFunc + isValidForProposalValidator + "propsoal" + (proposalValidator Shared.proposal) + proposalInputDatum + proposalRedeemer + ( ScriptContext + txInfo + proposalScriptPurpose + ) + + stake = + let idx = 0 + stakeInputDatum = mkStakeInputDatums ps !! idx + isValid = not $ ps.alterOutputStakes + in testFunc + isValid + "stake" + (stakeValidator Shared.stake) + stakeInputDatum + stakeRedeemer + ( ScriptContext + txInfo + (mkStakeScriptPurpose idx) + ) diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs new file mode 100644 index 0000000..f04535a --- /dev/null +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -0,0 +1,344 @@ +module Sample.Proposal.Cosign ( + Parameters (..), + validCosignNParameters, + duplicateCosignersParameters, + statusNotDraftCosignNParameters, + invalidStakeOutputParameters, + mkTestTree, +) where + +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (ProposalId), + ProposalRedeemer (Cosign), + ProposalStatus (..), + ResultTag (ResultTag), + emptyVotesFor, + ) +import Agora.Proposal.Scripts (proposalValidator) +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (draftTime), + ) +import Agora.SafeMoney (GTTag) +import Agora.Stake ( + Stake (gtClassRef), + StakeDatum (StakeDatum, owner), + StakeRedeemer (WitnessStake), + stakedAmount, + ) +import Agora.Stake.Scripts (stakeValidator) +import Data.Coerce (coerce) +import Data.Default (def) +import Data.List (sort) +import Data.Tagged (Tagged, untag) +import Plutarch.Context ( + BaseBuilder, + buildTxInfoUnsafe, + input, + output, + script, + signedWith, + timeRange, + txId, + withDatum, + withRefIndex, + withTxId, + withValue, + ) +import PlutusLedgerApi.V1 ( + POSIXTimeRange, + PubKeyHash, + ScriptContext (ScriptContext), + ScriptPurpose (Spending), + TxInfo, + TxOutRef (..), + Value, + ) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Shared ( + minAda, + proposalPolicySymbol, + proposalValidatorHash, + signer, + stake, + stakeAssetClass, + stakeValidatorHash, + ) +import Sample.Shared qualified as Shared +import Test.Specification ( + SpecificationTree, + group, + ) +import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue) + +-- | Parameters for cosigning a proposal. +data Parameters = Parameters + { newCosigners :: [PubKeyHash] + -- ^ New cosigners to be added, and the owners of the generated stakes. + , proposalStatus :: ProposalStatus + -- ^ Current state of the proposal. + , alterOutputStakes :: Bool + -- ^ Whether to generate invalid stake outputs. + -- In particular, the 'stakedAmount' of all the stake datums will be set to zero. + } + +-- | Owner of the creator stake, doesn't really matter in this case. +proposalCreator :: PubKeyHash +proposalCreator = signer + +-- | The amount of GTs every generated stake has, doesn't really matter in this case. +perStakedGTs :: Tagged GTTag Integer +perStakedGTs = 5 + +{- | Create input proposal datum given the parameters. + In particular, 'status' is set to 'proposalStstus'. +-} +mkProposalInputDatum :: Parameters -> ProposalDatum +mkProposalInputDatum ps = + let effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + in ProposalDatum + { proposalId = ProposalId 0 + , effects = effects + , status = ps.proposalStatus + , cosigners = [proposalCreator] + , thresholds = def + , votes = emptyVotesFor effects + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + +{- | Create the output proposal datum given the parameters. + The 'newCosigners' is added to the exisiting list of cosigners, note the said list should be sorted in + ascending order. +-} +mkProposalOutputDatum :: Parameters -> ProposalDatum +mkProposalOutputDatum ps = + let inputDatum = mkProposalInputDatum ps + in inputDatum + { cosigners = sort $ inputDatum.cosigners <> ps.newCosigners + } + +-- | Create all the input stakes given the parameters. +mkStakeInputDatums :: Parameters -> [StakeDatum] +mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk []) . newCosigners + +-- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners. +cosign :: Parameters -> TxInfo +cosign ps = buildTxInfoUnsafe builder + where + pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 + + --- + + stakeInputDatums :: [StakeDatum] + stakeInputDatums = mkStakeInputDatums ps + + stakeValue :: Value + stakeValue = + sortValue $ + minAda + <> Value.assetClassValue + (untag stake.gtClassRef) + (untag perStakedGTs) + <> sst + + stakeBuilder :: BaseBuilder + stakeBuilder = + foldMap + ( \(stakeDatum, refIdx) -> + let stakeOutputDatum = + if ps.alterOutputStakes + then stakeDatum {stakedAmount = 0} + else stakeDatum + in mconcat @BaseBuilder + [ input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeDatum + . withTxId stakeTxRef + . withRefIndex refIdx + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeOutputDatum + , signedWith stakeDatum.owner + ] + ) + $ zip + stakeInputDatums + [2 ..] + + --- + + proposalInputDatum :: ProposalDatum + proposalInputDatum = mkProposalInputDatum ps + + proposalOutputDatum :: ProposalDatum + proposalOutputDatum = mkProposalOutputDatum ps + + proposalBuilder :: BaseBuilder + proposalBuilder = + mconcat + [ input $ + script proposalValidatorHash + . withValue pst + . withDatum proposalInputDatum + . withTxId proposalTxRef + . withRefIndex proposalRefIdx + , output $ + script proposalValidatorHash + . withValue (sortValue (pst <> minAda)) + . withDatum proposalOutputDatum + ] + + validTimeRange :: POSIXTimeRange + validTimeRange = + closedBoundedInterval + (coerce proposalInputDatum.startingTime + 1) + ( coerce proposalInputDatum.startingTime + + proposalInputDatum.timingConfig.draftTime - 1 + ) + + --- + + builder :: BaseBuilder + builder = + mconcat + [ txId "05c67819fc3381a2052b929ab439244b7b5fe3b3bd07f2134055bbbb21bd9e52" + , timeRange validTimeRange + , proposalBuilder + , stakeBuilder + ] + +-- | Reference index of the proposal UTXO. +proposalRefIdx :: Integer +proposalRefIdx = 1 + +-- | Spend the proposal ST. +proposalScriptPurpose :: ScriptPurpose +proposalScriptPurpose = + Spending + ( TxOutRef + proposalTxRef + proposalRefIdx + ) + +-- | Consume the given stake. +mkStakeScriptPurpose :: Int -> ScriptPurpose +mkStakeScriptPurpose idx = + Spending $ + TxOutRef + stakeTxRef + $ proposalRefIdx + 1 + fromIntegral idx + +-- | Create a proposal redeemer which cosigns with the new cosginers. +mkProposalRedeemer :: Parameters -> ProposalRedeemer +mkProposalRedeemer (sort . newCosigners -> cs) = Cosign cs + +-- | Stake redeemer for cosuming all the stakes generated in the module. +stakeRedeemer :: StakeRedeemer +stakeRedeemer = WitnessStake + +--- + +-- | Create a valid parameters that cosign the proposal with a given number of cosigners. +validCosignNParameters :: Int -> Parameters +validCosignNParameters n + | n > 0 = + Parameters + { newCosigners = take n pubKeyHashes + , proposalStatus = Draft + , alterOutputStakes = False + } + | otherwise = error "Number of cosigners should be positive" + +--- + +{- | Parameters that make 'cosign' yield duplicate cosigners. + Invalid for the ptoposal validator, perfectly valid for stake validator. +-} +duplicateCosignersParameters :: Parameters +duplicateCosignersParameters = + Parameters + { newCosigners = [proposalCreator] + , proposalStatus = Draft + , alterOutputStakes = False + } + +--- + +{- | Generate a list of parameters that sets proposal status to something other than 'Draft'. + Invalid for the ptoposal validator, perfectly valid for stake validator. +-} +statusNotDraftCosignNParameters :: Int -> [Parameters] +statusNotDraftCosignNParameters n = + map + ( \st -> + Parameters + { newCosigners = take n pubKeyHashes + , proposalStatus = st + , alterOutputStakes = False + } + ) + [VotingReady, Locked, Finished] + +--- + +{- | Parameters thet change the output stake datums. + Invalid for both proposal validator and stake validator. +-} +invalidStakeOutputParameters :: Parameters +invalidStakeOutputParameters = + (validCosignNParameters 2) + { alterOutputStakes = True + } + +--- + +-- | Create a test tree given the parameters. Both the proposal validator and stake validator will be run. +mkTestTree :: + -- | The name of the test group. + String -> + Parameters -> + -- | Are the parameters valid for the proposal validator? + Bool -> + SpecificationTree +mkTestTree name ps isValid = group name [proposal, stake] + where + txInfo = cosign ps + + proposal = + let proposalInputDatum = mkProposalInputDatum ps + in testFunc + isValid + "propsoal" + (proposalValidator Shared.proposal) + proposalInputDatum + (mkProposalRedeemer ps) + ( ScriptContext + txInfo + proposalScriptPurpose + ) + + stake = + let idx = 0 + stakeInputDatum = mkStakeInputDatums ps !! idx + isValid = not ps.alterOutputStakes + in testFunc + isValid + "stake" + (stakeValidator Shared.stake) + stakeInputDatum + stakeRedeemer + ( ScriptContext + txInfo + (mkStakeScriptPurpose idx) + ) diff --git a/agora-specs/Sample/Proposal/Shared.hs b/agora-specs/Sample/Proposal/Shared.hs index 1a2ee64..17028ee 100644 --- a/agora-specs/Sample/Proposal/Shared.hs +++ b/agora-specs/Sample/Proposal/Shared.hs @@ -1,9 +1,39 @@ -module Sample.Proposal.Shared (proposalRef, stakeRef) where +module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) where -import PlutusLedgerApi.V1 (TxOutRef (..)) +import Plutarch.Api.V1 (PValidator) +import Plutarch.Lift (PUnsafeLiftDecl (..)) +import PlutusLedgerApi.V1 (ScriptContext, ToData, TxId) +import Test.Specification ( + SpecificationTree, + validatorFailsWith, + validatorSucceedsWith, + ) -proposalRef :: TxOutRef -proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1 +-- | 'TxId' of all the propsoal inputs in the samples. +proposalTxRef :: TxId +proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" -stakeRef :: TxOutRef -stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0 +-- | 'TxId' of all the stake inputs in the samples. +stakeTxRef :: TxId +stakeTxRef = "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" + +-- | Get the test function given whether a test case is valid. +testFunc :: + forall {datum :: PType} {redeemer :: PType}. + ( PUnsafeLiftDecl datum + , PUnsafeLiftDecl redeemer + , ToData (PLifted datum) + , ToData (PLifted redeemer) + ) => + -- | Should the validator pass? + Bool -> + String -> + ClosedTerm PValidator -> + PLifted datum -> + PLifted redeemer -> + ScriptContext -> + SpecificationTree +testFunc isValid = + if isValid + then validatorSucceedsWith + else validatorFailsWith diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index d8ac396..da8b4e5 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -11,6 +11,33 @@ module Sample.Proposal.UnlockStake ( -------------------------------------------------------------------------------- +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (..), + ProposalRedeemer (Unlock), + ProposalStatus (..), + ProposalVotes (..), + ResultTag (..), + ) +import Agora.Proposal.Scripts (proposalValidator) +import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) +import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) +import Control.Monad (join) +import Data.Coerce (coerce) +import Data.Default.Class (Default (def)) +import Data.Tagged (Tagged (..), untag) +import Plutarch.Context ( + BaseBuilder, + buildTxInfoUnsafe, + input, + output, + script, + txId, + withDatum, + withRefIndex, + withTxId, + withValue, + ) import PlutusLedgerApi.V1 ( DatumHash, ScriptContext (..), @@ -21,19 +48,7 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap - --------------------------------------------------------------------------------- - -import Agora.Proposal ( - ProposalDatum (..), - ProposalId (..), - ProposalRedeemer (Unlock), - ProposalStatus (..), - ProposalVotes (..), - ResultTag (..), - ) -import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) -import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) import Sample.Shared ( minAda, proposalPolicySymbol, @@ -43,19 +58,9 @@ import Sample.Shared ( stakeAssetClass, stakeValidatorHash, ) -import Test.Util (sortValue, updateMap) - --------------------------------------------------------------------------------- - -import Agora.Proposal.Scripts (proposalValidator) -import Control.Monad (join) -import Data.Coerce (coerce) -import Data.Default.Class (Default (def)) -import Data.Tagged (Tagged (..), untag) -import Plutarch.Context (BaseBuilder, buildTxInfoUnsafe, input, output, script, txId, withDatum, withRefIndex, withTxId, withValue) -import Sample.Proposal.Shared (proposalRef, stakeRef) import Sample.Shared qualified as Shared -import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith) +import Test.Specification (SpecificationTree) +import Test.Util (sortValue, updateMap) -------------------------------------------------------------------------------- @@ -223,8 +228,8 @@ unlockStake p = script proposalValidatorHash . withValue pst . withDatum i - . withTxId (txOutRefId proposalRef) - . withRefIndex (txOutRefIdx proposalRef + coerce i.proposalId) + . withTxId proposalTxRef + . withRefIndex (coerce i.proposalId + 2) , output $ script proposalValidatorHash . withValue (sortValue $ pst <> minAda) @@ -249,8 +254,8 @@ unlockStake p = script stakeValidatorHash . withValue stakeValue . withDatum sInDatum - . withTxId (txOutRefId stakeRef) - . withRefIndex (txOutRefIdx stakeRef) + . withTxId stakeTxRef + . withRefIndex 1 , output $ script stakeValidatorHash . withValue stakeValue @@ -271,6 +276,14 @@ mkProposalValidatorTestCase p shouldSucceed = let datum = mkProposalInputDatum p $ ProposalId 0 redeemer = Unlock (ResultTag 0) name = show p - scriptContext = ScriptContext (unlockStake p) (Spending proposalRef) - f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith - in f name (proposalValidator Shared.proposal) datum redeemer scriptContext + scriptContext = + ScriptContext + (unlockStake p) + (Spending (TxOutRef proposalTxRef 2)) + in testFunc + shouldSucceed + name + (proposalValidator Shared.proposal) + datum + redeemer + scriptContext diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs new file mode 100644 index 0000000..f06ac7e --- /dev/null +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -0,0 +1,249 @@ +module Sample.Proposal.Vote ( + validVoteParameters, + mkTestTree, +) where + +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (ProposalId), + ProposalRedeemer (Vote), + ProposalStatus (VotingReady), + ProposalVotes (ProposalVotes), + ResultTag (ResultTag), + ) +import Agora.Proposal.Scripts (proposalValidator) +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (draftTime, votingTime), + ) +import Agora.Stake ( + ProposalLock (ProposalLock), + Stake (gtClassRef), + StakeDatum (..), + StakeRedeemer (PermitVote), + ) +import Agora.Stake.Scripts (stakeValidator) +import Data.Default (Default (def)) +import Data.Tagged (Tagged (Tagged), untag) +import Plutarch.Context ( + BaseBuilder, + buildTxInfoUnsafe, + input, + output, + script, + signedWith, + timeRange, + txId, + withDatum, + withOutRef, + withValue, + ) +import PlutusLedgerApi.V1 ( + PubKeyHash, + ScriptContext (..), + ScriptPurpose (Spending), + TxInfo, + TxOutRef (TxOutRef), + ) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Shared ( + minAda, + proposalPolicySymbol, + proposalValidatorHash, + signer, + stake, + stakeAssetClass, + stakeValidatorHash, + ) +import Sample.Shared qualified as Shared +import Test.Specification ( + SpecificationTree, + group, + validatorSucceedsWith, + ) +import Test.Util (closedBoundedInterval, sortValue, updateMap) + +proposalRef :: TxOutRef +proposalRef = TxOutRef proposalTxRef 0 + +stakeRef :: TxOutRef +stakeRef = TxOutRef stakeTxRef 1 + +-- | Parameters for creating a voting transaction. +data Parameters = Parameters + { voteFor :: ResultTag + -- ^ The outcome the transaction is voting for. + , voteCount :: Integer + -- ^ The count of votes. + } + +stakeOwner :: PubKeyHash +stakeOwner = signer + +initialVotes :: AssocMap.Map ResultTag Integer +initialVotes = + AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 4242) + ] + +proposalInputDatum :: ProposalDatum +proposalInputDatum = + ProposalDatum + { proposalId = ProposalId 42 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = VotingReady + , cosigners = [stakeOwner] + , thresholds = def + , votes = ProposalVotes initialVotes + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + +existingLocks :: [ProposalLock] +existingLocks = + [ ProposalLock (ResultTag 0) (ProposalId 0) + , ProposalLock (ResultTag 2) (ProposalId 1) + ] + +mkStakeInputDatum :: Parameters -> StakeDatum +mkStakeInputDatum params = + StakeDatum + { stakedAmount = Tagged params.voteCount + , owner = stakeOwner + , lockedBy = existingLocks + } + +mkProposalRedeemer :: Parameters -> ProposalRedeemer +mkProposalRedeemer = Vote . voteFor + +mkNewLock :: Parameters -> ProposalLock +mkNewLock ps = ProposalLock ps.voteFor proposalInputDatum.proposalId + +mkStakeRedeemer :: Parameters -> StakeRedeemer +mkStakeRedeemer = PermitVote . mkNewLock + +-- | Create a valid transaction that votes on a propsal, given the parameters. +vote :: Parameters -> TxInfo +vote params = + let pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 + + --- + + stakeInputDatum = mkStakeInputDatum params + + --- + + updatedVotes :: AssocMap.Map ResultTag Integer + updatedVotes = updateMap (Just . (+ params.voteCount)) params.voteFor initialVotes + + --- + + proposalOutputDatum :: ProposalDatum + proposalOutputDatum = + proposalInputDatum + { votes = ProposalVotes updatedVotes + } + + --- + + -- Off-chain code should do exactly like this: prepend new lock toStatus the list. + updatedLocks :: [ProposalLock] + updatedLocks = mkNewLock params : existingLocks + + --- + + stakeOutputDatum :: StakeDatum + stakeOutputDatum = + stakeInputDatum + { lockedBy = updatedLocks + } + + --- + + validTimeRange = + closedBoundedInterval + ((def :: ProposalTimingConfig).draftTime + 1) + ((def :: ProposalTimingConfig).votingTime - 1) + + --- + + stakeValue = + sortValue $ + sst + <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount + <> minAda + + builder :: BaseBuilder + builder = + mconcat + [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c" + , signedWith stakeOwner + , timeRange validTimeRange + , input $ + script proposalValidatorHash + . withValue pst + . withDatum proposalInputDatum + . withOutRef proposalRef + , input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeInputDatum + . withOutRef stakeRef + , output $ + script proposalValidatorHash + . withValue pst + . withDatum proposalOutputDatum + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeOutputDatum + ] + in buildTxInfoUnsafe builder + +--- + +validVoteParameters :: Parameters +validVoteParameters = + Parameters + { voteFor = ResultTag 0 + , voteCount = 27 + } + +--- + +mkTestTree :: String -> Parameters -> Bool -> SpecificationTree +mkTestTree name ps isValid = group name [proposal, stake] + where + txInfo = vote ps + + proposal = + testFunc + isValid + "propsoal" + (proposalValidator Shared.proposal) + proposalInputDatum + (mkProposalRedeemer ps) + ( ScriptContext + txInfo + (Spending proposalRef) + ) + + stake = + let stakeInputDatum = mkStakeInputDatum ps + in validatorSucceedsWith + "stake" + (stakeValidator Shared.stake) + stakeInputDatum + (mkStakeRedeemer ps) + ( ScriptContext + txInfo + (Spending stakeRef) + ) diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 41234a1..a3c54df 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} - {- | Module : Spec.Proposal Maintainer : emi@haskell.fyi @@ -11,45 +9,19 @@ module Spec.Proposal (specs) where import Agora.Proposal ( Proposal (..), - ProposalDatum (..), - ProposalId (ProposalId), - ProposalRedeemer (..), ProposalStatus (..), - ProposalThresholds (..), - ProposalVotes (ProposalVotes), - ResultTag (ResultTag), - cosigners, - effects, - emptyVotesFor, - proposalId, - status, - thresholds, - votes, ) -import Agora.Proposal.Scripts (proposalPolicy, proposalValidator) -import Agora.Proposal.Time ( - ProposalStartingTime (ProposalStartingTime), - ) -import Agora.Stake ( - ProposalLock (ProposalLock), - StakeDatum (StakeDatum), - StakeRedeemer (PermitVote, WitnessStake), - ) -import Agora.Stake.Scripts (stakeValidator) -import Data.Default.Class (Default (def)) -import Data.Tagged (Tagged (Tagged), untag) -import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..)) -import PlutusTx.AssocMap qualified as AssocMap +import Agora.Proposal.Scripts (proposalPolicy) import Sample.Proposal qualified as Proposal +import Sample.Proposal.Advance qualified as Advance +import Sample.Proposal.Cosign qualified as Cosign import Sample.Proposal.UnlockStake qualified as UnlockStake -import Sample.Shared (signer, signer2) -import Sample.Shared qualified as Shared (proposal, stake) +import Sample.Proposal.Vote qualified as Vote +import Sample.Shared qualified as Shared (proposal) import Test.Specification ( SpecificationTree, group, policySucceedsWith, - validatorFailsWith, - validatorSucceedsWith, ) -- | Stake specs. @@ -67,279 +39,133 @@ specs = "validator" [ group "cosignature" - [ validatorSucceedsWith - "proposal" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = Draft - , cosigners = [signer] - , thresholds = def - , votes = - emptyVotesFor $ - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Cosign [signer2]) - (ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.proposalRef)) - , validatorSucceedsWith - "stake" - (stakeValidator Shared.stake) - (StakeDatum (Tagged 50_000_000) signer2 []) - WitnessStake - (ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.stakeRef)) - ] + $ let cosignerCases = [1, 5, 10] + + mkLegalGroup nCosigners = + Cosign.mkTestTree + ("with " <> show nCosigners <> " cosigners") + (Cosign.validCosignNParameters nCosigners) + True + legalGroup = + group "legal" $ + map mkLegalGroup cosignerCases + + mkIllegalStatusNotDraftGroup nCosigners = + group ("with " <> show nCosigners <> " cosigners") $ + map + ( \ps -> + Cosign.mkTestTree + ("status: " <> show ps.proposalStatus) + ps + False + ) + (Cosign.statusNotDraftCosignNParameters nCosigners) + illegalStatusNotDraftGroup = + group "proposal status not Draft" $ + map mkIllegalStatusNotDraftGroup cosignerCases + + illegalGroup = + group + "illegal" + [ Cosign.mkTestTree + "duplicate cosigners" + Cosign.duplicateCosignersParameters + False + , Cosign.mkTestTree + "altered output stake" + Cosign.invalidStakeOutputParameters + False + , illegalStatusNotDraftGroup + ] + in [legalGroup, illegalGroup] , group "voting" - [ validatorSucceedsWith - "proposal" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 42 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) + [ Vote.mkTestTree "legal" Vote.validVoteParameters True + -- TODO: add negative test cases + ] + , group "advancing" $ + let mkFromDraft nCosigners = + let name = "with " <> show nCosigners <> " cosigner(s)" + + legalGroup = + group + "legal" + [ Advance.mkTestTree + "to next state" + ( head $ + Advance.advanceToNextStateInTimeParameters + nCosigners + ) + True + , Advance.mkTestTree + "to failed state" + ( head $ + Advance.advanceToFailedStateDueToTimeoutParameters + nCosigners + ) + True ] - , status = VotingReady - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 4242) - ] + + illegalGroup = + group + "illegal" + [ Advance.mkTestTree + "insufficient cosigns" + (Advance.insufficientCosignsParameters nCosigners) + False + , Advance.mkTestTree + "invalid stake output" + (head $ Advance.invalidOutputStakeParameters nCosigners) + False + ] + in group name [legalGroup, illegalGroup] + + draftGroup = group "from draft" $ map mkFromDraft [1, 5, 10] + + legalGroup = + group + "legal" + [ group "advance to next state" $ + map + ( \ps -> + let name = "from: " <> show ps.fromStatus + in Advance.mkTestTree name ps True ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Vote (ResultTag 0)) - ( ScriptContext - ( Proposal.voteOnProposal - Proposal.VotingParameters - { Proposal.voteFor = ResultTag 0 - , Proposal.voteCount = 27 - } - ) - (Spending Proposal.proposalRef) - ) - , validatorSucceedsWith - "stake" - (stakeValidator Shared.stake) - ( StakeDatum - (Tagged 27) - signer - [ ProposalLock (ResultTag 0) (ProposalId 0) - , ProposalLock (ResultTag 2) (ProposalId 1) + (tail $ Advance.advanceToNextStateInTimeParameters 1) + , group "advance to failed state" $ + map + ( \ps -> + let name = "from: " <> show ps.fromStatus + in Advance.mkTestTree name ps True + ) + (tail $ Advance.advanceToFailedStateDueToTimeoutParameters 1) ] - ) - (PermitVote $ ProposalLock (ResultTag 0) (ProposalId 42)) - ( ScriptContext - ( Proposal.voteOnProposal - Proposal.VotingParameters - { Proposal.voteFor = ResultTag 0 - , Proposal.voteCount = 27 - } - ) - (Spending Proposal.stakeRef) - ) - ] - , group - "advancing" - [ group "successfully advance to next state" $ - map - ( \(name, initialState) -> - validatorSucceedsWith - name - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = initialState - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ - ( ResultTag 0 - , case initialState of - Draft -> 0 - _ -> untag (def :: ProposalThresholds).execute + 1 - ) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - AdvanceProposal - ( ScriptContext - ( Proposal.advanceProposalSuccess - Proposal.TransitionParameters - { Proposal.initialProposalStatus = initialState - , Proposal.proposalStartingTime = ProposalStartingTime 0 - } - ) - (Spending Proposal.proposalRef) - ) - ) - [ ("Draft -> VotringReady", Draft) - , ("VotingReady -> Locked", VotingReady) - , ("Locked -> Finished", Locked) - ] - , group "successfully advance to failed state: timeout" $ - map - ( \(name, initialState) -> - validatorSucceedsWith - name - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = initialState - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ - ( ResultTag 0 - , case initialState of - Draft -> 0 - _ -> untag (def :: ProposalThresholds).vote + 1 - ) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - AdvanceProposal - ( ScriptContext - ( Proposal.advanceProposalFailureTimeout - Proposal.TransitionParameters - { Proposal.initialProposalStatus = initialState - , Proposal.proposalStartingTime = ProposalStartingTime 0 - } - ) - (Spending Proposal.proposalRef) - ) - ) - [ ("Draft -> Finished", Draft) - , ("VotingReady -> Finished", VotingReady) - , ("Locked -> Finished", Locked) - ] - , validatorFailsWith - "illegal: insufficient votes" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = VotingReady - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 1) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - AdvanceProposal - ( ScriptContext - Proposal.advanceProposalInsufficientVotes - (Spending Proposal.proposalRef) - ) - , validatorFailsWith - "illegal: initial state is Finished" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = Finished - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, untag (def :: ProposalThresholds).vote + 1) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - AdvanceProposal - ( ScriptContext - Proposal.advanceFinishedProposal - (Spending Proposal.proposalRef) - ) - , validatorFailsWith - "illegal: with stake input" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = VotingReady - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 0) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - AdvanceProposal - ( ScriptContext - Proposal.advanceProposalWithInvalidOutputStake - (Spending Proposal.proposalRef) - ) - ] + + illegalGroup = + group + "illegal" + [ Advance.mkTestTree + "insufficient votes" + Advance.insufficientVotesParameters + False + , Advance.mkTestTree + "initial state is Finished" + Advance.advanceFromFinishedParameters + False + , group + "invalid stake output" + $ do + nStake <- [1, 5] + ps <- tail $ Advance.invalidOutputStakeParameters nStake + + let name = + "from " <> show ps.fromStatus <> "with " + <> show nStake + <> " stakes" + + pure $ Advance.mkTestTree name ps False + ] + in [draftGroup, legalGroup, illegalGroup] , group "unlocking" $ do proposalCount <- [1, 42] diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index 78600a5..b610dd7 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -13,22 +13,24 @@ module Test.Util ( updateMap, sortMap, sortValue, + blake2b_224, + pubKeyHashes, + userCredentials, + scriptCredentials, ) where -------------------------------------------------------------------------------- -import Prelude - --------------------------------------------------------------------------------- - import Codec.Serialise (serialise) -import Data.ByteString.Lazy qualified as ByteString.Lazy - --------------------------------------------------------------------------------- - +import Crypto.Hash qualified as Crypto import Data.Bifunctor (second) +import Data.ByteArray qualified as BA +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as C +import Data.ByteString.Lazy qualified as ByteString.Lazy import Data.List (sortOn) import Plutarch.Crypto (pblake2b_256) +import PlutusLedgerApi.V1 (Credential (PubKeyCredential, ScriptCredential), PubKeyHash (..), ValidatorHash (ValidatorHash)) import PlutusLedgerApi.V1.Interval qualified as PlutusTx import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) import PlutusLedgerApi.V1.Value (Value (..)) @@ -36,6 +38,7 @@ import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.IsData qualified as PlutusTx import PlutusTx.Ord qualified as PlutusTx +import Prelude -------------------------------------------------------------------------------- @@ -106,3 +109,25 @@ sortValue = . fmap (second sortMap) . AssocMap.toList . getValue + +-------------------------------------------------------------------------------- + +-- | Compute the hash of a given byte string using blake2b_224 algorithm. +blake2b_224 :: BS.ByteString -> BS.ByteString +blake2b_224 = BS.pack . BA.unpack . Crypto.hashWith Crypto.Blake2b_224 + +-- | An infinite list of blake2b_224 hashes. +blake2b_224Hashes :: [BS.ByteString] +blake2b_224Hashes = blake2b_224 . C.pack . show @Integer <$> [0 ..] + +-- | An infinite list of *valid* 'PubKeyHash'. +pubKeyHashes :: [PubKeyHash] +pubKeyHashes = PubKeyHash . PlutusTx.toBuiltin <$> blake2b_224Hashes + +-- | An infinite list of *valid* user credentials. +userCredentials :: [Credential] +userCredentials = PubKeyCredential <$> pubKeyHashes + +-- | An infinite list of *valid* script credentials. +scriptCredentials :: [Credential] +scriptCredentials = ScriptCredential . ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes diff --git a/agora.cabal b/agora.cabal index d20cf60..08f9e99 100644 --- a/agora.cabal +++ b/agora.cabal @@ -189,8 +189,11 @@ library agora-specs Sample.Effect.TreasuryWithdrawal Sample.Governor Sample.Proposal + Sample.Proposal.Advance + Sample.Proposal.Cosign Sample.Proposal.Shared Sample.Proposal.UnlockStake + Sample.Proposal.Vote Sample.Shared Sample.Stake Sample.Treasury diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index f947817..7138d26 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -313,13 +313,13 @@ stakeValidator stake = -- -- Validation strategy I have tried/considered so far: -- 1. Check that the number of input stakes equals to the number of output stakes, and verify - -- that every input stake has an output stake with the exact same value and datum hash. - -- However this approach has a fatal vulnerability: let's say we have two totally identical stakes, - -- a malicious user can comsume these two stakes and remove GTs from one of them. + -- that there's an output stake with the exact same value and datum hash as the stake being + -- validated , However this approach has a fatal vulnerability: let's say we have two totally + -- identical stakes, a malicious user can comsume these two stakes and remove GTs from one of them. -- 2. Perform the same checks as the last approch does, while also checking that every output stake is -- valid(stakedAmount == actual value). However this requires that all the output stake datum are -- included in the transaction, and we have to find and go through them one by one to access the - -- 'stakedAmount' fields, meaning that computationally this approach is *very* expensive. + -- 'stakedAmount' fields, meaning that computationally this approach is *very* expensive. -- 3. The one implemented below. Find all the continuous input/output, sort them by 'datumHash', and -- ensure that the two sorted lists are equal. let ownInputs = diff --git a/bench.csv b/bench.csv index a596e6f..1a8900e 100644 --- a/bench.csv +++ b/bench.csv @@ -8,24 +8,57 @@ Agora/Stake/policy/stakeCreation,50939580,148729,2387 Agora/Stake/validator/stakeDepositWithdraw deposit,180222751,492217,5003 Agora/Stake/validator/stakeDepositWithdraw withdraw,180222751,492217,4991 Agora/Proposal/policy/proposalCreation,23140177,69194,1515 -Agora/Proposal/validator/cosignature/proposal,240482868,674626,8525 -Agora/Proposal/validator/cosignature/stake,136781411,336612,5528 -Agora/Proposal/validator/voting/proposal,243946100,678901,8443 -Agora/Proposal/validator/voting/stake,128972262,348186,5489 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,219342631,620576,8350 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,247748475,699343,8359 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,236509366,666512,8359 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,214287939,609855,8352 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,233681921,660502,8353 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,234812899,662906,8353 +Agora/Proposal/validator/cosignature/legal/with 1 cosigners/propsoal,237484909,663370,8471 +Agora/Proposal/validator/cosignature/legal/with 1 cosigners/stake,123296365,319226,5470 +Agora/Proposal/validator/cosignature/legal/with 5 cosigners/propsoal,675336848,1882805,11101 +Agora/Proposal/validator/cosignature/legal/with 5 cosigners/stake,554091553,1461634,7980 +Agora/Proposal/validator/cosignature/legal/with 10 cosigners/propsoal,1336993992,3667352,14389 +Agora/Proposal/validator/cosignature/legal/with 10 cosigners/stake,1102063894,2914419,11117 +Agora/Proposal/validator/cosignature/illegal/duplicate cosigners/stake,123296365,319226,5470 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: VotingReady/stake,123296365,319226,5470 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: Locked/stake,123296365,319226,5470 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 1 cosigners/status: Finished/stake,123296365,319226,5470 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: VotingReady/stake,554091553,1461634,7980 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: Locked/stake,554091553,1461634,7980 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 5 cosigners/status: Finished/stake,554091553,1461634,7980 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: VotingReady/stake,1102063894,2914419,11117 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: Locked/stake,1102063894,2914419,11117 +Agora/Proposal/validator/cosignature/illegal/proposal status not Draft/with 10 cosigners/status: Finished/stake,1102063894,2914419,11117 +Agora/Proposal/validator/voting/legal/propsoal,247594094,689025,8443 +Agora/Proposal/validator/voting/legal/stake,141390725,374830,5489 +Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to next state/propsoal,222990625,630700,8426 +Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to next state/stake,123296365,319226,5467 +Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to failed state/propsoal,217935933,619979,8428 +Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/legal/to failed state/stake,123296365,319226,5469 +Agora/Proposal/validator/advancing/from draft/with 1 cosigner(s)/illegal/insufficient cosigns/stake,117222929,305504,5397 +Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to next state/propsoal,600833052,1725797,11249 +Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to next state/stake,526604275,1381680,8170 +Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to failed state/propsoal,240305281,682043,8789 +Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/legal/to failed state/stake,123296365,319226,5710 +Agora/Proposal/validator/advancing/from draft/with 5 cosigner(s)/illegal/insufficient cosigns/stake,445454241,1167344,7819 +Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to next state/propsoal,1164574757,3363392,14778 +Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to next state/stake,1154814568,3068129,11548 +Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to failed state/propsoal,268266966,759623,9242 +Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/legal/to failed state/stake,123296365,319226,6012 +Agora/Proposal/validator/advancing/from draft/with 10 cosigner(s)/illegal/insufficient cosigns/stake,1024215053,2732615,10845 +Agora/Proposal/validator/advancing/legal/advance to next state/from: VotingReady/propsoal,251396469,709467,8435 +Agora/Proposal/validator/advancing/legal/advance to next state/from: VotingReady/stake,123296365,319226,5474 +Agora/Proposal/validator/advancing/legal/advance to next state/from: Locked/propsoal,240157360,676636,8435 +Agora/Proposal/validator/advancing/legal/advance to next state/from: Locked/stake,123296365,319226,5474 +Agora/Proposal/validator/advancing/legal/advance to failed state/from: VotingReady/propsoal,237329915,670626,8429 +Agora/Proposal/validator/advancing/legal/advance to failed state/from: VotingReady/stake,123296365,319226,5470 +Agora/Proposal/validator/advancing/legal/advance to failed state/from: Locked/propsoal,238460893,673030,8429 +Agora/Proposal/validator/advancing/legal/advance to failed state/from: Locked/stake,123296365,319226,5470 +Agora/Proposal/validator/advancing/illegal/insufficient votes/stake,123296365,319226,5470 +Agora/Proposal/validator/advancing/illegal/initial state is Finished/stake,123296365,319226,5462 "Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",245987595,688711,8403 "Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",215263333,612711,8405 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",212560614,604622,8407 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",212560614,604622,8407 -"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1775652167,5199490,29510 -"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1448293766,4317963,29694 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1340653392,3978430,29678 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1340653392,3978430,29678 +"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1775652167,5199490,29511 +"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1448293766,4317963,29695 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1340653392,3978430,29679 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1340653392,3978430,29679 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452 @@ -33,5 +66,5 @@ Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,80 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,51007235,144191,2034 Agora/Governor/validator/proposal creation,309689999,834675,9064 -Agora/Governor/validator/GATs minting,418560845,1137908,9187 +Agora/Governor/validator/GATs minting,421016677,1141838,9187 Agora/Governor/validator/mutate governor state,88986020,248491,8662