formatted Treasury Withdrawal Effect

This commit is contained in:
Seungheon Oh 2022-04-11 18:43:50 -05:00 committed by Seungheon Oh
parent 37cf3ab88e
commit 76d1454692

View file

@ -3,25 +3,31 @@ Module : Agora.Effect.TreasuryWithdrawal
Maintainer : seungheon.ooh@gmail.com Maintainer : seungheon.ooh@gmail.com
Description: An Effect that withdraws treasury deposit Description: An Effect that withdraws treasury deposit
-} -}
module Agora.Effect.TreasuryWithdrawal (treasuryWithdrawalDatum) where module Agora.Effect.TreasuryWithdrawal (PTreasuryWithdrawalDatum, treasuryWithdrawalValidator) where
import GHC.Generics qualified as GHC import GHC.Generics qualified as GHC
import Generics.SOP import Generics.SOP (Generic, I (I))
import Agora.Effect import Agora.Effect (makeEffect)
import Agora.Utils import Agora.Utils (passert)
import Plutus.V1.Ledger.Value import Plutarch (popaque)
import Plutarch import Plutarch.Api.V1 (
import qualified Plutarch.Monadic as P PCredential,
import Plutarch.Api.V1 PTuple,
import Plutarch.DataRepr PValidator,
PValue,
ptuple,
)
import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (..))
import Plutarch.Monadic qualified as P
import Plutus.V1.Ledger.Value (CurrencySymbol)
data PTreasuryWithdrawalDatum (s :: S) data PTreasuryWithdrawalDatum (s :: S)
= PTreasuryWithdrawalDatum = PTreasuryWithdrawalDatum
( Term ( Term
s s
(PDataRecord ( PDataRecord
'[ "receivers" ':= PBuiltinList (PAsData (PTuple PCredential PValue)) ] '["receivers" ':= PBuiltinList (PAsData (PTuple PCredential PValue))]
) )
) )
deriving stock (GHC.Generic) deriving stock (GHC.Generic)
@ -30,22 +36,26 @@ data PTreasuryWithdrawalDatum (s :: S)
(PlutusType, PIsData, PDataFields) (PlutusType, PIsData, PDataFields)
via PIsDataReprInstances PTreasuryWithdrawalDatum via PIsDataReprInstances PTreasuryWithdrawalDatum
treasuryWithdrawalDatum :: forall {s :: S}. CurrencySymbol -> Term s PValidator treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalDatum currSymbol = makeEffect currSymbol $ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
\_cs (_datum :: Term _ PTreasuryWithdrawalDatum) _txOutRef _txInfo -> P.do \_cs (_datum :: Term _ PTreasuryWithdrawalDatum) _txOutRef _txInfo -> P.do
let outputs = pmap # let outputs =
plam (\_out -> P.do pmap
out <- pletFields @'["address", "value"] $ pfromData _out # plam
cred <- pletFields @'["credential"] $ pfromData out.address ( \_out -> P.do
pdata $ ptuple # cred.credential # out.value out <- pletFields @'["address", "value"] $ pfromData _out
) #$ cred <- pletFields @'["credential"] $ pfromData out.address
pfield @"outputs" # _txInfo pdata $ ptuple # cred.credential # out.value
recivers = pfromData (pfield @"receivers" # _datum) )
checkOutputs = pall # plam id #$ pmap # #$ pfield @"outputs"
plam (\_out -> P.do # _txInfo
pelem # _out # outputs recivers = pfromData $ pfield @"receivers" # _datum
) #$ checkOutputs =
recivers pall # plam id #$ pmap
passert "Transaction output does not match receivers" checkOutputs # plam
popaque $ pconstant () ( \_out -> P.do
pelem # _out # outputs
)
#$ recivers
passert "Transaction output does not match receivers" checkOutputs
popaque $ pconstant ()