From 1a03b0bb75c08ca5229b9f7b4d19e65f8e0d4d44 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Wed, 2 Mar 2022 11:57:34 +0000
Subject: [PATCH] added helper functions to treasury

---
 src/Agora/Treasury.hs | 76 ++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 71 insertions(+), 5 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 02ca842..9f69c9c 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -12,8 +12,19 @@ module Agora.Treasury where
 
 import GHC.Generics qualified as GHC
 import Generics.SOP
-import Plutarch.Api.V1.Contexts (PScriptContext)
+import Plutarch.Api.V1.Contexts (
+  PScriptContext,
+  PTuple,
+  PTxInfo (PTxInfo),
+ )
+import Plutarch.Api.V1.Maybe (PMaybeData (PDJust))
+import Plutarch.Api.V1.Scripts (PDatum, PDatumHash)
+import Plutarch.Api.V1.Tx (
+  PTxInInfo (PTxInInfo),
+  PTxOut (PTxOut),
+ )
 import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
+import Plutarch.Builtin (pforgetData)
 import Plutarch.DataRepr (
   PDataFields,
   PIsDataReprInstances (PIsDataReprInstances),
@@ -31,13 +42,68 @@ treasuryV ::
         :--> PAsData PScriptContext
         :--> PUnit
     )
-treasuryV = plam $ \_d r ctx' -> P.do
+treasuryV = plam $ \d r ctx' -> P.do
   ctx <- pletFields @["txInfo", "purpose"] ctx'
+  PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
   pmatch (pfromData r) $ \case
+    PWitnessTreasury _ -> P.do
+      txInfo <- pletFields @'["inputs", "outputs", "data"] txInfo'
+
+      -- inputs :: Term s ( PAsData PBuiltinList )
+      let inputs = txInfo.inputs
+
+      -- dat :: Term s (PAsData PBuiltinList)
+      let dat = pfield @"data" # txInfo'
+
+      -- dh :: Term s PDatumHash
+      let dH = getTrDatumHash # d # dat
+
+      pconstant ()
+
     -- Validation for receiving funds.
-    PReceiveFunds _ -> pconstant ()
-    -- Validation for witnessing transaction.
-    PWitnessTreasury _ -> pconstant ()
+    PReceiveFunds _ -> P.do
+      pconstant ()
+
+{- | Plutarch level function that, given a treasury datum and a
+    list of the transaction's data, will find its hash.
+-}
+getTrDatumHash ::
+  Term
+    s
+    ( PAsData PTreasuryDatum
+        :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
+        :--> PDatumHash
+    )
+getTrDatumHash = plam $ \d l -> P.do
+  let t = phead #$ pfilter # (matchDatums # d) # l
+  pfield @"_0" # t
+  where
+    matchDatums ::
+      Term
+        s
+        ( PAsData PTreasuryDatum
+            :--> PAsData (PTuple PDatumHash PDatum)
+            :--> PBool
+        )
+    matchDatums = plam $ \d t' ->
+      let t = pfield @"_1" # t'
+       in (pforgetData d) #== (pforgetData t)
+
+getValAtDHash ::
+  Term
+    s
+    ( PDatumHash
+        :--> PBuiltinList (PAsData PTxOut)
+        :--> PValue
+    )
+getValAtDHash = plam $ \dh outs -> P.do
+  let matchingOut = phead #$ pfilter # (matchHashes # dh) # outs
+  pfield @"value" # matchingOut
+  where
+    matchHashes :: Term s (PDatumHash :--> PAsData PTxOut :--> PBool)
+    matchHashes = plam $ \dh out' -> P.do
+      PDJust dh' <- pmatch $ pfield @"datumHash" # pfromData out'
+      dh #== pfield @"_0" # dh'
 
 {- | Plutarch level type representing datum of the treasury.
      Contains: