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

Treasury withdrawal effect: reject unspentable script outputs
2023-04-04 17:35:39 +02:00 · 2023-04-04 17:35:39 +02:00 · b4d7c1af42
commit b4d7c1af42
parent 838b37b56b a02019bd6d
6 changed files with 77 additions and 22 deletions
--- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
+++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs
@ -34,7 +34,7 @@ import PlutusLedgerApi.V2 (
  Value,
 )
 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.Util (CombinableBuilder, mkMinting, mkSpending, subtractValue, validatorHashes)

@ -129,9 +129,10 @@ mkReceiverOutputBuilder ::
  b
 mkReceiverOutputBuilder ps =
  let mkOutputValue =
-        if ps.badReceivedValue
-          then const $ Value.singleton "" "bruh" 1
-          else id
+        (minAda <>)
+          . if ps.badReceivedValue
+            then const $ Value.singleton "" "bruh" 1
+            else id
      mkFinalOutputs =
        mconcat
          . (if ps.badReceiverOrder then reverse else id)
--- a/agora-test/goldens/agora-golden.json
+++ b/agora-test/goldens/agora-golden.json
@ -112,12 +112,12 @@
            "version": "ScriptV2"
        },
        "agora:treasuryWithdrawalValidator": {
-            "cborHex": "590718590715010000323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330343370e900100109919299981b29981699b873301400f375660746460726072607200260700026466e052000001480084cdc3999119981a91119981080091800911999380220013005002330060050011324800126302700200123253330383233333301903c03f37520246eacc0f4c0ec0048c8c8c94ccc0f4cdc3a400000429405289821001181f0009baa303e303f303e00214a2607a00226602c0226eacc0f0c0e8c0f400458c8c0f0c0e8004c0f0004dd6181d000a400426464a66607066058605a466e1c005200033302070266446660466048e04008004cc0708c8c8c94ccc0f14cc0d4cc88cdd79ba73043002374e608600260800060102646464a66607e66e1d200200214a02944c110008c100004dd5000881d0a99981e198160009bac3040303e006137566080607c0042c6460806082002607e002607e607c6078002607c0026eb0c0f0004cc0708cc0a888004004dd6181e0011980e119299981d1981519181f9820000981f0009bac303e303c00413756607c60780022070607c00266606a444a66607800420022a6660780022c264a6660786605a44a6606a64646464a66608466e1d2002002132323253330453370e90000010a5013375e6e9c010dd3800982500118230009baa004132323253330453370e90010010a5013375e6e9c010dd3800982500118230009baa0043047002304300137540066460866088002608400626466ebcdd30011ba60013756608460800066080006266008607c006607c0042c6080607e0026eb0c0f0008dd6181e181d181d0008a4c2c6078607601e6eb004858c0e8c0e4034c0e000458c0e4008c0d4004dd5181a9819804a9998188008a4c2c60620066604046464646400aa66606466e1d20000021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022a66606466e1d20020021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022c606e00460660026ea8004dd6000981880098170019980e919191919002a99981799b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c926533303c001149858c0f0018c94ccc0e8cc0b88cc0c08cdc42400000200200220022c6eac010c0ccdd580199819919bb03232533303a5330333370e0029000099b87001480e04c0f400c58dc68009bae303b00132323230410043035375660800066606a466ec0c94ccc0eccdc49b8d001481004c0f800858dd7181e8009918208011bad30400010013756607c0020026eac004c0e4004c0d80194ccc0cccdc3a400000426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00454ccc0cccdc3a400400426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00458c0e0008c0d0004dd500098198008b181a00118180009baa0013758002605c0026eb0014c0b4008dd7002000911999998018130149ba9002001233300722337006eb4c0b000800520003756002290001111199980299803002001000919111801001980200089128009180e9129998118008912800899980198130009111801001898011812000911299981099baf00230030011223002003122500122301c22533302200110031330043025001300230230012233003300d00200130182223330040012300122333008220013005002330060050011300c49894ccc07000448940044c888c00800cc8c88cc00400c008c078008c07c004888ccc011c00010009111998021119980380280100080100091801911ba63300337560046eac0048c00888dd4198019bad002375a002444666600800644004004002460246004002446464466002006004444a6660340022660300060042646464a66603866ebc0080044cc06ccdd8001198049811003181100199980411001002980f0020a99980e19b90375c0046eb80044cc06c018cccc0208800400cc0780100144cc06c00ccccc02088004018014c078010c078008c074010c074004894ccc06000840044cccc00c88004c06c008c064008004804488c0080048c038894ccc0500045280a99980999baf301700100314a226004602a002446466006602c0026eacc058c050004c0580048c030894ccc04800440104cc040c00cc054004c008c04c0052f5c04466008460066eacc05400400488cc00c8c00cdd6980a000800918041129998070008a5115330043003301100113002300f0012233300b00200100314a046601000200429448ccc00c894ccc024004480104c894ccc028c004008584cc010c03000c8cdc80008019bae300b300c00100124a04600444a666010002200a26600c600660160026004601200246460044660040040024600446600400400297adef6c605740ae6955cfaba25573aae848c008dd5000aab9e1",
+            "cborHex": "59083e59083b010000323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330403370e900100109919299982129981c99b873301400f3756608c64608a608a608a002608800260629001099b8733223330412223330210012300122333270044002600a0046600c00a002264900024c6044004002464a666088646666660320900966ea4048dd5982498238009191919299982499b87480000085280a51304e002304a00137546094609660940042944c1240044cc058044dd59824182318248008b191824182300098240009bac3046001480084c8c94ccc110cc0e0c0e48cdc3800a4000666040e04cc094cc0708c8c8c94ccc1214cc104cc88cdd79ba7304f002374e609e00260980060102646464a66609666e1d200200214a02944c140008c130004dd500088230a999824198138009bac304c304a00613756609860940042c646098609a002609600260966094609000260940026eb0c120004cc0708cc09488004004dd618240011980e119192999823a9981f19813191826182680098258011bac304b304900513303732304c304d001304b002304b3049001137566096002208a60900026094002666082444a66609000420022a6660900022c26464a6660926605244a66084a6608464646464a66609e66e1d2002002132323253330523370e90000010a5013375e6e9c010dd3800982b80118298009baa004132323253330523370e90010010a5013375e6e9c010dd3800982b80118298009baa0043054002305000137540066460a060a2002609e0082664464660846086466e2120000010013302e0020013756609e006002266076004609e609a006609a00826600a609600860960062c6094002609860960026eb0c120008dd61824182318230008a4c2c6090608e01e6eb004858c118c114034c11000458c114008c104004dd51820981f804a99981e8008a4c2c607a0066605846464646400aa66607c66e1d20000021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022a66607c66e1d20020021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022c6086004607e0026ea8004dd6000981e800981d00199814919191919002a99981d99b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c9265333048001149858c120018c94ccc118cc0e88cc0f08cdc42400000200200220022c6eac010c0fcdd58019981f919bb03232533304653303f3370e0029000099b87001480e04c12400c58dc68009bae3047001323232304d00430413756609800666082466ec0c94ccc11ccdc49b8d001481004c12800858dd718248009918268011bad304c001001375660940020026eac004c114004c1080194ccc0fccdc3a400000426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00454ccc0fccdc3a400400426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00458c110008c100004dd5000981f8008b1820001181e0009baa001375800260740026eb0014c0e4008dd70020009119999980181901a9ba9002001233300722337006eb4c0e00080052000375600229000111119998029980300200100091911180100198020008912800918149129998178008912800899980198190009111801001898011818000911299981699baf00230030011223002003122500122302822533302e001100313300430310013002302f0012233003300800200130242223330040012300122333008220013005002330060050011300749894ccc0a000448940044c888c00800cc8c88cc00400c008c0a8008c0ac004888ccc011c00010009111998049119980600280100080100090111118010009180f9129998128008a50153330243375e605000200629444c008c09800488c8cc00cc09c004dd598139812800981380091199801980238000233008300b0100012300322374c660066eac008dd580091801111ba833003375a0046eb4004888cccc01000c880080080048c064c00800488c8c88cc00400c0088894ccc0840044cc07c00c0084c8c8c94ccc08ccdd780100089981119bb0002330093029006302900333300822002005302500415333023337206eb8008dd70008998110031999804110008019812802002899811001999980411000803002981280218128011812002181200091299980f80108008999980191000981100118100010009119980180480100091119803998020018010009111919191919bb037520046e98004c014008c014008dd598108011bae301d001223330030060020012223300433005003002001223301200200122232323232337606ea4008dd4000980280118028011bad301d002375c60320024002466e0520000012232323253330153370e90000010a51132323253330183370e90000010a50153330183370e90020010a5113371e0126eb8c070004c074008c064004dd5002180d001180b0009baa002488120923918e403bf43c34b4ef6b48eb2ee04babed17320d8d1b9ff9ad086e86f44ec002300c225333012001100413301030033015001300230130014bd701119802118019bab3015001001223300323003375a60280020024601044a66601c002294454cc010c00cc0440044c008c03c00488ccc02c00800400c5281198040008010a512333003225333009001120041322533300a300100216133004300c0032337200020066eb8c02cc0300040049281180111299980400088028998031801980580098011804800919180111980100100091801119801001000a5eb7bdb1815d02b9a5573eae8955ceaba1230023754002aae79",
            "description": "agora:treasuryWithdrawalValidator",
            "params": [
                "Ply.Core.Types:AsData#Data.Tagged:Tagged#GHC.TypeLits:\"AuthorityTokenTag\"#PlutusLedgerApi.V1.Value:CurrencySymbol"
            ],
-            "rawHex": "590715010000323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330343370e900100109919299981b29981699b873301400f375660746460726072607200260700026466e052000001480084cdc3999119981a91119981080091800911999380220013005002330060050011324800126302700200123253330383233333301903c03f37520246eacc0f4c0ec0048c8c8c94ccc0f4cdc3a400000429405289821001181f0009baa303e303f303e00214a2607a00226602c0226eacc0f0c0e8c0f400458c8c0f0c0e8004c0f0004dd6181d000a400426464a66607066058605a466e1c005200033302070266446660466048e04008004cc0708c8c8c94ccc0f14cc0d4cc88cdd79ba73043002374e608600260800060102646464a66607e66e1d200200214a02944c110008c100004dd5000881d0a99981e198160009bac3040303e006137566080607c0042c6460806082002607e002607e607c6078002607c0026eb0c0f0004cc0708cc0a888004004dd6181e0011980e119299981d1981519181f9820000981f0009bac303e303c00413756607c60780022070607c00266606a444a66607800420022a6660780022c264a6660786605a44a6606a64646464a66608466e1d2002002132323253330453370e90000010a5013375e6e9c010dd3800982500118230009baa004132323253330453370e90010010a5013375e6e9c010dd3800982500118230009baa0043047002304300137540066460866088002608400626466ebcdd30011ba60013756608460800066080006266008607c006607c0042c6080607e0026eb0c0f0008dd6181e181d181d0008a4c2c6078607601e6eb004858c0e8c0e4034c0e000458c0e4008c0d4004dd5181a9819804a9998188008a4c2c60620066604046464646400aa66606466e1d20000021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022a66606466e1d20020021323253330343370e6e340052038132324994ccc0d800452616303600316375c002606c0022c606e00460660026ea8004dd6000981880098170019980e919191919002a99981799b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c926533303c001149858c0f0018c94ccc0e8cc0b88cc0c08cdc42400000200200220022c6eac010c0ccdd580199819919bb03232533303a5330333370e0029000099b87001480e04c0f400c58dc68009bae303b00132323230410043035375660800066606a466ec0c94ccc0eccdc49b8d001481004c0f800858dd7181e8009918208011bad30400010013756607c0020026eac004c0e4004c0d80194ccc0cccdc3a400000426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00454ccc0cccdc3a400400426464a66606a66e1cdc6800a40702646493299981b8008a4c2c606e0062c6eb8004c0dc00458c0e0008c0d0004dd500098198008b181a00118180009baa0013758002605c0026eb0014c0b4008dd7002000911999998018130149ba9002001233300722337006eb4c0b000800520003756002290001111199980299803002001000919111801001980200089128009180e9129998118008912800899980198130009111801001898011812000911299981099baf00230030011223002003122500122301c22533302200110031330043025001300230230012233003300d00200130182223330040012300122333008220013005002330060050011300c49894ccc07000448940044c888c00800cc8c88cc00400c008c078008c07c004888ccc011c00010009111998021119980380280100080100091801911ba63300337560046eac0048c00888dd4198019bad002375a002444666600800644004004002460246004002446464466002006004444a6660340022660300060042646464a66603866ebc0080044cc06ccdd8001198049811003181100199980411001002980f0020a99980e19b90375c0046eb80044cc06c018cccc0208800400cc0780100144cc06c00ccccc02088004018014c078010c078008c074010c074004894ccc06000840044cccc00c88004c06c008c064008004804488c0080048c038894ccc0500045280a99980999baf301700100314a226004602a002446466006602c0026eacc058c050004c0580048c030894ccc04800440104cc040c00cc054004c008c04c0052f5c04466008460066eacc05400400488cc00c8c00cdd6980a000800918041129998070008a5115330043003301100113002300f0012233300b00200100314a046601000200429448ccc00c894ccc024004480104c894ccc028c004008584cc010c03000c8cdc80008019bae300b300c00100124a04600444a666010002200a26600c600660160026004601200246460044660040040024600446600400400297adef6c605740ae6955cfaba25573aae848c008dd5000aab9e1",
+            "rawHex": "59083b010000323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323232323222223232323232323232323232323253330403370e900100109919299982129981c99b873301400f3756608c64608a608a608a002608800260629001099b8733223330412223330210012300122333270044002600a0046600c00a002264900024c6044004002464a666088646666660320900966ea4048dd5982498238009191919299982499b87480000085280a51304e002304a00137546094609660940042944c1240044cc058044dd59824182318248008b191824182300098240009bac3046001480084c8c94ccc110cc0e0c0e48cdc3800a4000666040e04cc094cc0708c8c8c94ccc1214cc104cc88cdd79ba7304f002374e609e00260980060102646464a66609666e1d200200214a02944c140008c130004dd500088230a999824198138009bac304c304a00613756609860940042c646098609a002609600260966094609000260940026eb0c120004cc0708cc09488004004dd618240011980e119192999823a9981f19813191826182680098258011bac304b304900513303732304c304d001304b002304b3049001137566096002208a60900026094002666082444a66609000420022a6660900022c26464a6660926605244a66084a6608464646464a66609e66e1d2002002132323253330523370e90000010a5013375e6e9c010dd3800982b80118298009baa004132323253330523370e90010010a5013375e6e9c010dd3800982b80118298009baa0043054002305000137540066460a060a2002609e0082664464660846086466e2120000010013302e0020013756609e006002266076004609e609a006609a00826600a609600860960062c6094002609860960026eb0c120008dd61824182318230008a4c2c6090608e01e6eb004858c118c114034c11000458c114008c104004dd51820981f804a99981e8008a4c2c607a0066605846464646400aa66607c66e1d20000021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022a66607c66e1d20020021323253330403370e6e340052038132324994ccc10800452616304200316375c00260840022c6086004607e0026ea8004dd6000981e800981d00199814919191919002a99981d99b87480000084c8c8c8c8c8c8c8c8c8c8c8c8c9265333048001149858c120018c94ccc118cc0e88cc0f08cdc42400000200200220022c6eac010c0fcdd58019981f919bb03232533304653303f3370e0029000099b87001480e04c12400c58dc68009bae3047001323232304d00430413756609800666082466ec0c94ccc11ccdc49b8d001481004c12800858dd718248009918268011bad304c001001375660940020026eac004c114004c1080194ccc0fccdc3a400000426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00454ccc0fccdc3a400400426464a66608266e1cdc6800a4070264649329998218008a4c2c60860062c6eb8004c10c00458c110008c100004dd5000981f8008b1820001181e0009baa001375800260740026eb0014c0e4008dd70020009119999980181901a9ba9002001233300722337006eb4c0e00080052000375600229000111119998029980300200100091911180100198020008912800918149129998178008912800899980198190009111801001898011818000911299981699baf00230030011223002003122500122302822533302e001100313300430310013002302f0012233003300800200130242223330040012300122333008220013005002330060050011300749894ccc0a000448940044c888c00800cc8c88cc00400c008c0a8008c0ac004888ccc011c00010009111998049119980600280100080100090111118010009180f9129998128008a50153330243375e605000200629444c008c09800488c8cc00cc09c004dd598139812800981380091199801980238000233008300b0100012300322374c660066eac008dd580091801111ba833003375a0046eb4004888cccc01000c880080080048c064c00800488c8c88cc00400c0088894ccc0840044cc07c00c0084c8c8c94ccc08ccdd780100089981119bb0002330093029006302900333300822002005302500415333023337206eb8008dd70008998110031999804110008019812802002899811001999980411000803002981280218128011812002181200091299980f80108008999980191000981100118100010009119980180480100091119803998020018010009111919191919bb037520046e98004c014008c014008dd598108011bae301d001223330030060020012223300433005003002001223301200200122232323232337606ea4008dd4000980280118028011bad301d002375c60320024002466e0520000012232323253330153370e90000010a51132323253330183370e90000010a50153330183370e90020010a5113371e0126eb8c070004c074008c064004dd5002180d001180b0009baa002488120923918e403bf43c34b4ef6b48eb2ee04babed17320d8d1b9ff9ad086e86f44ec002300c225333012001100413301030033015001300230130014bd701119802118019bab3015001001223300323003375a60280020024601044a66601c002294454cc010c00cc0440044c008c03c00488ccc02c00800400c5281198040008010a512333003225333009001120041322533300a300100216133004300c0032337200020066eb8c02cc0300040049281180111299980400088028998031801980580098011804800919180111980100100091801119801001000a5eb7bdb1815d02b9a5573eae8955ceaba1230023754002aae79",
            "role": "ValidatorRole",
            "version": "ScriptV2"
        }
