formatted Treasury Withdrawal Effect
This commit is contained in:
parent
37cf3ab88e
commit
76d1454692
1 changed files with 39 additions and 29 deletions
|
|
@ -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 ()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue