Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'staging' into emiflake/backport-134

Browse source
This commit is contained in:
Emily 2022-06-28 12:42:51 +02:00 • committed by GitHub
commit 8f60a07faa
16 changed files with 127 additions and 213 deletions
Download patch file Download diff file Expand all files Collapse all files

78
.github/workflows/integrate.yaml vendored
View file

@ -1,78 +0,0 @@
on:
push:
paths:
- ".github/workflows/integrate.yaml"
- "**.hs"
- "**.nix"
- "flake.lock"
- "agora.cabal"
branches:
- main
- staging
pull_request:
paths:
- ".github/workflows/integrate.yaml"
- "**.hs"
- "**.nix"
- "flake.lock"
- "agora.cabal"
jobs:
flake:
runs-on: ubuntu-latest
strategy:
matrix:
tasks:
- agora
- formatCheck
- benchCheck
- agora-test
steps:
- uses: actions/checkout@v2.4.0
- uses: cachix/install-nix-action@v16
name: Set up Nix and IOHK caches
with:
nix_path: nixpkgs=channel:nixos-unstable
extra_nix_config: |
trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/
experimental-features = nix-command flakes
- uses: cachix/cachix-action@v10
with:
name: mlabs
authToken: ${{ secrets.CACHIX_KEY }}
- run: nix build .#checks.x86_64-linux.${{ matrix.tasks }}
name: Run '${{ matrix.tasks }}' from flake.nix
haddock:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: cachix/install-nix-action@v16
name: Set up Nix and IOHK caches
with:
nix_path: nixpkgs=channel:nixos-unstable
extra_nix_config: |
trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/
experimental-features = nix-command flakes
- uses: cachix/cachix-action@v10
with:
name: mlabs
authToken: ${{ secrets.CACHIX_KEY }}
- run: nix build .#packages.x86_64-linux.haddock
name: Run 'haddock' from flake.nix
# This publishes the haddock result to the branch 'gh-pages',
# which is set to automatically deploy to https://liqwid-labs.github.io/agora/.
- name: Publish Documentation
uses: peaceiris/actions-gh-pages@v3
if: github.ref == 'refs/heads/main'
with:
github_token: ${{ secrets.GITHUB_TOKEN }}
publish_dir: ./result/agora/html

10
agora/Agora/AuthorityToken.hs
View file

