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

Merge pull request #237 from Liqwid-Labs/connor/treasury-effect

Browse source 
Treasury withdrawal effect: reject unspentable script outputs
This commit is contained in:
emiflake 2023-04-04 17:35:39 +02:00 • committed by GitHub
commit 9e2b3e0cd3
6 changed files with 77 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

9
agora-specs/Sample/Effect/TreasuryWithdrawal.hs
View file

@ -34,7 +34,7 @@ import PlutusLedgerApi.V2 (
Value, Value,
) )
import PlutusLedgerApi.V3 (ScriptHash) import PlutusLedgerApi.V3 (ScriptHash)
import Sample.Shared (agoraScripts, authorityTokenPolicy, authorityTokenSymbol, signer, signer2, trScriptHash, trValidator) import Sample.Shared (agoraScripts, authorityTokenPolicy, authorityTokenSymbol, minAda, signer, signer2, trScriptHash, trValidator)
import Test.Specification (SpecificationTree, group, testPolicy, testValidator) import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
import Test.Util (CombinableBuilder, mkMinting, mkSpending, subtractValue, validatorHashes) import Test.Util (CombinableBuilder, mkMinting, mkSpending, subtractValue, validatorHashes)
@ -129,9 +129,10 @@ mkReceiverOutputBuilder ::
b b
mkReceiverOutputBuilder ps = mkReceiverOutputBuilder ps =
let mkOutputValue = let mkOutputValue =
if ps.badReceivedValue (minAda <>)
then const $ Value.singleton "" "bruh" 1 . if ps.badReceivedValue
else id then const $ Value.singleton "" "bruh" 1
else id
mkFinalOutputs = mkFinalOutputs =
mconcat mconcat
. (if ps.badReceiverOrder then reverse else id) . (if ps.badReceiverOrder then reverse else id)

4
agora-test/goldens/agora-golden.json
View file

