Treasury Withdrawal Effect checks if remainder is to the treasury

It checks if transaction is paying the remainders to the treasury.
This commit is contained in:
Seungheon Oh 2022-04-18 13:03:10 -05:00
parent 0b90e041c6
commit c9adf02614

View file

@ -13,15 +13,16 @@ import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I)) import Generics.SOP (Generic, I (I))
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Utils (findTxOutByTxOutRef, passert) import Agora.Utils ( paddValue, passert )
import Plutarch (popaque) import Plutarch (popaque)
import Plutarch.Api.V1 ( import Plutarch.Api.V1
PCredential, ( PCredential,
PTuple, PValue,
PValidator, PTxOut(PTxOut),
PValue, PTxInInfo(PTxInInfo),
ptuple, PTuple,
) ptuple,
PValidator )
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
@ -78,9 +79,9 @@ It can be more flexiable over...
-} -}
treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
\_cs (datum' :: Term _ PTreasuryWithdrawalDatum) txOutRef' txInfo' -> P.do \_cs (datum' :: Term _ PTreasuryWithdrawalDatum) _txOutRef' txInfo' -> P.do
receivers <- plet $ pfromData $ pfield @"receivers" # datum' receivers <- plet $ pfromData $ pfield @"receivers" # datum'
txInfo <- pletFields @'["outputs"] txInfo' txInfo <- pletFields @'["outputs", "inputs"] txInfo'
let outputValues = let outputValues =
pmap pmap
# plam # plam
@ -89,25 +90,41 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
cred <- pletFields @'["credential"] $ pfromData out.address cred <- pletFields @'["credential"] $ pfromData out.address
pdata $ ptuple # cred.credential # out.value pdata $ ptuple # cred.credential # out.value
) )
#$ txInfo.outputs # txInfo.outputs
outputContentMatchesRecivers = outputContentMatchesRecivers =
pall # plam (\out -> pelem # out # outputValues) pall # plam (\out -> pelem # out # outputValues)
#$ receivers #$ receivers
outputNumberMatchesReceivers = plength # receivers #== plength # (pfromData txInfo.outputs) sumValues =
outputIsNotPayingToEffect = P.do pfoldr
PJust txOut <- pmatch $ findTxOutByTxOutRef # txOutRef' # pfromData txInfo' # plam
input <- pletFields @'["address", "value"] $ txOut ( \((pfield @"_1" #) . pfromData -> x) y -> P.do
let notPayingToEffect = paddValue # (pfromData x) # y
pnot #$ pany )
# plam # (pconstant (mempty :: Value))
( \x -> inputCred =
input.address #== pfield @"address" # pfromData x pmap
) # plam (\inInfo -> P.do
# pfromData txInfo.outputs PTxInInfo inInfo' <- pmatch $ pfromData inInfo
notPayingToEffect PTxOut out <- pmatch $ pfromData $ pfield @"resolved" # inInfo'
let addr = pfromData $ pfield @"address" # out
pfield @"credential" # addr)
# pfromData txInfo.inputs
totalInput =
pfoldr
# plam (\x' y -> P.do
PTxInInfo x <- pmatch $ pfromData x'
PTxOut out <- pmatch $ pfromData $ pfield @"resolved" # x
paddValue # (pfromData $ pfield @"value" # out) # y)
# (pconstant (mempty :: Value))
# pfromData txInfo.inputs
sumOutputsToInputAddr = sumValues #$
pfilter
# plam (\((pfield @"_0" #) . pfromData -> addr) -> pelem # (addr) # inputCred) # outputValues
sumReceivers = sumValues # receivers
-- TODO: Probably need to check/exclude the effect input...
excessShouldBePaidToInputs = pdata (paddValue # sumReceivers # sumOutputsToInputAddr) #== pdata totalInput
passert "Transaction output does not match receivers" outputContentMatchesRecivers passert "Transaction output does not match receivers" outputContentMatchesRecivers
passert "" outputNumberMatchesReceivers passert "Remainders should be returned to the treasury" excessShouldBePaidToInputs
passert "" outputIsNotPayingToEffect
popaque $ pconstant () popaque $ pconstant ()