Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

formatted Treasury Withdrawal Effect

Browse source
This commit is contained in:
Seungheon Oh 2022-04-11 18:43:50 -05:00 • committed by Seungheon Oh
parent f9d7db9323
commit fecbf66782
No known key found for this signature in database
GPG key ID: 9B0E12D357369B66
1 changed files with 39 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

68
agora/Agora/Effect/TreasuryWithdrawal.hs
View file

@ -3,25 +3,31 @@ Module : Agora.Effect.TreasuryWithdrawal
Maintainer : seungheon.ooh@gmail.com
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 Generics.SOP
import Generics.SOP (Generic, I (I))
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
import Agora.Effect (makeEffect)
import Agora.Utils (passert)
import Plutarch (popaque)
import Plutarch.Api.V1 (
PCredential,
PTuple,
PValidator,
PValue,
ptuple,
)
import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (..))
import Plutarch.Monadic qualified as P
import Plutus.V1.Ledger.Value (CurrencySymbol)
data PTreasuryWithdrawalDatum (s :: S)
= PTreasuryWithdrawalDatum
( Term
s
(PDataRecord
'[ "receivers" ':= PBuiltinList (PAsData (PTuple PCredential PValue)) ]
( PDataRecord
'["receivers" ':= PBuiltinList (PAsData (PTuple PCredential PValue))]
)
)
deriving stock (GHC.Generic)
@ -30,22 +36,26 @@ data PTreasuryWithdrawalDatum (s :: S)
(PlutusType, PIsData, PDataFields)
via PIsDataReprInstances PTreasuryWithdrawalDatum
treasuryWithdrawalDatum :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalDatum currSymbol = makeEffect currSymbol $
treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalValidator 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 ()
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 ()