From 82e2f08b1abd50fd2a0f564f70b0dc9d31ef6ef3 Mon Sep 17 00:00:00 2001 From: zachyking Date: Fri, 7 Nov 2025 19:28:00 +0000 Subject: [PATCH] Implement fixes for audit findings --- dao/dao-lib/Dao/Configuration/Script.hs | 33 +- dao/dao-lib/Dao/Shared.hs | 21 + dao/dao-lib/Dao/Tally/Script.hs | 522 +++++++++++------- dao/dao-lib/Dao/Treasury/Script.hs | 175 ++++-- dao/dao-specs/Spec/Configuration/Script.hs | 6 + .../Spec/Configuration/Transactions.hs | 20 + dao/dao-specs/Spec/SampleData.hs | 55 +- dao/dao-specs/Spec/SpecUtils.hs | 10 + dao/dao-specs/Spec/Tally.hs | 4 +- dao/dao-specs/Spec/Tally/Context.hs | 12 +- dao/dao-specs/Spec/Tally/SampleData.hs | 6 +- dao/dao-specs/Spec/Tally/Script.hs | 8 +- dao/dao-specs/Spec/Tally/Transactions.hs | 28 +- dao/dao-specs/Spec/Tally/Utils.hs | 10 +- dao/dao-specs/Spec/Treasury.hs | 12 +- dao/dao-specs/Spec/Treasury/Context.hs | 237 ++++---- dao/dao-specs/Spec/Treasury/Script.hs | 14 +- dao/dao-specs/Spec/Treasury/Transactions.hs | 21 +- dao/dao-specs/Spec/Treasury/Utils.hs | 3 +- dao/dao-specs/Spec/Upgrade.hs | 8 +- dao/dao-specs/Spec/Upgrade/Context.hs | 100 ++-- dao/dao-specs/Spec/Vote.hs | 4 +- dao/dao-specs/Spec/Vote/Context.hs | 67 ++- dao/dao-specs/Spec/Vote/ContextValidator.hs | 40 +- dao/dao-specs/Spec/VoteValidator.hs | 4 + dao/dao.cabal | 1 + types/ApplicationTypes/Configuration.lbf | 10 +- types/ApplicationTypes/Proposal.lbf | 9 +- types/ApplicationTypes/Treasury.lbf | 15 + types/build.nix | 2 + 30 files changed, 950 insertions(+), 507 deletions(-) create mode 100644 types/ApplicationTypes/Treasury.lbf diff --git a/dao/dao-lib/Dao/Configuration/Script.hs b/dao/dao-lib/Dao/Configuration/Script.hs index 9da5bcc..57be653 100644 --- a/dao/dao-lib/Dao/Configuration/Script.hs +++ b/dao/dao-lib/Dao/Configuration/Script.hs @@ -24,10 +24,10 @@ import Dao.ScriptArgument ( ) import Dao.Shared ( convertDatum, + hasBurnedTokens, hasOneOfToken, hasSingleTokenWithSymbolAndTokenName, hasSymbolInValue, - hasTokenInValue, hasTokenInValueNoErrors, untypedPolicy, untypedValidator, @@ -55,7 +55,6 @@ import LambdaBuffers.ApplicationTypes.Tally ( import PlutusLedgerApi.V1.Interval (before) import PlutusLedgerApi.V1.Time (POSIXTime (POSIXTime)) import PlutusLedgerApi.V1.Value (Value) -import PlutusLedgerApi.V2 (CurrencySymbol) import PlutusLedgerApi.V2.Contexts ( ScriptContext (ScriptContext, scriptContextPurpose, scriptContextTxInfo), ScriptPurpose (Minting, Spending), @@ -79,7 +78,7 @@ import PlutusTx ( compile, ) import PlutusTx.Prelude ( - Bool, + Bool (True), BuiltinData, Integer, any, @@ -195,20 +194,19 @@ validateConfiguration hasTallyNft :: Value -> Bool hasTallyNft = hasSymbolInValue dynamicConfigDatum'tallyNft - -- Ensure there is exactly one output that contains the 'TallyStateDatum' datum - -- The `convertDatum` helper will throw an error if the output datum is not found + -- Get TallyStateDatum from spent inputs (not reference) + -- The Tally NFT must be spent and burned during upgrades TallyStateDatum {tallyStateDatum'proposal = proposal, ..} = - case filter (hasTallyNft . txOutValue . txInInfoResolved) txInfoReferenceInputs of - [] -> traceError "Should be exactly one tally NFT in the reference inputs. None found." + case filter (hasTallyNft . txOutValue . txInInfoResolved) txInfoInputs of + [] -> traceError "Should be exactly one tally NFT in the inputs. None found." [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum - _ -> traceError "Should be exactly one tally NFT in the reference inputs. More than one found." + _ -> traceError "Should be exactly one tally NFT in the inputs. More than one found." - -- Ensure that the 'ProposalType' set in the 'tsProposal' field - -- of the 'TallyStateDatum' is 'Upgrade', and retrieve the upgrade symbol - upgradeMinter :: CurrencySymbol - upgradeMinter = case proposal of - ProposalType'Upgrade u -> u + -- Ensure that the 'ProposalType' is 'Upgrade' + isUpgradeProposal :: Bool + !isUpgradeProposal = case proposal of + ProposalType'Upgrade _ -> True _ -> traceError "Not an upgrade proposal" -- The total votes, for and against, in the 'TallyStateDatum' @@ -233,9 +231,9 @@ validateConfiguration "majority is too small" (majorityPercent >= dynamicConfigDatum'upgradeMajorityPercent) - -- Make sure the upgrade token was minted - hasUpgradeMinterToken :: Bool - !hasUpgradeMinterToken = hasTokenInValue upgradeMinter "validateConfiguration, upgradeMinter" txInfoMint + -- Verify the Tally NFT is being burned (instead of checking for upgrade token) + tallyNftIsBurned :: Bool + !tallyNftIsBurned = hasBurnedTokens dynamicConfigDatum'tallyNft txInfoMint "Tally NFT must be burned for upgrade" -- Ensure the proposal has finished isAfterTallyEndTime :: Bool @@ -244,8 +242,9 @@ validateConfiguration `before` txInfoValidRange in traceIfFalse "Should be exactly one configuration NFT in the inputs" hasConfigurationNft + && traceIfFalse "Not an upgrade proposal" isUpgradeProposal && traceIfFalse "The proposal doesn't have enough votes" hasEnoughVotes - && traceIfFalse "Should be exactly one upgrade token minted" hasUpgradeMinterToken + && tallyNftIsBurned && traceIfFalse "Tallying not over. Try again later" isAfterTallyEndTime validateConfiguration _ _ _ _ = traceError "Wrong script purpose" diff --git a/dao/dao-lib/Dao/Shared.hs b/dao/dao-lib/Dao/Shared.hs index 3c9d4fb..a9d0657 100644 --- a/dao/dao-lib/Dao/Shared.hs +++ b/dao/dao-lib/Dao/Shared.hs @@ -20,6 +20,7 @@ module Dao.Shared ( integerToByteString, isScriptCredential, lovelacesOf, + hasExactAssetCount, ) where import Dao.ScriptArgument (ValidatorParams) @@ -44,14 +45,17 @@ import PlutusTx.Prelude ( Maybe (Just, Nothing), check, divide, + foldr, fromMaybe, isJust, + length, modulo, otherwise, traceError, traceIfFalse, ($), (&&), + (+), (.), (<), (<>), @@ -139,6 +143,23 @@ countOfTokenInValue symbol tokenName (Value value) = lovelacesOf :: Value -> Integer lovelacesOf = countOfTokenInValue adaSymbol adaToken +{-# INLINEABLE hasExactAssetCount #-} + +{- | Check if a Value contains exactly the expected number of distinct asset types + Used to prevent token dust attacks by ensuring no extra tokens are present +-} +hasExactAssetCount :: Value -> Integer -> Bool +hasExactAssetCount (Value val) expectedCount = + let + -- Count total number of distinct token types across all currency symbols + countTokensInMap :: Map TokenName Integer -> Integer + countTokensInMap tokenMap = fromMaybe 0 $ Just (length (Map.toList tokenMap)) + + totalAssets :: Integer + totalAssets = foldr (\(_, tokenMap) acc -> acc + countTokensInMap tokenMap) 0 (Map.toList val) + in + totalAssets == expectedCount + {-# INLINEABLE hasOneOfToken #-} hasOneOfToken :: CurrencySymbol -> TokenName -> Value -> Bool hasOneOfToken symbol tokenName (Value value) = case Map.lookup symbol value of diff --git a/dao/dao-lib/Dao/Tally/Script.hs b/dao/dao-lib/Dao/Tally/Script.hs index e8b5efe..4f2ec86 100644 --- a/dao/dao-lib/Dao/Tally/Script.hs +++ b/dao/dao-lib/Dao/Tally/Script.hs @@ -32,8 +32,10 @@ import Dao.Shared ( convertDatum, countOfTokenInValue, getTokenNameOfNft, + hasExactAssetCount, hasOneOfToken, hasSingleTokenWithSymbolAndTokenName, + hasSymbolInValue, integerToByteString, isScriptCredential, untypedPolicy, @@ -42,9 +44,11 @@ import Dao.Shared ( import LambdaBuffers.ApplicationTypes.Configuration ( DynamicConfigDatum ( DynamicConfigDatum, + dynamicConfigDatum'configurationValidator, dynamicConfigDatum'fungibleVotePercent, dynamicConfigDatum'tallyNft, dynamicConfigDatum'tallyValidator, + dynamicConfigDatum'treasuryValidator, dynamicConfigDatum'voteCurrencySymbol, dynamicConfigDatum'voteFungibleCurrencySymbol, dynamicConfigDatum'voteFungibleTokenName, @@ -77,8 +81,9 @@ import LambdaBuffers.ApplicationTypes.Vote ( import PlutusLedgerApi.V1.Address (Address (Address, addressCredential)) import PlutusLedgerApi.V1.Credential (Credential (ScriptCredential)) import PlutusLedgerApi.V1.Interval (before) -import PlutusLedgerApi.V1.Scripts (ScriptHash) +import PlutusLedgerApi.V1.Scripts (ScriptHash (ScriptHash)) import PlutusLedgerApi.V1.Value ( + CurrencySymbol, TokenName (TokenName), Value (Value), adaSymbol, @@ -111,7 +116,7 @@ import PlutusTx ( import PlutusTx.AssocMap (Map) import PlutusTx.AssocMap qualified as M import PlutusTx.Prelude ( - Bool (True), + Bool (False, True), BuiltinData, Integer, Maybe (Just, Nothing), @@ -124,6 +129,7 @@ import PlutusTx.Prelude ( map, mempty, not, + null, otherwise, traceError, traceIfFalse, @@ -142,6 +148,8 @@ import PlutusTx.Prelude qualified as PlutusTx This policy performs the following checks: + When minting (creating new proposal): + - (ID-303) The transaction must include a vote NFT in inputs (members-only proposal creation) - There is exactly one 'DynamicConfigDatum' in the reference inputs, marked by the config NFT (Corresponding config 'CurrencySymbol' and 'TokenName' provided by the 'TallyPolicyParams' argument) @@ -154,9 +162,13 @@ import PlutusTx.Prelude qualified as PlutusTx - This output contains a valid 'Dao.Types.TallyStateDatum' datum. - The initial vote count fields `tallyStateDatum'for` and `tallyStateDatum'against` of the 'Dao.Types.TallyStateDatum' are both set to zero. - - The tally output is at the tally validator + - The tally output is at the tally validator with no staking credential (Corresponding to the tally script provided by the 'dynamicConfigDatum'tallyValidator' field of the 'Dao.Types.DynamicConfigDatum') + + When burning (funding proposals): + - The Tally NFT exists in the transaction inputs + - Additional validation performed by Treasury or Configuration validators -} mkTallyNftMinter :: TallyPolicyParams -> BuiltinData -> ScriptContext -> Bool mkTallyNftMinter @@ -167,66 +179,104 @@ mkTallyNftMinter , scriptContextPurpose = Minting thisCurrencySymbol } = let + -- Check if we're minting (positive) or burning (negative) + -- Burns are used when funding proposals or during upgrades + isBurning :: Bool + isBurning = case M.lookup thisCurrencySymbol (getValue txInfoMint) of + Nothing -> traceError "This currency symbol not found in mints" + Just tokenMap -> case M.toList tokenMap of + [(_, amount)] -> amount PlutusTx.< 0 + _ -> traceError "Expected exactly one token type" + -- Helper for filtering for config UTXO in the reference inputs hasConfigurationNft :: Value -> Bool hasConfigurationNft = hasOneOfToken tpConfigSymbol tpConfigTokenName -- Get the configuration from the reference inputs - DynamicConfigDatum {dynamicConfigDatum'tallyValidator} = + DynamicConfigDatum {dynamicConfigDatum'tallyValidator, dynamicConfigDatum'voteNft} = case filter (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoReferenceInputs of [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum _ -> traceError "Should be exactly one valid config in the reference inputs" - - -- Helper for filtering for index UTXO in the inputs - hasIndexNft :: Value -> Bool - hasIndexNft = hasOneOfToken tpIndexSymbol tpIndexTokenName - - -- Get the index datum from the inputs - IndexDatum {indexDatum'index} = case filter (hasIndexNft . txOutValue . txInInfoResolved) txInfoInputs of - [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum - [] -> traceError "No index NFT found in inputs" - _ -> traceError "Should be exactly one valid Index NFT output" - - -- Helper for filtering for tally UTXO in the outputs - hasTallyNft :: Value -> Bool - hasTallyNft = hasOneOfToken thisCurrencySymbol theTokenName - - -- Get the tally state datum at the output marked by the tally NFT - TxOut {txOutDatum = outputDatum, txOutAddress = outputAddress} = - case filter (hasTallyNft . txOutValue) txInfoOutputs of - [tallyTxOut] -> tallyTxOut - [] -> traceError "No tally NFT found in outputs" - _ -> traceError "Should be exactly one valid Tally NFT output" - - -- Unwrap the 'OutputDatum' to get the 'TallyStateDatum' - -- Will fail with error if no datum found - tallyStateDatum :: TallyStateDatum - tallyStateDatum = convertDatum txInfoData outputDatum - - -- The initial votes for and against must both be set to zero - tallyIsInitializeToZero :: Bool - !tallyIsInitializeToZero = tallyStateDatum'for tallyStateDatum == 0 && tallyStateDatum'against tallyStateDatum == 0 - - -- The NFT must be at the address of the tally validator - outputOnTallyValidator :: Bool - !outputOnTallyValidator = addressCredential outputAddress == ScriptCredential dynamicConfigDatum'tallyValidator - - -- The token name must be set to the index value, - -- contained in the 'IndexDatum' ("0" initially) - theTokenName :: TokenName - !theTokenName = TokenName $ integerToByteString indexDatum'index - - -- Ensure exactly one valid tally token is minted - onlyOneTokenMinted :: Bool - !onlyOneTokenMinted = - hasSingleTokenWithSymbolAndTokenName - txInfoMint - thisCurrencySymbol - theTokenName in - traceIfFalse "Tally datum vote counts are not initialized to zero" tallyIsInitializeToZero - && traceIfFalse "Tally NFT must be sent to the Tally validator" outputOnTallyValidator - && traceIfFalse "Should be exactly one valid token minted" onlyOneTokenMinted + if isBurning + then -- Burning logic: validate this is a legitimate burn (during funding or upgrade) + -- The Treasury or Configuration validator will perform the actual checks + -- We just need to verify the Tally NFT being burned exists in inputs + + let + hasTallyInInputs :: Bool + hasTallyInInputs = + any (hasSymbolInValue thisCurrencySymbol . txOutValue . txInInfoResolved) txInfoInputs + in + traceIfFalse "Tally NFT being burned must exist in inputs" hasTallyInInputs + else -- Minting logic (original): create new proposal + + let + -- ID-303: Require vote pass token to prevent spam proposals + -- Only DAO members (those with vote NFT) can create proposals + hasVotePass :: Bool + !hasVotePass = any (hasSymbolInValue dynamicConfigDatum'voteNft . txOutValue . txInInfoResolved) txInfoInputs + + -- Helper for filtering for index UTXO in the inputs + hasIndexNft :: Value -> Bool + hasIndexNft = hasOneOfToken tpIndexSymbol tpIndexTokenName + + -- Get the index datum from the inputs + IndexDatum {indexDatum'index} = case filter (hasIndexNft . txOutValue . txInInfoResolved) txInfoInputs of + [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum + [] -> traceError "No index NFT found in inputs" + _ -> traceError "Should be exactly one valid Index NFT output" + + -- The token name must be set to the index value + theTokenName :: TokenName + !theTokenName = TokenName $ integerToByteString indexDatum'index + + -- Helper for filtering for tally UTXO in the outputs + hasTallyNft :: Value -> Bool + hasTallyNft = hasOneOfToken thisCurrencySymbol theTokenName + + -- Get the tally state datum at the output marked by the tally NFT + TxOut {txOutDatum = outputDatum, txOutAddress = outputAddress} = + case filter (hasTallyNft . txOutValue) txInfoOutputs of + [tallyTxOut] -> tallyTxOut + [] -> traceError "No tally NFT found in outputs" + _ -> traceError "Should be exactly one valid Tally NFT output" + + -- Unwrap the 'OutputDatum' to get the 'TallyStateDatum' + tallyStateDatum :: TallyStateDatum + tallyStateDatum = convertDatum txInfoData outputDatum + + -- The initial votes for and against must both be set to zero + tallyIsInitializeToZero :: Bool + !tallyIsInitializeToZero = tallyStateDatum'for tallyStateDatum == 0 && tallyStateDatum'against tallyStateDatum == 0 + + -- The NFT must be at the full address of the tally validator + -- We check payment credential matches the expected script hash + outputOnTallyValidator :: Bool + !outputOnTallyValidator = addressCredential outputAddress == ScriptCredential dynamicConfigDatum'tallyValidator + + -- Additionally verify no staking credential redirection (prevent staking rewards theft) + -- The output should have the same staking credential structure as any existing tally UTxO + -- For new proposals, we require the address to have no staking credential + -- (To prevent attackers from adding staking credentials) + noStakingCredential :: Bool + !noStakingCredential = case outputAddress of + Address _ Nothing -> True + _ -> False + + -- Ensure exactly one valid tally token is minted + onlyOneTokenMinted :: Bool + !onlyOneTokenMinted = + hasSingleTokenWithSymbolAndTokenName + txInfoMint + thisCurrencySymbol + theTokenName + in + traceIfFalse "Proposal creator must have vote pass (member-only)" hasVotePass + && traceIfFalse "Tally datum vote counts are not initialized to zero" tallyIsInitializeToZero + && traceIfFalse "Tally NFT must be sent to the Tally validator" outputOnTallyValidator + && traceIfFalse "Tally output must have no staking credential" noStakingCredential + && traceIfFalse "Should be exactly one valid token minted" onlyOneTokenMinted mkTallyNftMinter _ _ _ = traceError "Wrong type of script purpose!" untypedTallyPolicy :: BuiltinData -> BuiltinData -> BuiltinData -> () @@ -327,149 +377,235 @@ validateTally , scriptContextPurpose = Spending thisOutRef } = let - -- Helper for filtering for config UTXO in the reference inputs - hasConfigurationNft :: Value -> Bool - hasConfigurationNft = hasOneOfToken vpConfigSymbol vpConfigTokenName + (!oldValue, !thisValidatorHash) :: (Value, ScriptHash) = ownValueAndValidator txInfoInputs thisOutRef - -- Get the 'DynamicConfig' from the reference inputs - DynamicConfigDatum {..} = - case filter (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoReferenceInputs of - [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum - _ -> traceError "Should be exactly one config NFT in the reference inputs" + -- ID-501: Check if ANY tally NFT is being burned (by checking oldValue symbol) + -- We check oldValue symbol instead of config symbol to avoid needing config first + thisTallySymbol :: CurrencySymbol + thisTallySymbol = case [(cs, tn) | (cs, m) <- M.toList (getValue oldValue), cs PlutusTx./= adaSymbol, (tn, amt) <- M.toList m, amt PlutusTx.> 0] of + [(cs, _)] -> cs + _ -> traceError "Could not determine tally symbol from oldValue" - (!oldValue, !thisValidatorHash) :: (Value, ScriptHash) = ownValueAndValidator txInfoInputs thisOutRef + isTallyBeingBurned :: Bool + isTallyBeingBurned = case M.lookup thisTallySymbol (getValue txInfoMint) of + Nothing -> False + Just tokenMap -> case M.toList tokenMap of + [(_, amount)] -> amount PlutusTx.< 0 + _ -> False - -- Make sure there is only one tally and many votes - expectedScripts :: Bool - !expectedScripts = hasExpectedScripts txInfoInputs thisValidatorHash dynamicConfigDatum'voteValidator - - -- Check that Value contains the 'voteNft' token - -- This acts like a pass token that allows the user to vote - hasVotePassToken :: Value -> Maybe Value - hasVotePassToken (Value v) = - case filter (\(k, _) -> dynamicConfigDatum'voteNft == k) (M.toList v) of - [] -> Nothing - xs@[_] -> Just (Value (M.fromList xs)) - _ -> traceError "Too many vote nfts" - - -- Check for the presence of the vote token minted by - -- the 'mkVoteMinter' policy when casting a vote on a proposal - hasVoteWitness :: Value -> Bool - hasVoteWitness = hasOneOfToken dynamicConfigDatum'voteCurrencySymbol dynamicConfigDatum'voteTokenName - - thisTallyTokenName :: TokenName - thisTallyTokenName = getTokenNameOfNft dynamicConfigDatum'tallyNft oldValue "Tally Nft" - - -- Helper for loop that counts the votes - stepVotes :: - TxInInfo -> - (Integer, Integer, Map Address Value) -> - (Integer, Integer, Map Address Value) - stepVotes - TxInInfo {txInInfoResolved = TxOut {..}} - oldAcc@(oldForCount, oldAgainstCount, oldPayoutMap) = - case (hasVotePassToken txOutValue, hasVoteWitness txOutValue) of - (Just voteNft, True) -> - let - VoteDatum {..} = convertDatum txInfoData txOutDatum - - -- Count all the dynamicConfigDatum'voteFungibleCurrencySymbol - -- with dynamicConfigDatum'voteFungibleTokenName tokens on the vote utxo - fungibleTokens :: Integer - !fungibleTokens = - countOfTokenInValue - dynamicConfigDatum'voteFungibleCurrencySymbol - dynamicConfigDatum'voteFungibleTokenName - txOutValue - - -- Calculate fungible votes using the dynamicConfigDatum'fungibleVotePercent - fungibleVotes :: Integer - !fungibleVotes - | fungibleTokens == 0 = 0 - | otherwise = (fungibleTokens * dynamicConfigDatum'fungibleVotePercent) `divide` 1000 - - -- Add the lovelaces and the NFT - votePayout :: Value - !votePayout = - if fungibleTokens == 0 - then Value (M.insert adaSymbol (M.singleton adaToken voteDatum'returnAda) (getValue voteNft)) - else - Value $ - M.insert - dynamicConfigDatum'voteFungibleCurrencySymbol - (M.singleton dynamicConfigDatum'voteFungibleTokenName fungibleTokens) - ( M.insert - adaSymbol - (M.singleton adaToken voteDatum'returnAda) - (getValue voteNft) - ) - - checkProposal :: Bool - !checkProposal = voteDatum'proposalTokenName == thisTallyTokenName - - newForCount :: Integer - !newForCount = oldForCount + if voteDatum'direction == VoteDirection'For then 1 + fungibleVotes else 0 - - newAgainstCount :: Integer - !newAgainstCount = - oldAgainstCount - + if voteDatum'direction == VoteDirection'For then 0 else 1 + fungibleVotes - - newPayoutMap :: Map Address Value - !newPayoutMap = mergePayouts voteDatum'voteOwner votePayout oldPayoutMap - in - if checkProposal - then (newForCount, newAgainstCount, newPayoutMap) - else traceError "wrong vote proposal" - _ -> oldAcc - - -- Collect the votes - -- Make sure the votes are for the right proposal - -- Make sure the votes have the vote witness - (!forCount, !againstCount, !payoutMap) :: (Integer, Integer, Map Address Value) = - foldr stepVotes (0, 0, M.empty) txInfoInputs - - -- Helper for ensuring the vote NFT and ada are returned to the owner - addressedIsPaid :: [TxOut] -> (Address, Value) -> Bool - addressedIsPaid outputs (addr, value) = valuePaidTo' outputs addr `geq` value - - voteNftAndAdaToVoters :: Bool - !voteNftAndAdaToVoters = all (addressedIsPaid txInfoOutputs) (M.toList payoutMap) - - tallyingIsInactive :: Bool - !tallyingIsInactive = tallyStateDatum'proposalEndTime `before` txInfoValidRange - - voteTokenAreAllBurned :: Bool - !voteTokenAreAllBurned = not $ any (hasVoteWitness . txOutValue) txInfoOutputs - - (!newValue, !newDatum) :: (Value, TallyStateDatum) = - case filter - ( \TxOut {txOutAddress = Address {..}} -> - addressCredential == ScriptCredential thisValidatorHash - ) - txInfoOutputs of - [TxOut {..}] -> (txOutValue, convertDatum txInfoData txOutDatum) - _ -> traceError "Wrong number of continuing outputs" - - -- Ensure the tally NFT remains at the validator - newValueIsAtleastAsBigAsOldValue :: Bool - !newValueIsAtleastAsBigAsOldValue = newValue `geq` oldValue - - -- Ensure the tally datum is updated - tallyDatumIsUpdated :: Bool - !tallyDatumIsUpdated = - newDatum - == ts - { tallyStateDatum'for = oldFor + forCount - , tallyStateDatum'against = oldAgainst + againstCount - } + emptyScriptHash :: ScriptHash + emptyScriptHash = ScriptHash "" + + -- Helper for filtering for config UTXO in the reference inputs or inputs + hasConfigurationNft :: Value -> Bool + hasConfigurationNft = hasOneOfToken vpConfigSymbol vpConfigTokenName + + configSources :: [TxInInfo] + configSources = + let + refMatches = filter (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoReferenceInputs + in + if null refMatches + then filter (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoInputs + else refMatches + + -- Get the 'DynamicConfig' from either the reference inputs (preferred) or from spent inputs + DynamicConfigDatum {..} = case configSources of + [] -> traceError "Missing configuration datum" + [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum + _ -> traceError "Too many configuration datums" + + thisValidatorAddress :: Address + thisValidatorAddress = case filter (\TxInInfo {txInInfoOutRef} -> txInInfoOutRef == thisOutRef) txInfoInputs of + [TxInInfo {txInInfoResolved = TxOut {txOutAddress}}] -> txOutAddress + _ -> traceError "Could not find this tally input" + + scriptCredentials :: [Credential] + scriptCredentials = + filter + isScriptCredential + (map (addressCredential . txOutAddress . txInInfoResolved) txInfoInputs) + + tallyCredential :: Credential + tallyCredential = ScriptCredential thisValidatorHash + + credentialListFromHash :: ScriptHash -> [Credential] + credentialListFromHash hash + | hash == emptyScriptHash = mempty + | otherwise = [ScriptCredential hash] + + allowedBurnCredentials :: [Credential] + allowedBurnCredentials = + tallyCredential + : foldr + (\hash acc -> credentialListFromHash hash <> acc) + [] + [ dynamicConfigDatum'voteValidator + , dynamicConfigDatum'treasuryValidator + , dynamicConfigDatum'configurationValidator + ] + + credentialInList :: Credential -> [Credential] -> Bool + credentialInList cred = foldr (\candidate acc -> acc || cred == candidate) False + + hasConfigInput :: Bool + hasConfigInput = any (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoInputs + + treasuryCredential :: [Credential] + treasuryCredential = credentialListFromHash dynamicConfigDatum'treasuryValidator + + hasTreasuryScriptInput :: Bool + hasTreasuryScriptInput = any (`credentialInList` treasuryCredential) scriptCredentials + + hasCompanionInput :: Bool + hasCompanionInput = hasConfigInput || hasTreasuryScriptInput + + hasOnlyAllowedInputs :: Bool + hasOnlyAllowedInputs = all (\cred -> credentialInList cred allowedBurnCredentials) scriptCredentials + + hasSingleTallyInput :: Bool + hasSingleTallyInput = length (filter (== tallyCredential) scriptCredentials) == 1 in - traceIfFalse "Tally is active" tallyingIsInactive - && traceIfFalse "Unexpected scripts" expectedScripts - && traceIfFalse "Not all vote tokens and Ada returned" voteNftAndAdaToVoters - && traceIfFalse "Not all vote tokens are burned" voteTokenAreAllBurned - && traceIfFalse "Tally datum is not updated" tallyDatumIsUpdated - && traceIfFalse "Old value is not as big as new value" newValueIsAtleastAsBigAsOldValue + if isTallyBeingBurned + then + traceIfFalse "Tally burn must include treasury or configuration input" hasCompanionInput + && traceIfFalse "Unexpected script credentials while burning tally" hasOnlyAllowedInputs + && traceIfFalse "More than one tally input" hasSingleTallyInput + else -- Normal vote counting flow: validate continuing output and vote counting + + let + -- Make sure there is only one tally and many votes (only for vote counting) + expectedScripts :: Bool + !expectedScripts = hasExpectedScripts txInfoInputs thisValidatorHash dynamicConfigDatum'voteValidator + + tallyingIsInactive :: Bool + !tallyingIsInactive = tallyStateDatum'proposalEndTime `before` txInfoValidRange + + -- Check that Value contains the 'voteNft' token + -- This acts like a pass token that allows the user to vote + hasVotePassToken :: Value -> Maybe Value + hasVotePassToken (Value v) = + case filter (\(k, _) -> dynamicConfigDatum'voteNft == k) (M.toList v) of + [] -> Nothing + xs@[_] -> Just (Value (M.fromList xs)) + _ -> traceError "Too many vote nfts" + + -- Check for the presence of the vote token minted by + -- the 'mkVoteMinter' policy when casting a vote on a proposal + hasVoteWitness :: Value -> Bool + hasVoteWitness = hasOneOfToken dynamicConfigDatum'voteCurrencySymbol dynamicConfigDatum'voteTokenName + + thisTallyTokenName :: TokenName + thisTallyTokenName = getTokenNameOfNft dynamicConfigDatum'tallyNft oldValue "Tally Nft" + + -- Helper for loop that counts the votes + stepVotes :: + TxInInfo -> + (Integer, Integer, Map Address Value) -> + (Integer, Integer, Map Address Value) + stepVotes + TxInInfo {txInInfoResolved = TxOut {..}} + oldAcc@(oldForCount, oldAgainstCount, oldPayoutMap) = + case (hasVotePassToken txOutValue, hasVoteWitness txOutValue) of + (Just voteNft, True) -> + let + VoteDatum {..} = convertDatum txInfoData txOutDatum + + -- Count all the dynamicConfigDatum'voteFungibleCurrencySymbol + -- with dynamicConfigDatum'voteFungibleTokenName tokens on the vote utxo + fungibleTokens :: Integer + !fungibleTokens = + countOfTokenInValue + dynamicConfigDatum'voteFungibleCurrencySymbol + dynamicConfigDatum'voteFungibleTokenName + txOutValue + + -- Calculate fungible votes using the dynamicConfigDatum'fungibleVotePercent + fungibleVotes :: Integer + !fungibleVotes + | fungibleTokens == 0 = 0 + | otherwise = (fungibleTokens * dynamicConfigDatum'fungibleVotePercent) `divide` 1000 + + -- Add the lovelaces and the NFT + votePayout :: Value + !votePayout = + if fungibleTokens == 0 + then Value (M.insert adaSymbol (M.singleton adaToken voteDatum'returnAda) (getValue voteNft)) + else + Value $ + M.insert + dynamicConfigDatum'voteFungibleCurrencySymbol + (M.singleton dynamicConfigDatum'voteFungibleTokenName fungibleTokens) + ( M.insert + adaSymbol + (M.singleton adaToken voteDatum'returnAda) + (getValue voteNft) + ) + + checkProposal :: Bool + !checkProposal = voteDatum'proposalTokenName == thisTallyTokenName + + newForCount :: Integer + !newForCount = oldForCount + if voteDatum'direction == VoteDirection'For then 1 + fungibleVotes else 0 + + newAgainstCount :: Integer + !newAgainstCount = + oldAgainstCount + + if voteDatum'direction == VoteDirection'For then 0 else 1 + fungibleVotes + + newPayoutMap :: Map Address Value + !newPayoutMap = mergePayouts voteDatum'voteOwner votePayout oldPayoutMap + in + if checkProposal + then (newForCount, newAgainstCount, newPayoutMap) + else traceError "wrong vote proposal" + _ -> oldAcc + + -- Collect the votes + -- Make sure the votes are for the right proposal + -- Make sure the votes have the vote witness + (!forCount, !againstCount, !payoutMap) :: (Integer, Integer, Map Address Value) = + foldr stepVotes (0, 0, M.empty) txInfoInputs + + -- Helper for ensuring the vote NFT and ada are returned to the owner + addressedIsPaid :: [TxOut] -> (Address, Value) -> Bool + addressedIsPaid outputs (addr, value) = valuePaidTo' outputs addr `geq` value + + voteNftAndAdaToVoters :: Bool + !voteNftAndAdaToVoters = all (addressedIsPaid txInfoOutputs) (M.toList payoutMap) + + voteTokenAreAllBurned :: Bool + !voteTokenAreAllBurned = not $ any (hasVoteWitness . txOutValue) txInfoOutputs + + (!newValue, !newDatum) :: (Value, TallyStateDatum) = + case filter (\TxOut {txOutAddress} -> txOutAddress == thisValidatorAddress) txInfoOutputs of + [TxOut {..}] -> (txOutValue, convertDatum txInfoData txOutDatum) + _ -> traceError "Wrong number of continuing outputs" + + -- Ensure the tally NFT remains at the validator + newValueIsAtleastAsBigAsOldValue :: Bool + !newValueIsAtleastAsBigAsOldValue = newValue `geq` oldValue + + -- Ensure exactly 2 assets (ADA + Tally NFT) to prevent dust attacks + noDustTokens :: Bool + !noDustTokens = hasExactAssetCount newValue 2 + + -- Ensure the tally datum is updated + tallyDatumIsUpdated :: Bool + !tallyDatumIsUpdated = + newDatum + == ts + { tallyStateDatum'for = oldFor + forCount + , tallyStateDatum'against = oldAgainst + againstCount + } + in + traceIfFalse "Tally is active" tallyingIsInactive + && traceIfFalse "Unexpected scripts" expectedScripts + && traceIfFalse "Not all vote tokens and Ada returned" voteNftAndAdaToVoters + && traceIfFalse "Not all vote tokens are burned" voteTokenAreAllBurned + && traceIfFalse "Tally datum is not updated" tallyDatumIsUpdated + && traceIfFalse "Old value is not as big as new value" newValueIsAtleastAsBigAsOldValue + && traceIfFalse "Continuing output contains dust tokens" noDustTokens validateTally _ _ _ _ = traceError "Wrong script purpose" tallyValidatorCompiledCode :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> BuiltinData -> ()) diff --git a/dao/dao-lib/Dao/Treasury/Script.hs b/dao/dao-lib/Dao/Treasury/Script.hs index a3dd1ce..c5eec75 100644 --- a/dao/dao-lib/Dao/Treasury/Script.hs +++ b/dao/dao-lib/Dao/Treasury/Script.hs @@ -21,10 +21,11 @@ import Dao.ScriptArgument ( ) import Dao.Shared ( convertDatum, + hasBurnedTokens, + hasExactAssetCount, hasOneOfToken, hasSingleTokenWithSymbolAndTokenName, hasSymbolInValue, - hasTokenInValue, isScriptCredential, lovelacesOf, untypedPolicy, @@ -38,7 +39,9 @@ import LambdaBuffers.ApplicationTypes.Configuration ( dynamicConfigDatum'generalRelativeMajorityPercent, dynamicConfigDatum'maxGeneralDisbursement, dynamicConfigDatum'maxTripDisbursement, + dynamicConfigDatum'minTreasuryValue, dynamicConfigDatum'proposalTallyEndOffset, + dynamicConfigDatum'protocolFallbackAddress, dynamicConfigDatum'tallyNft, dynamicConfigDatum'totalVotes, dynamicConfigDatum'tripMajorityPercent, @@ -63,6 +66,9 @@ import LambdaBuffers.ApplicationTypes.Tally ( tallyStateDatum'proposalEndTime ), ) +import LambdaBuffers.ApplicationTypes.Treasury ( + TreasuryDatum (TreasuryDatum), + ) import PlutusLedgerApi.V1.Address (Address (Address, addressCredential)) import PlutusLedgerApi.V1.Credential (Credential (ScriptCredential)) import PlutusLedgerApi.V1.Interval (before) @@ -119,15 +125,18 @@ import PlutusTx.Prelude ( mapMaybe, mconcat, min, + not, otherwise, traceError, traceIfFalse, + ($), (&&), (*), (+), (-), (.), (/=), + (<), (==), (>=), ) @@ -193,18 +202,18 @@ import PlutusTx.Prelude ( the 'proposalTallyEndOffset' of the 'DynamicConfigDatum' against the validity range of the transaction. Ensuring the sum of these values is less than the range. - - That exactly one 'upgradeMinter' token was minted. The CurrencySymbol for this token - is provided as the field of the 'Upgrade' constructor of the Proposal type. + - That the tally NFT is burned to prevent double-funding or reuse of the proposal. + (Previously ensured by minting a separate upgrade token.) -} validateTreasury :: ValidatorParams -> - BuiltinData -> + TreasuryDatum -> BuiltinData -> ScriptContext -> Bool validateTreasury ValidatorParams {..} - _treasury + _treasuryDatum _action ScriptContext { scriptContextTxInfo = TxInfo {..} @@ -214,6 +223,56 @@ validateTreasury -- Check that there is only one of this script in the inputs (!inputValue, !thisValidator) :: (Value, ScriptHash) = ownValueAndValidator txInfoInputs thisTxRef + -- Get the full address of this treasury validator (including staking credential) + thisValidatorAddress :: Address + thisValidatorAddress = case filter (\TxInInfo {txInInfoOutRef} -> txInInfoOutRef == thisTxRef) txInfoInputs of + [TxInInfo {txInInfoResolved = TxOut {txOutAddress}}] -> txOutAddress + _ -> traceError "Treasury input" + + validateRouting :: Value -> Bool + validateRouting remainingValue = + let + remainingLovelaces :: Integer + !remainingLovelaces = lovelacesOf remainingValue + + isBelowThreshold :: Bool + !isBelowThreshold = remainingLovelaces < dynamicConfigDatum'minTreasuryValue + in + if isBelowThreshold + then + let + noContinuingOutput :: Bool + !noContinuingOutput = case getContinuingOutputs' thisValidatorAddress txInfoOutputs of + [] -> True + _ -> False + + fallbackValue :: Value + !fallbackValue = valuePaidTo' txInfoOutputs dynamicConfigDatum'protocolFallbackAddress + + sentToFallback :: Bool + !sentToFallback = fallbackValue `geq` remainingValue + in + traceIfFalse "Below threshold" noContinuingOutput + && traceIfFalse "Fallback" sentToFallback + else case getContinuingOutputs' thisValidatorAddress txInfoOutputs of + [TxOut {txOutValue = val, txOutDatum = datum}] -> + let + continuingDatum :: TreasuryDatum = convertDatum txInfoData datum + + validDatum :: Bool + !validDatum = continuingDatum == TreasuryDatum True + + valueIsCorrect :: Bool + !valueIsCorrect = val `geq` remainingValue + + noDustTokens :: Bool + !noDustTokens = hasExactAssetCount val 1 + in + traceIfFalse "Invalid continuing treasury datum" validDatum + && traceIfFalse "Disbursing too much" valueIsCorrect + && traceIfFalse "Continuing output contains dust tokens" noDustTokens + _ -> traceError "Should be exactly one continuing treasury output" + -- Helper for filtering for config UTXO hasConfigurationNft :: Value -> Bool hasConfigurationNft = hasOneOfToken vpConfigSymbol vpConfigTokenName @@ -222,18 +281,24 @@ validateTreasury DynamicConfigDatum {..} = case filter (hasConfigurationNft . txOutValue . txInInfoResolved) txInfoReferenceInputs of [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum - _ -> traceError "Should be exactly one config in the reference inputs" + _ -> traceError "Config ref" -- Helper for filtering for tally UTXO hasTallyNft :: Value -> Bool hasTallyNft = hasSymbolInValue dynamicConfigDatum'tallyNft - -- Get the TallyStateDatum from the reference inputs, should be exactly one + -- Get the TallyStateDatum from the spent inputs (not reference), should be exactly one + -- This prevents the same proposal from being funded multiple times TallyStateDatum {..} = - case filter (hasTallyNft . txOutValue . txInInfoResolved) txInfoReferenceInputs of - [] -> traceError "Missing tally NFT" + case filter (hasTallyNft . txOutValue . txInInfoResolved) txInfoInputs of + [] -> traceError "Tally missing" [TxInInfo {txInInfoResolved = TxOut {..}}] -> convertDatum txInfoData txOutDatum - _ -> traceError "Too many tally NFT values" + _ -> traceError "Tally count" + + -- Verify the Tally NFT is being burned + -- This ensures the proposal cannot be funded again + tallyNftIsBurned :: Bool + !tallyNftIsBurned = hasBurnedTokens dynamicConfigDatum'tallyNft txInfoMint "Tally NFT burn" -- Calculate the values needed for the corresponding checks totalVotes :: Integer @@ -272,15 +337,11 @@ validateTreasury travelerLovelaces :: Integer !travelerLovelaces = totalTravelCost - travelAgentLovelaces - -- Make sure the disbursed amount is less than the max - -- Find the total value returned to the script address - outputValue :: Value - !outputValue = case getContinuingOutputs' thisValidator txInfoOutputs of - [TxOut {..}] -> txOutValue - _ -> traceError "Should be exactly one continuing treasury output" + remainingValue :: Value + !remainingValue = inputValue - disbursedAmount - outputValueIsLargeEnough :: Bool - !outputValueIsLargeEnough = outputValue `geq` (inputValue - disbursedAmount) + routingIsValid :: Bool + !routingIsValid = validateRouting remainingValue -- Paid the ptGeneralPaymentAddress the ptGeneralPaymentValue paidToTravelAgentAddress :: Bool @@ -290,12 +351,24 @@ validateTreasury paidToTravelerAddress :: Bool !paidToTravelerAddress = lovelacesOf (valuePaidTo' txInfoOutputs travelerAddress) >= travelerLovelaces + + -- Ensure payment addresses are not script addresses + travelAgentIsNotScript :: Bool + !travelAgentIsNotScript = + not $ isScriptCredential (addressCredential travelAgentAddress) + + travelerIsNotScript :: Bool + !travelerIsNotScript = + not $ isScriptCredential (addressCredential travelerAddress) in traceIfFalse "The proposal doesn't have enough votes" hasEnoughVotes - && traceIfFalse "Disbursing too much" outputValueIsLargeEnough + && routingIsValid && traceIfFalse "Not paying enough to the travel agent address" paidToTravelAgentAddress && traceIfFalse "Not paying enough to the traveler address" paidToTravelerAddress + && traceIfFalse "Travel agent address cannot be script address" travelAgentIsNotScript + && traceIfFalse "Traveler address cannot be script address" travelerIsNotScript && traceIfFalse "Tallying not over. Try again later" isAfterTallyEndTime + && tallyNftIsBurned ProposalType'General generalPaymentAddress generalPaymentValue -> let hasEnoughVotes :: Bool @@ -315,26 +388,29 @@ validateTreasury adaToken (min dynamicConfigDatum'maxGeneralDisbursement generalPaymentValue) - -- Make sure the disbursed amount is less than the max - -- Find the total value returned to the script address - outputValue :: Value - !outputValue = case getContinuingOutputs' thisValidator txInfoOutputs of - [TxOut {..}] -> txOutValue - _ -> traceError "expected exactly one continuing output" + remainingValue :: Value + !remainingValue = inputValue - disbursedAmount - outputValueIsLargeEnough :: Bool - !outputValueIsLargeEnough = outputValue `geq` (inputValue - disbursedAmount) + routingIsValid :: Bool + !routingIsValid = validateRouting remainingValue -- Paid the ptGeneralPaymentAddress the ptGeneralPaymentValue paidToAddress :: Bool !paidToAddress = lovelacesOf (valuePaidTo' txInfoOutputs generalPaymentAddress) >= generalPaymentValue + + -- Ensure payment address is not a script address + generalPaymentIsNotScript :: Bool + !generalPaymentIsNotScript = + not $ isScriptCredential (addressCredential generalPaymentAddress) in traceIfFalse "The proposal doesn't have enough votes" hasEnoughVotes - && traceIfFalse "Disbursing too much" outputValueIsLargeEnough + && routingIsValid && traceIfFalse "Not paying to the correct address" paidToAddress + && traceIfFalse "General payment address cannot be script address" generalPaymentIsNotScript && traceIfFalse "Tallying not over. Try again later" isAfterTallyEndTime - ProposalType'Upgrade upgradeMinter -> + && tallyNftIsBurned + ProposalType'Upgrade maybeNewTreasuryAddress -> let hasEnoughVotes :: Bool !hasEnoughVotes = @@ -345,13 +421,36 @@ validateTreasury "majority is too small" (majorityPercent >= dynamicConfigDatum'upgradeMajorityPercent) - -- Make sure the upgrade token was minted - hasUpgradeMinterToken :: Bool - !hasUpgradeMinterToken = hasTokenInValue upgradeMinter "Treasury Minter" txInfoMint + -- Validate treasury migration based on Maybe Address + treasuryMigrationValid :: Bool + !treasuryMigrationValid = case maybeNewTreasuryAddress of + Nothing -> + -- Config-only upgrade: Treasury should NOT be spent + -- This validator only runs if Treasury is being spent, so this should fail + traceError "Upgrade does not allow Treasury spending (config-only upgrade)" + Just newTreasuryAddress -> + -- Treasury migration: Validate all funds go to new address + let + -- Ensure no continuing output to old Treasury + noContinuingOutput :: Bool + !noContinuingOutput = case getContinuingOutputs' thisValidatorAddress txInfoOutputs of + [] -> True + _ -> False + + fundsToNewTreasury :: Value + !fundsToNewTreasury = valuePaidTo' txInfoOutputs newTreasuryAddress + + -- Verify all funds sent to new treasury address + fundsSentToNewTreasury :: Bool + !fundsSentToNewTreasury = fundsToNewTreasury `geq` inputValue + in + traceIfFalse "Treasury migration: continuing output to old treasury detected" noContinuingOutput + && traceIfFalse "Treasury migration: funds not fully transferred to new address" fundsSentToNewTreasury in traceIfFalse "The proposal doesn't have enough votes" hasEnoughVotes - && traceIfFalse "Not minting upgrade token" hasUpgradeMinterToken + && treasuryMigrationValid && traceIfFalse "Tallying not over. Try again later" isAfterTallyEndTime + && tallyNftIsBurned validateTreasury _ _ _ _ = traceError "Wrong script purpose" addressOutputsAt :: Address -> [TxOut] -> [Value] @@ -367,15 +466,11 @@ valuePaidTo' :: [TxOut] -> Address -> Value valuePaidTo' outs addr = mconcat (addressOutputsAt addr outs) getContinuingOutputs' :: - ScriptHash -> + Address -> [TxOut] -> [TxOut] -getContinuingOutputs' vh = - filter - ( \TxOut {..} -> - addressCredential txOutAddress - == ScriptCredential vh - ) +getContinuingOutputs' expectedAddr = + filter (\TxOut {txOutAddress} -> txOutAddress == expectedAddr) ownValueAndValidator :: [TxInInfo] -> TxOutRef -> (Value, ScriptHash) ownValueAndValidator ins txOutRef = go ins diff --git a/dao/dao-specs/Spec/Configuration/Script.hs b/dao/dao-specs/Spec/Configuration/Script.hs index 10cb976..97447b6 100644 --- a/dao/dao-specs/Spec/Configuration/Script.hs +++ b/dao/dao-specs/Spec/Configuration/Script.hs @@ -5,6 +5,7 @@ Description : Configuration scripts module Spec.Configuration.Script ( -- * Validator upgradeConfigNftTypedValidator, + configurationValidatorScriptHash, -- * Minting policy configNftTypedMintingPolicy, @@ -20,8 +21,10 @@ import Plutus.Model.V2 ( mkTypedPolicy, mkTypedValidator, scriptCurrencySymbol, + scriptHash, toBuiltinPolicy, ) +import PlutusLedgerApi.V1.Scripts (ScriptHash) import PlutusLedgerApi.V1.Value (CurrencySymbol) import PlutusTx qualified import PlutusTx.Prelude (BuiltinData, ($), (.)) @@ -53,3 +56,6 @@ compiledConfigValidator :: PlutusTx.CompiledCode (ValidatorParams -> (BuiltinData -> BuiltinData -> BuiltinData -> ())) compiledConfigValidator = $$(PlutusTx.compile [||mkUntypedValidator . validateConfiguration||]) + +configurationValidatorScriptHash :: ScriptHash +configurationValidatorScriptHash = scriptHash upgradeConfigNftTypedValidator diff --git a/dao/dao-specs/Spec/Configuration/Transactions.hs b/dao/dao-specs/Spec/Configuration/Transactions.hs index b0bc2a3..65f0e77 100644 --- a/dao/dao-specs/Spec/Configuration/Transactions.hs +++ b/dao/dao-specs/Spec/Configuration/Transactions.hs @@ -1,6 +1,8 @@ module Spec.Configuration.Transactions ( runInitConfig, runHighRelativeMajorityTotalVotesInitConfig, + runInitTreasuryTestConfig, + runInitHighThresholdTreasuryTestConfig, ) where import Plutus.Model (Run) @@ -8,6 +10,8 @@ import Spec.Configuration.Script (upgradeConfigNftTypedValidator) import Spec.SampleData ( sampleDynamicConfig, sampleHighRelativeMajorityHighTotalVotesDynamicConfig, + sampleHighThresholdTreasuryTestDynamicConfig, + sampleTreasuryTestDynamicConfig, ) import Spec.SpecUtils (runInitReferenceScript) import Spec.Values (dummyConfigNftValue) @@ -25,3 +29,19 @@ runHighRelativeMajorityTotalVotesInitConfig = upgradeConfigNftTypedValidator sampleHighRelativeMajorityHighTotalVotesDynamicConfig dummyConfigNftValue + +-- Special config for Treasury tests that uses alwaysSucceed for tally burning (ID-501) +runInitTreasuryTestConfig :: Run () +runInitTreasuryTestConfig = + runInitReferenceScript + upgradeConfigNftTypedValidator + sampleTreasuryTestDynamicConfig + dummyConfigNftValue + +-- Special config for negative Treasury tests (high threshold + alwaysSucceed tally) +runInitHighThresholdTreasuryTestConfig :: Run () +runInitHighThresholdTreasuryTestConfig = + runInitReferenceScript + upgradeConfigNftTypedValidator + sampleHighThresholdTreasuryTestDynamicConfig + dummyConfigNftValue diff --git a/dao/dao-specs/Spec/SampleData.hs b/dao/dao-specs/Spec/SampleData.hs index 89a36ec..b9d2f00 100644 --- a/dao/dao-specs/Spec/SampleData.hs +++ b/dao/dao-specs/Spec/SampleData.hs @@ -1,24 +1,47 @@ module Spec.SampleData ( sampleDynamicConfig, sampleHighRelativeMajorityHighTotalVotesDynamicConfig, + sampleTreasuryTestDynamicConfig, + sampleHighThresholdTreasuryTestDynamicConfig, + sampleTallyPolicyParams, ) where +import Dao.ScriptArgument (TallyPolicyParams (TallyPolicyParams)) import LambdaBuffers.ApplicationTypes.Configuration (DynamicConfigDatum (..)) -import PlutusLedgerApi.V1.Scripts (ScriptHash (ScriptHash)) import PlutusLedgerApi.V1.Value (TokenName (TokenName), adaToken) +import Spec.Addresses (dummyGeneralPaymentAddress) +import Spec.AlwaysSucceed.Script (alwaysSucceedCurrencySymbol) import Spec.Configuration.SampleData (sampleValidatorParams) -import Spec.Tally.Script (tallyValidatorScriptHash) +import Spec.Configuration.Script (configurationValidatorScriptHash) +import Spec.Tally.Script (tallyConfigNftCurrencySymbol, tallyValidatorScriptHash) import Spec.Treasury.Script (treasuryValidatorScriptHash) -import Spec.Values (dummyTallySymbol, dummyVoteFungibleSymbol, dummyVoteNFTSymbol) +import Spec.Values ( + dummyConfigNftSymbol, + dummyConfigNftTokenName, + dummyIndexConfigNftSymbol, + dummyIndexConfigNftTokenName, + dummyTallySymbol, + dummyVoteFungibleSymbol, + dummyVoteNFTSymbol, + ) import Spec.Vote.Script (voteCurrencySymbol, voteValidatorScriptHash) +-- Shared tally policy params used across tests +sampleTallyPolicyParams :: TallyPolicyParams +sampleTallyPolicyParams = + TallyPolicyParams + dummyIndexConfigNftSymbol + dummyIndexConfigNftTokenName + dummyConfigNftSymbol + dummyConfigNftTokenName + -- DynamicConfigDatum samples sampleDynamicConfig :: DynamicConfigDatum sampleDynamicConfig = DynamicConfigDatum { dynamicConfigDatum'treasuryValidator = treasuryValidatorScriptHash , dynamicConfigDatum'tallyValidator = tallyValidatorScriptHash - , dynamicConfigDatum'configurationValidator = ScriptHash "" + , dynamicConfigDatum'configurationValidator = configurationValidatorScriptHash , dynamicConfigDatum'voteValidator = voteValidatorScriptHash , dynamicConfigDatum'upgradeMajorityPercent = 1 , dynamicConfigDatum'upgradeRelativeMajorityPercent = 1 @@ -31,13 +54,15 @@ sampleDynamicConfig = , dynamicConfigDatum'maxTripDisbursement = 1 , dynamicConfigDatum'agentDisbursementPercent = 1 , dynamicConfigDatum'proposalTallyEndOffset = 0 - , dynamicConfigDatum'tallyNft = dummyTallySymbol + , dynamicConfigDatum'tallyNft = dummyTallySymbol -- Use dummy for simplified tests , dynamicConfigDatum'voteCurrencySymbol = voteCurrencySymbol sampleValidatorParams , dynamicConfigDatum'voteTokenName = TokenName "vote" , dynamicConfigDatum'voteNft = dummyVoteNFTSymbol , dynamicConfigDatum'voteFungibleCurrencySymbol = dummyVoteFungibleSymbol , dynamicConfigDatum'voteFungibleTokenName = adaToken , dynamicConfigDatum'fungibleVotePercent = 1 + , dynamicConfigDatum'minTreasuryValue = 3_000_000 + , dynamicConfigDatum'protocolFallbackAddress = dummyGeneralPaymentAddress } sampleHighRelativeMajorityHighTotalVotesDynamicConfig :: DynamicConfigDatum @@ -45,7 +70,7 @@ sampleHighRelativeMajorityHighTotalVotesDynamicConfig = DynamicConfigDatum { dynamicConfigDatum'treasuryValidator = treasuryValidatorScriptHash , dynamicConfigDatum'tallyValidator = tallyValidatorScriptHash - , dynamicConfigDatum'configurationValidator = ScriptHash "" + , dynamicConfigDatum'configurationValidator = configurationValidatorScriptHash , dynamicConfigDatum'voteValidator = voteValidatorScriptHash , dynamicConfigDatum'upgradeMajorityPercent = 1 , dynamicConfigDatum'upgradeRelativeMajorityPercent = 70 @@ -59,11 +84,27 @@ sampleHighRelativeMajorityHighTotalVotesDynamicConfig = , dynamicConfigDatum'maxTripDisbursement = 1 , dynamicConfigDatum'agentDisbursementPercent = 1 , dynamicConfigDatum'proposalTallyEndOffset = 0 - , dynamicConfigDatum'tallyNft = dummyTallySymbol + , dynamicConfigDatum'tallyNft = dummyTallySymbol -- Use dummy for simplified tests , dynamicConfigDatum'voteCurrencySymbol = voteCurrencySymbol sampleValidatorParams , dynamicConfigDatum'voteTokenName = TokenName "vote" , dynamicConfigDatum'voteNft = dummyVoteNFTSymbol , dynamicConfigDatum'voteFungibleCurrencySymbol = dummyVoteFungibleSymbol , dynamicConfigDatum'voteFungibleTokenName = adaToken , dynamicConfigDatum'fungibleVotePercent = 1 + , dynamicConfigDatum'minTreasuryValue = 3_000_000 + , dynamicConfigDatum'protocolFallbackAddress = dummyGeneralPaymentAddress + } + +-- Special config for Treasury tests that uses alwaysSucceed currency for tally burning (ID-501) +sampleTreasuryTestDynamicConfig :: DynamicConfigDatum +sampleTreasuryTestDynamicConfig = + sampleDynamicConfig + { dynamicConfigDatum'tallyNft = alwaysSucceedCurrencySymbol -- Use alwaysSucceed so we can burn + } + +-- Special config for negative Treasury tests (high threshold + alwaysSucceed tally) +sampleHighThresholdTreasuryTestDynamicConfig :: DynamicConfigDatum +sampleHighThresholdTreasuryTestDynamicConfig = + sampleHighRelativeMajorityHighTotalVotesDynamicConfig + { dynamicConfigDatum'tallyNft = alwaysSucceedCurrencySymbol -- Use alwaysSucceed so we can burn } diff --git a/dao/dao-specs/Spec/SpecUtils.hs b/dao/dao-specs/Spec/SpecUtils.hs index 9ed9a37..7428f29 100644 --- a/dao/dao-specs/Spec/SpecUtils.hs +++ b/dao/dao-specs/Spec/SpecUtils.hs @@ -3,6 +3,7 @@ module Spec.SpecUtils ( runInitReferenceScript, checkFails, mkTypedValidator', + mkTypedValidatorOptimized, getFirstRefScript, minAda, amountOfAda, @@ -16,6 +17,7 @@ module Spec.SpecUtils ( ) where import Dao.Shared (hasOneOfToken) +import Plutonomy (aggressiveOptimizerOptions, optimizeUPLCWith) import Plutus.Model ( Ada (Lovelace), IsValidator, @@ -129,6 +131,14 @@ mkTypedValidator' :: TypedValidator datum redeemer mkTypedValidator' mkValidator = mkTypedValidator . mkValidator +-- | Version with Plutonomy optimization applied (removes traces, optimizes code) +mkTypedValidatorOptimized :: + (config -> CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ())) -> + config -> + TypedValidator datum redeemer +mkTypedValidatorOptimized mkValidator config = + mkTypedValidator $ optimizeUPLCWith aggressiveOptimizerOptions (mkValidator config) + data ScriptType = Reference | Script deriving stock (Eq) diff --git a/dao/dao-specs/Spec/Tally.hs b/dao/dao-specs/Spec/Tally.hs index 737538e..15c750e 100644 --- a/dao/dao-specs/Spec/Tally.hs +++ b/dao/dao-specs/Spec/Tally.hs @@ -20,7 +20,7 @@ import Spec.Tally.Context ( invalidWrongTokenNameTallyConfigNftTest, validTallyConfigNftTest, ) -import Spec.Values (dummyConfigNftValue, dummyIndexConfigNftValue) +import Spec.Values (dummyConfigNftValue, dummyIndexConfigNftValue, dummyVoteNFTValue) import Test.Tasty (TestTree, testGroup) import Prelude ((<>)) @@ -70,4 +70,4 @@ nftSpec config = bad "Doesn't spend index, should fail with balancing error" invalidDoesNotSpendIndexConfigNftTest - initialFunds = adaValue 10_000_000 <> dummyConfigNftValue <> dummyIndexConfigNftValue + initialFunds = adaValue 10_000_000 <> dummyConfigNftValue <> dummyIndexConfigNftValue <> dummyVoteNFTValue diff --git a/dao/dao-specs/Spec/Tally/Context.hs b/dao/dao-specs/Spec/Tally/Context.hs index 8bba460..bf85838 100644 --- a/dao/dao-specs/Spec/Tally/Context.hs +++ b/dao/dao-specs/Spec/Tally/Context.hs @@ -26,6 +26,7 @@ import Plutus.Model ( ) import Plutus.Model.V2 ( DatumMode (InlineDatum), + payToKey, payToScript, refInputInline, spendScript, @@ -51,7 +52,9 @@ import Spec.Values ( dummyIndexConfigNftSymbol, dummyIndexConfigNftTokenName, dummyIndexConfigNftValue, + dummyVoteNFTValue, ) +import Spec.Vote.Transactions (runInitVoteNft) import Prelude (mconcat, mempty, (+), (<>)) validTallyConfigNftTest :: Run () @@ -132,8 +135,11 @@ mkTallyConfigTest tallyConfigValue incrementIndex configRef spendIndex = do fromBuiltinIndex :: Maybe IndexDatum fromBuiltinIndex = fromBuiltinData builtinIndex - user <- newUser $ amountOfAda 4_000_000 - spend1 <- spend user (adaValue 2_000_002) + -- Initialize vote NFT first (like Vote tests do) + runInitVoteNft + -- User needs vote NFT for policy requirement (ID-303) + user <- newUser $ amountOfAda 4_000_000 <> dummyVoteNFTValue + spend1 <- spend user (adaValue 2_000_002 <> dummyVoteNFTValue) spend2 <- spend user (adaValue 4_000_000) let config = @@ -164,7 +170,7 @@ mkTallyConfigTest tallyConfigValue incrementIndex configRef spendIndex = do , -- \^ Mint the tally NFT userSpend spend1 , userSpend spend2 - -- \^ Spend these to balance the tx + -- \^ Spend these to balance the tx (vote NFT in spend1 for policy requirement) ] -- Valid tx has the config in the reference inputs diff --git a/dao/dao-specs/Spec/Tally/SampleData.hs b/dao/dao-specs/Spec/Tally/SampleData.hs index d8760c9..d5ca621 100644 --- a/dao/dao-specs/Spec/Tally/SampleData.hs +++ b/dao/dao-specs/Spec/Tally/SampleData.hs @@ -34,12 +34,14 @@ import LambdaBuffers.ApplicationTypes.Tally ( ), ) import PlutusLedgerApi.V1.Time (POSIXTime (POSIXTime)) +import PlutusTx.Prelude ( + Maybe (Just), + ) import Spec.Addresses ( dummyGeneralPaymentAddress, dummyTravelAgentAddress, dummyTravelerPaymentAddress, ) -import Spec.AlwaysSucceed.Script (alwaysSucceedCurrencySymbol) sampleUpgradeWithEndTimeInPastTallyStateDatum :: TallyStateDatum sampleUpgradeWithEndTimeInPastTallyStateDatum = @@ -150,7 +152,7 @@ sampleGeneralWithEndTimeInPastTallyStateDatum = } sampleUpgradeProposalType :: ProposalType -sampleUpgradeProposalType = ProposalType'Upgrade alwaysSucceedCurrencySymbol +sampleUpgradeProposalType = ProposalType'Upgrade (Just dummyGeneralPaymentAddress) sampleGeneralProposalType :: ProposalType sampleGeneralProposalType = ProposalType'General dummyGeneralPaymentAddress 1 diff --git a/dao/dao-specs/Spec/Tally/Script.hs b/dao/dao-specs/Spec/Tally/Script.hs index bb1163a..d7fa81e 100644 --- a/dao/dao-specs/Spec/Tally/Script.hs +++ b/dao/dao-specs/Spec/Tally/Script.hs @@ -31,7 +31,7 @@ import PlutusLedgerApi.V1.Value (CurrencySymbol, Value, singleton) import PlutusTx qualified import PlutusTx.Prelude (BuiltinData, ($), (.)) import Spec.Configuration.SampleData (sampleValidatorParams) -import Spec.SpecUtils (mkUntypedValidator) +import Spec.SpecUtils (mkTypedValidatorOptimized, mkUntypedValidator) -- Policy script and info tallyConfigNftTypedMintingPolicy :: TallyPolicyParams -> TypedPolicy () @@ -57,9 +57,9 @@ tallyValidatorScriptHash :: ScriptHash tallyValidatorScriptHash = scriptHash tallyNftTypedValidator tallyTypedValidator' :: ValidatorParams -> TallyValidatorScript -tallyTypedValidator' config = - mkTypedValidator - (compiledTallyValidator `PlutusTx.applyCode` PlutusTx.liftCode config) +tallyTypedValidator' = + mkTypedValidatorOptimized + (\config -> compiledTallyValidator `PlutusTx.applyCode` PlutusTx.liftCode config) compiledTallyValidator :: PlutusTx.CompiledCode (ValidatorParams -> (BuiltinData -> BuiltinData -> BuiltinData -> ())) diff --git a/dao/dao-specs/Spec/Tally/Transactions.hs b/dao/dao-specs/Spec/Tally/Transactions.hs index aa73eac..1673318 100644 --- a/dao/dao-specs/Spec/Tally/Transactions.hs +++ b/dao/dao-specs/Spec/Tally/Transactions.hs @@ -13,6 +13,8 @@ module Spec.Tally.Transactions ( ) where import Plutus.Model (Run) +import PlutusLedgerApi.V1.Value (singleton) +import Spec.SampleData (sampleTallyPolicyParams) import Spec.SpecUtils (runInitPayToScript) import Spec.Tally.SampleData ( sampleGeneralWithEndTimeInFutureTallyStateDatum, @@ -27,82 +29,82 @@ import Spec.Tally.SampleData ( sampleUpgradeWithVotesEndTimeInFutureTallyStateDatum, sampleUpgradeWithVotesEndTimeInPastTallyStateDatum, ) -import Spec.Tally.Script (tallyNftTypedValidator) -import Spec.Values (dummyTallyValue) +import Spec.Tally.Script (tallyConfigNftCurrencySymbol, tallyNftTypedValidator) +import Spec.Values (dummyTallyTokenName) runInitTripTallyWithEndTimeInFutureNotEnoughVotes :: Run () runInitTripTallyWithEndTimeInFutureNotEnoughVotes = runInitPayToScript tallyNftTypedValidator sampleTripNotEnoughVotesEndTimeInFutureTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitTripTallyWithEndTimeInPastNotEnoughVotes :: Run () runInitTripTallyWithEndTimeInPastNotEnoughVotes = runInitPayToScript tallyNftTypedValidator sampleTripNotEnoughVotesEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitUpgradeTallyWithEndTimeInPastNotEnoughVotes :: Run () runInitUpgradeTallyWithEndTimeInPastNotEnoughVotes = runInitPayToScript tallyNftTypedValidator sampleUpgradeNotEnoughVotesEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitGeneralTallyWithEndTimeInFuture :: Run () runInitGeneralTallyWithEndTimeInFuture = runInitPayToScript tallyNftTypedValidator sampleGeneralWithEndTimeInFutureTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitGeneralTallyWithEndTimeInPast :: Run () runInitGeneralTallyWithEndTimeInPast = runInitPayToScript tallyNftTypedValidator sampleGeneralWithEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitTripTallyWithEndTimeInFuture :: Run () runInitTripTallyWithEndTimeInFuture = runInitPayToScript tallyNftTypedValidator sampleTripWithEndTimeInFutureTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitTripTallyWithEndTimeInPast :: Run () runInitTripTallyWithEndTimeInPast = runInitPayToScript tallyNftTypedValidator sampleTripWithEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitUpgradeTallyWithEndTimeInPast :: Run () runInitUpgradeTallyWithEndTimeInPast = runInitPayToScript tallyNftTypedValidator sampleUpgradeWithVotesEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitUpgradeWithVotesWithEndTimeInFutureTallyStateDatum :: Run () runInitUpgradeWithVotesWithEndTimeInFutureTallyStateDatum = runInitPayToScript tallyNftTypedValidator sampleUpgradeWithVotesEndTimeInFutureTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitTallyWithEndTimeInPast :: Run () runInitTallyWithEndTimeInPast = runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInPastTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) runInitTallyWithEndTimeInFuture :: Run () runInitTallyWithEndTimeInFuture = runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInFutureTallyStateDatum - dummyTallyValue + (singleton (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName 1) diff --git a/dao/dao-specs/Spec/Tally/Utils.hs b/dao/dao-specs/Spec/Tally/Utils.hs index 1966276..8a8897f 100644 --- a/dao/dao-specs/Spec/Tally/Utils.hs +++ b/dao/dao-specs/Spec/Tally/Utils.hs @@ -3,16 +3,14 @@ module Spec.Tally.Utils (findTally) where import LambdaBuffers.ApplicationTypes.Tally (TallyStateDatum) import Plutus.Model (Run) import PlutusLedgerApi.V2.Tx (TxOut, TxOutRef) +import Spec.SampleData (sampleTallyPolicyParams) import Spec.SpecUtils (findConfigUtxo) -import Spec.Tally.Script (tallyNftTypedValidator) -import Spec.Values ( - dummyTallySymbol, - dummyTallyTokenName, - ) +import Spec.Tally.Script (tallyConfigNftCurrencySymbol, tallyNftTypedValidator) +import Spec.Values (dummyTallyTokenName) findTally :: Run (TxOutRef, TxOut, TallyStateDatum) findTally = findConfigUtxo tallyNftTypedValidator - dummyTallySymbol + (tallyConfigNftCurrencySymbol sampleTallyPolicyParams) dummyTallyTokenName diff --git a/dao/dao-specs/Spec/Treasury.hs b/dao/dao-specs/Spec/Treasury.hs index e6ea809..59f69af 100644 --- a/dao/dao-specs/Spec/Treasury.hs +++ b/dao/dao-specs/Spec/Treasury.hs @@ -9,6 +9,8 @@ import Plutus.Model ( defaultBabbageV2, testNoErrors, ) +import PlutusLedgerApi.V1.Value (singleton) +import Spec.AlwaysSucceed.Script (alwaysSucceedCurrencySymbol) import Spec.SpecUtils (amountOfAda) import Spec.Treasury.Context ( invalidNotEnoughVotesTripTreasuryTest, @@ -16,7 +18,7 @@ import Spec.Treasury.Context ( validTripTreasuryTest, validUpgradeTreasuryTest, ) -import Spec.Values (dummyConfigNftValue, dummyTallyValue, dummyTreasuryValue) +import Spec.Values (dummyConfigNftValue, dummyIndexConfigNftValue, dummyTallyTokenName, dummyTreasuryValue, dummyVoteNFTValue) import Test.Tasty (TestTree, testGroup) import Prelude (mconcat) @@ -58,8 +60,10 @@ nftSpec config = initialFunds = mconcat - [ amountOfAda 20_000_000 + [ amountOfAda 50_000_000 -- Need more for runInitTreasuryWithFunds (4M) + disbursements , dummyConfigNftValue - , dummyTallyValue - , dummyTreasuryValue + , dummyIndexConfigNftValue + , singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 -- AlwaysSucceed tally (for burning per ID-501) + , dummyTreasuryValue -- Real treasury value (no separate policy tests) + , dummyVoteNFTValue ] diff --git a/dao/dao-specs/Spec/Treasury/Context.hs b/dao/dao-specs/Spec/Treasury/Context.hs index 3c53206..04b83e6 100644 --- a/dao/dao-specs/Spec/Treasury/Context.hs +++ b/dao/dao-specs/Spec/Treasury/Context.hs @@ -10,6 +10,7 @@ module Spec.Treasury.Context ( ) where import Control.Monad (when) +import LambdaBuffers.ApplicationTypes.Treasury (TreasuryDatum (TreasuryDatum)) import Plutus.Model ( Run, adaValue, @@ -30,7 +31,7 @@ import Plutus.Model.V2 ( ) import PlutusLedgerApi.V1.Interval (from) import PlutusLedgerApi.V1.Value (Value, adaToken, singleton) -import PlutusTx.Prelude (($)) +import PlutusTx.Prelude (Bool (True), ($)) import Spec.Addresses ( dummyGeneralPaymentAddress, dummyTravelerPaymentAddress, @@ -42,20 +43,29 @@ import Spec.AlwaysSucceed.Script ( import Spec.Configuration.Transactions ( runHighRelativeMajorityTotalVotesInitConfig, runInitConfig, + runInitHighThresholdTreasuryTestConfig, + runInitTreasuryTestConfig, ) import Spec.Configuration.Utils (findConfig) -import Spec.SpecUtils (amountOfAda) -import Spec.Tally.Transactions ( - runInitGeneralTallyWithEndTimeInPast, - runInitTripTallyWithEndTimeInPast, - runInitTripTallyWithEndTimeInPastNotEnoughVotes, - runInitUpgradeTallyWithEndTimeInPast, +import Spec.Index.Transactions (runInitIndex) +import Spec.SampleData (sampleTallyPolicyParams) +import Spec.SpecUtils (amountOfAda, findConfigUtxo, runInitPayToScript) +import Spec.Tally.SampleData ( + sampleGeneralWithEndTimeInPastTallyStateDatum, + sampleTripNotEnoughVotesEndTimeInPastTallyStateDatum, + sampleTripWithEndTimeInPastTallyStateDatum, + sampleUpgradeWithVotesEndTimeInPastTallyStateDatum, + ) +import Spec.Tally.Script ( + tallyConfigNftCurrencySymbol, + tallyConfigNftTypedMintingPolicy, + tallyNftTypedValidator, ) -import Spec.Tally.Utils (findTally) import Spec.Treasury.Script (treasuryTypedValidator) -import Spec.Treasury.Transactions (runInitTreasury) +import Spec.Treasury.Transactions (runInitTreasury, runInitTreasuryWithFunds) import Spec.Treasury.Utils (findTreasury) -import Spec.Values (dummyTreasuryValue) +import Spec.Values (dummyTallySymbol, dummyTallyTokenName, dummyTallyValue, dummyTreasurySymbol, dummyTreasuryTokenName, dummyTreasuryValue) +import Spec.Vote.Transactions (runInitVoteNft) import Prelude (Eq, mconcat, (<>), (==)) -- Positive test for when the proposal is a Trip proposal @@ -74,50 +84,49 @@ mkTripTreasuryTest :: EnoughVotes -> Run () mkTripTreasuryTest enoughVotes = do -- Choose which config to load based on whether we want to trigger -- the negative test for not enough votes or not - when (enoughVotes == HasEnoughVotes) runInitConfig - when (enoughVotes == NotEnoughVotes) runHighRelativeMajorityTotalVotesInitConfig + -- Use special Treasury test config that has alwaysSucceed for tally burning (ID-501) + when (enoughVotes == HasEnoughVotes) runInitTreasuryTestConfig + when (enoughVotes == NotEnoughVotes) runInitHighThresholdTreasuryTestConfig + + runInitIndex + runInitVoteNft + + -- Use alwaysSucceedCurrencySymbol for tally (so we can burn it per ID-501) + -- Note: Original tests used dummyTallyValue but didn't burn. After audit fix ID-501, we MUST burn the tally. + let tallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 + when (enoughVotes == HasEnoughVotes) $ + runInitPayToScript tallyNftTypedValidator sampleTripWithEndTimeInPastTallyStateDatum tallyValue + when (enoughVotes == NotEnoughVotes) $ + runInitPayToScript tallyNftTypedValidator sampleTripNotEnoughVotesEndTimeInPastTallyStateDatum tallyValue + + runInitTreasury -- Treasury starts with just minAda + treasury token (like original) + (configOutRef, _, _) <- findConfig + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator alwaysSucceedCurrencySymbol dummyTallyTokenName + (treasuryOutRef, _, treasuryDatum) <- findConfigUtxo treasuryTypedValidator dummyTreasurySymbol dummyTreasuryTokenName - -- Choose which tally to load based on whether we want to trigger - -- the negative test for not enough votes or not - when (enoughVotes == HasEnoughVotes) runInitTripTallyWithEndTimeInPast - when (enoughVotes == NotEnoughVotes) runInitTripTallyWithEndTimeInPastNotEnoughVotes + user <- newUser $ amountOfAda 3_000_000 - runInitTreasury + let + -- ID-501: Burn the tally token (was referenced in original, now must be spent and burned) + burnDummyTallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName (-1) - (configOutRef, _, _) <- findConfig - (tallyOutRef, _, _) <- findTally - (treasuryOutRef, _, _) <- findTreasury - - user <- newUser $ amountOfAda 9_000_000 - spend1 <- spend user $ amountOfAda 6_000_000 - spend2 <- spend user $ amountOfAda 6_000_000 - spend3 <- spend user $ amountOfAda 8_000_002 - - let baseTx = - mconcat - [ spendScript treasuryTypedValidator treasuryOutRef () () - , refInputInline configOutRef - , refInputInline tallyOutRef - , userSpend spend1 - , userSpend spend2 - ] - - payToTreasuryValidator = - payToScript - treasuryTypedValidator - (InlineDatum ()) - (amountOfAda 4_000_000 <> dummyTreasuryValue) - - -- Need to pay something to the traveller's payment address provided - payToTravelerAddress = - mconcat - [ payToKey - dummyTravelerPaymentAddress - (adaValue 2) - , userSpend spend3 - ] - - combinedTxs = baseTx <> payToTreasuryValidator <> payToTravelerAddress + baseTx = + mconcat + [ spendScript treasuryTypedValidator treasuryOutRef () (TreasuryDatum True) + , refInputInline configOutRef + , spendScript tallyNftTypedValidator tallyOutRef () tallyDatum -- ID-501: spend instead of reference + , mintValue alwaysSucceedTypedMintingPolicy () burnDummyTallyValue -- ID-501: burn tally + ] + + -- ID-401: With disbursedAmount=1 lovelace, Treasury remainder (2M - 1) is below 3M threshold + -- Must send remainder (including treasury token) to fallback address + -- Treasury 2M + Tally 2M = 4M total from scripts, minus 2 ADA disbursed = 3_999_998 + payToFallback = payToKey dummyGeneralPaymentAddress (amountOfAda 3_999_998 <> dummyTreasuryValue) + + -- Need to pay 2 ADA to the traveller's payment address provided (from disbursement) + payToTravelerAddress = payToKey dummyTravelerPaymentAddress (adaValue 2) + + combinedTxs = baseTx <> payToFallback <> payToTravelerAddress theTimeNow <- currentTime finalTx <- validateIn (from theTimeNow) combinedTxs @@ -127,45 +136,41 @@ mkTripTreasuryTest enoughVotes = do -- Positive test for when the proposal is an Upgrade proposal validUpgradeTreasuryTest :: Run () validUpgradeTreasuryTest = do - runInitConfig - runInitUpgradeTallyWithEndTimeInPast - runInitTreasury + runInitTreasuryTestConfig -- Use special Treasury test config for tally burning (ID-501) + runInitIndex + runInitVoteNft + + -- Use alwaysSucceedCurrencySymbol for tally (so we can burn it per ID-501) + -- Use the one with votes to avoid division by zero + let tallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithVotesEndTimeInPastTallyStateDatum tallyValue + runInitTreasury -- Treasury starts with just minAda + treasury token (like original) (configOutRef, _, _) <- findConfig - (tallyOutRef, _, _) <- findTally - (treasuryOutRef, _, _) <- findTreasury + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator alwaysSucceedCurrencySymbol dummyTallyTokenName + (treasuryOutRef, _, treasuryDatum) <- findConfigUtxo treasuryTypedValidator dummyTreasurySymbol dummyTreasuryTokenName - user <- newUser $ amountOfAda 8_000_000 - spend1 <- spend user $ amountOfAda 4_000_000 - spend2 <- spend user $ amountOfAda 2_000_002 + user <- newUser $ amountOfAda 3_000_000 theTimeNow <- currentTime let - upgradeToken :: Value - upgradeToken = singleton alwaysSucceedCurrencySymbol adaToken 1 + -- ID-501 & ID-503: Burn the tally token (replaces separate upgrade token per ID-503) + burnDummyTallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName (-1) baseTx = mconcat - [ spendScript treasuryTypedValidator treasuryOutRef () () - , mintValue alwaysSucceedTypedMintingPolicy () upgradeToken + [ spendScript treasuryTypedValidator treasuryOutRef () (TreasuryDatum True) , refInputInline configOutRef - , refInputInline tallyOutRef - , userSpend spend1 - , userSpend spend2 + , spendScript tallyNftTypedValidator tallyOutRef () tallyDatum -- ID-501: spend instead of reference + , mintValue alwaysSucceedTypedMintingPolicy () burnDummyTallyValue -- ID-501 & ID-503: burn tally ] - payToTreasuryValidator = - payToScript - treasuryTypedValidator - (InlineDatum ()) - (adaValue 2 <> dummyTreasuryValue) - - -- Pay it to the user, just for balancing the tx for now - -- Not sure what is meant to happen with this token after minting it here - payUpgradeTokenToUser = payToKey user upgradeToken + -- ID-502: Upgrade proposal - ALL funds must go to new treasury address (no continuing output) + -- Treasury 2M + Tally 2M = 4M + treasury token, all sent to new treasury address + payToNewTreasuryAddress = payToKey dummyGeneralPaymentAddress (amountOfAda 4_000_000 <> dummyTreasuryValue) - combinedTxs = baseTx <> payToTreasuryValidator <> payUpgradeTokenToUser + combinedTxs = baseTx <> payToNewTreasuryAddress finalTx <- validateIn (from theTimeNow) combinedTxs @@ -174,49 +179,47 @@ validUpgradeTreasuryTest = do -- Positive test for when the proposal is a General proposal validGeneralTreasuryTest :: Run () validGeneralTreasuryTest = do - runInitConfig - runInitGeneralTallyWithEndTimeInPast - runInitTreasury + runInitTreasuryTestConfig -- Use special Treasury test config for tally burning (ID-501) + runInitIndex + runInitVoteNft + -- Use simplified dummy Tally initialization with alwaysSucceed token + let tallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 + runInitPayToScript tallyNftTypedValidator sampleGeneralWithEndTimeInPastTallyStateDatum tallyValue + + runInitTreasury -- Treasury starts with just minAda + treasury token (like original) (configOutRef, _, _) <- findConfig - (tallyOutRef, _, _) <- findTally - (treasuryOutRef, _, _) <- findTreasury - - user <- newUser $ amountOfAda 9_000_000 - spend1 <- spend user $ amountOfAda 6_000_000 - spend2 <- spend user $ amountOfAda 6_000_000 - spend3 <- spend user $ amountOfAda 8_000_002 - - let baseTx = - mconcat - [ spendScript treasuryTypedValidator treasuryOutRef () () - , refInputInline configOutRef - , refInputInline tallyOutRef - , userSpend spend1 - , userSpend spend2 - ] - - payToTreasuryValidator = - payToScript - treasuryTypedValidator - (InlineDatum ()) - (amountOfAda 4_000_000 <> dummyTreasuryValue) - - -- Need to pay something to the payment address provided - payToGeneralAddress = - mconcat - [ payToKey - dummyGeneralPaymentAddress - (adaValue 2) - , userSpend spend3 - ] - - combinedTxs = - mconcat - [ baseTx - , payToTreasuryValidator - , payToGeneralAddress - ] + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator alwaysSucceedCurrencySymbol dummyTallyTokenName + (treasuryOutRef, _, treasuryDatum) <- findConfigUtxo treasuryTypedValidator dummyTreasurySymbol dummyTreasuryTokenName + + user <- newUser $ amountOfAda 3_000_000 + + let + -- ID-501: Burn the tally token (was referenced in original, now must be spent and burned) + burnDummyTallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName (-1) + + baseTx = + mconcat + [ spendScript treasuryTypedValidator treasuryOutRef () (TreasuryDatum True) + , refInputInline configOutRef + , spendScript tallyNftTypedValidator tallyOutRef () tallyDatum -- ID-501: spend instead of reference + , mintValue alwaysSucceedTypedMintingPolicy () burnDummyTallyValue -- ID-501: burn tally + ] + + -- ID-401: With maxGeneralDisbursement=1 lovelace, Treasury remainder (2M - 1) is below 3M threshold + -- Must send remainder (including treasury token) to fallback address + -- Treasury 2M + Tally 2M = 4M total from scripts, minus 2 ADA disbursed = 3_999_998 + payToFallback = payToKey dummyGeneralPaymentAddress (amountOfAda 3_999_998 <> dummyTreasuryValue) + + -- Need to pay 2 ADA to the payment address provided (from disbursement) + payToGeneralAddress = payToKey dummyGeneralPaymentAddress (adaValue 2) + + combinedTxs = + mconcat + [ baseTx + , payToFallback + , payToGeneralAddress + ] theTimeNow <- currentTime finalTx <- validateIn (from theTimeNow) combinedTxs diff --git a/dao/dao-specs/Spec/Treasury/Script.hs b/dao/dao-specs/Spec/Treasury/Script.hs index 1e26a6e..ca6c747 100644 --- a/dao/dao-specs/Spec/Treasury/Script.hs +++ b/dao/dao-specs/Spec/Treasury/Script.hs @@ -11,15 +11,17 @@ where import Dao.ScriptArgument (ValidatorParams) import Dao.Treasury.Script (validateTreasury) -import Plutus.Model.V2 (TypedValidator, mkTypedValidator, scriptHash, toBuiltinValidator) +import LambdaBuffers.ApplicationTypes.Treasury (TreasuryDatum) +import Plutus.Model.V2 (TypedValidator, mkTypedValidator, scriptHash) import PlutusLedgerApi.V1.Scripts (ScriptHash) import PlutusTx qualified import PlutusTx.Prelude (BuiltinData) import Spec.Configuration.SampleData (sampleValidatorParams) +import Spec.SpecUtils (mkTypedValidatorOptimized, mkUntypedValidator) import Prelude ((.)) -- Validator script and info -type TreasuryValidatorScript = TypedValidator () () +type TreasuryValidatorScript = TypedValidator TreasuryDatum () treasuryValidatorScriptHash :: ScriptHash treasuryValidatorScriptHash = scriptHash treasuryTypedValidator @@ -28,11 +30,11 @@ treasuryTypedValidator :: TreasuryValidatorScript treasuryTypedValidator = treasuryTypedValidator' sampleValidatorParams treasuryTypedValidator' :: ValidatorParams -> TreasuryValidatorScript -treasuryTypedValidator' config = - mkTypedValidator - (compiledTreasuryValidator `PlutusTx.applyCode` PlutusTx.liftCode config) +treasuryTypedValidator' = + mkTypedValidatorOptimized + (\config -> compiledTreasuryValidator `PlutusTx.applyCode` PlutusTx.liftCode config) compiledTreasuryValidator :: PlutusTx.CompiledCode (ValidatorParams -> (BuiltinData -> BuiltinData -> BuiltinData -> ())) compiledTreasuryValidator = - $$(PlutusTx.compile [||toBuiltinValidator . validateTreasury||]) + $$(PlutusTx.compile [||mkUntypedValidator . validateTreasury||]) diff --git a/dao/dao-specs/Spec/Treasury/Transactions.hs b/dao/dao-specs/Spec/Treasury/Transactions.hs index 569a392..3800007 100644 --- a/dao/dao-specs/Spec/Treasury/Transactions.hs +++ b/dao/dao-specs/Spec/Treasury/Transactions.hs @@ -1,15 +1,32 @@ module Spec.Treasury.Transactions ( runInitTreasury, + runInitTreasuryWithFunds, ) where -import Plutus.Model (Run) +import Plutus.Model (Run, adaValue, getMainUser, payToScript, spend, submitTx, userSpend) +import Plutus.Model.V2 (DatumMode (InlineDatum)) +import PlutusTx.Prelude (Bool (True)) import Spec.SpecUtils (runInitPayToScript) import Spec.Treasury.Script (treasuryTypedValidator) import Spec.Values (dummyTreasuryValue) +import Prelude (($), (<>)) + +import LambdaBuffers.ApplicationTypes.Treasury (TreasuryDatum (TreasuryDatum)) runInitTreasury :: Run () runInitTreasury = runInitPayToScript treasuryTypedValidator - () + (TreasuryDatum True) dummyTreasuryValue + +-- Initialize treasury with actual funds (4M ADA for disbursements + minAda) +-- Note: The treasury token is already in initialFunds, so we need to spend it separately +runInitTreasuryWithFunds :: Run () +runInitTreasuryWithFunds = do + admin <- getMainUser + let value = adaValue 4_000_002 <> dummyTreasuryValue + spendAda <- spend admin (adaValue 4_000_002) + spendToken <- spend admin dummyTreasuryValue + let payTx = payToScript treasuryTypedValidator (InlineDatum (TreasuryDatum True)) value + submitTx admin $ payTx <> userSpend spendAda <> userSpend spendToken diff --git a/dao/dao-specs/Spec/Treasury/Utils.hs b/dao/dao-specs/Spec/Treasury/Utils.hs index 4090988..2f1f138 100644 --- a/dao/dao-specs/Spec/Treasury/Utils.hs +++ b/dao/dao-specs/Spec/Treasury/Utils.hs @@ -1,5 +1,6 @@ module Spec.Treasury.Utils (findTreasury) where +import LambdaBuffers.ApplicationTypes.Treasury (TreasuryDatum) import Plutus.Model (Run) import PlutusLedgerApi.V2.Tx (TxOut, TxOutRef) import Spec.SpecUtils (findConfigUtxo) @@ -9,7 +10,7 @@ import Spec.Values ( dummyTreasuryTokenName, ) -findTreasury :: Run (TxOutRef, TxOut, ()) +findTreasury :: Run (TxOutRef, TxOut, TreasuryDatum) findTreasury = findConfigUtxo treasuryTypedValidator diff --git a/dao/dao-specs/Spec/Upgrade.hs b/dao/dao-specs/Spec/Upgrade.hs index 37af6c1..fb3e019 100644 --- a/dao/dao-specs/Spec/Upgrade.hs +++ b/dao/dao-specs/Spec/Upgrade.hs @@ -9,6 +9,8 @@ import Plutus.Model ( defaultBabbageV2, testNoErrors, ) +import PlutusLedgerApi.V1.Value (singleton) +import Spec.AlwaysSucceed.Script (alwaysSucceedCurrencySymbol) import Spec.SpecUtils (amountOfAda, checkFails) import Spec.Upgrade.Context ( invalidUpgradeNoConfigInputTest, @@ -17,7 +19,7 @@ import Spec.Upgrade.Context ( invalidUpgradeNotEnoughVotesTest, validUpgradeTest, ) -import Spec.Values (dummyConfigNftValue, dummyTallyValue) +import Spec.Values (dummyConfigNftValue, dummyIndexConfigNftValue, dummyTallyTokenName, dummyVoteNFTValue) import Test.Tasty (TestTree, testGroup) import Prelude (mconcat) @@ -78,5 +80,7 @@ nftSpec config = mconcat [ amountOfAda 20_000_000 , dummyConfigNftValue - , dummyTallyValue + , dummyIndexConfigNftValue + , singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 -- AlwaysSucceed tally for burning + , dummyVoteNFTValue ] diff --git a/dao/dao-specs/Spec/Upgrade/Context.hs b/dao/dao-specs/Spec/Upgrade/Context.hs index 98552d6..1b24a80 100644 --- a/dao/dao-specs/Spec/Upgrade/Context.hs +++ b/dao/dao-specs/Spec/Upgrade/Context.hs @@ -13,37 +13,32 @@ import Plutus.Model ( currentTime, mintValue, newUser, - refInputInline, spend, spendScript, submitTx, userSpend, validateIn, ) -import Plutus.Model.V2 ( - DatumMode (InlineDatum), - payToKey, - payToScript, - ) +import Plutus.Model.V2 (DatumMode (InlineDatum), payToScript) import PlutusLedgerApi.V1.Interval (from) -import PlutusLedgerApi.V1.Value (Value, adaToken, singleton) -import Spec.AlwaysSucceed.Script ( - alwaysSucceedCurrencySymbol, - alwaysSucceedTypedMintingPolicy, - ) +import PlutusLedgerApi.V1.Value (singleton) +import Spec.AlwaysSucceed.Script (alwaysSucceedCurrencySymbol, alwaysSucceedTypedMintingPolicy) import Spec.Configuration.Script (upgradeConfigNftTypedValidator) import Spec.Configuration.Transactions ( runHighRelativeMajorityTotalVotesInitConfig, runInitConfig, + runInitTreasuryTestConfig, ) import Spec.Configuration.Utils (findConfig) -import Spec.SpecUtils (amountOfAda) -import Spec.Tally.Transactions ( - runInitUpgradeTallyWithEndTimeInPast, - runInitUpgradeTallyWithEndTimeInPastNotEnoughVotes, +import Spec.Index.Transactions (runInitIndex) +import Spec.SpecUtils (amountOfAda, findConfigUtxo, runInitPayToScript) +import Spec.Tally.SampleData ( + sampleUpgradeNotEnoughVotesEndTimeInPastTallyStateDatum, + sampleUpgradeWithVotesEndTimeInPastTallyStateDatum, ) -import Spec.Tally.Utils (findTally) -import Spec.Values (dummyConfigNftValue) +import Spec.Tally.Script (tallyNftTypedValidator) +import Spec.Values (dummyConfigNftValue, dummyTallyTokenName) +import Spec.Vote.Transactions (runInitVoteNft) import Prelude (Eq, mconcat, mempty, otherwise, ($), (<>), (==)) -- | Positive test @@ -99,8 +94,8 @@ data ConfigInput deriving stock (Eq) data UpgradeTokenMinted - = UpgradeTokenMinted -- Valid - | NoUpgradeTokenMinted -- Invalid + = UpgradeTokenMinted -- Valid (Tally NFT burned) + | NoUpgradeTokenMinted -- Invalid (Tally NFT not burned) deriving stock (Eq) data EnoughVotes @@ -117,36 +112,47 @@ mkUpgradeTest :: mkUpgradeTest tallyReference configInput upgradeMinted enoughVotes = do -- Choose which config to load based on whether we want to trigger -- the negative test for not enough votes or not - when (enoughVotes == HasEnoughVotes) runInitConfig + -- Use special Treasury test config that has alwaysSucceed for tally burning (ID-501) + when (enoughVotes == HasEnoughVotes) runInitTreasuryTestConfig when (enoughVotes == NotEnoughVotes) runHighRelativeMajorityTotalVotesInitConfig - -- Choose which tally to load based on whether we want to trigger - -- the negative test for not enough votes or not - when (enoughVotes == HasEnoughVotes) runInitUpgradeTallyWithEndTimeInPast - when (enoughVotes == NotEnoughVotes) runInitUpgradeTallyWithEndTimeInPastNotEnoughVotes + -- Initialize Index (required for proper test setup, matches successful Tally test pattern) + runInitIndex + + -- Initialize vote NFT before Tally initialization (required for Tally NFT minting) + runInitVoteNft + + -- Use simplified dummy Tally initialization with alwaysSucceed token + -- Use samples with votes to avoid division by zero in vote percentage calculations + let tallyValue = singleton alwaysSucceedCurrencySymbol dummyTallyTokenName 1 + when (enoughVotes == HasEnoughVotes) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithVotesEndTimeInPastTallyStateDatum tallyValue + when (enoughVotes == NotEnoughVotes) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeNotEnoughVotesEndTimeInPastTallyStateDatum tallyValue (configOutRef, _, configDatum) <- findConfig - (tallyOutRef, _, _) <- findTally + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator alwaysSucceedCurrencySymbol dummyTallyTokenName - user <- newUser $ amountOfAda 8_000_000 - spend1 <- spend user $ amountOfAda 4_000_000 - spend2 <- spend user $ amountOfAda 2_000_002 + user <- newUser $ amountOfAda 3_000_000 theTimeNow <- currentTime let - upgradeToken :: Value - upgradeToken = singleton alwaysSucceedCurrencySymbol adaToken 1 + baseTx = mempty -- No user spending needed - scripts provide all the ADA - baseTx = - mconcat - [ userSpend spend1 - , userSpend spend2 - ] + -- Spend tally input when required (ID-501: Tally must be spent, not referenced) + withTallyInput + | tallyReference == TallyIncluded = spendScript tallyNftTypedValidator tallyOutRef () tallyDatum + | otherwise = mempty - -- Mint upgrade token for valid test - withUpgradeTokenMinted - | upgradeMinted == UpgradeTokenMinted = mintValue alwaysSucceedTypedMintingPolicy () upgradeToken + -- Burn Tally NFT when required (ID-503: replaces upgrade token, ID-501: prevents reuse) + -- Using alwaysSucceed policy for simplified testing + withTallyBurn + | upgradeMinted == UpgradeTokenMinted = + mintValue + alwaysSucceedTypedMintingPolicy + () + (singleton alwaysSucceedCurrencySymbol dummyTallyTokenName (-1)) | otherwise = mempty -- Spend config input for valid test @@ -154,29 +160,21 @@ mkUpgradeTest tallyReference configInput upgradeMinted enoughVotes = do | configInput == ConfigIncluded = spendScript upgradeConfigNftTypedValidator configOutRef () configDatum | otherwise = mempty - -- Include tally in the reference inputs for valid test - withTallyReference - | tallyReference == TallyIncluded = refInputInline tallyOutRef - | otherwise = mempty - + -- Config has 2M + Tally has 2M = 4M total ADA from scripts + -- Return all 4M with the config NFT (tally token is burned per ID-501) payToConfigValidator = payToScript upgradeConfigNftTypedValidator (InlineDatum configDatum) - (adaValue 2 <> dummyConfigNftValue) - - -- Pay it to the user, just for balancing the tx for now - -- Not sure what is meant to happen with this token after minting it here - payUpgradeTokenToUser = payToKey user upgradeToken + (amountOfAda 4_000_000 <> dummyConfigNftValue) combinedTxs = mconcat [ baseTx , payToConfigValidator - , payUpgradeTokenToUser - , withTallyReference + , withTallyInput + , withTallyBurn , withConfigInput - , withUpgradeTokenMinted ] finalTx <- validateIn (from theTimeNow) combinedTxs diff --git a/dao/dao-specs/Spec/Vote.hs b/dao/dao-specs/Spec/Vote.hs index 8114856..eca9e6d 100644 --- a/dao/dao-specs/Spec/Vote.hs +++ b/dao/dao-specs/Spec/Vote.hs @@ -58,9 +58,9 @@ nftSpec config = initialFunds = mconcat - [ adaValue 10_000_000 + [ adaValue 20_000_000 -- Enough for init TXs + user creation , dummyConfigNftValue , dummyIndexConfigNftValue - , dummyTallyValue + , dummyTallyValue -- For runInitTallyWithEndTimeInFuture , dummyVoteNFTValue ] diff --git a/dao/dao-specs/Spec/Vote/Context.hs b/dao/dao-specs/Spec/Vote/Context.hs index 7931244..498bf85 100644 --- a/dao/dao-specs/Spec/Vote/Context.hs +++ b/dao/dao-specs/Spec/Vote/Context.hs @@ -11,13 +11,17 @@ module Spec.Vote.Context ( import Control.Monad (void) import Dao.ScriptArgument (ValidatorParams) +import Debug.Trace (traceM) import LambdaBuffers.ApplicationTypes.Vote ( VoteMinterActionRedeemer (VoteMinterActionRedeemer'Mint), ) import Plutus.Model ( Run, + TypedPolicy, adaValue, currentTime, + getMainUser, + logInfo, mintValue, newUser, spend, @@ -29,16 +33,25 @@ import Plutus.Model.V2 ( DatumMode (InlineDatum), payToScript, refInputInline, + spendScript, ) import PlutusLedgerApi.V1.Interval (to) import PlutusLedgerApi.V1.Value (TokenName (TokenName), Value, singleton) import Spec.Configuration.SampleData (sampleValidatorParams) import Spec.Configuration.Transactions (runInitConfig) import Spec.Configuration.Utils (findConfig) -import Spec.SpecUtils (minAda, oneSecond) -import Spec.Tally.Transactions (runInitTallyWithEndTimeInFuture) +import Spec.Index.Transactions (runInitIndex) +import Spec.SpecUtils (amountOfAda, findConfigUtxo, minAda, oneSecond, runInitPayToScript) +import Spec.Tally.SampleData (sampleUpgradeWithEndTimeInFutureTallyStateDatum) +import Spec.Tally.Script (tallyNftTypedValidator) import Spec.Tally.Utils (findTally) -import Spec.Values (dummyVoteNFTValue) +import Spec.Values ( + dummyIndexConfigNftValue, + dummyTallySymbol, + dummyTallyTokenName, + dummyTallyValue, + dummyVoteNFTValue, + ) import Spec.Vote.SampleData (sampleVoteDatum) import Spec.Vote.Script ( VoteMintingPolicy, @@ -47,7 +60,7 @@ import Spec.Vote.Script ( voteTypedValidator, ) import Spec.Vote.Transactions (runInitVoteNft) -import Prelude (mconcat, mempty, (*), (+), (<>)) +import Prelude (mconcat, mempty, show, (*), (+), (<>)) validVoteConfigNftTest :: Run () validVoteConfigNftTest = @@ -91,16 +104,38 @@ mkVoteConfigNftTest :: ValidityRange -> Run () mkVoteConfigNftTest voteConfigValue voteConfigRef validityRange = do - runInitConfig - -- Simulate a voteNFT at the user's wallet + let logMsg msg = do + logInfo msg + traceM msg + + logMsg "TX1: runInitConfig" + void runInitConfig + logMsg "TX2: runInitIndex" + void runInitIndex + logMsg "TX3: runInitVoteNft" runInitVoteNft - void runInitTallyWithEndTimeInFuture - + logMsg "TX4: Initialize dummy Tally (simple)" + -- Use dummy tally value instead of minting real one + runInitPayToScript + tallyNftTypedValidator + sampleUpgradeWithEndTimeInFutureTallyStateDatum + dummyTallyValue + logMsg "All init transactions complete" + + logMsg "Finding config..." (configOutRef, _, _) <- findConfig - (tallyOutRef, _, _tallyDatum) <- findTally - - user <- newUser (minAda <> dummyVoteNFTValue) - spend' <- spend user (adaValue 2 <> dummyVoteNFTValue) + logMsg ("✓ Found config: " <> show configOutRef) + + logMsg "Finding tally (using dummy tally value)..." + -- findTally uses the computed tally symbol, but we used dummyTallyValue + -- So we need to find it using the dummy symbol instead + (tallyOutRef, _, _tallyDatum) <- findConfigUtxo tallyNftTypedValidator dummyTallySymbol dummyTallyTokenName + logMsg ("✓ Found tally: " <> show tallyOutRef) + + -- Admin has vote NFT from TX3 (runInitVoteNft) + admin <- getMainUser + logMsg "Admin spending: minAda + 2 ADA + dummyVoteNFTValue for vote minting" + spend' <- spend admin (minAda <> adaValue 2 <> dummyVoteNFTValue) theTimeNow <- currentTime let @@ -128,15 +163,17 @@ mkVoteConfigNftTest voteConfigValue voteConfigRef validityRange = do payToScript voteTypedValidator (InlineDatum sampleVoteDatum) - (adaValue 2 <> voteValue <> dummyVoteNFTValue) + (minAda <> adaValue 2 <> voteValue <> dummyVoteNFTValue) combinedTxs = mconcat [baseTx, payToVoteValidator, withVoteConfig] finalTx <- validateIn (to (theTimeNow + 20 * oneSecond)) combinedTxs + logMsg "Submitting vote minting transaction..." case validityRange of - SpecifyRange -> submitTx user finalTx - NoSpecificRange -> submitTx user combinedTxs -- Should (will) fail + SpecifyRange -> submitTx admin finalTx + NoSpecificRange -> submitTx admin combinedTxs -- Should (will) fail + logMsg "✓ Vote minted successfully!" -- Valid token value, correct symbol and exactly one minted validVoteConfigValue :: ValidatorParams -> Value diff --git a/dao/dao-specs/Spec/Vote/ContextValidator.hs b/dao/dao-specs/Spec/Vote/ContextValidator.hs index 703460f..c005b78 100644 --- a/dao/dao-specs/Spec/Vote/ContextValidator.hs +++ b/dao/dao-specs/Spec/Vote/ContextValidator.hs @@ -42,16 +42,16 @@ import Plutus.Model.V2 ( import PlutusLedgerApi.V1.Interval (from) import Spec.Configuration.Transactions (runInitConfig) import Spec.Configuration.Utils (findConfig) -import Spec.SpecUtils (amountOfAda) -import Spec.Tally.Script (tallyNftTypedValidator) -import Spec.Tally.Transactions ( - runInitTallyWithEndTimeInFuture, - runInitTallyWithEndTimeInPast, +import Spec.Index.Transactions (runInitIndex) +import Spec.SpecUtils (amountOfAda, findConfigUtxo, runInitPayToScript) +import Spec.Tally.SampleData ( + sampleUpgradeWithEndTimeInFutureTallyStateDatum, + sampleUpgradeWithEndTimeInPastTallyStateDatum, ) -import Spec.Tally.Utils (findTally) -import Spec.Values (dummyTallyValue, dummyVoteValue) +import Spec.Tally.Script (tallyNftTypedValidator) +import Spec.Values (dummyTallySymbol, dummyTallyTokenName, dummyTallyValue, dummyVoteValue) import Spec.Vote.Script (voteTypedValidator) -import Spec.Vote.Transactions (runInitVote, runInitVoteWithUser) +import Spec.Vote.Transactions (runInitVote, runInitVoteNft, runInitVoteWithUser) import Spec.Vote.Utils (findVote) import Prelude (Eq, mconcat, mempty, ($), (<>), (==)) @@ -132,12 +132,18 @@ mkVoteValidatorCountRedeemerTest :: Run () mkVoteValidatorCountRedeemerTest configRef voteValidator tallyValidator tallyPeriod = do runInitConfig + runInitIndex + runInitVoteNft runInitVote - when (tallyPeriod == TallyPeriodOver) runInitTallyWithEndTimeInPast -- Valid - when (tallyPeriod == StillInTallyPeriod) runInitTallyWithEndTimeInFuture -- Invalid + -- Use simplified dummy Tally initialization instead of real minting + when (tallyPeriod == TallyPeriodOver) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInPastTallyStateDatum dummyTallyValue + when (tallyPeriod == StillInTallyPeriod) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInFutureTallyStateDatum dummyTallyValue + (configOutRef, _, _) <- findConfig - (tallyOutRef, _, tallyDatum) <- findTally + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator dummyTallySymbol dummyTallyTokenName (voteOutRef, _, voteDatum) <- findVote user <- newUser $ amountOfAda 4_000_000 @@ -232,11 +238,17 @@ mkVoteValidatorCancelRedeemerTest tallyPeriod ownerSigns = do runInitConfig + runInitIndex + runInitVoteNft + + -- Use simplified dummy Tally initialization instead of real minting + when (tallyPeriod == TallyPeriodOver) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInPastTallyStateDatum dummyTallyValue + when (tallyPeriod == StillInTallyPeriod) $ + runInitPayToScript tallyNftTypedValidator sampleUpgradeWithEndTimeInFutureTallyStateDatum dummyTallyValue - when (tallyPeriod == TallyPeriodOver) runInitTallyWithEndTimeInPast -- Valid - when (tallyPeriod == StillInTallyPeriod) runInitTallyWithEndTimeInFuture -- Invalid (configOutRef, _, _) <- findConfig - (tallyOutRef, _, tallyDatum) <- findTally + (tallyOutRef, _, tallyDatum) <- findConfigUtxo tallyNftTypedValidator dummyTallySymbol dummyTallyTokenName user <- newUser $ amountOfAda 4_000_000 spend1 <- spend user $ amountOfAda 2_000_000 diff --git a/dao/dao-specs/Spec/VoteValidator.hs b/dao/dao-specs/Spec/VoteValidator.hs index 3077f0f..bd927ed 100644 --- a/dao/dao-specs/Spec/VoteValidator.hs +++ b/dao/dao-specs/Spec/VoteValidator.hs @@ -12,7 +12,9 @@ import Plutus.Model ( import Spec.SpecUtils (amountOfAda, checkFails) import Spec.Values ( dummyConfigNftValue, + dummyIndexConfigNftValue, dummyTallyValue, + dummyVoteNFTValue, dummyVoteValue, ) import Spec.Vote.ContextValidator ( @@ -97,8 +99,10 @@ nftSpec config = mconcat [ amountOfAda 20_000_000 , dummyConfigNftValue + , dummyIndexConfigNftValue , dummyVoteValue , dummyTallyValue + , dummyVoteNFTValue ] good = testNoErrors initialFunds config bad = checkFails config initialFunds diff --git a/dao/dao.cabal b/dao/dao.cabal index 4bb52ec..0291b97 100644 --- a/dao/dao.cabal +++ b/dao/dao.cabal @@ -74,6 +74,7 @@ library dao-specs hs-source-dirs: dao-specs build-depends: , dao-lb-types + , plutonomy , plutus-ledger-api , plutus-simple-model , plutus-tx diff --git a/types/ApplicationTypes/Configuration.lbf b/types/ApplicationTypes/Configuration.lbf index 03a4bf1..0600bb5 100644 --- a/types/ApplicationTypes/Configuration.lbf +++ b/types/ApplicationTypes/Configuration.lbf @@ -1,7 +1,7 @@ module ApplicationTypes.Configuration import Prelude (Eq, Integer) -import Plutus.V1 (CurrencySymbol, PlutusData, ScriptHash, TokenName) +import Plutus.V1 (CurrencySymbol, PlutusData, ScriptHash, TokenName, Address) -- | DynamicConfig Datum holds the main info needed for the contracts. record DynamicConfigDatum = { @@ -56,6 +56,12 @@ record DynamicConfigDatum = { , voteFungibleTokenName : TokenName -- | Fungible token percentage (Percentage value is times a 1000) , fungibleVotePercent : Integer + -- | Minimum value threshold for treasury UTxO (in lovelaces) + -- If remaining value falls below this, it's sent to fallback address + , minTreasuryValue : Integer + -- | Protocol-controlled fallback address for small treasury remainders + -- Used when treasury value drops below minTreasuryValue threshold + , protocolFallbackAddress : Address } derive Eq DynamicConfigDatum -derive PlutusData DynamicConfigDatum +derive PlutusData DynamicConfigDatum diff --git a/types/ApplicationTypes/Proposal.lbf b/types/ApplicationTypes/Proposal.lbf index 5a608c0..da83ae9 100644 --- a/types/ApplicationTypes/Proposal.lbf +++ b/types/ApplicationTypes/Proposal.lbf @@ -1,6 +1,6 @@ module ApplicationTypes.Proposal -import Prelude (Eq, Integer) +import Prelude (Eq, Integer, Maybe) import Plutus.V1 ( Address , CurrencySymbol @@ -11,11 +11,12 @@ import Plutus.V1 -- A `Trip` proposal, a `General` proposal or an `Upgrade` proposal. sum ProposalType = -- | Upgrade a proposal + -- The Maybe Address indicates if funds should be migrated to a new treasury + -- Nothing = config-only upgrade, Just Address = migrate treasury to new address Upgrade - -- | Symbol of the upgrade minting policy - CurrencySymbol + (Maybe Address) | -- | A general proposal - General + General -- | General payment address Address -- | General payment amount diff --git a/types/ApplicationTypes/Treasury.lbf b/types/ApplicationTypes/Treasury.lbf new file mode 100644 index 0000000..2908344 --- /dev/null +++ b/types/ApplicationTypes/Treasury.lbf @@ -0,0 +1,15 @@ +module ApplicationTypes.Treasury + +import Prelude (Eq, Bool) +import Plutus.V1 (PlutusData) + +-- | Treasury datum +-- Simple marker type to ensure Treasury UTxOs have proper datums +-- This prevents UTxOs from becoming unspendable +-- The marker field is always set to True +record TreasuryDatum = { + marker : Bool +} + +derive Eq TreasuryDatum +derive PlutusData TreasuryDatum \ No newline at end of file diff --git a/types/build.nix b/types/build.nix index d723ab3..f4c56e1 100644 --- a/types/build.nix +++ b/types/build.nix @@ -11,6 +11,7 @@ "ApplicationTypes/Configuration.lbf" "ApplicationTypes/Index.lbf" "ApplicationTypes/Tally.lbf" + "ApplicationTypes/Treasury.lbf" ]; }; @@ -24,6 +25,7 @@ "ApplicationTypes/Configuration.lbf" "ApplicationTypes/Index.lbf" "ApplicationTypes/Tally.lbf" + "ApplicationTypes/Treasury.lbf" ]; };