@ -112,12 +112,12 @@
"version": "ScriptV2" "version": "ScriptV2"
}, },
"agora:treasuryWithdrawalValidator": { "agora:treasuryWithdrawalValidator": {
"cborHex": "590718590715010000323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330343370e900100109919299981b29981699b873301400f375660746460726072607200260700026466e052000001480084cdc3999119981a91119981080091800911999380220013005002330060050011324800126302700200123253330383233333301903c03f37520246eacc0f4c0ec0048c8c8c94ccc0f4cdc3a400000429405289821001181f0009baa303e303f303e00214a2607a00226602c0226eacc0f0c0e8c0f400458c8c0f0c0e8004c0f0004dd6181d000a400426464a66607066058605a466e1c005200033302070266446660466048e04008004cc0708c8c8c94ccc0f14cc0d4cc88cdd79ba73043002374e608600260800060102646464a66607e66e1d200200214a02944c110008c100004dd5000881d0a99981e198160009bac3040303e006137566080607c0042c6460806082002607e002607e607c6078002607c0026eb0c0f0004cc0708cc0a888004004dd6181e0011980e119299981d1981519181f9820000981f0009bac303e303c00413756607c60780022070607c00266606a444a66607800420022a6660780022c264a6660786605a44a6606a64646464a66608466e1d2002002132323253330453370e90000010a5013375e6e9c010dd3800982500118230009baa004132323253330453370e90010010a5013375e6e9c010dd3800982500118230009baa0043047002304300137540066460866088002608400626466ebcdd30011ba60013756608460800066080006266008607c006607c0042c6080607e0026eb0c0f0008dd6181e181d181d0008a4c2c6078607601e6eb004858c0e8c0e4034c0e000458c0e4008c0d4004dd5181a9819804a9998188008a4c2c60620066604046464646400aa66606466e1d20000021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022a66606466e1d20020021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022c606e00460660026ea8004dd6000981880098170019980e919191919002a99981799b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c926533303c001149858c0f0018c94ccc0e8cc0b88cc0c08cdc42400000200200220022c6eac010c0ccdd580199819919bb03232533303a5330333370e0029000099b87001480e04c0f400c58dc68009bae303b00132323230410043035375660800066606a466ec0c94ccc0eccdc49b8d001481004c0f800858dd7181e8009918208011bad30400010013756607c0020026eac004c0e4004c0d80194ccc0cccdc3a400000426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00454ccc0cccdc3a400400426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00458c0e0008c0d0004dd500098198008b181a00118180009baa0013758002605c0026eb0014c0b4008dd7002000911999998018130149ba9002001233300722337006eb4c0b000800520003756002290001111199980299803002001000919111801001980200089128009180e9129998118008912800899980198130009111801001898011812000911299981099baf00230030011223002003122500122301c22533302200110031330043025001300230230012233003300d00200130182223330040012300122333008220013005002330060050011300c49894ccc07000448940044c888c00800cc8c88cc00400c008c078008c07c004888ccc011c00010009111998021119980380280100080100091801911ba63300337560046eac0048c00888dd4198019bad002375a002444666600800644004004002460246004002446464466002006004444a6660340022660300060042646464a66603866ebc0080044cc06ccdd8001198049811003181100199980411001002980f0020a99980e19b90375c0046eb80044cc06c018cccc0208800400cc0780100144cc06c00ccccc02088004018014c078010c078008c074010c074004894ccc06000840044cccc00c88004c06c008c064008004804488c0080048c038894ccc0500045280a99980999baf301700100314a226004602a002446466006602c0026eacc058c050004c0580048c030894ccc04800440104cc040c00cc054004c008c04c0052f5c04466008460066eacc05400400488cc00c8c00cdd6980a000800918041129998070008a5115330043003301100113002300f0012233300b00200100314a046601000200429448ccc00c894ccc024004480104c894ccc028c004008584cc010c03000c8cdc80008019bae300b300c00100124a04600444a666010002200a26600c600660160026004601200246460044660040040024600446600400400297adef6c605740ae6955cfaba25573aae848c008dd5000aab9e1", "cborHex": "59083e59083b010000323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330403370e900100109919299982129981c99b873301400f3756608c64608a608a608a002608800260629001099b8733223330412223330210012300122333270044002600a0046600c00a002264900024c6044004002464a666088646666660320900966ea4048dd5982498238009191919299982499b87480000085280a51304e002304a00137546094609660940042944c1240044cc058044dd59824182318248008b191824182300098240009bac3046001480084c8c94ccc110cc0e0c0e48cdc3800a4000666040e04cc094cc0708c8c8c94ccc1214cc104cc88cdd79ba7304f002374e609e00260980060102646464a66609666e1d200200214a02944c140008c130004dd500088230a999824198138009bac304c304a00613756609860940042c646098609a002609600260966094609000260940026eb0c120004cc0708cc09488004004dd618240011980e119192999823a9981f19813191826182680098258011bac304b304900513303732304c304d001304b002304b3049001137566096002208a60900026094002666082444a66609000420022a6660900022c26464a6660926605244a66084a6608464646464a66609e66e1d2002002132323253330523370e90000010a5013375e6e9c010dd3800982b80118298009baa004132323253330523370e90010010a5013375e6e9c010dd3800982b80118298009baa0043054002305000137540066460a060a2002609e0082664464660846086466e2120000010013302e0020013756609e006002266076004609e609a006609a00826600a609600860960062c6094002609860960026eb0c120008dd61824182318230008a4c2c6090608e01e6eb004858c118c114034c11000458c114008c104004dd51820981f804a99981e8008a4c2c607a0066605846464646400aa66607c66e1d20000021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022a66607c66e1d20020021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022c6086004607e0026ea8004dd6000981e800981d00199814919191919002a99981d99b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c9265333048001149858c120018c94ccc118cc0e88cc0f08cdc42400000200200220022c6eac010c0fcdd58019981f919bb03232533304653303f3370e0029000099b87001480e04c12400c58dc68009bae3047001323232304d00430413756609800666082466ec0c94ccc11ccdc49b8d001481004c12800858dd718248009918268011bad304c001001375660940020026eac004c114004c1080194ccc0fccdc3a400000426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00454ccc0fccdc3a400400426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00458c110008c100004dd5000981f8008b1820001181e0009baa001375800260740026eb0014c0e4008dd70020009119999980181901a9ba9002001233300722337006eb4c0e00080052000375600229000111119998029980300200100091911180100198020008912800918149129998178008912800899980198190009111801001898011818000911299981699baf00230030011223002003122500122302822533302e001100313300430310013002302f0012233003300800200130242223330040012300122333008220013005002330060050011300749894ccc0a000448940044c888c00800cc8c88cc00400c008c0a8008c0ac004888ccc011c00010009111998049119980600280100080100090111118010009180f9129998128008a50153330243375e605000200629444c008c09800488c8cc00cc09c004dd598139812800981380091199801980238000233008300b0100012300322374c660066eac008dd580091801111ba833003375a0046eb4004888cccc01000c880080080048c064c00800488c8c88cc00400c0088894ccc0840044cc07c00c0084c8c8c94ccc08ccdd780100089981119bb0002330093029006302900333300822002005302500415333023337206eb8008dd70008998110031999804110008019812802002899811001999980411000803002981280218128011812002181200091299980f80108008999980191000981100118100010009119980180480100091119803998020018010009111919191919bb037520046e98004c014008c014008dd598108011bae301d001223330030060020012223300433005003002001223301200200122232323232337606ea4008dd4000980280118028011bad301d002375c60320024002466e0520000012232323253330153370e90000010a51132323253330183370e90000010a50153330183370e90020010a5113371e0126eb8c070004c074008c064004dd5002180d001180b0009baa002488120923918e403bf43c34b4ef6b48eb2ee04babed17320d8d1b9ff9ad086e86f44ec002300c225333012001100413301030033015001300230130014bd701119802118019bab3015001001223300323003375a60280020024601044a66601c002294454cc010c00cc0440044c008c03c00488ccc02c00800400c5281198040008010a512333003225333009001120041322533300a300100216133004300c0032337200020066eb8c02cc0300040049281180111299980400088028998031801980580098011804800919180111980100100091801119801001000a5eb7bdb1815d02b9a5573eae8955ceaba1230023754002aae79",
"description": "agora:treasuryWithdrawalValidator", "description": "agora:treasuryWithdrawalValidator",
"params": [ "params": [
"Ply.Core.Types:AsData#Data.Tagged:Tagged#GHC.TypeLits:\"AuthorityTokenTag\"#PlutusLedgerApi.V1.Value:CurrencySymbol" "Ply.Core.Types:AsData#Data.Tagged:Tagged#GHC.TypeLits:\"AuthorityTokenTag\"#PlutusLedgerApi.V1.Value:CurrencySymbol"
], ],
"rawHex": "590715010000323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330343370e900100109919299981b29981699b873301400f375660746460726072607200260700026466e052000001480084cdc3999119981a91119981080091800911999380220013005002330060050011324800126302700200123253330383233333301903c03f37520246eacc0f4c0ec0048c8c8c94ccc0f4cdc3a400000429405289821001181f0009baa303e303f303e00214a2607a00226602c0226eacc0f0c0e8c0f400458c8c0f0c0e8004c0f0004dd6181d000a400426464a66607066058605a466e1c005200033302070266446660466048e04008004cc0708c8c8c94ccc0f14cc0d4cc88cdd79ba73043002374e608600260800060102646464a66607e66e1d200200214a02944c110008c100004dd5000881d0a99981e198160009bac3040303e006137566080607c0042c6460806082002607e002607e607c6078002607c0026eb0c0f0004cc0708cc0a888004004dd6181e0011980e119299981d1981519181f9820000981f0009bac303e303c00413756607c60780022070607c00266606a444a66607800420022a6660780022c264a6660786605a44a6606a64646464a66608466e1d2002002132323253330453370e90000010a5013375e6e9c010dd3800982500118230009baa004132323253330453370e90010010a5013375e6e9c010dd3800982500118230009baa0043047002304300137540066460866088002608400626466ebcdd30011ba60013756608460800066080006266008607c006607c0042c6080607e0026eb0c0f0008dd6181e181d181d0008a4c2c6078607601e6eb004858c0e8c0e4034c0e000458c0e4008c0d4004dd5181a9819804a9998188008a4c2c60620066604046464646400aa66606466e1d20000021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022a66606466e1d20020021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022c606e00460660026ea8004dd6000981880098170019980e919191919002a99981799b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c926533303c001149858c0f0018c94ccc0e8cc0b88cc0c08cdc42400000200200220022c6eac010c0ccdd580199819919bb03232533303a5330333370e0029000099b87001480e04c0f400c58dc68009bae303b00132323230410043035375660800066606a466ec0c94ccc0eccdc49b8d001481004c0f800858dd7181e8009918208011bad30400010013756607c0020026eac004c0e4004c0d80194ccc0cccdc3a400000426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00454ccc0cccdc3a400400426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00458c0e0008c0d0004dd500098198008b181a00118180009baa0013758002605c0026eb0014c0b4008dd7002000911999998018130149ba9002001233300722337006eb4c0b000800520003756002290001111199980299803002001000919111801001980200089128009180e9129998118008912800899980198130009111801001898011812000911299981099baf00230030011223002003122500122301c22533302200110031330043025001300230230012233003300d00200130182223330040012300122333008220013005002330060050011300c49894ccc07000448940044c888c00800cc8c88cc00400c008c078008c07c004888ccc011c00010009111998021119980380280100080100091801911ba63300337560046eac0048c00888dd4198019bad002375a002444666600800644004004002460246004002446464466002006004444a6660340022660300060042646464a66603866ebc0080044cc06ccdd8001198049811003181100199980411001002980f0020a99980e19b90375c0046eb80044cc06c018cccc0208800400cc0780100144cc06c00ccccc02088004018014c078010c078008c074010c074004894ccc06000840044cccc00c88004c06c008c064008004804488c0080048c038894ccc0500045280a99980999baf301700100314a226004602a002446466006602c0026eacc058c050004c0580048c030894ccc04800440104cc040c00cc054004c008c04c0052f5c04466008460066eacc05400400488cc00c8c00cdd6980a000800918041129998070008a5115330043003301100113002300f0012233300b00200100314a046601000200429448ccc00c894ccc024004480104c894ccc028c004008584cc010c03000c8cdc80008019bae300b300c00100124a04600444a666010002200a26600c600660160026004601200246460044660040040024600446600400400297adef6c605740ae6955cfaba25573aae848c008dd5000aab9e1", "rawHex": "59083b010000323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330403370e900100109919299982129981c99b873301400f3756608c64608a608a608a002608800260629001099b8733223330412223330210012300122333270044002600a0046600c00a002264900024c6044004002464a666088646666660320900966ea4048dd5982498238009191919299982499b87480000085280a51304e002304a00137546094609660940042944c1240044cc058044dd59824182318248008b191824182300098240009bac3046001480084c8c94ccc110cc0e0c0e48cdc3800a4000666040e04cc094cc0708c8c8c94ccc1214cc104cc88cdd79ba7304f002374e609e00260980060102646464a66609666e1d200200214a02944c140008c130004dd500088230a999824198138009bac304c304a00613756609860940042c646098609a002609600260966094609000260940026eb0c120004cc0708cc09488004004dd618240011980e119192999823a9981f19813191826182680098258011bac304b304900513303732304c304d001304b002304b3049001137566096002208a60900026094002666082444a66609000420022a6660900022c26464a6660926605244a66084a6608464646464a66609e66e1d2002002132323253330523370e90000010a5013375e6e9c010dd3800982b80118298009baa004132323253330523370e90010010a5013375e6e9c010dd3800982b80118298009baa0043054002305000137540066460a060a2002609e0082664464660846086466e2120000010013302e0020013756609e006002266076004609e609a006609a00826600a609600860960062c6094002609860960026eb0c120008dd61824182318230008a4c2c6090608e01e6eb004858c118c114034c11000458c114008c104004dd51820981f804a99981e8008a4c2c607a0066605846464646400aa66607c66e1d20000021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022a66607c66e1d20020021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022c6086004607e0026ea8004dd6000981e800981d00199814919191919002a99981d99b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c9265333048001149858c120018c94ccc118cc0e88cc0f08cdc42400000200200220022c6eac010c0fcdd58019981f919bb03232533304653303f3370e0029000099b87001480e04c12400c58dc68009bae3047001323232304d00430413756609800666082466ec0c94ccc11ccdc49b8d001481004c12800858dd718248009918268011bad304c001001375660940020026eac004c114004c1080194ccc0fccdc3a400000426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00454ccc0fccdc3a400400426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00458c110008c100004dd5000981f8008b1820001181e0009baa001375800260740026eb0014c0e4008dd70020009119999980181901a9ba9002001233300722337006eb4c0e00080052000375600229000111119998029980300200100091911180100198020008912800918149129998178008912800899980198190009111801001898011818000911299981699baf00230030011223002003122500122302822533302e001100313300430310013002302f0012233003300800200130242223330040012300122333008220013005002330060050011300749894ccc0a000448940044c888c00800cc8c88cc00400c008c0a8008c0ac004888ccc011c00010009111998049119980600280100080100090111118010009180f9129998128008a50153330243375e605000200629444c008c09800488c8cc00cc09c004dd598139812800981380091199801980238000233008300b0100012300322374c660066eac008dd580091801111ba833003375a0046eb4004888cccc01000c880080080048c064c00800488c8c88cc00400c0088894ccc0840044cc07c00c0084c8c8c94ccc08ccdd780100089981119bb0002330093029006302900333300822002005302500415333023337206eb8008dd70008998110031999804110008019812802002899811001999980411000803002981280218128011812002181200091299980f80108008999980191000981100118100010009119980180480100091119803998020018010009111919191919bb037520046e98004c014008c014008dd598108011bae301d001223330030060020012223300433005003002001223301200200122232323232337606ea4008dd4000980280118028011bad301d002375c60320024002466e0520000012232323253330153370e90000010a51132323253330183370e90000010a50153330183370e90020010a5113371e0126eb8c070004c074008c064004dd5002180d001180b0009baa002488120923918e403bf43c34b4ef6b48eb2ee04babed17320d8d1b9ff9ad086e86f44ec002300c225333012001100413301030033015001300230130014bd701119802118019bab3015001001223300323003375a60280020024601044a66601c002294454cc010c00cc0440044c008c03c00488ccc02c00800400c5281198040008010a512333003225333009001120041322533300a300100216133004300c0032337200020066eb8c02cc0300040049281180111299980400088028998031801980580098011804800919180111980100100091801119801001000a5eb7bdb1815d02b9a5573eae8955ceaba1230023754002aae79",
"role": "ValidatorRole", "role": "ValidatorRole",
"version": "ScriptV2" "version": "ScriptV2"
} }

