Merge pull request #127 from Liqwid-Labs/connor/pletFieldsC
Replace all `tcont $ pletFields` with `pletFieldsC`
This commit is contained in:
commit
eb5951657f
15 changed files with 128 additions and 136 deletions
|
|
@ -33,7 +33,7 @@ import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
|||
import "plutarch" Plutarch.Api.V1.Value (PValue (PValue))
|
||||
import Plutarch.Builtin (pforgetData)
|
||||
import Plutarch.Extra.List (plookup)
|
||||
import Plutarch.Extra.TermCont (pguardC, pmatchC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -73,7 +73,7 @@ authorityTokensValidIn :: Term s (PCurrencySymbol :--> PTxOut :--> PBool)
|
|||
authorityTokensValidIn = phoistAcyclic $
|
||||
plam $ \authorityTokenSym txOut'' -> unTermCont $ do
|
||||
PTxOut txOut' <- pmatchC txOut''
|
||||
txOut <- tcont $ pletFields @'["address", "value"] $ txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] $ txOut'
|
||||
PAddress address <- pmatchC txOut.address
|
||||
PValue value' <- pmatchC txOut.value
|
||||
PMap value <- pmatchC value'
|
||||
|
|
@ -112,7 +112,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
|
|||
let gatAmountMinted :: Term _ PInteger
|
||||
gatAmountMinted = psymbolValueOf # gatCs # mint
|
||||
|
||||
txInfoF <- tcont $ pletFields @'["inputs"] $ txInfo
|
||||
txInfoF <- pletFieldsC @'["inputs"] $ txInfo
|
||||
|
||||
pure $
|
||||
foldr1
|
||||
|
|
@ -137,9 +137,9 @@ authorityTokenPolicy :: AuthorityToken -> ClosedTerm PMintingPolicy
|
|||
authorityTokenPolicy params =
|
||||
plam $ \_redeemer ctx' ->
|
||||
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
|
||||
txInfo <- tcont $ pletFields @'["inputs", "mint", "outputs"] txInfo'
|
||||
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
|
||||
let inputs = txInfo.inputs
|
||||
mintedValue = pfromData txInfo.mint
|
||||
AssetClass (govCs, govTn) = params.authority
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ module Agora.Effect (makeEffect) where
|
|||
|
||||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
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 PlutusLedgerApi.V1.Value (CurrencySymbol)
|
||||
|
||||
|
|
@ -29,7 +29,7 @@ makeEffect ::
|
|||
ClosedTerm PValidator
|
||||
makeEffect gatCs' f =
|
||||
plam $ \datum _redeemer ctx' -> unTermCont $ do
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
txInfo' <- pletC ctx.txInfo
|
||||
|
||||
-- convert input datum, PData, into desierable type
|
||||
|
|
@ -42,7 +42,7 @@ makeEffect gatCs' f =
|
|||
txOutRef' <- pletC (pfield @"_0" # txOutRef)
|
||||
|
||||
-- fetch minted values to ensure single GAT is burned
|
||||
txInfo <- tcont $ pletFields @'["mint"] txInfo'
|
||||
txInfo <- pletFieldsC @'["mint"] txInfo'
|
||||
let mint :: Term _ (PValue _ _)
|
||||
mint = txInfo.mint
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ import Plutarch.DataRepr (
|
|||
PDataFields,
|
||||
PIsDataReprInstances (PIsDataReprInstances),
|
||||
)
|
||||
import Plutarch.Extra.TermCont (pguardC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletFieldsC)
|
||||
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (..))
|
||||
|
|
@ -151,8 +151,8 @@ deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFr
|
|||
mutateGovernorValidator :: Governor -> ClosedTerm PValidator
|
||||
mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
|
||||
\_gatCs (datum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do
|
||||
datumF <- tcont $ pletFields @'["newDatum", "governorRef"] datum
|
||||
txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo
|
||||
datumF <- pletFieldsC @'["newDatum", "governorRef"] datum
|
||||
txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums"] txInfo
|
||||
|
||||
let mint :: Term _ (PBuiltinList _)
|
||||
mint = pto $ pto $ pto $ pfromData txInfoF.mint
|
||||
|
|
@ -185,7 +185,7 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
|
|||
)
|
||||
# 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.
|
||||
pguardC "Can only modify the pinned governor" $
|
||||
|
|
@ -198,7 +198,7 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
|
|||
let govAddress = pfield @"address" #$ govInInfo.resolved
|
||||
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" $
|
||||
govOutput.address #== govAddress
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ import Plutarch.DataRepr (
|
|||
PDataFields,
|
||||
PIsDataReprInstances (..),
|
||||
)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import PlutusLedgerApi.V1.Credential (Credential)
|
||||
import PlutusLedgerApi.V1.Value (CurrencySymbol, Value)
|
||||
|
|
@ -143,16 +143,16 @@ deriving via
|
|||
treasuryWithdrawalValidator :: forall {s :: S}. CurrencySymbol -> Term s PValidator
|
||||
treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
|
||||
\_cs (datum' :: Term _ PTreasuryWithdrawalDatum) txOutRef' txInfo' -> unTermCont $ do
|
||||
datum <- tcont $ pletFields @'["receivers", "treasuries"] datum'
|
||||
txInfo <- tcont $ pletFields @'["outputs", "inputs"] txInfo'
|
||||
datum <- pletFieldsC @'["receivers", "treasuries"] datum'
|
||||
txInfo <- pletFieldsC @'["outputs", "inputs"] txInfo'
|
||||
PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef' # pfromData txInfo.inputs
|
||||
effInput <- tcont $ pletFields @'["address", "value"] $ txOut
|
||||
effInput <- pletFieldsC @'["address", "value"] $ txOut
|
||||
outputValues <-
|
||||
pletC $
|
||||
pmap
|
||||
# plam
|
||||
( \(pfromData -> txOut') -> unTermCont $ do
|
||||
txOut <- tcont $ pletFields @'["address", "value"] $ txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] $ txOut'
|
||||
let cred = pfield @"credential" # pfromData txOut.address
|
||||
pure . pdata $ ptuple # cred # txOut.value
|
||||
)
|
||||
|
|
@ -162,7 +162,7 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
|
|||
pmap
|
||||
# plam
|
||||
( \((pfield @"resolved" #) . pfromData -> txOut') -> unTermCont $ do
|
||||
txOut <- tcont $ pletFields @'["address", "value"] $ txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] $ txOut'
|
||||
let cred = pfield @"credential" # pfromData txOut.address
|
||||
pure . pdata $ ptuple # cred # txOut.value
|
||||
)
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ import Plutarch.DataRepr (
|
|||
PIsDataReprInstances (PIsDataReprInstances),
|
||||
)
|
||||
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.SafeMoney (PDiscrete (..))
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
|
|
@ -231,9 +231,8 @@ governorDatumValid :: Term s (PGovernorDatum :--> PBool)
|
|||
governorDatumValid = phoistAcyclic $
|
||||
plam $ \datum -> unTermCont $ do
|
||||
thresholds <-
|
||||
tcont $
|
||||
pletFields @'["execute", "create", "vote"] $
|
||||
pfield @"proposalThresholds" # datum
|
||||
pletFieldsC @'["execute", "create", "vote"] $
|
||||
pfield @"proposalThresholds" # datum
|
||||
|
||||
PDiscrete execute' <- pmatchC thresholds.execute
|
||||
PDiscrete draft' <- pmatchC thresholds.create
|
||||
|
|
|
|||
|
|
@ -166,7 +166,7 @@ governorPolicy gov =
|
|||
let ownAssetClass = passetClass # ownSymbol # pconstant ""
|
||||
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" $
|
||||
pisUTXOSpent # oref # txInfoF.inputs
|
||||
|
|
@ -280,11 +280,11 @@ governorPolicy gov =
|
|||
governorValidator :: Governor -> ClosedTerm PValidator
|
||||
governorValidator gov =
|
||||
plam $ \datum' redeemer' ctx' -> unTermCont $ do
|
||||
(pfromData -> redeemer, _) <- tcont $ ptryFrom redeemer'
|
||||
ctxF <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
(pfromData -> redeemer, _) <- ptryFromC redeemer'
|
||||
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
|
||||
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
|
||||
|
||||
|
|
@ -292,19 +292,18 @@ governorValidator gov =
|
|||
pletC $
|
||||
mustBePJust # "Own input not found"
|
||||
#$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs
|
||||
ownInputF <- tcont $ pletFields @'["address", "value"] ownInput
|
||||
ownInputF <- pletFieldsC @'["address", "value"] ownInput
|
||||
let ownAddress = pfromData $ ownInputF.address
|
||||
|
||||
(pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum'
|
||||
(pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFromC datum'
|
||||
oldGovernorDatumF <-
|
||||
tcont $
|
||||
pletFields
|
||||
@'[ "proposalThresholds"
|
||||
, "nextProposalId"
|
||||
, "proposalTimings"
|
||||
, "createProposalTimeRangeMaxWidth"
|
||||
]
|
||||
oldGovernorDatum
|
||||
pletFieldsC
|
||||
@'[ "proposalThresholds"
|
||||
, "nextProposalId"
|
||||
, "proposalTimings"
|
||||
, "createProposalTimeRangeMaxWidth"
|
||||
]
|
||||
oldGovernorDatum
|
||||
|
||||
-- Check that GST will be returned to the governor.
|
||||
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
|
||||
|
|
@ -315,7 +314,7 @@ governorValidator gov =
|
|||
pguardC "Exactly one utxo should be sent to the governor" $
|
||||
plength # ownOutputs #== 1
|
||||
|
||||
ownOutput <- tcont $ pletFields @'["value", "datumHash"] $ phead # ownOutputs
|
||||
ownOutput <- pletFieldsC @'["value", "datumHash"] $ phead # ownOutputs
|
||||
let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value
|
||||
pguardC "State token should stay at governor's address" $
|
||||
ownOuputGSTAmount #== 1
|
||||
|
|
@ -362,7 +361,7 @@ governorValidator gov =
|
|||
# phoistAcyclic
|
||||
( plam $
|
||||
\((pfield @"resolved" #) -> txOut') -> unTermCont $ do
|
||||
txOut <- tcont $ pletFields @'["address", "value"] txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] txOut'
|
||||
|
||||
pure $
|
||||
txOut.address #== pdata pstakeValidatorAddress
|
||||
|
|
@ -370,7 +369,7 @@ governorValidator gov =
|
|||
)
|
||||
# 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" $
|
||||
pisDJust # stakeInputF.datumHash
|
||||
|
|
@ -378,7 +377,7 @@ governorValidator gov =
|
|||
let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
|
||||
|
||||
stakeInputDatumF <-
|
||||
tcont $ pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
|
||||
pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
|
||||
|
||||
pguardC "Required amount of stake GTs should be presented" $
|
||||
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
|
||||
|
|
@ -396,7 +395,7 @@ governorValidator gov =
|
|||
# phoistAcyclic
|
||||
( plam $
|
||||
\txOut' -> unTermCont $ do
|
||||
txOut <- tcont $ pletFields @'["address", "value"] txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] txOut'
|
||||
|
||||
pure $
|
||||
txOut.address #== pdata pproposalValidatorAddress
|
||||
|
|
@ -419,10 +418,9 @@ governorValidator gov =
|
|||
proposalDatumValid' # proposalOutputDatum'
|
||||
|
||||
proposalOutputDatum <-
|
||||
tcont $
|
||||
pletFields
|
||||
@'["effects", "cosigners", "proposalId", "votes"]
|
||||
proposalOutputDatum'
|
||||
pletFieldsC
|
||||
@'["effects", "cosigners", "proposalId", "votes"]
|
||||
proposalOutputDatum'
|
||||
|
||||
pguardC "Proposal should have only one cosigner" $
|
||||
plength # pfromData proposalOutputDatum.cosigners #== 1
|
||||
|
|
@ -464,7 +462,7 @@ governorValidator gov =
|
|||
# phoistAcyclic
|
||||
( plam $
|
||||
\txOut' -> unTermCont $ do
|
||||
txOut <- tcont $ pletFields @'["address", "value"] txOut'
|
||||
txOut <- pletFieldsC @'["address", "value"] txOut'
|
||||
|
||||
pure $
|
||||
txOut.address #== pdata pstakeValidatorAddress
|
||||
|
|
@ -472,7 +470,7 @@ governorValidator gov =
|
|||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
stakeOutputF <- tcont $ pletFields @'["datumHash", "value"] $ stakeOutput
|
||||
stakeOutputF <- pletFieldsC @'["datumHash", "value"] $ stakeOutput
|
||||
|
||||
pguardC "Staked GTs should be sent back to stake validator" $
|
||||
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
|
||||
|
|
@ -527,36 +525,34 @@ governorValidator gov =
|
|||
(psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
|
||||
|
||||
proposalInputF <-
|
||||
tcont $
|
||||
pletFields @'["datumHash"] $
|
||||
pfield @"resolved"
|
||||
#$ pfromData
|
||||
$ mustBePJust
|
||||
# "Proposal input not found"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
|
||||
txOutF <- tcont $ pletFields @'["address", "value"] txOut
|
||||
pletFieldsC @'["datumHash"] $
|
||||
pfield @"resolved"
|
||||
#$ pfromData
|
||||
$ mustBePJust
|
||||
# "Proposal input not found"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
|
||||
txOutF <- pletFieldsC @'["address", "value"] txOut
|
||||
|
||||
pure $
|
||||
psymbolValueOf # ppstSymbol # txOutF.value #== 1
|
||||
#&& txOutF.address #== pdata pproposalValidatorAddress
|
||||
)
|
||||
# pfromData txInfoF.inputs
|
||||
pure $
|
||||
psymbolValueOf # ppstSymbol # txOutF.value #== 1
|
||||
#&& txOutF.address #== pdata pproposalValidatorAddress
|
||||
)
|
||||
# pfromData txInfoF.inputs
|
||||
|
||||
proposalOutputF <-
|
||||
tcont $
|
||||
pletFields @'["datumHash"] $
|
||||
mustBePJust # "Proposal output not found"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \txOut -> unTermCont $ do
|
||||
txOutF <- tcont $ pletFields @'["address", "value"] txOut
|
||||
pure $
|
||||
psymbolValueOf # ppstSymbol # txOutF.value #== 1
|
||||
#&& txOutF.address #== pdata pproposalValidatorAddress
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
pletFieldsC @'["datumHash"] $
|
||||
mustBePJust # "Proposal output not found"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \txOut -> unTermCont $ do
|
||||
txOutF <- pletFieldsC @'["address", "value"] txOut
|
||||
pure $
|
||||
psymbolValueOf # ppstSymbol # txOutF.value #== 1
|
||||
#&& txOutF.address #== pdata pproposalValidatorAddress
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
proposalInputDatum <-
|
||||
pletC $
|
||||
|
|
@ -574,9 +570,8 @@ governorValidator gov =
|
|||
#&& proposalDatumValid' # proposalOutputDatum
|
||||
|
||||
proposalInputDatumF <-
|
||||
tcont $
|
||||
pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
|
||||
proposalInputDatum
|
||||
pletFieldsC @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
|
||||
proposalInputDatum
|
||||
|
||||
-- Check that the proposal state is advanced so that a proposal cannot be executed twice.
|
||||
|
||||
|
|
@ -634,7 +629,7 @@ governorValidator gov =
|
|||
phoistAcyclic $
|
||||
plam
|
||||
( \effects (pfromData -> output') -> unTermCont $ do
|
||||
output <- tcont $ pletFields @'["address", "datumHash"] $ output'
|
||||
output <- pletFieldsC @'["address", "datumHash"] $ output'
|
||||
|
||||
let scriptHash =
|
||||
mustBePJust # "GAT receiver is not a script"
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ import Plutarch.DataRepr (
|
|||
PDataFields,
|
||||
PIsDataReprInstances (PIsDataReprInstances),
|
||||
)
|
||||
import Plutarch.Extra.TermCont (pletFieldsC)
|
||||
import Plutarch.Lift (
|
||||
PConstantDecl,
|
||||
PLifted,
|
||||
|
|
@ -123,7 +124,7 @@ pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool)
|
|||
pvalidatedByMultisig =
|
||||
phoistAcyclic $
|
||||
plam $ \multi' txInfo -> unTermCont $ do
|
||||
multi <- tcont $ pletFields @'["keys", "minSigs"] multi'
|
||||
multi <- pletFieldsC @'["keys", "minSigs"] multi'
|
||||
let signatories = pfield @"signatories" # txInfo
|
||||
pure $
|
||||
pfromData multi.minSigs
|
||||
|
|
|
|||
|
|
@ -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.Builtin (PBuiltinMap)
|
||||
import Plutarch.DataRepr (PIsDataReprInstances (..))
|
||||
import Plutarch.Extra.TermCont (ptryFromC)
|
||||
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Reducible (Reduce, Reducible)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
|
|
@ -38,7 +39,7 @@ instance PTryFrom PData (PAsData PPubKeyHash) where
|
|||
type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(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")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
|
||||
|
||||
|
|
@ -78,7 +79,7 @@ instance PTryFrom PData (PAsData PValidatorHash) where
|
|||
type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(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")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
|
||||
|
||||
|
|
@ -87,7 +88,7 @@ instance PTryFrom PData (PAsData PDatumHash) where
|
|||
type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
|
||||
tcont $ ptryFrom @(PAsData PByteString) opq
|
||||
ptryFromC @(PAsData PByteString) opq
|
||||
tcont $ \f -> pif (plengthBS # unwrapped #== 64) (f ()) (ptraceError "a DatumHash should be 64 bytes long")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
|
||||
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprI
|
|||
import Plutarch.Extra.List (pnotNull)
|
||||
import Plutarch.Extra.Map qualified as PM
|
||||
import Plutarch.Extra.Map.Unsorted qualified as PUM
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
|
||||
import Plutarch.Lift (
|
||||
DerivePConstantViaNewtype (..),
|
||||
PConstantDecl,
|
||||
|
|
@ -691,7 +691,7 @@ proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBo
|
|||
proposalDatumValid proposal =
|
||||
phoistAcyclic $
|
||||
plam $ \datum' -> unTermCont $ do
|
||||
datum <- tcont $ pletFields @'["effects", "cosigners", "votes"] $ datum'
|
||||
datum <- pletFieldsC @'["effects", "cosigners", "votes"] $ datum'
|
||||
|
||||
let atLeastOneNegativeResult =
|
||||
pany
|
||||
|
|
|
|||
|
|
@ -95,9 +95,9 @@ proposalPolicy ::
|
|||
proposalPolicy (AssetClass (govCs, govTn)) =
|
||||
plam $ \_redeemer ctx' -> unTermCont $ do
|
||||
PScriptContext ctx' <- pmatchC ctx'
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
|
||||
txInfo <- tcont $ pletFields @'["inputs", "mint"] txInfo'
|
||||
txInfo <- pletFieldsC @'["inputs", "mint"] txInfo'
|
||||
PMinting _ownSymbol <- pmatchC $ pfromData ctx.purpose
|
||||
|
||||
let inputs = txInfo.inputs
|
||||
|
|
@ -151,24 +151,23 @@ proposalValidator :: Proposal -> ClosedTerm PValidator
|
|||
proposalValidator proposal =
|
||||
plam $ \datum redeemer ctx' -> unTermCont $ do
|
||||
PScriptContext ctx' <- pmatchC ctx'
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
txInfo <- pletC $ pfromData ctx.txInfo
|
||||
PTxInfo txInfo' <- pmatchC txInfo
|
||||
txInfoF <-
|
||||
tcont $
|
||||
pletFields
|
||||
@'[ "inputs"
|
||||
, "outputs"
|
||||
, "mint"
|
||||
, "datums"
|
||||
, "signatories"
|
||||
, "validRange"
|
||||
]
|
||||
txInfo'
|
||||
pletFieldsC
|
||||
@'[ "inputs"
|
||||
, "outputs"
|
||||
, "mint"
|
||||
, "datums"
|
||||
, "signatories"
|
||||
, "validRange"
|
||||
]
|
||||
txInfo'
|
||||
PSpending ((pfield @"_0" #) -> txOutRef) <- pmatchC $ pfromData ctx.purpose
|
||||
|
||||
PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef # txInfoF.inputs
|
||||
txOutF <- tcont $ pletFields @'["address", "value"] $ txOut
|
||||
txOutF <- pletFieldsC @'["address", "value"] $ txOut
|
||||
|
||||
(pfromData -> proposalDatum, _) <-
|
||||
ptryFromC @(PAsData PProposalDatum) datum
|
||||
|
|
@ -176,18 +175,17 @@ proposalValidator proposal =
|
|||
ptryFromC @(PAsData PProposalRedeemer) redeemer
|
||||
|
||||
proposalF <-
|
||||
tcont $
|
||||
pletFields
|
||||
@'[ "proposalId"
|
||||
, "effects"
|
||||
, "status"
|
||||
, "cosigners"
|
||||
, "thresholds"
|
||||
, "votes"
|
||||
, "timingConfig"
|
||||
, "startingTime"
|
||||
]
|
||||
proposalDatum
|
||||
pletFieldsC
|
||||
@'[ "proposalId"
|
||||
, "effects"
|
||||
, "status"
|
||||
, "cosigners"
|
||||
, "thresholds"
|
||||
, "votes"
|
||||
, "timingConfig"
|
||||
, "startingTime"
|
||||
]
|
||||
proposalDatum
|
||||
|
||||
ownAddress <- pletC $ txOutF.address
|
||||
|
||||
|
|
@ -211,7 +209,7 @@ proposalValidator proposal =
|
|||
mustBePJust # "Own output should be present" #$ pfind
|
||||
# plam
|
||||
( \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,
|
||||
-- Maybe we can cache the sorted datum map?
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ import Plutarch.DataRepr (
|
|||
PDataFields,
|
||||
PIsDataReprInstances (..),
|
||||
)
|
||||
import Plutarch.Extra.TermCont (pguardC, pmatchC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
|
||||
import Plutarch.Lift (
|
||||
DerivePConstantViaNewtype (..),
|
||||
PConstantDecl,
|
||||
|
|
@ -308,11 +308,11 @@ currentProposalTime :: forall (s :: S). Term s (PPOSIXTimeRange :--> PProposalTi
|
|||
currentProposalTime = phoistAcyclic $
|
||||
plam $ \iv -> unTermCont $ do
|
||||
PInterval iv' <- pmatchC iv
|
||||
ivf <- tcont $ pletFields @'["from", "to"] iv'
|
||||
ivf <- pletFieldsC @'["from", "to"] iv'
|
||||
PLowerBound lb <- pmatchC ivf.from
|
||||
PUpperBound ub <- pmatchC ivf.to
|
||||
lbf <- tcont $ pletFields @'["_0", "_1"] lb
|
||||
ubf <- tcont $ pletFields @'["_0", "_1"] ub
|
||||
lbf <- pletFieldsC @'["_0", "_1"] lb
|
||||
ubf <- pletFieldsC @'["_0", "_1"] ub
|
||||
pure $
|
||||
pcon $
|
||||
PProposalTime
|
||||
|
|
|
|||
|
|
@ -327,7 +327,7 @@ findStakeOwnedBy = phoistAcyclic $
|
|||
PNothing -> pcon PNothing
|
||||
PJust (pfromData -> v) -> unTermCont $ do
|
||||
let txOut = pfield @"resolved" # pto v
|
||||
txOutF <- tcont $ pletFields @'["datumHash"] $ txOut
|
||||
txOutF <- pletFieldsC @'["datumHash"] $ txOut
|
||||
pure $
|
||||
pmatch txOutF.datumHash $ \case
|
||||
PDNothing _ -> pcon PNothing
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
|
|||
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisTokenSpent, ptxSignedBy, pvalueSpent)
|
||||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
|
||||
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.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||
import Plutarch.SafeMoney (
|
||||
|
|
@ -66,11 +66,11 @@ stakePolicy ::
|
|||
ClosedTerm PMintingPolicy
|
||||
stakePolicy gtClassRef =
|
||||
plam $ \_redeemer ctx' -> unTermCont $ do
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
txInfo <- pletC $ ctx.txInfo
|
||||
let _a :: Term _ PTxInfo
|
||||
_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
|
||||
ownSymbol <- pletC $ pfield @"_0" # ownSymbol'
|
||||
|
|
@ -88,7 +88,7 @@ stakePolicy gtClassRef =
|
|||
pany
|
||||
# plam
|
||||
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
|
||||
txOutF <- tcont $ pletFields @'["value", "datumHash"] txOut
|
||||
txOutF <- pletFieldsC @'["value", "datumHash"] txOut
|
||||
pure $
|
||||
pif
|
||||
(psymbolValueOf # ownSymbol # txOutF.value #== 1)
|
||||
|
|
@ -116,7 +116,7 @@ stakePolicy gtClassRef =
|
|||
#$ pfind
|
||||
# plam
|
||||
( \output -> unTermCont $ do
|
||||
outputF <- tcont $ pletFields @'["value", "address"] output
|
||||
outputF <- pletFieldsC @'["value", "address"] output
|
||||
pure $
|
||||
pmatch (pfromData $ pfield @"credential" # outputF.address) $ \case
|
||||
-- Should pay to a script address
|
||||
|
|
@ -129,12 +129,10 @@ stakePolicy gtClassRef =
|
|||
# pfromData txInfoF.outputs
|
||||
|
||||
outputF <-
|
||||
tcont $
|
||||
pletFields @'["value", "address", "datumHash"] scriptOutputWithStakeST
|
||||
pletFieldsC @'["value", "address", "datumHash"] scriptOutputWithStakeST
|
||||
datumF <-
|
||||
tcont $
|
||||
pletFields @'["owner", "stakedAmount"] $
|
||||
mustFindDatum' @PStakeDatum # outputF.datumHash # txInfoF.datums
|
||||
pletFieldsC @'["owner", "stakedAmount"] $
|
||||
mustFindDatum' @PStakeDatum # outputF.datumHash # txInfoF.datums
|
||||
|
||||
let hasExpectedStake =
|
||||
ptraceIfFalse "Stake ouput has expected amount of stake token" $
|
||||
|
|
@ -208,16 +206,16 @@ stakePolicy gtClassRef =
|
|||
stakeValidator :: Stake -> ClosedTerm PValidator
|
||||
stakeValidator stake =
|
||||
plam $ \datum redeemer ctx' -> unTermCont $ do
|
||||
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
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
|
||||
|
||||
-- TODO: Use PTryFrom
|
||||
let stakeDatum' :: Term _ PStakeDatum
|
||||
stakeDatum' = pfromData $ punsafeCoerce datum
|
||||
stakeDatum <- tcont $ pletFields @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
|
||||
stakeDatum <- pletFieldsC @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
|
||||
|
||||
PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
|
||||
|
||||
|
|
@ -264,7 +262,7 @@ stakeValidator stake =
|
|||
mustBePJust # "Own output should be present" #$ pfind
|
||||
# plam
|
||||
( \input -> unTermCont $ do
|
||||
inputF <- tcont $ pletFields @'["address", "value"] input
|
||||
inputF <- pletFieldsC @'["address", "value"] input
|
||||
pure $
|
||||
inputF.address #== ownAddress
|
||||
#&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ import Plutarch.DataRepr (
|
|||
DerivePConstantViaData (..),
|
||||
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.TryFrom ()
|
||||
import PlutusLedgerApi.V1.Value (CurrencySymbol)
|
||||
|
|
@ -108,7 +108,7 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
|
|||
(treasuryRedeemer, _) <- ptryFromC redeemer
|
||||
|
||||
-- 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.
|
||||
PMinting _ <- pmatchC ctx.purpose
|
||||
|
|
@ -118,7 +118,7 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
|
|||
|
||||
-- Get the minted value from txInfo.
|
||||
txInfo' <- pletC ctx.txInfo
|
||||
txInfo <- tcont $ pletFields @'["mint"] txInfo'
|
||||
txInfo <- pletFieldsC @'["mint"] txInfo'
|
||||
let mint :: Term _ (PValue _ _)
|
||||
mint = txInfo.mint
|
||||
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ import Plutarch.Api.V1.ScriptContext (pfindDatum)
|
|||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
||||
import Plutarch.Builtin (pforgetData)
|
||||
import Plutarch.Extra.List (plookupTuple)
|
||||
import Plutarch.Extra.TermCont (pletC, pmatchC)
|
||||
import Plutarch.Extra.TermCont (pletC, pmatchC, ptryFromC)
|
||||
import PlutusLedgerApi.V1 (
|
||||
Address (..),
|
||||
Credential (..),
|
||||
|
|
@ -162,7 +162,7 @@ mustFindDatum' = phoistAcyclic $
|
|||
plam $ \mdh datums -> unTermCont $ do
|
||||
let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh
|
||||
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
|
||||
|
||||
{- | Extract the value stored in a PMaybe container.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue