handle proposal creation
This commit is contained in:
Hongrui Fang
fanghr
parent
0e397d2a89
commit
175d4aa319
2 changed files with 143 additions and 22 deletions
|
|
@ -35,16 +35,22 @@ import Generics.SOP (Generic, I (I))
|
|||
|
||||
import Agora.AuthorityToken (authorityTokensValidIn)
|
||||
import Agora.Proposal (
|
||||
PProposalDatum,
|
||||
PProposalId,
|
||||
PProposalStatus (PDraft),
|
||||
PProposalThresholds,
|
||||
Proposal (..),
|
||||
ProposalId,
|
||||
ProposalThresholds,
|
||||
pnextProposalId,
|
||||
proposalPolicy,
|
||||
proposalValidator,
|
||||
)
|
||||
import Agora.Utils (
|
||||
allInputs,
|
||||
findOutputsToAddress,
|
||||
findTxOutDatum,
|
||||
hasOnlyOneTokenOfCurrencySymbol,
|
||||
mustFindDatum',
|
||||
passert,
|
||||
passetClassValueOf,
|
||||
passetClassValueOf',
|
||||
|
|
@ -66,6 +72,8 @@ import Plutarch.Api.V1 (
|
|||
PValue,
|
||||
mintingPolicySymbol,
|
||||
mkMintingPolicy,
|
||||
mkValidator,
|
||||
validatorHash,
|
||||
)
|
||||
import Plutarch.Api.V1.Extra (pownMintValue)
|
||||
import Plutarch.DataRepr (
|
||||
|
|
@ -79,8 +87,20 @@ import Plutarch.Unsafe (punsafeCoerce)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutus.V1.Ledger.Api (MintingPolicy, TxOutRef)
|
||||
import Plutus.V1.Ledger.Value (AssetClass (..), CurrencySymbol, TokenName (..))
|
||||
import Plutarch.Builtin (pforgetData)
|
||||
import Plutus.V1.Ledger.Api (
|
||||
Address (Address),
|
||||
Credential (ScriptCredential),
|
||||
CurrencySymbol (..),
|
||||
MintingPolicy,
|
||||
TxOutRef,
|
||||
Validator,
|
||||
ValidatorHash,
|
||||
)
|
||||
import Plutus.V1.Ledger.Value (
|
||||
AssetClass (..),
|
||||
TokenName (..),
|
||||
)
|
||||
import PlutusTx qualified
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -210,8 +230,10 @@ governorPolicy params =
|
|||
- The utxo which holds the state token, has a well well-formed 'GovernorDatum' datum.
|
||||
|
||||
For 'CreateProposal' redeemer, it will check:
|
||||
- Exactly one proposal token is minted.
|
||||
- The datum which is corresponding to the proposal token must be correct.
|
||||
- Exactly one proposal state token is minted.
|
||||
- Exactly one utxo should be sent to the proposal validator.
|
||||
- The utxo must contain the proposal state token.
|
||||
- The datum of said utxo must be correct.
|
||||
- Proposal id in the governor datum must be advanced.
|
||||
|
||||
TODO: PMintGATs
|
||||
|
|
@ -223,7 +245,7 @@ governorPolicy params =
|
|||
governorValidator :: Governor -> ClosedTerm PValidator
|
||||
governorValidator params =
|
||||
plam $ \datum' redeemer' ctx' -> P.do
|
||||
-- TODO: use `PTryFrom`
|
||||
-- TODO: use ptryFrom
|
||||
redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer'
|
||||
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||
|
||||
|
|
@ -233,27 +255,30 @@ governorValidator params =
|
|||
let txOutRef = pfromData txOutRef'
|
||||
|
||||
PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo
|
||||
ownInput <- pletFields @'["address", "value", "datumHash"] ownInput'
|
||||
ownInput <- pletFields @'["address", "value"] ownInput'
|
||||
let selfAddress = pfromData $ ownInput.address
|
||||
|
||||
PJust oldDatum'' <- pmatch $ findTxOutDatum # txInfo # ownInput'
|
||||
oldDatum' <- plet $ pto oldDatum''
|
||||
let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce oldDatum'
|
||||
-- TODO: use ptryFrom
|
||||
let oldParams' = pfromData @PGovernorDatum $ punsafeCoerce datum'
|
||||
oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams'
|
||||
|
||||
let ownInputDatumNFTAmount = stateTokenValueOf # ownInput.value
|
||||
passert "Own input should have exactly one state token" $ ownInputDatumNFTAmount #== 1
|
||||
passert "Own input should have exactly one state token" $
|
||||
ownInputDatumNFTAmount #== 1
|
||||
|
||||
ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress
|
||||
passert "Exactly one utxo should be sent to the governor" $ plength # ownOutputs #== 1
|
||||
passert "Exactly one utxo should be sent to the governor" $
|
||||
plength # ownOutputs #== 1
|
||||
|
||||
ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs
|
||||
let ownOuputDatumNFTAmount = stateTokenValueOf # ownOutput.value
|
||||
passert "State token should stay at governor's address" $ ownOuputDatumNFTAmount #== 1
|
||||
passert "Output utxo to governor should have datum" $ pisDJust # ownOutput.datumHash
|
||||
passert "State token should stay at governor's address" $
|
||||
ownOuputDatumNFTAmount #== 1
|
||||
passert "Output utxo to governor should have datum" $
|
||||
pisDJust # ownOutput.datumHash
|
||||
|
||||
-- TODO: use `PTryFrom` and reject bad datum
|
||||
let newDatum' = pfromData @PGovernorDatum $ punsafeCoerce datum'
|
||||
newDatum' <- plet $ mustFindDatum' @PGovernorDatum # ownOutput.datumHash # ctx.txInfo
|
||||
newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum'
|
||||
|
||||
mint <- plet $ pfromData $ pfield @"mint" # txInfo
|
||||
|
|
@ -261,18 +286,59 @@ governorValidator params =
|
|||
|
||||
case redeemer of
|
||||
PCreateProposal _ -> P.do
|
||||
-- check that nothing is minted
|
||||
passert "Nothing should be minted" $ plength # mint' #== 0
|
||||
|
||||
-- check that proposal is advanced
|
||||
passert "Proposal id should be advanced by 1" $
|
||||
pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId
|
||||
|
||||
-- TODO: waiting for impl of proposal
|
||||
-- check that exactly one proposal token is minted
|
||||
pps <- plet $ pconstant proposalSymbol
|
||||
passert "Exactly one proposal token must be minted" $
|
||||
hasOnlyOneTokenOfCurrencySymbol # pps # mint
|
||||
|
||||
outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress
|
||||
passert "Exactly one utxo should be sent to the proposal validator" $
|
||||
plength # outputs #== 1
|
||||
|
||||
output <- pletFields @'["value", "datumHash"] $ phead # outputs
|
||||
passert "The proposal state token must be sent to the proposal validator" $
|
||||
psymbolValueOf # pconstant proposalSymbol # output.value #== 1
|
||||
|
||||
passert "The utxo paid to the proposal validator must have datum" $
|
||||
pisDJust # output.datumHash
|
||||
|
||||
let proposalDatum' =
|
||||
mustFindDatum' @PProposalDatum
|
||||
# output.datumHash
|
||||
# ctx.txInfo
|
||||
|
||||
proposalParams <-
|
||||
pletFields
|
||||
@'["id", "status", "cosigners", "thresholds", "votes"]
|
||||
proposalDatum'
|
||||
|
||||
passert "Invalid proposal id in proposal parameters" $
|
||||
proposalParams.id #== oldParams.nextProposalId
|
||||
|
||||
passert "Invalid thresholds in proposal parameters" $
|
||||
proposalParams.thresholds #== oldParams.proposalThresholds
|
||||
|
||||
passert "Initial proposal votes should be zero" $
|
||||
pnull #$ pto $ pto $ pfromData proposalParams.votes
|
||||
|
||||
passert "Initial proposal status should be Draft" $ P.do
|
||||
s <- pmatch $ proposalParams.status
|
||||
case s of
|
||||
PDraft _ -> pconstant True
|
||||
_ -> pconstant False
|
||||
|
||||
passert "Initial proposal cosigners should be empty" $
|
||||
pnull #$ pfromData proposalParams.cosigners
|
||||
|
||||
ptraceError "Not implemented yet"
|
||||
PMintGATs _ -> P.do
|
||||
-- check datum is not changed
|
||||
passert "Datum should not be changed" $ oldDatum' #== datum'
|
||||
passert "Datum should not be changed" $
|
||||
(pforgetData $ pdata newDatum') #== datum'
|
||||
|
||||
-- check exactly one(?) authority token is minted
|
||||
|
||||
|
|
@ -281,10 +347,12 @@ governorValidator params =
|
|||
PMutateGovernor _ -> P.do
|
||||
-- check that input has exactly one GAT and will be burnt
|
||||
let gatAmount = psymbolValueOf # gatS # mint
|
||||
passert "One GAT should be burnt" $ gatAmount #== -1
|
||||
passert "One GAT should be burnt" $
|
||||
gatAmount #== -1
|
||||
|
||||
-- nothing should be minted/burnt other than GAT
|
||||
passert "No token should be minted/burnt other than GAT" $ plength # mint' #== 1
|
||||
passert "No token should be minted/burnt other than GAT" $
|
||||
plength # mint' #== 1
|
||||
|
||||
-- check that GAT is tagged by the address
|
||||
passert "all input GATs are valid" $
|
||||
|
|
@ -296,6 +364,27 @@ governorValidator params =
|
|||
stateTokenAssetClass :: AssetClass
|
||||
stateTokenAssetClass = governorStateTokenAssetClass params
|
||||
|
||||
proposalParams :: Proposal
|
||||
proposalParams =
|
||||
Proposal
|
||||
{ governorSTAssetClass = stateTokenAssetClass
|
||||
}
|
||||
|
||||
proposalSymbol :: CurrencySymbol
|
||||
proposalSymbol = mintingPolicySymbol policy
|
||||
where
|
||||
policy :: MintingPolicy
|
||||
policy = mkMintingPolicy $ proposalPolicy proposalParams
|
||||
|
||||
proposalValidatorAddress :: Address
|
||||
proposalValidatorAddress = Address (ScriptCredential hash) Nothing
|
||||
where
|
||||
hash :: ValidatorHash
|
||||
hash = validatorHash validator
|
||||
|
||||
validator :: Validator
|
||||
validator = mkValidator $ proposalValidator proposalParams
|
||||
|
||||
stateTokenValueOf :: Term s (PValue :--> PInteger)
|
||||
stateTokenValueOf = passetClassValueOf' stateTokenAssetClass
|
||||
|
||||
|
|
|
|||
|
|
@ -44,6 +44,9 @@ module Agora.Utils (
|
|||
validatorHashToTokenName,
|
||||
pvalidatorHashToTokenName,
|
||||
getMintingPolicySymbol,
|
||||
hasOnlyOneTokenOfAssetClass',
|
||||
hasOnlyOneTokenOfCurrencySymbol,
|
||||
mustFindDatum',
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -518,3 +521,32 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh))
|
|||
-- | Get the CurrencySymbol of a PMintingPolicy.
|
||||
getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol
|
||||
getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v
|
||||
|
||||
hasOnlyOneTokenOfAssetClass' :: AssetClass -> Term s (PValue :--> PBool)
|
||||
hasOnlyOneTokenOfAssetClass' ac@(AssetClass (as, _)) = phoistAcyclic $
|
||||
plam $ \vs -> P.do
|
||||
let ps = pconstant as
|
||||
|
||||
psymbolValueOf # ps # vs #== 1
|
||||
#&& passetClassValueOf' ac # vs #== 1
|
||||
#&& (plength #$ pto $ pto $ pto vs) #== 1
|
||||
|
||||
hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool)
|
||||
hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $
|
||||
plam $ \cs vs -> P.do
|
||||
psymbolValueOf # cs # vs #== 1
|
||||
#&& (plength #$ pto $ pto $ pto vs) #== 1
|
||||
|
||||
{- Find datum, in an unsafe manner.
|
||||
|
||||
FIXME: reimplement using 'ptryFrom'.
|
||||
-}
|
||||
mustFindDatum' ::
|
||||
forall (datum :: PType).
|
||||
PIsData datum =>
|
||||
forall s. Term s (PMaybeData PDatumHash :--> PTxInfo :--> datum)
|
||||
mustFindDatum' = phoistAcyclic $
|
||||
plam $ \mdh info -> P.do
|
||||
PDJust ((pfield @"_0" #) -> dh) <- pmatch mdh
|
||||
PJust dt <- pmatch $ pfindDatum # dh # info
|
||||
pfromData $ punsafeCoerce dt
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue