From 2fc54b3fc5cfd26c6b70983502a7063303625e7c Mon Sep 17 00:00:00 2001
From: Seungheon Oh <sho@caligula.attlocal.net>
Date: Tue, 12 Apr 2022 19:38:33 -0500
Subject: [PATCH] Treasury Withdrawal Effect

ensures exact number of outputs, Haskell-level datum
---
 agora/Agora/Effect/TreasuryWithdrawal.hs | 56 +++++++++++++++++-------
 1 file changed, 41 insertions(+), 15 deletions(-)

diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs
index f56391c..567a13a 100644
--- a/agora/Agora/Effect/TreasuryWithdrawal.hs
+++ b/agora/Agora/Effect/TreasuryWithdrawal.hs
@@ -1,12 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 {- |
 Module     : Agora.Effect.TreasuryWithdrawal
 Maintainer : seungheon.ooh@gmail.com
 Description: An Effect that withdraws treasury deposit
 -}
-module Agora.Effect.TreasuryWithdrawal (PTreasuryWithdrawalDatum, treasuryWithdrawalValidator) where
+module Agora.Effect.TreasuryWithdrawal (TreasuryWithdrawalDatum, PTreasuryWithdrawalDatum, treasuryWithdrawalValidator) where
 
 import GHC.Generics qualified as GHC
-import Generics.SOP (Generic, I (I))
+import Generics.SOP ( I(I), Generic )
 
 import Agora.Effect (makeEffect)
 import Agora.Utils (passert)
@@ -18,9 +20,22 @@ import Plutarch.Api.V1 (
   PValue,
   ptuple,
  )
-import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (..))
+import Plutarch.DataRepr
+    ( PDataFields,
+      PIsDataReprInstances(..),
+      DerivePConstantViaData(..) )
+import Plutarch.Lift ( PUnsafeLiftDecl(..) )
 import Plutarch.Monadic qualified as P
-import Plutus.V1.Ledger.Value (CurrencySymbol)
+import Plutus.V1.Ledger.Credential ( Credential )
+import Plutus.V1.Ledger.Value ( CurrencySymbol, Value )
+import PlutusTx qualified
+
+data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum {receivers :: [(Credential, Value)]}
+  deriving stock (Show, GHC.Generic)
+  deriving anyclass (Generic)
+
+PlutusTx.makeLift ''TreasuryWithdrawalDatum
+PlutusTx.unstableMakeIsData ''TreasuryWithdrawalDatum
 
 data PTreasuryWithdrawalDatum (s :: S)
   = PTreasuryWithdrawalDatum
@@ -36,10 +51,19 @@ data PTreasuryWithdrawalDatum (s :: S)
     (PlutusType, PIsData, PDataFields)
     via PIsDataReprInstances PTreasuryWithdrawalDatum
 
+instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where
+  type PLifted PTreasuryWithdrawalDatum = TreasuryWithdrawalDatum
+deriving via
+  (DerivePConstantViaData TreasuryWithdrawalDatum PTreasuryWithdrawalDatum)
+  instance
+    (PConstant TreasuryWithdrawalDatum)
+
 treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
 treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
   \_cs (_datum :: Term _ PTreasuryWithdrawalDatum) _txOutRef _txInfo -> P.do
-    let outputs =
+    receivers <- plet $ pfromData $ pfield @"receivers" # _datum
+    txInfo <- pletFields @'["outputs"] _txInfo
+    let outputValues =
           pmap
             # plam
               ( \_out -> P.do
@@ -47,15 +71,17 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
                   cred <- pletFields @'["credential"] $ pfromData out.address
                   pdata $ ptuple # cred.credential # out.value
               )
-            #$ pfield @"outputs"
-            # _txInfo
-        recivers = pfromData $ pfield @"receivers" # _datum
-        checkOutputs =
+            #$ txInfo.outputs
+        outputContentMatchesRecivers =
           pall # plam id #$ pmap
-            # plam
-              ( \_out -> P.do
-                  pelem # _out # outputs
-              )
-            #$ recivers
-    passert "Transaction output does not match receivers" checkOutputs
+            # plam (\_out -> pelem # _out # outputValues)
+            #$ receivers
+        outputNumberMatchesRecivers = plength # receivers #== plength # (pfromData txInfo.outputs)
+        outputIsNotPayingToEffect = pconstant True -- How to check if it's not paying to effect itself?
+
+    passert "Transaction output does not match receivers"
+      $     outputContentMatchesRecivers
+        #&& outputNumberMatchesRecivers
+        #&& outputIsNotPayingToEffect
+
     popaque $ pconstant ()