From f9d7db93232c345a41c6c672bbcb2b1af75468c3 Mon Sep 17 00:00:00 2001
From: Seungheon Oh <sho@caligula.attlocal.net>
Date: Mon, 11 Apr 2022 18:25:39 -0500
Subject: [PATCH] Rebase master to Treasury Withdrawal Effect

Liqwid-Labs/agora#46
---
 agora.cabal                              |  1 +
 agora/Agora/Effect/TreasuryWithdrawal.hs | 51 ++++++++++++++++++++++++
 2 files changed, 52 insertions(+)
 create mode 100644 agora/Agora/Effect/TreasuryWithdrawal.hs

diff --git a/agora.cabal b/agora.cabal
index 041af40..aae5776 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -123,6 +123,7 @@ library
   exposed-modules:
     Agora.AuthorityToken
     Agora.Effect
+    Agora.Effect.TreasuryWithdrawal
     Agora.Governor
     Agora.MultiSig
     Agora.Proposal
diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs
new file mode 100644
index 0000000..9a32143
--- /dev/null
+++ b/agora/Agora/Effect/TreasuryWithdrawal.hs
@@ -0,0 +1,51 @@
+{- |
+Module     : Agora.Effect.TreasuryWithdrawal
+Maintainer : seungheon.ooh@gmail.com
+Description: An Effect that withdraws treasury deposit
+-}
+module Agora.Effect.TreasuryWithdrawal (treasuryWithdrawalDatum) where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+
+import Agora.Effect
+import Agora.Utils
+import Plutus.V1.Ledger.Value
+import Plutarch
+import qualified Plutarch.Monadic as P
+import Plutarch.Api.V1
+import Plutarch.DataRepr
+
+data PTreasuryWithdrawalDatum (s :: S)
+  = PTreasuryWithdrawalDatum
+      ( Term
+          s
+          (PDataRecord
+           '[ "receivers" ':= PBuiltinList (PAsData (PTuple PCredential PValue)) ]
+          )
+      )
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData, PDataFields)
+    via PIsDataReprInstances PTreasuryWithdrawalDatum
+
+treasuryWithdrawalDatum :: forall {s :: S}. CurrencySymbol -> Term s PValidator
+treasuryWithdrawalDatum currSymbol = makeEffect currSymbol $
+  \_cs (_datum :: Term _ PTreasuryWithdrawalDatum) _txOutRef _txInfo -> P.do
+  let outputs = pmap #
+                plam (\_out -> P.do
+                       out <- pletFields @'["address", "value"] $ pfromData _out
+                       cred <- pletFields @'["credential"] $ pfromData out.address
+                       pdata $ ptuple # cred.credential # out.value
+                     ) #$
+                pfield @"outputs" # _txInfo
+      recivers = pfromData (pfield @"receivers" # _datum)
+      checkOutputs = pall # plam id #$ pmap #
+                     plam (\_out -> P.do
+                            pelem # _out # outputs
+                          ) #$
+                     recivers
+  passert "Transaction output does not match receivers" checkOutputs
+  popaque $ pconstant ()
+