4
agora-test/goldens/agoraDebug-golden.json
View file

File diff suppressed because one or more lines are too long

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

@ -15,9 +15,11 @@ module Agora.Effect.TreasuryWithdrawal (
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.SafeMoney (AuthorityTokenTag) import Agora.SafeMoney (AuthorityTokenTag)
import Agora.Utils (psubtractSortedValue, puncurryTuple) import Agora.Utils (pisSubValueOf, psubtractSortedValue, puncurryTuple)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.Internal.Hashing (hashData)
import Plutarch.Api.V1 (PCredential, PCurrencySymbol, PValue) import Plutarch.Api.V1 (PCredential, PCurrencySymbol, PValue)
import Plutarch.Api.V1.Address (PCredential (PPubKeyCredential))
import Plutarch.Api.V1.Value (pforgetPositive) import Plutarch.Api.V1.Value (pforgetPositive)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
AmountGuarantees (Positive), AmountGuarantees (Positive),
@ -27,6 +29,7 @@ import Plutarch.Api.V2 (
PTxOut, PTxOut,
PValidator, PValidator,
) )
import Plutarch.Api.V2.Tx (POutputDatum (..))
import Plutarch.DataRepr ( import Plutarch.DataRepr (
PDataFields, PDataFields,
) )
@ -42,6 +45,7 @@ import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
import PlutusLedgerApi.V1.Credential (Credential) import PlutusLedgerApi.V1.Credential (Credential)
import PlutusLedgerApi.V1.Scripts (DatumHash (DatumHash))
import PlutusLedgerApi.V1.Value (Value) import PlutusLedgerApi.V1.Value (Value)
import PlutusTx qualified import PlutusTx qualified
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
@ -209,13 +213,18 @@ treasuryWithdrawalValidator = plam $
extractTreasuryOutputValue :: extractTreasuryOutputValue ::
Term _ (PTxOut :--> PValue 'Sorted 'Positive) Term _ (PTxOut :--> PValue 'Sorted 'Positive)
extractTreasuryOutputValue = plam $ extractTreasuryOutputValue = plam $
flip (pletFields @'["address", "value"]) $ \outputF -> flip (pletFields @'["address", "value", "datum"]) $ \outputF ->
let cred = pfield @"credential" # outputF.address let cred = pfield @"credential" # outputF.address
isTreasuryOutput = isTreasuryOutput =
pelem # cred # datumF.treasuries ptraceIfFalse "Should sent to one of the treasuries" $
pelem # pdata cred # datumF.treasuries
isDatumValid =
ptraceIfFalse "Valid output datum" $
checkOutputDatum # cred # outputF.datum
in pif in pif
isTreasuryOutput (isTreasuryOutput #&& isDatumValid)
outputF.value outputF.value
mempty mempty
@ -230,10 +239,11 @@ treasuryWithdrawalValidator = plam $
pure . popaque $ pconstant () pure . popaque $ pconstant ()
where where
-- Make sure that all the receivers get the correct payment and return the -- Make sure that all the receivers get the correct payment, return the
-- remaining outputs. -- remaining outputs.
--
-- This function is not hoisted cause it's used only once.
checkReceiverOutputs :: checkReceiverOutputs ::
forall (s :: S).
Term Term
s s
( PBuiltinList ( PBuiltinList
@ -245,7 +255,7 @@ treasuryWithdrawalValidator = plam $
pelimList pelimList
( \r rs -> ( \r rs ->
pelimList pelimList
( \o os -> pletFields @'["value", "address"] o $ \oF -> ( \o os -> pletFields @'["value", "address", "datum"] o $ \oF ->
let isValidReceiverOutput = let isValidReceiverOutput =
puncurryTuple puncurryTuple
# plam # plam
@ -255,7 +265,9 @@ treasuryWithdrawalValidator = plam $
[ ptraceIfFalse "Valid credential" $ [ ptraceIfFalse "Valid credential" $
expCred #== pfield @"credential" # oF.address expCred #== pfield @"credential" # oF.address
, ptraceIfFalse "Valid value" $ , ptraceIfFalse "Valid value" $
expVal #== oF.value pisSubValueOf # oF.value # expVal
, ptraceIfFalse "Valid output datum" $
checkOutputDatum # expCred # oF.datum
] ]
) )
# pfromData r # pfromData r
@ -269,3 +281,17 @@ treasuryWithdrawalValidator = plam $
) )
outputs outputs
receivers receivers
unitDatum = PlutusTx.toData ()
unitDatumHash = DatumHash $ hashData unitDatum
checkOutputDatum :: Term s (PCredential :--> POutputDatum :--> PBool)
checkOutputDatum = phoistAcyclic $ plam $ \cred datum -> pmatch cred $
\case
PPubKeyCredential _ -> pcon PTrue
_ -> pmatch datum $ \case
PNoOutputDatum _ -> pcon PFalse
POutputDatum _ -> pcon PTrue
POutputDatumHash ((pfield @"datumHash" #) -> hash) ->
pconstant unitDatumHash #== hash

34
agora/Agora/Utils.hs
View file

@ -20,10 +20,12 @@ module Agora.Utils (
phashDatum, phashDatum,
puncurryTuple, puncurryTuple,
psubtractSortedValue, psubtractSortedValue,
pisSubValueOf,
) where ) where
import Plutarch.Api.V1 (KeyGuarantees (Sorted)) import Plutarch.Api.V1 (AmountGuarantees (Positive), KeyGuarantees (Sorted))
import Plutarch.Api.V1.AssocMap (punionWith) import Plutarch.Api.V1.AssocMap (punionWith)
import Plutarch.Api.V1.AssocMap qualified as AssocMap
import Plutarch.Api.V1.Scripts (PDatumHash (PDatumHash)) import Plutarch.Api.V1.Scripts (PDatumHash (PDatumHash))
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
AmountGuarantees (NoGuarantees), AmountGuarantees (NoGuarantees),
@ -37,9 +39,10 @@ import Plutarch.Crypto (pblake2b_256)
import Plutarch.DataRepr (punDataSum) import Plutarch.DataRepr (punDataSum)
import Plutarch.Extra.AssetClass (PAssetClass, PAssetClassData, ptoScottEncoding) import Plutarch.Extra.AssetClass (PAssetClass, PAssetClassData, ptoScottEncoding)
import Plutarch.Extra.Field (pletAll) import Plutarch.Extra.Field (pletAll)
import Plutarch.Extra.Functor (PFunctor (pfmap))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Extra.Value (psymbolValueOf) import Plutarch.Extra.Value (psymbolValueOf)
import Plutarch.Num ((#-)) import Plutarch.Num (PNum (pnegate, (#+)))
import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast) import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
@ -167,6 +170,31 @@ psubtractSortedValue ::
psubtractSortedValue = phoistAcyclic $ plam $ \a b -> psubtractSortedValue = phoistAcyclic $ plam $ \a b ->
punsafeCoerce $ punsafeCoerce $
punionWith punionWith
# (punionWith # plam (#-)) # (punionWith # plam (#+))
# pto a # pto a
#$ pfmap
# (pfmap # pnegate)
# pto b # pto b
pisPositiveValue ::
forall (kg :: KeyGuarantees) (am :: AmountGuarantees) (s :: S).
Term s (PValue kg am :--> PBool)
pisPositiveValue =
phoistAcyclic $
plam $
(AssocMap.pall # (AssocMap.pall # plam (0 #<)) #)
. pto
pisSubValueOf ::
forall (s :: S).
Term
s
( PValue 'Sorted 'Positive
:--> PValue 'Sorted 'Positive
:--> PBool
)
pisSubValueOf = phoistAcyclic $ plam $ \vl vr ->
pisPositiveValue
#$ psubtractSortedValue
# vl
# vr

6
bench.csv
View file

@ -1,9 +1,9 @@
name,cpu,mem,size name,cpu,mem,size
Agora/Effects/Treasury Withdrawal Effect/totally valid/effect,307988057,881427,4118 Agora/Effects/Treasury Withdrawal Effect/totally valid/effect,404221466,1186248,4516
Agora/Effects/Treasury Withdrawal Effect/totally valid/treasury,55756262,158723,1778 Agora/Effects/Treasury Withdrawal Effect/totally valid/treasury,55756262,158723,1778
Agora/Effects/Treasury Withdrawal Effect/totally valid/authority,12933097,37168,2361 Agora/Effects/Treasury Withdrawal Effect/totally valid/authority,12933097,37168,2361
Agora/Effects/Treasury Withdrawal Effect/bad received value/treasury,55756262,158723,1778 Agora/Effects/Treasury Withdrawal Effect/bad received value/treasury,55756262,158723,1796
Agora/Effects/Treasury Withdrawal Effect/bad received value/authority,12933097,37168,2361 Agora/Effects/Treasury Withdrawal Effect/bad received value/authority,12933097,37168,2379
Agora/Effects/Treasury Withdrawal Effect/bad receiver order/treasury,55756262,158723,1778 Agora/Effects/Treasury Withdrawal Effect/bad receiver order/treasury,55756262,158723,1778
Agora/Effects/Treasury Withdrawal Effect/bad receiver order/authority,12933097,37168,2361 Agora/Effects/Treasury Withdrawal Effect/bad receiver order/authority,12933097,37168,2361
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,127096099,363203,11972 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,127096099,363203,11972

1 name cpu mem size
2 Agora/Effects/Treasury Withdrawal Effect/totally valid/effect 307988057 404221466 881427 1186248 4118 4516
3 Agora/Effects/Treasury Withdrawal Effect/totally valid/treasury 55756262 158723 1778
4 Agora/Effects/Treasury Withdrawal Effect/totally valid/authority 12933097 37168 2361
5 Agora/Effects/Treasury Withdrawal Effect/bad received value/treasury 55756262 158723 1778 1796
6 Agora/Effects/Treasury Withdrawal Effect/bad received value/authority 12933097 37168 2361 2379
7 Agora/Effects/Treasury Withdrawal Effect/bad receiver order/treasury 55756262 158723 1778
8 Agora/Effects/Treasury Withdrawal Effect/bad receiver order/authority 12933097 37168 2361
9 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass 127096099 363203 11972