From cdda68332a453787a53589b81b70804835d679c4 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Thu, 23 Jun 2022 18:40:41 +0800 Subject: [PATCH 1/3] replace all `tcont $ pletFields` with `pletFieldsC` and all `tcont $ ptryFrom` with `ptryFromC` --- agora/Agora/AuthorityToken.hs | 10 +-- agora/Agora/Effect.hs | 6 +- agora/Agora/Effect/GovernorMutation.hs | 10 +-- agora/Agora/Effect/TreasuryWithdrawal.hs | 12 +-- agora/Agora/Governor.hs | 7 +- agora/Agora/Governor/Scripts.hs | 107 +++++++++++------------ agora/Agora/MultiSig.hs | 3 +- agora/Agora/Plutarch/Orphans.hs | 7 +- agora/Agora/Proposal.hs | 4 +- agora/Agora/Proposal/Scripts.hs | 52 ++++++----- agora/Agora/Proposal/Time.hs | 8 +- agora/Agora/Stake.hs | 2 +- agora/Agora/Stake/Scripts.hs | 26 +++--- agora/Agora/Treasury.hs | 6 +- agora/Agora/Utils.hs | 4 +- 15 files changed, 128 insertions(+), 136 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index af97e96..79b8869 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -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 diff --git a/agora/Agora/Effect.hs b/agora/Agora/Effect.hs index 3a56ed0..2239d24 100644 --- a/agora/Agora/Effect.hs +++ b/agora/Agora/Effect.hs @@ -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 diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 1dbd550..4b01ebb 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -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 diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs index 7c5da3e..b170a4f 100644 --- a/agora/Agora/Effect/TreasuryWithdrawal.hs +++ b/agora/Agora/Effect/TreasuryWithdrawal.hs @@ -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 ) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index b25fe4d..9df17ea 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -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 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index b2639a8..e617a76 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -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" diff --git a/agora/Agora/MultiSig.hs b/agora/Agora/MultiSig.hs index a454ad2..5f34ec8 100644 --- a/agora/Agora/MultiSig.hs +++ b/agora/Agora/MultiSig.hs @@ -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 diff --git a/agora/Agora/Plutarch/Orphans.hs b/agora/Agora/Plutarch/Orphans.hs index e205762..e40fb9a 100644 --- a/agora/Agora/Plutarch/Orphans.hs +++ b/agora/Agora/Plutarch/Orphans.hs @@ -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) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 3390fbf..ed1cb6d 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -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 diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 6d92604..076b325 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -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? diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 1a82129..bf642e7 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -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 diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index ab41ab4..6ab4e63 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -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 diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index be546f8..e8b5e46 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -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 diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index 85f4869..1af783e 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -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 diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 02ef1eb..2b24a50 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -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. From c1e0e01d6c9743eedfa22d39c2b2d0ad64c8a4fe Mon Sep 17 00:00:00 2001 From: Seungheon Oh Date: Mon, 27 Jun 2022 14:46:02 -0500 Subject: [PATCH 2/3] Hydra --- .github/workflows/integrate.yaml | 78 -------------------------------- flake.nix | 1 + 2 files changed, 1 insertion(+), 78 deletions(-) delete mode 100644 .github/workflows/integrate.yaml diff --git a/.github/workflows/integrate.yaml b/.github/workflows/integrate.yaml deleted file mode 100644 index bea599e..0000000 --- a/.github/workflows/integrate.yaml +++ /dev/null @@ -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 diff --git a/flake.nix b/flake.nix index 2573c31..2988236 100644 --- a/flake.nix +++ b/flake.nix @@ -249,5 +249,6 @@ touch $out ''); devShell = perSystem (system: self.flake.${system}.devShell); + hydraJobs.required = self.checks.x86_64-linux.default; }; } From 01e4222026ad1ab542fadcdb0c2812b1c547f047 Mon Sep 17 00:00:00 2001 From: Seungheon Oh Date: Mon, 27 Jun 2022 14:57:14 -0500 Subject: [PATCH 3/3] Hydra --- flake.nix | 1 - 1 file changed, 1 deletion(-) diff --git a/flake.nix b/flake.nix index 2988236..2573c31 100644 --- a/flake.nix +++ b/flake.nix @@ -249,6 +249,5 @@ touch $out ''); devShell = perSystem (system: self.flake.${system}.devShell); - hydraJobs.required = self.checks.x86_64-linux.default; }; }