@ -33,7 +33,7 @@ import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import "plutarch" Plutarch.Api.V1.Value (PValue (PValue)) import "plutarch" Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.List (plookup) import Plutarch.Extra.List (plookup)
import Plutarch.Extra.TermCont (pguardC, pmatchC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -73,7 +73,7 @@ authorityTokensValidIn :: Term s (PCurrencySymbol :--> PTxOut :--> PBool)
authorityTokensValidIn = phoistAcyclic $ authorityTokensValidIn = phoistAcyclic $
plam $ \authorityTokenSym txOut'' -> unTermCont $ do plam $ \authorityTokenSym txOut'' -> unTermCont $ do
PTxOut txOut' <- pmatchC txOut'' PTxOut txOut' <- pmatchC txOut''
txOut <- tcont $ pletFields @'["address", "value"] $ txOut' txOut <- pletFieldsC @'["address", "value"] $ txOut'
PAddress address <- pmatchC txOut.address PAddress address <- pmatchC txOut.address
PValue value' <- pmatchC txOut.value PValue value' <- pmatchC txOut.value
PMap value <- pmatchC value' PMap value <- pmatchC value'
@ -112,7 +112,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
let gatAmountMinted :: Term _ PInteger let gatAmountMinted :: Term _ PInteger
gatAmountMinted = psymbolValueOf # gatCs # mint gatAmountMinted = psymbolValueOf # gatCs # mint
txInfoF <- tcont $ pletFields @'["inputs"] $ txInfo txInfoF <- pletFieldsC @'["inputs"] $ txInfo
pure $ pure $
foldr1 foldr1
@ -137,9 +137,9 @@ authorityTokenPolicy :: AuthorityToken -> ClosedTerm PMintingPolicy
authorityTokenPolicy params = authorityTokenPolicy params =
plam $ \_redeemer ctx' -> plam $ \_redeemer ctx' ->
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
txInfo <- tcont $ pletFields @'["inputs", "mint", "outputs"] txInfo' txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
let inputs = txInfo.inputs let inputs = txInfo.inputs
mintedValue = pfromData txInfo.mint mintedValue = pfromData txInfo.mint
AssetClass (govCs, govTn) = params.authority AssetClass (govCs, govTn) = params.authority

6
agora/Agora/Effect.hs
View file

@ -9,7 +9,7 @@ module Agora.Effect (makeEffect) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue) import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue)
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.TryFrom () import Plutarch.TryFrom ()
import PlutusLedgerApi.V1.Value (CurrencySymbol) import PlutusLedgerApi.V1.Value (CurrencySymbol)
@ -29,7 +29,7 @@ makeEffect ::
ClosedTerm PValidator ClosedTerm PValidator
makeEffect gatCs' f = makeEffect gatCs' f =
plam $ \datum _redeemer ctx' -> unTermCont $ do plam $ \datum _redeemer ctx' -> unTermCont $ do
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo' <- pletC ctx.txInfo txInfo' <- pletC ctx.txInfo
-- convert input datum, PData, into desierable type -- convert input datum, PData, into desierable type
@ -42,7 +42,7 @@ makeEffect gatCs' f =
txOutRef' <- pletC (pfield @"_0" # txOutRef) txOutRef' <- pletC (pfield @"_0" # txOutRef)
-- fetch minted values to ensure single GAT is burned -- fetch minted values to ensure single GAT is burned
txInfo <- tcont $ pletFields @'["mint"] txInfo' txInfo <- pletFieldsC @'["mint"] txInfo'
let mint :: Term _ (PValue _ _) let mint :: Term _ (PValue _ _)
mint = txInfo.mint mint = txInfo.mint

10
agora/Agora/Effect/GovernorMutation.hs
View file

@ -49,7 +49,7 @@ import Plutarch.DataRepr (
PDataFields, PDataFields,
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Extra.TermCont (pguardC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
import PlutusLedgerApi.V1.Value (AssetClass (..)) import PlutusLedgerApi.V1.Value (AssetClass (..))
@ -151,8 +151,8 @@ deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFr
mutateGovernorValidator :: Governor -> ClosedTerm PValidator mutateGovernorValidator :: Governor -> ClosedTerm PValidator
mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
\_gatCs (datum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do \_gatCs (datum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do
datumF <- tcont $ pletFields @'["newDatum", "governorRef"] datum datumF <- pletFieldsC @'["newDatum", "governorRef"] datum
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums"] txInfo
let mint :: Term _ (PBuiltinList _) let mint :: Term _ (PBuiltinList _)
mint = pto $ pto $ pto $ pfromData txInfoF.mint mint = pto $ pto $ pto $ pfromData txInfoF.mint
@ -185,7 +185,7 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
govInInfo <- tcont $ pletFields @'["outRef", "resolved"] $ inputWithGST govInInfo <- pletFieldsC @'["outRef", "resolved"] $ inputWithGST
-- The effect can only modify the governor UTXO referenced in the datum. -- The effect can only modify the governor UTXO referenced in the datum.
pguardC "Can only modify the pinned governor" $ pguardC "Can only modify the pinned governor" $
@ -198,7 +198,7 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
let govAddress = pfield @"address" #$ govInInfo.resolved let govAddress = pfield @"address" #$ govInInfo.resolved
govOutput' = pfromData $ phead # pfromData txInfoF.outputs govOutput' = pfromData $ phead # pfromData txInfoF.outputs
govOutput <- tcont $ pletFields @'["address", "value", "datumHash"] govOutput' govOutput <- pletFieldsC @'["address", "value", "datumHash"] govOutput'
pguardC "No output to the governor" $ pguardC "No output to the governor" $
govOutput.address #== govAddress govOutput.address #== govAddress

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

@ -34,7 +34,7 @@ import Plutarch.DataRepr (
PDataFields, PDataFields,
PIsDataReprInstances (..), PIsDataReprInstances (..),
) )
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import PlutusLedgerApi.V1.Credential (Credential) import PlutusLedgerApi.V1.Credential (Credential)
import PlutusLedgerApi.V1.Value (CurrencySymbol, Value) import PlutusLedgerApi.V1.Value (CurrencySymbol, Value)
@ -143,16 +143,16 @@ deriving via
treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
\_cs (datum' :: Term _ PTreasuryWithdrawalDatum) txOutRef' txInfo' -> unTermCont $ do \_cs (datum' :: Term _ PTreasuryWithdrawalDatum) txOutRef' txInfo' -> unTermCont $ do
datum <- tcont $ pletFields @'["receivers", "treasuries"] datum' datum <- pletFieldsC @'["receivers", "treasuries"] datum'
txInfo <- tcont $ pletFields @'["outputs", "inputs"] txInfo' txInfo <- pletFieldsC @'["outputs", "inputs"] txInfo'
PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef' # pfromData txInfo.inputs PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef' # pfromData txInfo.inputs
effInput <- tcont $ pletFields @'["address", "value"] $ txOut effInput <- pletFieldsC @'["address", "value"] $ txOut
outputValues <- outputValues <-
pletC $ pletC $
pmap pmap
# plam # plam
( \(pfromData -> txOut') -> unTermCont $ do ( \(pfromData -> txOut') -> unTermCont $ do
txOut <- tcont $ pletFields @'["address", "value"] $ txOut' txOut <- pletFieldsC @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address let cred = pfield @"credential" # pfromData txOut.address
pure . pdata $ ptuple # cred # txOut.value pure . pdata $ ptuple # cred # txOut.value
) )
@ -162,7 +162,7 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
pmap pmap
# plam # plam
( \((pfield @"resolved" #) . pfromData -> txOut') -> unTermCont $ do ( \((pfield @"resolved" #) . pfromData -> txOut') -> unTermCont $ do
txOut <- tcont $ pletFields @'["address", "value"] $ txOut' txOut <- pletFieldsC @'["address", "value"] $ txOut'
let cred = pfield @"credential" # pfromData txOut.address let cred = pfield @"credential" # pfromData txOut.address
pure . pdata $ ptuple # cred # txOut.value pure . pdata $ ptuple # cred # txOut.value
) )

7
agora/Agora/Governor.hs
View file

@ -45,7 +45,7 @@ import Plutarch.DataRepr (
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.TermCont (pletC, pmatchC) import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.SafeMoney (PDiscrete (..)) import Plutarch.SafeMoney (PDiscrete (..))
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
@ -231,9 +231,8 @@ governorDatumValid :: Term s (PGovernorDatum :--> PBool)
governorDatumValid = phoistAcyclic $ governorDatumValid = phoistAcyclic $
plam $ \datum -> unTermCont $ do plam $ \datum -> unTermCont $ do
thresholds <- thresholds <-
tcont $ pletFieldsC @'["execute", "create", "vote"] $
pletFields @'["execute", "create", "vote"] $ pfield @"proposalThresholds" # datum
pfield @"proposalThresholds" # datum
PDiscrete execute' <- pmatchC thresholds.execute PDiscrete execute' <- pmatchC thresholds.execute
PDiscrete draft' <- pmatchC thresholds.create PDiscrete draft' <- pmatchC thresholds.create

107
agora/Agora/Governor/Scripts.hs
View file

@ -166,7 +166,7 @@ governorPolicy gov =
let ownAssetClass = passetClass # ownSymbol # pconstant "" let ownAssetClass = passetClass # ownSymbol # pconstant ""
txInfo = pfromData $ pfield @"txInfo" # ctx' txInfo = pfromData $ pfield @"txInfo" # ctx'
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "validRange"] txInfo txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums", "validRange"] txInfo
pguardC "Referenced utxo should be spent" $ pguardC "Referenced utxo should be spent" $
pisUTXOSpent # oref # txInfoF.inputs pisUTXOSpent # oref # txInfoF.inputs
@ -280,11 +280,11 @@ governorPolicy gov =
governorValidator :: Governor -> ClosedTerm PValidator governorValidator :: Governor -> ClosedTerm PValidator
governorValidator gov = governorValidator gov =
plam $ \datum' redeemer' ctx' -> unTermCont $ do plam $ \datum' redeemer' ctx' -> unTermCont $ do
(pfromData -> redeemer, _) <- tcont $ ptryFrom redeemer' (pfromData -> redeemer, _) <- ptryFromC redeemer'
ctxF <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo' <- pletC $ pfromData $ ctxF.txInfo txInfo' <- pletC $ pfromData $ ctxF.txInfo
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo' txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo'
PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- pmatchC $ pfromData ctxF.purpose PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- pmatchC $ pfromData ctxF.purpose
@ -292,19 +292,18 @@ governorValidator gov =
pletC $ pletC $
mustBePJust # "Own input not found" mustBePJust # "Own input not found"
#$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs #$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs
ownInputF <- tcont $ pletFields @'["address", "value"] ownInput ownInputF <- pletFieldsC @'["address", "value"] ownInput
let ownAddress = pfromData $ ownInputF.address let ownAddress = pfromData $ ownInputF.address
(pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum' (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFromC datum'
oldGovernorDatumF <- oldGovernorDatumF <-
tcont $ pletFieldsC
pletFields @'[ "proposalThresholds"
@'[ "proposalThresholds" , "nextProposalId"
, "nextProposalId" , "proposalTimings"
, "proposalTimings" , "createProposalTimeRangeMaxWidth"
, "createProposalTimeRangeMaxWidth" ]
] oldGovernorDatum
oldGovernorDatum
-- Check that GST will be returned to the governor. -- Check that GST will be returned to the governor.
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
@ -315,7 +314,7 @@ governorValidator gov =
pguardC "Exactly one utxo should be sent to the governor" $ pguardC "Exactly one utxo should be sent to the governor" $
plength # ownOutputs #== 1 plength # ownOutputs #== 1
ownOutput <- tcont $ pletFields @'["value", "datumHash"] $ phead # ownOutputs ownOutput <- pletFieldsC @'["value", "datumHash"] $ phead # ownOutputs
let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value
pguardC "State token should stay at governor's address" $ pguardC "State token should stay at governor's address" $
ownOuputGSTAmount #== 1 ownOuputGSTAmount #== 1
@ -362,7 +361,7 @@ governorValidator gov =
# phoistAcyclic # phoistAcyclic
( plam $ ( plam $
\((pfield @"resolved" #) -> txOut') -> unTermCont $ do \((pfield @"resolved" #) -> txOut') -> unTermCont $ do
txOut <- tcont $ pletFields @'["address", "value"] txOut' txOut <- pletFieldsC @'["address", "value"] txOut'
pure $ pure $
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
@ -370,7 +369,7 @@ governorValidator gov =
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
stakeInputF <- tcont $ pletFields @'["datumHash", "value"] $ pfield @"resolved" # stakeInput stakeInputF <- pletFieldsC @'["datumHash", "value"] $ pfield @"resolved" # stakeInput
pguardC "Stake input doesn't have datum" $ pguardC "Stake input doesn't have datum" $
pisDJust # stakeInputF.datumHash pisDJust # stakeInputF.datumHash
@ -378,7 +377,7 @@ governorValidator gov =
let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
stakeInputDatumF <- stakeInputDatumF <-
tcont $ pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
pguardC "Required amount of stake GTs should be presented" $ pguardC "Required amount of stake GTs should be presented" $
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value) stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
@ -396,7 +395,7 @@ governorValidator gov =
# phoistAcyclic # phoistAcyclic
( plam $ ( plam $
\txOut' -> unTermCont $ do \txOut' -> unTermCont $ do
txOut <- tcont $ pletFields @'["address", "value"] txOut' txOut <- pletFieldsC @'["address", "value"] txOut'
pure $ pure $
txOut.address #== pdata pproposalValidatorAddress txOut.address #== pdata pproposalValidatorAddress
@ -419,10 +418,9 @@ governorValidator gov =
proposalDatumValid' # proposalOutputDatum' proposalDatumValid' # proposalOutputDatum'
proposalOutputDatum <- proposalOutputDatum <-
tcont $ pletFieldsC
pletFields @'["effects", "cosigners", "proposalId", "votes"]
@'["effects", "cosigners", "proposalId", "votes"] proposalOutputDatum'
proposalOutputDatum'
pguardC "Proposal should have only one cosigner" $ pguardC "Proposal should have only one cosigner" $
plength # pfromData proposalOutputDatum.cosigners #== 1 plength # pfromData proposalOutputDatum.cosigners #== 1
@ -464,7 +462,7 @@ governorValidator gov =
# phoistAcyclic # phoistAcyclic
( plam $ ( plam $
\txOut' -> unTermCont $ do \txOut' -> unTermCont $ do
txOut <- tcont $ pletFields @'["address", "value"] txOut' txOut <- pletFieldsC @'["address", "value"] txOut'
pure $ pure $
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
@ -472,7 +470,7 @@ governorValidator gov =
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
stakeOutputF <- tcont $ pletFields @'["datumHash", "value"] $ stakeOutput stakeOutputF <- pletFieldsC @'["datumHash", "value"] $ stakeOutput
pguardC "Staked GTs should be sent back to stake validator" $ pguardC "Staked GTs should be sent back to stake validator" $
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value) stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
@ -527,36 +525,34 @@ governorValidator gov =
(psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
proposalInputF <- proposalInputF <-
tcont $ pletFieldsC @'["datumHash"] $
pletFields @'["datumHash"] $ pfield @"resolved"
pfield @"resolved" #$ pfromData
#$ pfromData $ mustBePJust
$ mustBePJust # "Proposal input not found"
# "Proposal input not found" #$ pfind
#$ pfind # plam
# plam ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do txOutF <- pletFieldsC @'["address", "value"] txOut
txOutF <- tcont $ pletFields @'["address", "value"] txOut
pure $ pure $
psymbolValueOf # ppstSymbol # txOutF.value #== 1 psymbolValueOf # ppstSymbol # txOutF.value #== 1
#&& txOutF.address #== pdata pproposalValidatorAddress #&& txOutF.address #== pdata pproposalValidatorAddress
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
proposalOutputF <- proposalOutputF <-
tcont $ pletFieldsC @'["datumHash"] $
pletFields @'["datumHash"] $ mustBePJust # "Proposal output not found"
mustBePJust # "Proposal output not found" #$ pfind
#$ pfind # plam
# plam ( \txOut -> unTermCont $ do
( \txOut -> unTermCont $ do txOutF <- pletFieldsC @'["address", "value"] txOut
txOutF <- tcont $ pletFields @'["address", "value"] txOut pure $
pure $ psymbolValueOf # ppstSymbol # txOutF.value #== 1
psymbolValueOf # ppstSymbol # txOutF.value #== 1 #&& txOutF.address #== pdata pproposalValidatorAddress
#&& txOutF.address #== pdata pproposalValidatorAddress )
) # pfromData txInfoF.outputs
# pfromData txInfoF.outputs
proposalInputDatum <- proposalInputDatum <-
pletC $ pletC $
@ -574,9 +570,8 @@ governorValidator gov =
#&& proposalDatumValid' # proposalOutputDatum #&& proposalDatumValid' # proposalOutputDatum
proposalInputDatumF <- proposalInputDatumF <-
tcont $ pletFieldsC @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"] proposalInputDatum
proposalInputDatum
-- Check that the proposal state is advanced so that a proposal cannot be executed twice. -- Check that the proposal state is advanced so that a proposal cannot be executed twice.
@ -634,7 +629,7 @@ governorValidator gov =
phoistAcyclic $ phoistAcyclic $
plam plam
( \effects (pfromData -> output') -> unTermCont $ do ( \effects (pfromData -> output') -> unTermCont $ do
output <- tcont $ pletFields @'["address", "datumHash"] $ output' output <- pletFieldsC @'["address", "datumHash"] $ output'
let scriptHash = let scriptHash =
mustBePJust # "GAT receiver is not a script" mustBePJust # "GAT receiver is not a script"

3
agora/Agora/MultiSig.hs
View file

@ -25,6 +25,7 @@ import Plutarch.DataRepr (
PDataFields, PDataFields,
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Extra.TermCont (pletFieldsC)
import Plutarch.Lift ( import Plutarch.Lift (
PConstantDecl, PConstantDecl,
PLifted, PLifted,
@ -123,7 +124,7 @@ pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool)
pvalidatedByMultisig = pvalidatedByMultisig =
phoistAcyclic $ phoistAcyclic $
plam $ \multi' txInfo -> unTermCont $ do plam $ \multi' txInfo -> unTermCont $ do
multi <- tcont $ pletFields @'["keys", "minSigs"] multi' multi <- pletFieldsC @'["keys", "minSigs"] multi'
let signatories = pfield @"signatories" # txInfo let signatories = pfield @"signatories" # txInfo
pure $ pure $
pfromData multi.minSigs pfromData multi.minSigs

5
agora/Agora/Plutarch/Orphans.hs
View file

@ -14,6 +14,7 @@ import Control.Arrow (first)
import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue) import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue)
import Plutarch.Builtin (PBuiltinMap) import Plutarch.Builtin (PBuiltinMap)
import Plutarch.DataRepr (PIsDataReprInstances (..)) import Plutarch.DataRepr (PIsDataReprInstances (..))
import Plutarch.Extra.TermCont (ptryFromC)
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+))) import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
import Plutarch.Reducible (Reduce, Reducible) import Plutarch.Reducible (Reduce, Reducible)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
@ -38,7 +39,7 @@ instance PTryFrom PData (PAsData PPubKeyHash) where
type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
ptryFrom' opq = runTermCont $ do ptryFrom' opq = runTermCont $ do
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <- (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
tcont $ ptryFrom @(PAsData PByteString) opq ptryFromC @(PAsData PByteString) opq
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a PubKeyHash should be 28 bytes long") tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a PubKeyHash should be 28 bytes long")
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped) pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
@ -78,7 +79,7 @@ instance PTryFrom PData (PAsData PValidatorHash) where
type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
ptryFrom' opq = runTermCont $ do ptryFrom' opq = runTermCont $ do
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <- (wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
tcont $ ptryFrom @(PAsData PByteString) opq ptryFromC @(PAsData PByteString) opq
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a ValidatorHash should be 28 bytes long") tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a ValidatorHash should be 28 bytes long")
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped) pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)

4
agora/Agora/Proposal.hs
View file

@ -54,7 +54,7 @@ import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprI
import Plutarch.Extra.List (pnotNull) import Plutarch.Extra.List (pnotNull)
import Plutarch.Extra.Map qualified as PM import Plutarch.Extra.Map qualified as PM
import Plutarch.Extra.Map.Unsorted qualified as PUM import Plutarch.Extra.Map.Unsorted qualified as PUM
import Plutarch.Extra.TermCont (pguardC, pletC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
import Plutarch.Lift ( import Plutarch.Lift (
DerivePConstantViaNewtype (..), DerivePConstantViaNewtype (..),
PConstantDecl, PConstantDecl,
@ -692,7 +692,7 @@ proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBo
proposalDatumValid proposal = proposalDatumValid proposal =
phoistAcyclic $ phoistAcyclic $
plam $ \datum' -> unTermCont $ do plam $ \datum' -> unTermCont $ do
datum <- tcont $ pletFields @'["effects", "cosigners", "votes"] $ datum' datum <- pletFieldsC @'["effects", "cosigners", "votes"] $ datum'
let atLeastOneNegativeResult = let atLeastOneNegativeResult =
pany pany

52
agora/Agora/Proposal/Scripts.hs
View file

@ -97,9 +97,9 @@ proposalPolicy ::
proposalPolicy (AssetClass (govCs, govTn)) = proposalPolicy (AssetClass (govCs, govTn)) =
plam $ \_redeemer ctx' -> unTermCont $ do plam $ \_redeemer ctx' -> unTermCont $ do
PScriptContext ctx' <- pmatchC ctx' PScriptContext ctx' <- pmatchC ctx'
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
txInfo <- tcont $ pletFields @'["inputs", "mint"] txInfo' txInfo <- pletFieldsC @'["inputs", "mint"] txInfo'
PMinting _ownSymbol <- pmatchC $ pfromData ctx.purpose PMinting _ownSymbol <- pmatchC $ pfromData ctx.purpose
let inputs = txInfo.inputs let inputs = txInfo.inputs
@ -153,24 +153,23 @@ proposalValidator :: Proposal -> ClosedTerm PValidator
proposalValidator proposal = proposalValidator proposal =
plam $ \datum redeemer ctx' -> unTermCont $ do plam $ \datum redeemer ctx' -> unTermCont $ do
PScriptContext ctx' <- pmatchC ctx' PScriptContext ctx' <- pmatchC ctx'
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo <- pletC $ pfromData ctx.txInfo txInfo <- pletC $ pfromData ctx.txInfo
PTxInfo txInfo' <- pmatchC txInfo PTxInfo txInfo' <- pmatchC txInfo
txInfoF <- txInfoF <-
tcont $ pletFieldsC
pletFields @'[ "inputs"
@'[ "inputs" , "outputs"
, "outputs" , "mint"
, "mint" , "datums"
, "datums" , "signatories"
, "signatories" , "validRange"
, "validRange" ]
] txInfo'
txInfo'
PSpending ((pfield @"_0" #) -> txOutRef) <- pmatchC $ pfromData ctx.purpose PSpending ((pfield @"_0" #) -> txOutRef) <- pmatchC $ pfromData ctx.purpose
PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef # txInfoF.inputs PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef # txInfoF.inputs
txOutF <- tcont $ pletFields @'["address", "value"] $ txOut txOutF <- pletFieldsC @'["address", "value"] $ txOut
(pfromData -> proposalDatum, _) <- (pfromData -> proposalDatum, _) <-
ptryFromC @(PAsData PProposalDatum) datum ptryFromC @(PAsData PProposalDatum) datum
@ -178,18 +177,17 @@ proposalValidator proposal =
ptryFromC @(PAsData PProposalRedeemer) redeemer ptryFromC @(PAsData PProposalRedeemer) redeemer
proposalF <- proposalF <-
tcont $ pletFieldsC
pletFields @'[ "proposalId"
@'[ "proposalId" , "effects"
, "effects" , "status"
, "status" , "cosigners"
, "cosigners" , "thresholds"
, "thresholds" , "votes"
, "votes" , "timingConfig"
, "timingConfig" , "startingTime"
, "startingTime" ]
] proposalDatum
proposalDatum
ownAddress <- pletC $ txOutF.address ownAddress <- pletC $ txOutF.address
@ -213,7 +211,7 @@ proposalValidator proposal =
mustBePJust # "Own output should be present" #$ pfind mustBePJust # "Own output should be present" #$ pfind
# plam # plam
( \input -> unTermCont $ do ( \input -> unTermCont $ do
inputF <- tcont $ pletFields @'["address", "value", "datumHash"] input inputF <- pletFieldsC @'["address", "value", "datumHash"] input
-- TODO: this is highly inefficient: O(n) for every output, -- TODO: this is highly inefficient: O(n) for every output,
-- Maybe we can cache the sorted datum map? -- Maybe we can cache the sorted datum map?

8
agora/Agora/Proposal/Time.hs
View file

@ -44,7 +44,7 @@ import Plutarch.DataRepr (
PDataFields, PDataFields,
PIsDataReprInstances (..), PIsDataReprInstances (..),
) )
import Plutarch.Extra.TermCont (pguardC, pmatchC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
import Plutarch.Lift ( import Plutarch.Lift (
DerivePConstantViaNewtype (..), DerivePConstantViaNewtype (..),
PConstantDecl, PConstantDecl,
@ -308,11 +308,11 @@ currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTi
currentProposalTime = phoistAcyclic $ currentProposalTime = phoistAcyclic $
plam $ \iv -> unTermCont $ do plam $ \iv -> unTermCont $ do
PInterval iv' <- pmatchC iv PInterval iv' <- pmatchC iv
ivf <- tcont $ pletFields @'["from", "to"] iv' ivf <- pletFieldsC @'["from", "to"] iv'
PLowerBound lb <- pmatchC ivf.from PLowerBound lb <- pmatchC ivf.from
PUpperBound ub <- pmatchC ivf.to PUpperBound ub <- pmatchC ivf.to
lbf <- tcont $ pletFields @'["_0", "_1"] lb lbf <- pletFieldsC @'["_0", "_1"] lb
ubf <- tcont $ pletFields @'["_0", "_1"] ub ubf <- pletFieldsC @'["_0", "_1"] ub
pure $ pure $
pcon $ pcon $
PProposalTime PProposalTime

2
agora/Agora/Stake.hs
View file

@ -327,7 +327,7 @@ findStakeOwnedBy = phoistAcyclic $
PNothing -> pcon PNothing PNothing -> pcon PNothing
PJust (pfromData -> v) -> unTermCont $ do PJust (pfromData -> v) -> unTermCont $ do
let txOut = pfield @"resolved" # pto v let txOut = pfield @"resolved" # pto v
txOutF <- tcont $ pletFields @'["datumHash"] $ txOut txOutF <- pletFieldsC @'["datumHash"] $ txOut
pure $ pure $
pmatch txOutF.datumHash $ \case pmatch txOutF.datumHash $ \case
PDNothing _ -> pcon PNothing PDNothing _ -> pcon PNothing

26
agora/Agora/Stake/Scripts.hs
View file

@ -31,7 +31,7 @@ import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisTokenSpent, ptxSignedBy, pvalueSpent) import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisTokenSpent, ptxSignedBy, pvalueSpent)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf) import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Internal (punsafeCoerce) import Plutarch.Internal (punsafeCoerce)
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+))) import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
import Plutarch.SafeMoney ( import Plutarch.SafeMoney (
@ -66,11 +66,11 @@ stakePolicy ::
ClosedTerm PMintingPolicy ClosedTerm PMintingPolicy
stakePolicy gtClassRef = stakePolicy gtClassRef =
plam $ \_redeemer ctx' -> unTermCont $ do plam $ \_redeemer ctx' -> unTermCont $ do
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo <- pletC $ ctx.txInfo txInfo <- pletC $ ctx.txInfo
let _a :: Term _ PTxInfo let _a :: Term _ PTxInfo
_a = txInfo _a = txInfo
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "signatories", "datums"] txInfo txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "signatories", "datums"] txInfo
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
ownSymbol <- pletC $ pfield @"_0" # ownSymbol' ownSymbol <- pletC $ pfield @"_0" # ownSymbol'
@ -88,7 +88,7 @@ stakePolicy gtClassRef =
pany pany
# plam # plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- tcont $ pletFields @'["value", "datumHash"] txOut txOutF <- pletFieldsC @'["value", "datumHash"] txOut
pure $ pure $
pif pif
(psymbolValueOf # ownSymbol # txOutF.value #== 1) (psymbolValueOf # ownSymbol # txOutF.value #== 1)
@ -116,7 +116,7 @@ stakePolicy gtClassRef =
#$ pfind #$ pfind
# plam # plam
( \output -> unTermCont $ do ( \output -> unTermCont $ do
outputF <- tcont $ pletFields @'["value", "address"] output outputF <- pletFieldsC @'["value", "address"] output
pure $ pure $
pmatch (pfromData $ pfield @"credential" # outputF.address) $ \case pmatch (pfromData $ pfield @"credential" # outputF.address) $ \case
-- Should pay to a script address -- Should pay to a script address
@ -129,12 +129,10 @@ stakePolicy gtClassRef =
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
outputF <- outputF <-
tcont $ pletFieldsC @'["value", "address", "datumHash"] scriptOutputWithStakeST
pletFields @'["value", "address", "datumHash"] scriptOutputWithStakeST
datumF <- datumF <-
tcont $ pletFieldsC @'["owner", "stakedAmount"] $
pletFields @'["owner", "stakedAmount"] $ mustFindDatum' @PStakeDatum # outputF.datumHash # txInfoF.datums
mustFindDatum' @PStakeDatum # outputF.datumHash # txInfoF.datums
let hasExpectedStake = let hasExpectedStake =
ptraceIfFalse "Stake ouput has expected amount of stake token" $ ptraceIfFalse "Stake ouput has expected amount of stake token" $
@ -208,16 +206,16 @@ stakePolicy gtClassRef =
stakeValidator :: Stake -> ClosedTerm PValidator stakeValidator :: Stake -> ClosedTerm PValidator
stakeValidator stake = stakeValidator stake =
plam $ \datum redeemer ctx' -> unTermCont $ do plam $ \datum redeemer ctx' -> unTermCont $ do
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
txInfo <- pletC $ pfromData ctx.txInfo txInfo <- pletC $ pfromData ctx.txInfo
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "signatories", "datums"] txInfo txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "signatories", "datums"] txInfo
(pfromData -> stakeRedeemer, _) <- ptryFromC redeemer (pfromData -> stakeRedeemer, _) <- ptryFromC redeemer
-- TODO: Use PTryFrom -- TODO: Use PTryFrom
let stakeDatum' :: Term _ PStakeDatum let stakeDatum' :: Term _ PStakeDatum
stakeDatum' = pfromData $ punsafeCoerce datum stakeDatum' = pfromData $ punsafeCoerce datum
stakeDatum <- tcont $ pletFields @'["owner", "stakedAmount", "lockedBy"] stakeDatum' stakeDatum <- pletFieldsC @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
PSpending txOutRef <- pmatchC $ pfromData ctx.purpose PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
@ -264,7 +262,7 @@ stakeValidator stake =
mustBePJust # "Own output should be present" #$ pfind mustBePJust # "Own output should be present" #$ pfind
# plam # plam
( \input -> unTermCont $ do ( \input -> unTermCont $ do
inputF <- tcont $ pletFields @'["address", "value"] input inputF <- pletFieldsC @'["address", "value"] input
pure $ pure $
inputF.address #== ownAddress inputF.address #== ownAddress
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1 #&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1

6
agora/Agora/Treasury.hs
View file

@ -20,7 +20,7 @@ import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Lift (PConstantDecl (..), PLifted (..), PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl (..), PLifted (..), PUnsafeLiftDecl)
import Plutarch.TryFrom () import Plutarch.TryFrom ()
import PlutusLedgerApi.V1.Value (CurrencySymbol) import PlutusLedgerApi.V1.Value (CurrencySymbol)
@ -108,7 +108,7 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
(treasuryRedeemer, _) <- ptryFromC redeemer (treasuryRedeemer, _) <- ptryFromC redeemer
-- plet required fields from script context. -- plet required fields from script context.
ctx <- tcont $ pletFields @["txInfo", "purpose"] ctx' ctx <- pletFieldsC @["txInfo", "purpose"] ctx'
-- Ensure that script is for burning i.e. minting a negative amount. -- Ensure that script is for burning i.e. minting a negative amount.
PMinting _ <- pmatchC ctx.purpose PMinting _ <- pmatchC ctx.purpose
@ -118,7 +118,7 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
-- Get the minted value from txInfo. -- Get the minted value from txInfo.
txInfo' <- pletC ctx.txInfo txInfo' <- pletC ctx.txInfo
txInfo <- tcont $ pletFields @'["mint"] txInfo' txInfo <- pletFieldsC @'["mint"] txInfo'
let mint :: Term _ (PValue _ _) let mint :: Term _ (PValue _ _)
mint = txInfo.mint mint = txInfo.mint

4
agora/Agora/Utils.hs
View file

@ -43,7 +43,7 @@ import Plutarch.Api.V1.ScriptContext (pfindDatum)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.List (plookupTuple) import Plutarch.Extra.List (plookupTuple)
import Plutarch.Extra.TermCont (pletC, pmatchC) import Plutarch.Extra.TermCont (pletC, pmatchC, ptryFromC)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1 (
Address (..), Address (..),
Credential (..), Credential (..),
@ -162,7 +162,7 @@ mustFindDatum' = phoistAcyclic $
plam $ \mdh datums -> unTermCont $ do plam $ \mdh datums -> unTermCont $ do
let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh
dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
(d, _) <- tcont $ ptryFrom $ pforgetData $ pdata dt (d, _) <- ptryFromC $ pforgetData $ pdata dt
pure $ pfromData d pure $ pfromData d
{- | Extract the value stored in a PMaybe container. {- | Extract the value stored in a PMaybe container.