--- a/agora-test/goldens/agoraDebug-golden.json
+++ b/agora-test/goldens/agoraDebug-golden.json
--- a/agora/Agora/Effect/TreasuryWithdrawal.hs
+++ b/agora/Agora/Effect/TreasuryWithdrawal.hs
@ -15,9 +15,11 @@ module Agora.Effect.TreasuryWithdrawal (

 import Agora.Effect (makeEffect)
 import Agora.SafeMoney (AuthorityTokenTag)
-import Agora.Utils (psubtractSortedValue, puncurryTuple)
+import Agora.Utils (pisSubValueOf, psubtractSortedValue, puncurryTuple)
 import Generics.SOP qualified as SOP
+import Plutarch.Api.Internal.Hashing (hashData)
 import Plutarch.Api.V1 (PCredential, PCurrencySymbol, PValue)
+import Plutarch.Api.V1.Address (PCredential (PPubKeyCredential))
 import Plutarch.Api.V1.Value (pforgetPositive)
 import Plutarch.Api.V2 (
  AmountGuarantees (Positive),
@ -27,6 +29,7 @@ import Plutarch.Api.V2 (
  PTxOut,
  PValidator,
 )
+import Plutarch.Api.V2.Tx (POutputDatum (..))
 import Plutarch.DataRepr (
  PDataFields,
 )
@ -42,6 +45,7 @@ import Plutarch.Extra.Tagged (PTagged)
 import Plutarch.Extra.Traversable (pfoldMap)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
 import PlutusLedgerApi.V1.Credential (Credential)
+import PlutusLedgerApi.V1.Scripts (DatumHash (DatumHash))
 import PlutusLedgerApi.V1.Value (Value)
 import PlutusTx qualified
 import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
@ -209,13 +213,18 @@ treasuryWithdrawalValidator = plam $
        extractTreasuryOutputValue ::
          Term _ (PTxOut :--> PValue 'Sorted 'Positive)
        extractTreasuryOutputValue = plam $
-          flip (pletFields @'["address", "value"]) $ \outputF ->
+          flip (pletFields @'["address", "value", "datum"]) $ \outputF ->
            let cred = pfield @"credential" # outputF.address

                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
-                  isTreasuryOutput
+                  (isTreasuryOutput #&& isDatumValid)
                  outputF.value
                  mempty

@ -230,10 +239,11 @@ treasuryWithdrawalValidator = plam $

      pure . popaque $ pconstant ()
  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.
+    --
+    -- This function is not hoisted cause it's used only once.
    checkReceiverOutputs ::
-      forall (s :: S).
      Term
        s
        ( PBuiltinList
@ -245,7 +255,7 @@ treasuryWithdrawalValidator = plam $
      pelimList
        ( \r rs ->
            pelimList
-              ( \o os -> pletFields @'["value", "address"] o $ \oF ->
+              ( \o os -> pletFields @'["value", "address", "datum"] o $ \oF ->
                  let isValidReceiverOutput =
                        puncurryTuple
                          # plam
@ -255,7 +265,9 @@ treasuryWithdrawalValidator = plam $
                                  [ ptraceIfFalse "Valid credential" $
                                      expCred #== pfield @"credential" # oF.address
                                  , ptraceIfFalse "Valid value" $
-                                      expVal #== oF.value
+                                      pisSubValueOf # oF.value # expVal
+                                  , ptraceIfFalse "Valid output datum" $
+                                      checkOutputDatum # expCred # oF.datum
                                  ]
                            )
                          # pfromData r
@ -269,3 +281,17 @@ treasuryWithdrawalValidator = plam $
        )
        outputs
        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
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@ -20,10 +20,12 @@ module Agora.Utils (
  phashDatum,
  puncurryTuple,
  psubtractSortedValue,
+  pisSubValueOf,
 ) 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 qualified as AssocMap
 import Plutarch.Api.V1.Scripts (PDatumHash (PDatumHash))
 import Plutarch.Api.V2 (
  AmountGuarantees (NoGuarantees),
@ -37,9 +39,10 @@ import Plutarch.Crypto (pblake2b_256)
 import Plutarch.DataRepr (punDataSum)
 import Plutarch.Extra.AssetClass (PAssetClass, PAssetClassData, ptoScottEncoding)
 import Plutarch.Extra.Field (pletAll)
+import Plutarch.Extra.Functor (PFunctor (pfmap))
 import Plutarch.Extra.Tagged (PTagged)
 import Plutarch.Extra.Value (psymbolValueOf)
-import Plutarch.Num ((#-))
+import Plutarch.Num (PNum (pnegate, (#+)))
 import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast)
 import PlutusLedgerApi.V2 (
  Address (Address),
@ -167,6 +170,31 @@ psubtractSortedValue ::
 psubtractSortedValue = phoistAcyclic $ plam $ \a b ->
  punsafeCoerce $
    punionWith
-      # (punionWith # plam (#-))
+      # (punionWith # plam (#+))
      # pto a
+      #$ pfmap
+      # (pfmap # pnegate)
      # 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
--- a/bench.csv
+++ b/bench.csv
@ -1,9 +1,9 @@
 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/authority,12933097,37168,2361
-Agora/Effects/Treasury Withdrawal Effect/bad received value/treasury,55756262,158723,1778
-Agora/Effects/Treasury Withdrawal Effect/bad received value/authority,12933097,37168,2361
+Agora/Effects/Treasury Withdrawal Effect/bad received value/treasury,55756262,158723,1796
+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/authority,12933097,37168,2361
 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,127096099,363203,11972