Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

optimized validator

Browse source
This commit is contained in:
Seungheon Oh 2022-04-22 20:09:23 -05:00
parent bf13fd926e
commit 5c63764159
1 changed files with 27 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

57
agora/Agora/Effect/TreasuryWithdrawal.hs
View file

@ -92,41 +92,38 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
txInfo <- pletFields @'["outputs", "inputs"] txInfo' txInfo <- pletFields @'["outputs", "inputs"] txInfo'
PJust txOut <- pmatch $ findTxOutByTxOutRef # txOutRef' # pfromData txInfo' PJust txOut <- pmatch $ findTxOutByTxOutRef # txOutRef' # pfromData txInfo'
effInput <- pletFields @'["address", "value"] $ txOut effInput <- pletFields @'["address", "value"] $ txOut
let outputValues = outputValues <-
pmap
# plam
( \(pfromData -> txOut') -> P.do
txOut <- pletFields @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address
pdata $ ptuple # cred # txOut.value
)
# txInfo.outputs
inputValues =
pmap
# plam
( \((pfield @"resolved" #) . pfromData -> txOut') -> P.do
txOut <- pletFields @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address
pdata $ ptuple # cred # txOut.value
)
# txInfo.inputs
treasuryInputValues <-
plet $ plet $
pfilter pmap
# plam (\((pfield @"_0" #) . pfromData -> cred) -> pelem # cred # datum.treasuries) # plam
# inputValues ( \(pfromData -> txOut') -> P.do
let treasuryOutputValues = txOut <- pletFields @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address
pdata $ ptuple # cred # txOut.value
)
# txInfo.outputs
inputValues <-
plet $
pmap
# plam
( \((pfield @"resolved" #) . pfromData -> txOut') -> P.do
txOut <- pletFields @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address
pdata $ ptuple # cred # txOut.value
)
# txInfo.inputs
let ofTreasury =
pfilter pfilter
# plam # plam (\((pfield @"_0" #) . pfromData -> cred) -> pelem # cred # datum.treasuries)
(\((pfield @"_0" #) . pfromData -> cred) -> pelem # cred # datum.treasuries)
# outputValues
sumValues = sumValues =
pfoldr pfoldr
# plam (\((pfield @"_1" #) . pfromData -> x) y -> paddValue # pfromData x # y) # plam (\((pfield @"_1" #) . pfromData -> x) y -> paddValue # pfromData x # y)
# pconstant (mempty :: Value) # pconstant (mempty :: Value)
treasuryInputValuesSum = sumValues # treasuryInputValues treasuryInputValuesSum = sumValues #$ ofTreasury # inputValues
treasuryOutputValuesSum = sumValues # treasuryOutputValues treasuryOutputValuesSum = sumValues #$ ofTreasury # outputValues
receiverValuesSum = sumValues # datum.receivers receiverValuesSum = sumValues # datum.receivers
-- Constraints
outputContentMatchesRecivers = outputContentMatchesRecivers =
pall # plam (\out -> pelem # out # outputValues) pall # plam (\out -> pelem # out # outputValues)
#$ datum.receivers #$ datum.receivers
@ -148,8 +145,8 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
) )
# inputValues # inputValues
passert "Transaction output does not match receivers" outputContentMatchesRecivers
passert "Transaction should not pay to effects" shouldNotPayToEffect passert "Transaction should not pay to effects" shouldNotPayToEffect
passert "Transaction should only have treasuries specified in the datum as input" inputsAreOnlyTreasuries passert "Transaction output does not match receivers" outputContentMatchesRecivers
passert "Remainders should be returned to the treasury" excessShouldBePaidToInputs passert "Remainders should be returned to the treasury" excessShouldBePaidToInputs
passert "Transaction should only have treasuries specified in the datum as input" inputsAreOnlyTreasuries
popaque $ pconstant () popaque $ pconstant ()