safely check input/output governor datum

...utilize a bunch of util functions as well
This commit is contained in:
fanghr 2022-05-07 17:03:47 +08:00
parent 6ab6afbdb7
commit 40d5cf5f74

View file

@ -27,13 +27,11 @@ import Generics.SOP (Generic, I (I))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PMaybeData (PDJust),
PTxOutRef, PTxOutRef,
PValidator, PValidator,
PValue, PValue,
) )
import Plutarch.Api.V1.Extra (pvalueOf) import Plutarch.Api.V1.Extra (pvalueOf)
import Plutarch.Builtin (pforgetData)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, PDataFields,
@ -57,6 +55,7 @@ import Agora.Governor (
Governor, Governor,
GovernorDatum, GovernorDatum,
PGovernorDatum, PGovernorDatum,
governorDatumValid,
) )
import Agora.Governor.Scripts ( import Agora.Governor.Scripts (
authorityTokenSymbolFromGovernor, authorityTokenSymbolFromGovernor,
@ -64,8 +63,11 @@ import Agora.Governor.Scripts (
) )
import Agora.Utils ( import Agora.Utils (
findOutputsToAddress, findOutputsToAddress,
findTxOutByTxOutRef,
mustBePDJust,
mustBePJust,
passert, passert,
pfindDatum, ptryFindDatum,
) )
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -99,7 +101,7 @@ newtype PMutateGovernorDatum (s :: S)
deriving anyclass (Generic) deriving anyclass (Generic)
deriving anyclass (PIsDataRepr) deriving anyclass (PIsDataRepr)
deriving deriving
(PlutusType, PIsData, PDataFields) (PlutusType, PIsData, PDataFields, PEq)
via (PIsDataReprInstances PMutateGovernorDatum) via (PIsDataReprInstances PMutateGovernorDatum)
instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum
@ -130,12 +132,19 @@ instance PTryFrom PData (PAsData PMutateGovernorDatum) where
-} -}
mutateGovernorValidator :: Governor -> ClosedTerm PValidator mutateGovernorValidator :: Governor -> ClosedTerm PValidator
mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
\_gatCs (datum :: Term _ PMutateGovernorDatum) _txOutRef txInfo' -> P.do \_gatCs (datum' :: Term _ PMutateGovernorDatum) txOutRef txInfo' -> P.do
let newDatum = pforgetData $ pfield @"newDatum" # datum datum <- pletFields @'["newDatum", "governorRef"] datum'
pinnedGovernor = pfield @"governorRef" # datum
txInfo <- pletFields @'["mint", "inputs", "outputs", "datums"] txInfo' txInfo <- pletFields @'["mint", "inputs", "outputs", "datums"] txInfo'
let selfAddress =
pfield @"address"
#$ mustBePJust # "Self governorInput not found"
#$ findTxOutByTxOutRef # txOutRef # txInfo.inputs
passert "No output to the effect validator" $
pnull #$ findOutputsToAddress # txInfo.outputs # selfAddress
let mint :: Term _ (PBuiltinList _) let mint :: Term _ (PBuiltinList _)
mint = pto $ pto $ pto $ pfromData txInfo.mint mint = pto $ pto $ pto $ pfromData txInfo.mint
@ -155,39 +164,39 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
passert "Governor's state token must be moved" $ passert "Governor's state token must be moved" $
plength # filteredInputs #== 1 plength # filteredInputs #== 1
input <- plet $ phead # filteredInputs governorInput <- plet $ phead # filteredInputs
passert "Can only modify the pinned governor" $ passert "Can only modify the pinned governor" $
pfield @"outRef" # input #== pinnedGovernor pfield @"outRef" # governorInput #== datum.governorRef
let govAddress = let govAddress =
pfield @"address" pfield @"address"
#$ pfield @"resolved" #$ pfield @"resolved"
#$ pfromData input #$ pfromData governorInput
filteredOutputs <- plet $ findOutputsToAddress # pfromData txInfo.outputs # govAddress filteredOutputs <- plet $ findOutputsToAddress # pfromData txInfo.outputs # govAddress
passert "Exactly one output to the governor" $ passert "Exactly one output to the governor" $
plength # filteredOutputs #== 1 plength # filteredOutputs #== 1
outputToGovernor <- plet $ phead # filteredOutputs governorOutput <- plet $ phead # filteredOutputs
passert "Governor's state token must stay at governor's address" $ passert "Governor's state token must stay at governor's address" $
(gstValueOf #$ pfield @"value" # outputToGovernor) #== 1 (gstValueOf #$ pfield @"value" # governorOutput) #== 1
outputDatumHash' <- pmatch $ pfromData $ pfield @"datumHash" # outputToGovernor let governorOutputDatumHash =
mustBePDJust # "Governor output doesn't have datum"
#$ pfromData
$ pfield @"datumHash" # governorOutput
governorOutputDatum =
pfromData @PGovernorDatum $
mustBePJust # "Governor output datum not found"
#$ ptryFindDatum # governorOutputDatumHash # txInfo.datums
case outputDatumHash' of passert "Unexpected governor datum" $ datum.newDatum #== governorOutputDatum
PDJust (pfromData . (pfield @"_0" #) -> outputDatumHash) -> P.do passert "New governor datum should be valid" $ governorDatumValid # governorOutputDatum
datum' <- pmatch $ pfindDatum # outputDatumHash # pfromData txInfo.datums
case datum' of
PJust datum -> P.do
passert "Unexpected output datum" $
pto datum #== newDatum
popaque $ pconstant () popaque $ pconstant ()
_ -> ptraceError "Output datum not found"
_ -> ptraceError "Ouput to governor should have datum"
where where
gstValueOf :: Term s (PValue :--> PInteger) gstValueOf :: Term s (PValue :--> PInteger)
gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn