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

use v2 types

Browse source
This commit is contained in:
Hongrui Fang 2022-08-15 21:27:57 +08:00
parent b453f2b216
commit fec449ceb5
36 changed files with 504 additions and 360 deletions
Download patch file Download diff file Expand all files Collapse all files

2
agora-bench/Bench.hs
View file

@ -9,7 +9,7 @@ import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord
import Data.List (intercalate) import Data.List (intercalate)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Plutarch.Evaluate (evalScript) import Plutarch.Evaluate (evalScript)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V2 (
ExBudget (ExBudget), ExBudget (ExBudget),
ExCPU (..), ExCPU (..),
ExMemory (..), ExMemory (..),

14
agora-specs/Property/Generator.hs
View file

@ -32,7 +32,13 @@ import Plutarch.Context (
output, output,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value (
AssetClass (AssetClass),
assetClassValue,
currencySymbol,
tokenName,
)
import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (..), Credential (..),
PubKeyHash (PubKeyHash), PubKeyHash (PubKeyHash),
@ -42,12 +48,6 @@ import PlutusLedgerApi.V1 (
Value, Value,
toBuiltin, toBuiltin,
) )
import PlutusLedgerApi.V1.Value (
AssetClass (AssetClass),
assetClassValue,
currencySymbol,
tokenName,
)
import Test.QuickCheck ( import Test.QuickCheck (
Arbitrary (arbitrary), Arbitrary (arbitrary),
Gen, Gen,

14
agora-specs/Property/Governor.hs
View file

@ -20,27 +20,27 @@ import Agora.Proposal.Time (
import Data.Default.Class (Default (def)) import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (Tagged), untag) import Data.Tagged (Tagged (Tagged), untag)
import Data.Universe (Finite (..), Universe (..)) import Data.Universe (Finite (..), Universe (..))
import Plutarch.Api.V1 (PScriptContext) import Plutarch.Api.V2 (PScriptContext)
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Context ( import Plutarch.Context (
MintingBuilder, MintingBuilder,
buildMintingUnsafe, buildMinting',
input, input,
mint, mint,
output, output,
script, script,
withDatum, withDatum,
withMinting, withMinting,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value (assetClassValue)
import PlutusLedgerApi.V2 (
ScriptContext (scriptContextTxInfo), ScriptContext (scriptContextTxInfo),
TxInInfo (txInInfoOutRef), TxInInfo (txInInfoOutRef),
TxInfo (txInfoInputs, txInfoMint, txInfoOutputs), TxInfo (txInfoInputs, txInfoMint, txInfoOutputs),
TxOut (txOutValue), TxOut (txOutValue),
) )
import PlutusLedgerApi.V1.Value (assetClassValue)
import Property.Generator (genInput, genOutput) import Property.Generator (genInput, genOutput)
import Sample.Shared ( import Sample.Shared (
govAssetClass, govAssetClass,
@ -164,7 +164,7 @@ governorMintingProperty =
, withValue gst , withValue gst
, withDatum govDatum , withDatum govDatum
] ]
referencedInput = input $ withOutRef gstUTXORef referencedInput = input $ withRef gstUTXORef
govDatum :: GovernorDatum govDatum :: GovernorDatum
govDatum = govDatum =
@ -189,7 +189,7 @@ governorMintingProperty =
GovernorOutputNotFound -> referencedInput <> mintAmount 1 GovernorOutputNotFound -> referencedInput <> mintAmount 1
GovernorPolicyCorrect -> referencedInput <> outputToGov <> mintAmount 1 GovernorPolicyCorrect -> referencedInput <> outputToGov <> mintAmount 1
return . buildMintingUnsafe $ inputs <> outputs <> comp <> withMinting govSymbol return . buildMinting' $ inputs <> outputs <> comp <> withMinting govSymbol
expected :: ScriptContext -> Maybe () expected :: ScriptContext -> Maybe ()
expected sc = expected sc =

43
agora-specs/Sample/Effect/GovernorMutation.hs
View file

@ -15,15 +15,24 @@ import Agora.Effect.GovernorMutation (
MutateGovernorDatum (..), MutateGovernorDatum (..),
mutateGovernorValidator, mutateGovernorValidator,
) )
import Agora.Governor (GovernorDatum (..)) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
import Agora.Utils (validatorHashToTokenName) import Agora.Utils (validatorHashToTokenName)
import Data.Default.Class (Default (def)) import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..)) import Data.Tagged (Tagged (..))
import Plutarch.Api.V1 (mkValidator, validatorHash) import Plutarch.Api.V2 (mkValidator, validatorHash)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1 qualified as Interval (always)
import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Value (AssetClass, assetClass)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import PlutusLedgerApi.V2 (
Address, Address,
Datum (..), Datum (..),
OutputDatum (OutputDatumHash),
ScriptPurpose (Spending),
ToData (..), ToData (..),
TxInInfo (..), TxInInfo (..),
TxInfo (..), TxInfo (..),
@ -32,13 +41,7 @@ import PlutusLedgerApi.V1 (
Validator, Validator,
ValidatorHash (..), ValidatorHash (..),
) )
import PlutusLedgerApi.V1 qualified as Interval (always) import PlutusTx.AssocMap qualified as AssocMap
import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Value (AssetClass, assetClass)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import Sample.Shared ( import Sample.Shared (
agoraScripts, agoraScripts,
authorityTokenSymbol, authorityTokenSymbol,
@ -46,6 +49,7 @@ import Sample.Shared (
govAssetClass, govAssetClass,
govValidatorAddress, govValidatorAddress,
minAda, minAda,
mkRedeemer,
signer, signer,
) )
import Test.Util (datumPair, toDatumHash) import Test.Util (datumPair, toDatumHash)
@ -114,7 +118,8 @@ mkEffectTxInfo newGovDatum =
TxOut TxOut
{ txOutAddress = govValidatorAddress { txOutAddress = govValidatorAddress
, txOutValue = gst , txOutValue = gst
, txOutDatumHash = Just $ toDatumHash governorInputDatum , txOutDatum = OutputDatumHash $ toDatumHash governorInputDatum
, txOutReferenceScript = Nothing
} }
-- --
@ -129,7 +134,8 @@ mkEffectTxInfo newGovDatum =
TxOut TxOut
{ txOutAddress = effectValidatorAddress { txOutAddress = effectValidatorAddress
, txOutValue = at -- The effect carry an authotity token. , txOutValue = at -- The effect carry an authotity token.
, txOutDatumHash = Just $ toDatumHash effectInputDatum , txOutDatum = OutputDatumHash $ toDatumHash effectInputDatum
, txOutReferenceScript = Nothing
} }
-- --
@ -143,21 +149,28 @@ mkEffectTxInfo newGovDatum =
TxOut TxOut
{ txOutAddress = govValidatorAddress { txOutAddress = govValidatorAddress
, txOutValue = mconcat [gst, minAda] , txOutValue = mconcat [gst, minAda]
, txOutDatumHash = Just $ toDatumHash governorOutputDatum , txOutDatum = OutputDatumHash $ toDatumHash governorOutputDatum
, txOutReferenceScript = Nothing
} }
in TxInfo in TxInfo
{ txInfoInputs = { txInfoInputs =
[ TxInInfo effectRef effectInput [ TxInInfo effectRef effectInput
, TxInInfo govRef governorInput , TxInInfo govRef governorInput
] ]
, txInfoReferenceInputs = []
, txInfoOutputs = [governorOutput] , txInfoOutputs = [governorOutput]
, txInfoFee = Value.singleton "" "" 2 , txInfoFee = Value.singleton "" "" 2
, txInfoMint = burnt , txInfoMint = burnt
, txInfoDCert = [] , txInfoDCert = []
, txInfoWdrl = [] , txInfoWdrl = AssocMap.empty
, txInfoValidRange = Interval.always , txInfoValidRange = Interval.always
, txInfoSignatories = [signer] , txInfoSignatories = [signer]
, txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum] , txInfoData = AssocMap.fromList $ datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum]
, txInfoRedeemers =
AssocMap.fromList
[ (Spending effectRef, mkRedeemer ())
, (Spending govRef, mkRedeemer MutateGovernor)
]
, txInfoId = "74c75505691e7baa981fa80e50b9b7e88dbe1eda67d4f062d89d203b" , txInfoId = "74c75505691e7baa981fa80e50b9b7e88dbe1eda67d4f062d89d203b"
} }

90
agora-specs/Sample/Effect/TreasuryWithdrawal.hs
View file

@ -23,39 +23,31 @@ import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
treasuryWithdrawalValidator, treasuryWithdrawalValidator,
) )
import Data.Default (def) import Plutarch.Api.V2 (mkValidator, validatorHash)
import Plutarch.Api.V1 (mkValidator, validatorHash) import PlutusLedgerApi.V1.Interval qualified as Interval (always)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (..), Credential (..),
CurrencySymbol, CurrencySymbol,
DatumHash (DatumHash), DatumHash (DatumHash),
OutputDatum (OutputDatumHash),
PubKeyHash, PubKeyHash,
Redeemer (Redeemer),
ScriptContext (..), ScriptContext (..),
ScriptPurpose (Spending), ScriptPurpose (Spending),
TokenName (TokenName), TokenName (TokenName),
TxInInfo (TxInInfo), TxInInfo (TxInInfo),
TxInfo ( TxInfo (..),
TxInfo,
txInfoDCert,
txInfoData,
txInfoFee,
txInfoId,
txInfoInputs,
txInfoMint,
txInfoOutputs,
txInfoSignatories,
txInfoValidRange,
txInfoWdrl
),
TxOut (..), TxOut (..),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
Validator, Validator,
ValidatorHash (ValidatorHash), ValidatorHash (ValidatorHash),
Value, Value,
toBuiltinData,
) )
import PlutusLedgerApi.V1.Interval qualified as Interval (always) import PlutusTx.AssocMap qualified as AssocMap
import PlutusLedgerApi.V1.Value qualified as Value (singleton) import Sample.Shared (deterministicTracingConfing)
import Test.Util (scriptCredentials, userCredentials) import Test.Util (scriptCredentials, userCredentials)
-- | A sample Currency Symbol. -- | A sample Currency Symbol.
@ -81,7 +73,8 @@ inputGAT =
TxOut TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
, txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
, txOutDatumHash = Just (DatumHash "") , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create an input given the index of the treasury and the 'Value' at this input. -- | Create an input given the index of the treasury and the 'Value' at this input.
@ -92,7 +85,8 @@ inputTreasury indx val =
TxOut TxOut
{ txOutAddress = Address (treasuries !! indx) Nothing { txOutAddress = Address (treasuries !! indx) Nothing
, txOutValue = val , txOutValue = val
, txOutDatumHash = Just (DatumHash "") , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create a input given the index of the user and the 'Value' at this input. -- | Create a input given the index of the user and the 'Value' at this input.
@ -103,7 +97,8 @@ inputUser indx val =
TxOut TxOut
{ txOutAddress = Address (users !! indx) Nothing { txOutAddress = Address (users !! indx) Nothing
, txOutValue = val , txOutValue = val
, txOutDatumHash = Just (DatumHash "") , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create a input representing the collateral given by a user. -- | Create a input representing the collateral given by a user.
@ -114,7 +109,8 @@ inputCollateral indx =
TxOut TxOut
{ txOutAddress = Address (users !! indx) Nothing { txOutAddress = Address (users !! indx) Nothing
, txOutValue = Value.singleton "" "" 2000000 , txOutValue = Value.singleton "" "" 2000000
, txOutDatumHash = Just (DatumHash "") , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create an output at the nth treasury with the given 'Value'. -- | Create an output at the nth treasury with the given 'Value'.
@ -123,7 +119,8 @@ outputTreasury indx val =
TxOut TxOut
{ txOutAddress = Address (treasuries !! indx) Nothing { txOutAddress = Address (treasuries !! indx) Nothing
, txOutValue = val , txOutValue = val
, txOutDatumHash = Nothing , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create an output at the nth user with the given 'Value'. -- | Create an output at the nth user with the given 'Value'.
@ -132,7 +129,8 @@ outputUser indx val =
TxOut TxOut
{ txOutAddress = Address (users !! indx) Nothing { txOutAddress = Address (users !! indx) Nothing
, txOutValue = val , txOutValue = val
, txOutDatumHash = Nothing , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Create a list of the outputs that are required as encoded in 'TreasuryWithdrawalDatum'. -- | Create a list of the outputs that are required as encoded in 'TreasuryWithdrawalDatum'.
@ -143,12 +141,13 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
TxOut TxOut
{ txOutAddress = Address (fst x) Nothing { txOutAddress = Address (fst x) Nothing
, txOutValue = snd x , txOutValue = snd x
, txOutDatumHash = Nothing , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
} }
-- | Effect validator instance. -- | Effect validator instance.
validator :: Validator validator :: Validator
validator = mkValidator def $ treasuryWithdrawalValidator currSymbol validator = mkValidator deterministicTracingConfing $ treasuryWithdrawalValidator currSymbol
-- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator. -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
validatorHashTN :: TokenName validatorHashTN :: TokenName
@ -156,20 +155,25 @@ validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext
buildScriptContext inputs outputs = buildScriptContext inputs outputs =
ScriptContext let spending = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
{ scriptContextTxInfo = in ScriptContext
TxInfo { scriptContextTxInfo =
{ txInfoInputs = inputs TxInfo
, txInfoOutputs = outputs { txInfoInputs = inputs
, txInfoFee = Value.singleton "" "" 2 , txInfoReferenceInputs = []
, txInfoMint = Value.singleton currSymbol validatorHashTN (-1) , txInfoOutputs = outputs
, txInfoDCert = [] , txInfoFee = Value.singleton "" "" 2
, txInfoWdrl = [] , txInfoMint = Value.singleton currSymbol validatorHashTN (-1)
, txInfoValidRange = Interval.always , txInfoDCert = []
, txInfoSignatories = [signer] , txInfoWdrl = AssocMap.empty
, txInfoData = [] , txInfoValidRange = Interval.always
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" , txInfoSignatories = [signer]
} , txInfoData = AssocMap.empty
, scriptContextPurpose = , txInfoRedeemers =
Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) AssocMap.fromList
} [ (spending, Redeemer $ toBuiltinData ())
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = spending
}

10
agora-specs/Sample/Governor/Initialize.hs
View file

@ -42,16 +42,16 @@ import Plutarch.Context (
signedWith, signedWith,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
CurrencySymbol, CurrencySymbol,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash, ValidatorHash,
) )
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared ( import Sample.Shared (
minAda, minAda,
) )
@ -175,7 +175,7 @@ mintGST ps = builder
mconcat mconcat
[ pubKey witnessPubKey [ pubKey witnessPubKey
, withValue witnessValue , withValue witnessValue
, withOutRef witnessRef , withRef witnessRef
] ]
, output $ , output $
mconcat mconcat

18
agora-specs/Sample/Governor/Mutate.hs
View file

@ -22,7 +22,7 @@ import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..))
import Agora.Scripts (AgoraScripts (..)) import Agora.Scripts (AgoraScripts (..))
import Agora.Utils (validatorHashToTokenName) import Agora.Utils (validatorHashToTokenName)
import Data.Default (def) import Data.Default (def)
import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash) import Plutarch.Api.V2 (PValidator, mkValidator, validatorHash)
import Plutarch.Context ( import Plutarch.Context (
input, input,
mint, mint,
@ -30,17 +30,17 @@ import Plutarch.Context (
pubKey, pubKey,
script, script,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
Data, Data,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash, ValidatorHash,
Value, Value,
toData, toData,
) )
import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared ( import Sample.Shared (
agoraScripts, agoraScripts,
authorityTokenSymbol, authorityTokenSymbol,
@ -49,7 +49,13 @@ import Sample.Shared (
minAda, minAda,
) )
import Test.Specification (SpecificationTree, testValidator) import Test.Specification (SpecificationTree, testValidator)
import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, validatorHashes) import Test.Util (
CombinableBuilder,
mkSpending,
pubKeyHashes,
sortValue,
validatorHashes,
)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -150,7 +156,7 @@ mkGovernorBuilder ps =
[ script govValidatorHash [ script govValidatorHash
, withDatum governorInputDatum , withDatum governorInputDatum
, withValue value , withValue value
, withOutRef governorRef , withRef governorRef
] ]
, output $ , output $
mconcat mconcat

16
agora-specs/Sample/Proposal/Advance.hs
View file

@ -80,11 +80,13 @@ import Plutarch.Context (
signedWith, signedWith,
timeRange, timeRange,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import Plutarch.Lift (PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
DatumHash, DatumHash,
POSIXTime, POSIXTime,
POSIXTimeRange, POSIXTimeRange,
@ -92,8 +94,6 @@ import PlutusLedgerApi.V1 (
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash, ValidatorHash,
) )
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared ( import Sample.Proposal.Shared (
governorTxRef, governorTxRef,
@ -317,7 +317,7 @@ mkProposalBuilder ps =
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalValidatorHash
, withOutRef proposalRef , withRef proposalRef
, withDatum (mkProposalInputDatum ps) , withDatum (mkProposalInputDatum ps)
, withValue value , withValue value
] ]
@ -400,7 +400,7 @@ mkStakeBuilder ps =
, input $ , input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeValidatorHash
, withOutRef (mkStakeRef idx) , withRef (mkStakeRef idx)
, withValue perStakeValue , withValue perStakeValue
, withDatum i , withDatum i
] ]
@ -462,14 +462,14 @@ mkGovernorBuilder ps =
mconcat mconcat
[ script govValidatorHash [ script govValidatorHash
, withValue value , withValue value
, withOutRef governorRef , withRef governorRef
, withDatum governorInputDatum , withDatum governorInputDatum
] ]
, output $ , output $
mconcat mconcat
[ script govValidatorHash [ script govValidatorHash
, withValue value , withValue value
, withOutRef governorRef , withRef governorRef
, withDatum (mkGovernorOutputDatum ps) , withDatum (mkGovernorOutputDatum ps)
] ]
] ]

13
agora-specs/Sample/Proposal/Cosign.hs
View file

@ -46,17 +46,16 @@ import Plutarch.Context (
timeRange, timeRange,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withTxId,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
POSIXTimeRange, POSIXTimeRange,
PubKeyHash, PubKeyHash,
TxOutRef (..), TxOutRef (..),
Value, Value,
) )
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared ( import Sample.Shared (
@ -165,8 +164,7 @@ cosign ps = builder
[ script stakeValidatorHash [ script stakeValidatorHash
, withValue stakeValue , withValue stakeValue
, withDatum stakeDatum , withDatum stakeDatum
, withTxId stakeTxRef , withRef (mkStakeRef refIdx)
, withOutRef (mkStakeRef refIdx)
] ]
, output $ , output $
mconcat mconcat
@ -196,8 +194,7 @@ cosign ps = builder
[ script proposalValidatorHash [ script proposalValidatorHash
, withValue pst , withValue pst
, withDatum proposalInputDatum , withDatum proposalInputDatum
, withTxId proposalTxRef , withRef proposalRef
, withOutRef proposalRef
] ]
, output $ , output $
mconcat mconcat

17
agora-specs/Sample/Proposal/Create.hs
View file

@ -31,7 +31,12 @@ import Agora.Proposal (
ResultTag (ResultTag), ResultTag (ResultTag),
emptyVotesFor, emptyVotesFor,
) )
import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..)) import Agora.Proposal.Time (
MaxTimeRangeWidth (
MaxTimeRangeWidth
),
ProposalStartingTime (..),
)
import Agora.Scripts (AgoraScripts (..)) import Agora.Scripts (AgoraScripts (..))
import Agora.Stake ( import Agora.Stake (
ProposalLock (..), ProposalLock (..),
@ -50,10 +55,11 @@ import Plutarch.Context (
timeRange, timeRange,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
DatumHash, DatumHash,
POSIXTime (POSIXTime), POSIXTime (POSIXTime),
POSIXTimeRange, POSIXTimeRange,
@ -62,7 +68,6 @@ import PlutusLedgerApi.V1 (
ValidatorHash, ValidatorHash,
always, always,
) )
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef) import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared ( import Sample.Shared (
@ -303,7 +308,7 @@ createProposal ps = builder
[ script govValidatorHash [ script govValidatorHash
, withValue governorValue , withValue governorValue
, withDatum governorInputDatum , withDatum governorInputDatum
, withOutRef governorRef , withRef governorRef
] ]
, output $ , output $
mconcat mconcat
@ -317,7 +322,7 @@ createProposal ps = builder
[ script stakeValidatorHash [ script stakeValidatorHash
, withValue stakeValue , withValue stakeValue
, withDatum (mkStakeInputDatum ps) , withDatum (mkStakeInputDatum ps)
, withOutRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat

2
agora-specs/Sample/Proposal/Shared.hs
View file

@ -7,7 +7,7 @@ Shared constants for proposal samples.
-} -}
module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, governorTxRef) where module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, governorTxRef) where
import PlutusLedgerApi.V1 (TxId) import PlutusLedgerApi.V2 (TxId)
-- | 'TxId' of all the proposal inputs in the samples. -- | 'TxId' of all the proposal inputs in the samples.
proposalTxRef :: TxId proposalTxRef :: TxId

10
agora-specs/Sample/Proposal/UnlockStake.hs
View file

@ -46,16 +46,16 @@ import Plutarch.Context (
signedWith, signedWith,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
DatumHash, DatumHash,
PubKeyHash, PubKeyHash,
TxOutRef (..), TxOutRef (..),
ValidatorHash, ValidatorHash,
) )
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef) import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared ( import Sample.Shared (
@ -261,7 +261,7 @@ unlockStake ps =
[ script proposalValidatorHash [ script proposalValidatorHash
, withValue pst , withValue pst
, withDatum i , withDatum i
, withOutRef (mkProposalRef idx) , withRef (mkProposalRef idx)
] ]
, output $ , output $
mconcat mconcat
@ -293,7 +293,7 @@ unlockStake ps =
[ script stakeValidatorHash [ script stakeValidatorHash
, withValue stakeValue , withValue stakeValue
, withDatum sInDatum , withDatum sInDatum
, withOutRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat

10
agora-specs/Sample/Proposal/Vote.hs
View file

@ -40,14 +40,14 @@ import Plutarch.Context (
timeRange, timeRange,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
PubKeyHash, PubKeyHash,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
) )
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared ( import Sample.Shared (
@ -222,14 +222,14 @@ vote params =
[ script proposalValidatorHash [ script proposalValidatorHash
, withValue pst , withValue pst
, withDatum proposalInputDatum , withDatum proposalInputDatum
, withOutRef proposalRef , withRef proposalRef
] ]
, input $ , input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeValidatorHash
, withValue stakeValue , withValue stakeValue
, withDatum stakeInputDatum , withDatum stakeInputDatum
, withOutRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat

26
agora-specs/Sample/Shared.hs
View file

@ -14,6 +14,7 @@ module Sample.Shared (
minAda, minAda,
deterministicTracingConfing, deterministicTracingConfing,
mkEffect, mkEffect,
mkRedeemer,
-- * Agora Scripts -- * Agora Scripts
agoraScripts, agoraScripts,
@ -75,13 +76,21 @@ import Agora.Utils (
import Data.Default.Class (Default (..)) import Data.Default.Class (Default (..))
import Data.Tagged (Tagged (..)) import Data.Tagged (Tagged (..))
import Plutarch (Config (..), TracingMode (DetTracing)) import Plutarch (Config (..), TracingMode (DetTracing))
import Plutarch.Api.V1 ( import Plutarch.Api.V2 (
PValidator, PValidator,
mintingPolicySymbol, mintingPolicySymbol,
mkValidator, mkValidator,
validatorHash, validatorHash,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Contexts (TxOut (..))
import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..))
import PlutusLedgerApi.V1.Value (AssetClass, TokenName)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClass,
singleton,
)
import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (ScriptCredential), Credential (ScriptCredential),
CurrencySymbol, CurrencySymbol,
@ -91,18 +100,12 @@ import PlutusLedgerApi.V1 (
MintingPolicy (..), MintingPolicy (..),
POSIXTimeRange, POSIXTimeRange,
PubKeyHash, PubKeyHash,
Redeemer (..),
ToData (toBuiltinData),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
UpperBound (..), UpperBound (..),
Value, Value,
) )
import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Contexts (TxOut (..))
import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..))
import PlutusLedgerApi.V1.Value (AssetClass, TokenName)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClass,
singleton,
)
import PlutusTx qualified import PlutusTx qualified
-- Plutarch compiler configauration. -- Plutarch compiler configauration.
@ -219,6 +222,9 @@ proposalStartingTimeFromTimeRange _ = error "Given time range should be finite a
mkEffect :: (PlutusTx.ToData datum) => ClosedTerm PValidator -> CompiledEffect datum mkEffect :: (PlutusTx.ToData datum) => ClosedTerm PValidator -> CompiledEffect datum
mkEffect v = CompiledEffect $ mkValidator deterministicTracingConfing v mkEffect v = CompiledEffect $ mkValidator deterministicTracingConfing v
mkRedeemer :: forall redeemer. PlutusTx.ToData redeemer => redeemer -> Redeemer
mkRedeemer = Redeemer . toBuiltinData
------------------------------------------------------------------ ------------------------------------------------------------------
treasuryOut :: TxOut treasuryOut :: TxOut

29
agora-specs/Sample/Stake.hs
View file

@ -27,8 +27,8 @@ import Data.Tagged (Tagged, untag)
import Plutarch.Context ( import Plutarch.Context (
MintingBuilder, MintingBuilder,
SpendingBuilder, SpendingBuilder,
buildMintingUnsafe, buildMinting',
buildSpendingUnsafe, buildSpending',
input, input,
mint, mint,
output, output,
@ -37,22 +37,23 @@ import Plutarch.Context (
txId, txId,
withDatum, withDatum,
withMinting, withMinting,
withOutRef, withRef,
withSpendingOutRef, withSpendingOutRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 (
Datum (Datum),
ScriptContext (..),
ScriptPurpose (Minting),
ToData (toBuiltinData),
TxInfo (txInfoData, txInfoSignatories),
)
import PlutusLedgerApi.V1.Contexts (TxOutRef (..)) import PlutusLedgerApi.V1.Contexts (TxOutRef (..))
import PlutusLedgerApi.V1.Value qualified as Value ( import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue, assetClassValue,
singleton, singleton,
) )
import PlutusLedgerApi.V2 (
Datum (Datum),
ScriptContext (..),
ScriptPurpose (Minting),
ToData (toBuiltinData),
TxInfo (txInfoData, txInfoSignatories),
)
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Shared ( import Sample.Shared (
governor, governor,
signer, signer,
@ -83,7 +84,7 @@ stakeCreation =
] ]
, withMinting stakeSymbol , withMinting stakeSymbol
] ]
in buildMintingUnsafe builder in buildMinting' builder
-- | This ScriptContext should fail because the datum has too much GT. -- | This ScriptContext should fail because the datum has too much GT.
stakeCreationWrongDatum :: ScriptContext stakeCreationWrongDatum :: ScriptContext
@ -91,7 +92,7 @@ stakeCreationWrongDatum =
let datum :: Datum let datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer Nothing []) -- Too much GT datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer Nothing []) -- Too much GT
in ScriptContext in ScriptContext
{ scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]} { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = AssocMap.fromList [("", datum)]}
, scriptContextPurpose = Minting stakeSymbol , scriptContextPurpose = Minting stakeSymbol
} }
@ -144,7 +145,7 @@ stakeDepositWithdraw config =
<> Value.assetClassValue (untag governor.gtClassRef) (untag stakeBefore.stakedAmount) <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeBefore.stakedAmount)
) )
, withDatum stakeAfter , withDatum stakeAfter
, withOutRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat
@ -158,4 +159,4 @@ stakeDepositWithdraw config =
] ]
, withSpendingOutRef stakeRef , withSpendingOutRef stakeRef
] ]
in buildSpendingUnsafe builder in buildSpending' builder

12
agora-specs/Sample/Stake/SetDelegate.hs
View file

@ -28,23 +28,23 @@ import Agora.Stake (
import Data.Tagged (untag) import Data.Tagged (untag)
import Plutarch.Context ( import Plutarch.Context (
SpendingBuilder, SpendingBuilder,
buildSpendingUnsafe, buildSpending',
input, input,
output, output,
script, script,
signedWith, signedWith,
txId, txId,
withDatum, withDatum,
withOutRef, withRef,
withSpendingOutRef, withSpendingOutRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
PubKeyHash, PubKeyHash,
ScriptContext, ScriptContext,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
) )
import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared ( import Sample.Shared (
agoraScripts, agoraScripts,
governor, governor,
@ -91,7 +91,7 @@ mkStakeInputDatum ps =
-- | Generate a 'ScriptContext' that tries to change the delegate of a stake. -- | Generate a 'ScriptContext' that tries to change the delegate of a stake.
setDelegate :: Parameters -> ScriptContext setDelegate :: Parameters -> ScriptContext
setDelegate ps = buildSpendingUnsafe builder setDelegate ps = buildSpending' builder
where where
stakeRef :: TxOutRef stakeRef :: TxOutRef
stakeRef = TxOutRef "0ffef57e30cc604342c738e31e0451593837b313e7bfb94b0922b142782f98e6" 1 stakeRef = TxOutRef "0ffef57e30cc604342c738e31e0451593837b313e7bfb94b0922b142782f98e6" 1
@ -134,7 +134,7 @@ setDelegate ps = buildSpendingUnsafe builder
[ script stakeValidatorHash [ script stakeValidatorHash
, withValue stakeValue , withValue stakeValue
, withDatum stakeInput , withDatum stakeInput
, withOutRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat

32
agora-specs/Sample/Treasury.hs
View file

@ -19,7 +19,7 @@ module Sample.Treasury (
import Plutarch.Context ( import Plutarch.Context (
MintingBuilder, MintingBuilder,
buildMintingUnsafe, buildMinting',
credential, credential,
input, input,
mint, mint,
@ -28,22 +28,23 @@ import Plutarch.Context (
signedWith, signedWith,
txId, txId,
withMinting, withMinting,
withTxId, withRefTxId,
withValue, withValue,
) )
import PlutusLedgerApi.V1 (
Credential (PubKeyCredential),
PubKeyHash (PubKeyHash),
)
import PlutusLedgerApi.V1.Address (Address (..)) import PlutusLedgerApi.V1.Address (Address (..))
import PlutusLedgerApi.V1.Contexts ( import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (
Credential (PubKeyCredential),
OutputDatum (NoOutputDatum),
PubKeyHash (PubKeyHash),
ValidatorHash (ValidatorHash),
)
import PlutusLedgerApi.V2.Contexts (
ScriptContext (..), ScriptContext (..),
TxInInfo (..), TxInInfo (..),
TxOut (..), TxOut (..),
TxOutRef (..), TxOutRef (..),
) )
import PlutusLedgerApi.V1.Scripts (ValidatorHash (ValidatorHash))
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import Sample.Shared ( import Sample.Shared (
gatCs, gatCs,
gatTn, gatTn,
@ -60,7 +61,7 @@ baseCtxBuilder =
mconcat mconcat
[ credential trCredential [ credential trCredential
, withValue minAda , withValue minAda
, withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" , withRefTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
] ]
in mconcat in mconcat
[ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
@ -84,10 +85,10 @@ validCtx =
mconcat mconcat
[ script mockTrEffectHash [ script mockTrEffectHash
, withValue (Value.singleton gatCs gatTn 1 <> minAda) , withValue (Value.singleton gatCs gatTn 1 <> minAda)
, withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
] ]
] ]
in buildMintingUnsafe builder in buildMinting' builder
treasuryRef :: TxOutRef treasuryRef :: TxOutRef
treasuryRef = treasuryRef =
@ -108,7 +109,8 @@ walletIn =
0 0
, txInInfoResolved = , txInInfoResolved =
TxOut TxOut
{ txOutDatumHash = Nothing { txOutDatum = NoOutputDatum
, txOutReferenceScript = Nothing
, txOutValue = Value.singleton gatCs gatTn 1 , txOutValue = Value.singleton gatCs gatTn 1
, txOutAddress = , txOutAddress =
Address Address
@ -127,7 +129,7 @@ trCtxGATNameNotAddress =
mconcat mconcat
[ script wrongEffHash [ script wrongEffHash
, withValue (Value.singleton gatCs gatTn 1 <> minAda) , withValue (Value.singleton gatCs gatTn 1 <> minAda)
, withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
] ]
] ]
in buildMintingUnsafe builder in buildMinting' builder

2
agora-specs/Spec/Effect/GovernorMutation.hs
View file

@ -5,7 +5,7 @@ import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
import Agora.Proposal (ProposalId (..)) import Agora.Proposal (ProposalId (..))
import Agora.Scripts (AgoraScripts (..)) import Agora.Scripts (AgoraScripts (..))
import Data.Default.Class (Default (def)) import Data.Default.Class (Default (def))
import PlutusLedgerApi.V1 (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import PlutusLedgerApi.V2 (ScriptContext (ScriptContext), ScriptPurpose (Spending))
import Sample.Effect.GovernorMutation ( import Sample.Effect.GovernorMutation (
effectRef, effectRef,
govRef, govRef,

14
agora-specs/Spec/Treasury.hs
View file

@ -26,17 +26,17 @@ import Agora.Treasury (
treasuryValidator, treasuryValidator,
) )
import Agora.Utils (CompiledValidator (CompiledValidator)) import Agora.Utils (CompiledValidator (CompiledValidator))
import Plutarch.Api.V1 (mkValidator) import Plutarch.Api.V2 (mkValidator)
import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey))
import PlutusLedgerApi.V1.Contexts (
ScriptContext (scriptContextPurpose, scriptContextTxInfo),
ScriptPurpose (Certifying, Rewarding, Spending),
TxInfo (txInfoInputs, txInfoMint),
)
import PlutusLedgerApi.V1.Credential ( import PlutusLedgerApi.V1.Credential (
StakingCredential (StakingHash), StakingCredential (StakingHash),
) )
import PlutusLedgerApi.V1.Value qualified as Value (singleton) import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey))
import PlutusLedgerApi.V2.Contexts (
ScriptContext (scriptContextPurpose, scriptContextTxInfo),
ScriptPurpose (Certifying, Rewarding, Spending),
TxInfo (txInfoInputs, txInfoMint),
)
import Sample.Shared (deterministicTracingConfing, trCredential) import Sample.Shared (deterministicTracingConfing, trCredential)
import Sample.Treasury ( import Sample.Treasury (
gatCs, gatCs,

14
agora-testlib/Test/Specification.hs
View file

@ -49,18 +49,26 @@ module Test.Specification (
toTestTree, toTestTree,
) where ) where
import Agora.Utils (CompiledEffect (..), CompiledMintingPolicy (..), CompiledValidator (..)) import Agora.Utils (
CompiledEffect (..),
CompiledMintingPolicy (..),
CompiledValidator (..),
)
import Control.Composition ((.**), (.***)) import Control.Composition ((.**), (.***))
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Plutarch.Evaluate (evalScript) import Plutarch.Evaluate (evalScript)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Scripts (
Context (..),
applyMintingPolicyScript,
applyValidator,
)
import PlutusLedgerApi.V2 (
Datum (..), Datum (..),
Redeemer (Redeemer), Redeemer (Redeemer),
Script, Script,
ScriptContext, ScriptContext,
ToData (toBuiltinData), ToData (toBuiltinData),
) )
import PlutusLedgerApi.V1.Scripts (Context (..), applyMintingPolicyScript, applyValidator)
import PlutusTx.IsData qualified as PlutusTx (ToData) import PlutusTx.IsData qualified as PlutusTx (ToData)
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase) import Test.Tasty.HUnit (assertFailure, testCase)

16
agora-testlib/Test/Util.hs
View file

@ -36,13 +36,16 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy
import Data.List (sortOn) import Data.List (sortOn)
import Plutarch.Context ( import Plutarch.Context (
Builder, Builder,
buildMintingUnsafe, buildMinting',
buildSpendingUnsafe, buildSpending',
withMinting, withMinting,
withSpendingOutRef, withSpendingOutRef,
) )
import Plutarch.Crypto (pblake2b_256) import Plutarch.Crypto (pblake2b_256)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1.Interval qualified as PlutusTx
import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
import PlutusLedgerApi.V1.Value (Value (..))
import PlutusLedgerApi.V2 (
Credential ( Credential (
PubKeyCredential, PubKeyCredential,
ScriptCredential ScriptCredential
@ -53,9 +56,6 @@ import PlutusLedgerApi.V1 (
TxOutRef, TxOutRef,
ValidatorHash (ValidatorHash), ValidatorHash (ValidatorHash),
) )
import PlutusLedgerApi.V1.Interval qualified as PlutusTx
import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
import PlutusLedgerApi.V1.Value (Value (..))
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.Builtins qualified as PlutusTx
import PlutusTx.IsData qualified as PlutusTx import PlutusTx.IsData qualified as PlutusTx
@ -190,7 +190,7 @@ mkSpending ::
TxOutRef -> TxOutRef ->
ScriptContext ScriptContext
mkSpending mkBuilder ps oref = mkSpending mkBuilder ps oref =
buildSpendingUnsafe $ buildSpending' $
mkBuilder ps <> withSpendingOutRef oref mkBuilder ps <> withSpendingOutRef oref
{- | Given the builder generator and the parameters, create a 'ScriptContext' {- | Given the builder generator and the parameters, create a 'ScriptContext'
@ -203,7 +203,7 @@ mkMinting ::
CurrencySymbol -> CurrencySymbol ->
ScriptContext ScriptContext
mkMinting mkBuilder ps cs = mkMinting mkBuilder ps cs =
buildMintingUnsafe $ buildMinting' $
mkBuilder ps <> withMinting cs mkBuilder ps <> withMinting cs
type CombinableBuilder b = (Monoid b, Builder b) type CombinableBuilder b = (Monoid b, Builder b)

16
agora/Agora/AuthorityToken.hs
View file

@ -13,11 +13,15 @@ module Agora.AuthorityToken (
) where ) where
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential (..),
PCurrencySymbol (..),
)
import Plutarch.Api.V1.AssocMap (PMap (PMap))
import Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Api.V2 (
AmountGuarantees, AmountGuarantees,
KeyGuarantees, KeyGuarantees,
PAddress (..), PAddress (..),
PCredential (..),
PCurrencySymbol (..),
PMintingPolicy, PMintingPolicy,
PScriptContext (..), PScriptContext (..),
PScriptPurpose (..), PScriptPurpose (..),
@ -25,14 +29,12 @@ import Plutarch.Api.V1 (
PTxInfo (..), PTxInfo (..),
PTxOut (..), PTxOut (..),
) )
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf)
import Plutarch.Api.V1.AssocMap (PMap (PMap))
import Plutarch.Api.V1.ScriptContext (pisTokenSpent)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import "plutarch" Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
import Plutarch.Extra.List (plookup) import Plutarch.Extra.List (plookup)
import Plutarch.Extra.ScriptContext (pisTokenSpent)
import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC, pmatchC)
import Plutarch.Extra.Value (psymbolValueOf)
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------

2
agora/Agora/Bootstrap.hs
View file

@ -19,7 +19,7 @@ import Agora.Utils (
CompiledValidator (..), CompiledValidator (..),
) )
import Plutarch (Config) import Plutarch (Config)
import Plutarch.Api.V1 ( import Plutarch.Api.V2 (
mintingPolicySymbol, mintingPolicySymbol,
mkMintingPolicy, mkMintingPolicy,
mkValidator, mkValidator,

4
agora/Agora/Effect.hs
View file

@ -10,11 +10,13 @@ module Agora.Effect (makeEffect) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCurrencySymbol, PCurrencySymbol,
PValue,
)
import Plutarch.Api.V2 (
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
PTxInfo, PTxInfo,
PTxOutRef, PTxOutRef,
PValidator, PValidator,
PValue,
) )
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.TryFrom () import Plutarch.TryFrom ()

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

@ -26,22 +26,22 @@ import Agora.Governor (
) )
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass) import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass)
import Plutarch.Api.V1 ( import Agora.Utils (pmustFindDatum)
import Plutarch.Api.V1 (PValue)
import Plutarch.Api.V2 (
PTxOutRef, PTxOutRef,
PValidator, PValidator,
PValue,
) )
import Plutarch.Api.V1.ScriptContext (pisScriptAddress, ptryFindDatum)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pvalueOf)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, PDataFields,
) )
import Plutarch.Extra.Maybe ( import Plutarch.Extra.Maybe (
passertPDJust,
passertPJust, passertPJust,
) )
import Plutarch.Extra.ScriptContext (pisScriptAddress)
import Plutarch.Extra.TermCont (pguardC, pletFieldsC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC)
import Plutarch.Extra.Value (pvalueOf)
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 (..))
@ -191,7 +191,7 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $
let govAddress = pfield @"address" #$ govInInfo.resolved let govAddress = pfield @"address" #$ govInInfo.resolved
govOutput' = phead # pfromData txInfoF.outputs govOutput' = phead # pfromData txInfoF.outputs
govOutput <- pletFieldsC @'["address", "value", "datumHash"] govOutput' govOutput <- pletFieldsC @'["address", "value", "datum"] govOutput'
pguardC "No output to the governor" $ pguardC "No output to the governor" $
govOutput.address #== govAddress govOutput.address #== govAddress
@ -199,11 +199,9 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $
pguardC "Governor output doesn't carry the GST" $ pguardC "Governor output doesn't carry the GST" $
gstValueOf # govOutput.value #== 1 gstValueOf # govOutput.value #== 1
let governorOutputDatumHash = let governorOutputDatum =
passertPDJust # "Governor output doesn't have datum" # govOutput.datumHash ptrace "Governor output datum not found" $
governorOutputDatum = pmustFindDatum @PGovernorDatum # govOutput.datum # txInfoF.datums
passertPJust @PGovernorDatum # "Governor output datum not found"
#$ ptryFindDatum # governorOutputDatumHash # txInfoF.datums
-- Ensure the output governor datum is what we want. -- Ensure the output governor datum is what we want.
pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum

2
agora/Agora/Effect/NoOp.hs
View file

@ -9,7 +9,7 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Plutarch.Api.V1 (PValidator) import Plutarch.Api.V2 (PValidator)
import PlutusLedgerApi.V1.Value (CurrencySymbol) import PlutusLedgerApi.V1.Value (CurrencySymbol)
{- | Dummy datum for NoOp effect. {- | Dummy datum for NoOp effect.

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

@ -16,20 +16,22 @@ module Agora.Effect.TreasuryWithdrawal (
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
AmountGuarantees (Positive),
KeyGuarantees (Sorted),
PCredential (..), PCredential (..),
PTuple,
PValidator,
PValue, PValue,
ptuple, ptuple,
) )
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisPubKey) import Plutarch.Api.V1.Value (pnormalize)
import "plutarch" Plutarch.Api.V1.Value (pnormalize) import Plutarch.Api.V2 (
AmountGuarantees (Positive),
KeyGuarantees (Sorted),
PTuple,
PValidator,
)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, PDataFields,
) )
import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, pisPubKey)
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, 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)

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

@ -43,33 +43,25 @@ import Agora.Stake (
pnumCreatedProposals, pnumCreatedProposals,
) )
import Agora.Utils ( import Agora.Utils (
mustFindDatum', pfindDatum,
pfromDatumHash,
pmustFindDatum,
validatorHashToAddress, validatorHashToAddress,
) )
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PAddress,
PCurrencySymbol, PCurrencySymbol,
PDatumHash,
PMap, PMap,
PValidatorHash,
)
import Plutarch.Api.V2 (
PAddress,
PDatumHash,
PMintingPolicy, PMintingPolicy,
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTxOut, PTxOut,
PValidator, PValidator,
PValidatorHash,
) )
import Plutarch.Api.V1.AssetClass ( import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
passetClass,
passetClassValueOf,
)
import Plutarch.Api.V1.ScriptContext (
pfindOutputsToAddress,
pfindTxInByTxOutRef,
pisUTXOSpent,
pscriptHashFromAddress,
ptryFindDatum,
pvalueSpent,
)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.IsData (pmatchEnumFromData) import Plutarch.Extra.IsData (pmatchEnumFromData)
import Plutarch.Extra.List (pfirstJust) import Plutarch.Extra.List (pfirstJust)
@ -77,9 +69,17 @@ import Plutarch.Extra.Map (
plookup, plookup,
plookup', plookup',
) )
import Plutarch.Extra.Maybe (passertPDJust, passertPJust, pfromJust, pisDJust) import Plutarch.Extra.Maybe (passertPJust, pfromJust, pnothing)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext (
pfindOutputsToAddress,
pfindTxInByTxOutRef,
pisUTXOSpent,
pscriptHashFromAddress,
pvalueSpent,
)
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -140,8 +140,8 @@ governorPolicy initialSpend =
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
let datumHash = pfield @"datumHash" # govOutput let outputDatum = pfield @"datum" # govOutput
datum = mustFindDatum' @PGovernorDatum # datumHash # txInfoF.datums datum = pmustFindDatum @PGovernorDatum # outputDatum # txInfoF.datums
pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum
@ -265,18 +265,14 @@ governorValidator as =
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 <- pletFieldsC @'["value", "datumHash"] $ phead # ownOutputs ownOutput <- pletFieldsC @'["value", "datum"] $ 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
-- Check that own output have datum of type 'GovernorDatum'. -- Check that own output have datum of type 'GovernorDatum'.
let outputGovernorStateDatumHash =
passertPDJust # "Governor output doesn't have datum" # ownOutput.datumHash
newGovernorDatum <- newGovernorDatum <-
pletC $ pletC $ pmustFindDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums
passertPJust # "Ouput governor state datum not found"
#$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums
pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum
@ -323,12 +319,9 @@ governorValidator as =
stakeInput <- pletC $ phead # stakeInputs stakeInput <- pletC $ phead # stakeInputs
stakeInputF <- pletFieldsC @'["datumHash", "value"] $ pfield @"resolved" # stakeInput stakeInputF <- pletFieldsC @'["datum", "value"] $ pfield @"resolved" # stakeInput
pguardC "Stake input doesn't have datum" $ let stakeInputDatum = pmustFindDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums
pisDJust # stakeInputF.datumHash
let stakeInputDatum = mustFindDatum' @(PAsData PStakeDatum) # stakeInputF.datumHash # txInfoF.datums
stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum
@ -356,12 +349,10 @@ governorValidator as =
pguardC "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ pguardC "Exactly one UTXO with proposal state token should be sent to the proposal validator" $
plength # outputsToProposalValidatorWithStateToken #== 1 plength # outputsToProposalValidatorWithStateToken #== 1
outputDatumHash <- pletC $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken
proposalOutputDatum' <- proposalOutputDatum' <-
pletC $ pletC $
mustFindDatum' @(PAsData PProposalDatum) pmustFindDatum @(PAsData PProposalDatum)
# outputDatumHash # (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken)
# txInfoF.datums # txInfoF.datums
proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum' proposalOutputDatum <- pletAllC $ pto $ pfromData proposalOutputDatum'
@ -396,31 +387,21 @@ governorValidator as =
] ]
-- Check the output stake has been proposly updated. -- Check the output stake has been proposly updated.
let stakeOutputDatumHash = let stakeOutputDatum =
passertPJust # "Output stake should be presented" passertPJust # "Output stake should be presented"
#$ pfirstJust #$ pfirstJust
# phoistAcyclic # plam
( plam ( \txOut -> unTermCont $ do
( \txOut -> unTermCont $ do txOutF <- pletFieldsC @'["datum", "value"] txOut
txOutF <- pletFieldsC @'["datumHash", "value"] txOut
pure $ pure $
pif pif
(psymbolValueOf # psstSymbol # txOutF.value #== 1) (psymbolValueOf # psstSymbol # txOutF.value #== 1)
( pcon $ (pfindDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums)
PJust $ (pcon PNothing)
passertPDJust # "Output stake datum should be presented"
# txOutF.datumHash
)
(pcon PNothing)
)
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
stakeOutputDatum =
passertPJust @(PAsData PStakeDatum) # "Stake output datum presented"
#$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
stakeOutputLocks = stakeOutputLocks =
pfromData $ pfield @"lockedBy" #$ pto $ pfromData stakeOutputDatum pfromData $ pfield @"lockedBy" #$ pto $ pfromData stakeOutputDatum
@ -450,27 +431,24 @@ governorValidator as =
pguardC "The governor can only process one proposal at a time" $ pguardC "The governor can only process one proposal at a time" $
(psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
proposalInputF <-
pletFieldsC @'["datumHash"] $
pfield @"resolved"
#$ passertPJust
# "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
proposalInputDatum <- proposalInputDatum <-
pletC $ pletC $
mustFindDatum' @(PAsData PProposalDatum) passertPJust
# proposalInputF.datumHash # "Proposal input not found"
# txInfoF.datums #$ pfirstJust
# plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- pletFieldsC @'["address", "value", "datum"] txOut
pure $
pif
( psymbolValueOf # ppstSymbol # txOutF.value #== 1
#&& txOutF.address #== pdata pproposalValidatorAddress
)
(pfindDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums)
pnothing
)
# pfromData txInfoF.inputs
proposalInputDatumF <- proposalInputDatumF <-
pletFieldsC @'["effects", "status", "thresholds", "votes"] $ pletFieldsC @'["effects", "status", "thresholds", "votes"] $
@ -516,14 +494,16 @@ governorValidator as =
phoistAcyclic $ phoistAcyclic $
plam plam
( \effects output' -> unTermCont $ do ( \effects output' -> unTermCont $ do
output <- pletFieldsC @'["address", "datumHash"] output' output <- pletFieldsC @'["address", "datum"] output'
let scriptHash = let scriptHash =
passertPJust # "GAT receiver is not a script" passertPJust # "GAT receiver is not a script"
#$ pscriptHashFromAddress # output.address #$ pscriptHashFromAddress # output.address
datumHash = datumHash =
passertPDJust # "Output to effect should have datum" ptrace
#$ output.datumHash "Output to effect should have datum"
pfromDatumHash
# output.datum
expectedDatumHash = expectedDatumHash =
passertPJust # "Receiver is not in the effect list" passertPJust # "Receiver is not in the effect list"

7
agora/Agora/Proposal.hs
View file

@ -45,14 +45,13 @@ import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, Propos
import Agora.SafeMoney (GTTag) import Agora.SafeMoney (GTTag)
import Data.Tagged (Tagged) import Data.Tagged (Tagged)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (PMap, PValidatorHash)
import Plutarch.Api.V1.AssocMap qualified as PAssocMap
import Plutarch.Api.V2 (
KeyGuarantees (Unsorted), KeyGuarantees (Unsorted),
PDatumHash, PDatumHash,
PMap,
PPubKeyHash, PPubKeyHash,
PValidatorHash,
) )
import Plutarch.Api.V1.AssocMap qualified as PAssocMap
import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields) import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields)
import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)

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

@ -37,10 +37,12 @@ import Agora.Stake (
pisVoter, pisVoter,
) )
import Agora.Utils ( import Agora.Utils (
mustFindDatum', pfromDatumHash,
pltAsData, pltAsData,
pmustFindDatum,
ptryFindDatum,
) )
import Plutarch.Api.V1 ( import Plutarch.Api.V2 (
PDatumHash, PDatumHash,
PMintingPolicy, PMintingPolicy,
PPubKeyHash, PPubKeyHash,
@ -50,21 +52,19 @@ import Plutarch.Api.V1 (
PTxOut, PTxOut,
PValidator, PValidator,
) )
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf) import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
import Plutarch.Api.V1.ScriptContext (
pfindTxInByTxOutRef,
pisTokenSpent,
ptryFindDatum,
ptxSignedBy,
)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.IsData (pmatchEnum) import Plutarch.Extra.IsData (pmatchEnum)
import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy) import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy)
import Plutarch.Extra.Map (plookup, pupdate) import Plutarch.Extra.Map (plookup, pupdate)
import Plutarch.Extra.Maybe (passertPJust, pfromDJust, pfromJust, pisJust) import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef,
pisTokenSpent,
ptxSignedBy,
)
import Plutarch.Extra.TermCont ( import Plutarch.Extra.TermCont (
pguardC, pguardC,
pletC, pletC,
@ -72,6 +72,7 @@ import Plutarch.Extra.TermCont (
pmatchC, pmatchC,
ptryFromC, ptryFromC,
) )
import Plutarch.Extra.Value (psymbolValueOf)
import Plutarch.SafeMoney (PDiscrete (..)) import Plutarch.SafeMoney (PDiscrete (..))
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
@ -213,8 +214,8 @@ proposalValidator as maximumCosigners =
-- Maybe we can cache the sorted datum map? -- Maybe we can cache the sorted datum map?
let datum = let datum =
pfromData $ pfromData $
mustFindDatum' @(PAsData PProposalDatum) pmustFindDatum @(PAsData PProposalDatum)
# inputF.datumHash # inputF.datum
# txInfoF.datums # txInfoF.datums
proposalId = pfield @"proposalId" # pto datum proposalId = pfield @"proposalId" # pto datum
@ -229,8 +230,8 @@ proposalValidator as maximumCosigners =
proposalOut <- proposalOut <-
pletC $ pletC $
pfromData $ pfromData $
mustFindDatum' @(PAsData PProposalDatum) pmustFindDatum @(PAsData PProposalDatum)
# (pfield @"datumHash" # ownOutput) # (pfield @"datum" # ownOutput)
# txInfoF.datums # txInfoF.datums
proposalUnchanged <- pletC $ proposalOut #== proposalDatum proposalUnchanged <- pletC $ proposalOut #== proposalDatum
@ -267,11 +268,11 @@ proposalValidator as maximumCosigners =
filterStakeDatumHash :: Term _ (PTxOut :--> PMaybe (PAsData PDatumHash)) <- filterStakeDatumHash :: Term _ (PTxOut :--> PMaybe (PAsData PDatumHash)) <-
pletC $ pletC $
plam $ \txOut -> unTermCont $ do plam $ \txOut -> unTermCont $ do
txOutF <- pletFieldsC @'["value", "datumHash"] txOut txOutF <- pletFieldsC @'["value", "datum"] txOut
pure $ pure $
pif pif
(passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1) (passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1)
( let datumHash = pfromDJust # txOutF.datumHash ( let datumHash = pfromDatumHash # txOutF.datum
in pcon $ PJust $ pdata datumHash in pcon $ PJust $ pdata datumHash
) )
(pcon PNothing) (pcon PNothing)

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

@ -36,9 +36,9 @@ import Plutarch.Api.V1 (
PInterval (PInterval), PInterval (PInterval),
PLowerBound (PLowerBound), PLowerBound (PLowerBound),
PPOSIXTime, PPOSIXTime,
PPOSIXTimeRange,
PUpperBound (PUpperBound), PUpperBound (PUpperBound),
) )
import Plutarch.Api.V2 (PPOSIXTimeRange)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, PDataFields,

11
agora/Agora/Scripts.hs
View file

@ -23,11 +23,14 @@ import Agora.Governor (GovernorDatum, GovernorRedeemer)
import Agora.Proposal (ProposalDatum, ProposalRedeemer) import Agora.Proposal (ProposalDatum, ProposalRedeemer)
import Agora.Stake (StakeDatum, StakeRedeemer) import Agora.Stake (StakeDatum, StakeRedeemer)
import Agora.Treasury (TreasuryRedeemer) import Agora.Treasury (TreasuryRedeemer)
import Agora.Utils (CompiledMintingPolicy (..), CompiledValidator (..), validatorHashToTokenName) import Agora.Utils (
import Plutarch.Api.V1 (mintingPolicySymbol, validatorHash) CompiledMintingPolicy (..),
import PlutusLedgerApi.V1 (CurrencySymbol) CompiledValidator (..),
import PlutusLedgerApi.V1.Scripts (ValidatorHash) validatorHashToTokenName,
)
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
import PlutusLedgerApi.V1.Value (AssetClass (..)) import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V2 (CurrencySymbol, ValidatorHash)
{- | Precompiled core scripts. {- | Precompiled core scripts.

2
agora/Agora/Stake.hs
View file

@ -34,7 +34,7 @@ import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
import Agora.SafeMoney (GTTag) import Agora.SafeMoney (GTTag)
import Data.Tagged (Tagged (..)) import Data.Tagged (Tagged (..))
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 ( import Plutarch.Api.V2 (
PMaybeData, PMaybeData,
PPubKeyHash, PPubKeyHash,
) )

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

@ -16,30 +16,41 @@ import Agora.Stake (
pstakeLocked, pstakeLocked,
) )
import Agora.Utils ( import Agora.Utils (
mustFindDatum', pfromDatumHash,
pmustFindDatum,
) )
import Data.Function (on) import Data.Function (on)
import Data.Tagged (Tagged (..), untag) import Data.Tagged (Tagged (..), untag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
AmountGuarantees (Positive),
PCredential (PPubKeyCredential, PScriptCredential), PCredential (PPubKeyCredential, PScriptCredential),
PTokenName,
PValue,
)
import Plutarch.Api.V2 (
AmountGuarantees (Positive),
PDatumHash, PDatumHash,
PMintingPolicy, PMintingPolicy,
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTokenName,
PTxInfo, PTxInfo,
PTxOut, PTxOut,
PValidator, PValidator,
PValue,
) )
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf) import Plutarch.Extra.AssetClass (
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent) passetClass,
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf) passetClassValueOf,
pvalueOf,
)
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.List (pmapMaybe, pmsortBy) import Plutarch.Extra.List (pmapMaybe, pmsortBy)
import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pfromDJust, pmaybeData) import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Extra.Value (
pgeqByClass',
pgeqBySymbol,
psymbolValueOf,
)
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+))) import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
import Plutarch.SafeMoney ( import Plutarch.SafeMoney (
pdiscreteValue', pdiscreteValue',
@ -96,14 +107,14 @@ stakePolicy gtClassRef =
pany pany
# plam # plam
( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
txOutF <- pletFieldsC @'["value", "datumHash"] txOut txOutF <- pletFieldsC @'["value", "datum"] txOut
pure $ pure $
pif pif
(psymbolValueOf # ownSymbol # txOutF.value #== 1) (psymbolValueOf # ownSymbol # txOutF.value #== 1)
( let datum = ( let datum =
pfromData $ pfromData $
mustFindDatum' @(PAsData PStakeDatum) pmustFindDatum @(PAsData PStakeDatum)
# txOutF.datumHash # txOutF.datum
# txInfoF.datums # txInfoF.datums
in pnot # (pstakeLocked # datum) in pnot # (pstakeLocked # datum)
) )
@ -141,12 +152,12 @@ stakePolicy gtClassRef =
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
outputF <- outputF <-
pletFieldsC @'["value", "address", "datumHash"] scriptOutputWithStakeST pletFieldsC @'["value", "address", "datum"] scriptOutputWithStakeST
datumF <- datumF <-
pletFieldsC @'["owner", "stakedAmount"] $ pletFieldsC @'["owner", "stakedAmount"] $
pto $ pto $
pfromData $ pfromData $
mustFindDatum' @(PAsData PStakeDatum) # outputF.datumHash # txInfoF.datums pmustFindDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums
let hasExpectedStake = let hasExpectedStake =
ptraceIfFalse "Stake ouput has expected amount of stake token" $ ptraceIfFalse "Stake ouput has expected amount of stake token" $
@ -344,7 +355,7 @@ stakeValidator as gtClassRef =
sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #) sortTxOuts = phoistAcyclic $ plam (pmsortBy # plam ((#<) `on` (getDatumHash #)) #)
where where
getDatumHash :: Term _ (PTxOut :--> PDatumHash) getDatumHash :: Term _ (PTxOut :--> PDatumHash)
getDatumHash = phoistAcyclic $ plam ((pfromDJust #) . pfromData . (pfield @"datumHash" #)) getDatumHash = phoistAcyclic $ plam ((pfromDatumHash #) . (pfield @"datum" #))
sortedOwnInputs = sortTxOuts # ownInputs sortedOwnInputs = sortTxOuts # ownInputs
sortedOwnOutputs = sortTxOuts # ownOutputs sortedOwnOutputs = sortTxOuts # ownOutputs
@ -365,8 +376,8 @@ stakeValidator as gtClassRef =
stakeOut <- stakeOut <-
pletC $ pletC $
pfromData $ pfromData $
mustFindDatum' @(PAsData PStakeDatum) pmustFindDatum @(PAsData PStakeDatum)
# (pfield @"datumHash" # ownOutput) # (pfield @"datum" # ownOutput)
# txInfoF.datums # txInfoF.datums
ownOutputValue <- ownOutputValue <-

5
agora/Agora/Treasury.hs
View file

@ -12,9 +12,8 @@ module Agora.Treasury (module Agora.Treasury) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PValidator) import Plutarch.Api.V1.Value (PValue)
import Plutarch.Api.V1.Contexts (PScriptPurpose (PMinting)) import Plutarch.Api.V2 (PScriptPurpose (PMinting), PValidator)
import "plutarch" Plutarch.Api.V1.Value (PValue)
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.IsData ( import Plutarch.Extra.IsData (
DerivePConstantViaEnum (..), DerivePConstantViaEnum (..),

165
agora/Agora/Utils.hs
View file

@ -10,26 +10,32 @@ Plutarch utility functions that should be upstreamed or don't belong anywhere el
-} -}
module Agora.Utils ( module Agora.Utils (
validatorHashToTokenName, validatorHashToTokenName,
mustFindDatum',
validatorHashToAddress, validatorHashToAddress,
pltAsData, pltAsData,
withBuiltinPairAsData, withBuiltinPairAsData,
CompiledValidator (..), CompiledValidator (..),
CompiledMintingPolicy (..), CompiledMintingPolicy (..),
CompiledEffect (..), CompiledEffect (..),
presolveOutputDatum,
pfindDatum,
pmustFindDatum,
(#.*),
(#.**),
pfromDatumHash,
pfromInlineDatum,
ptryFindDatum,
) where ) where
import Plutarch.Api.V1 ( import Plutarch.Api.V1.AssocMap (KeyGuarantees (Unsorted), PMap)
import Plutarch.Api.V1.AssocMap qualified as PAssocMap
import Plutarch.Api.V2 (
PDatum, PDatum,
PDatumHash, PDatumHash,
PMaybeData, POutputDatum (..),
PTuple,
) )
import Plutarch.Builtin (pforgetData) import Plutarch.Extra.Functor (pfmap)
import Plutarch.Extra.List (plookupTuple) import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing)
import Plutarch.Extra.Maybe (passertPDJust, passertPJust) import PlutusLedgerApi.V2 (
import Plutarch.Extra.TermCont (ptryFromC)
import PlutusLedgerApi.V1 (
Address (..), Address (..),
Credential (..), Credential (..),
MintingPolicy, MintingPolicy,
@ -50,27 +56,6 @@ import PlutusLedgerApi.V1 (
validatorHashToTokenName :: ValidatorHash -> TokenName validatorHashToTokenName :: ValidatorHash -> TokenName
validatorHashToTokenName (ValidatorHash hash) = TokenName hash validatorHashToTokenName (ValidatorHash hash) = TokenName hash
{- | Find datum given a maybe datum hash
@since 0.1.0
-}
mustFindDatum' ::
forall (datum :: PType).
(PIsData datum, PTryFrom PData datum) =>
forall s.
Term
s
( PMaybeData PDatumHash
:--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
:--> datum
)
mustFindDatum' = phoistAcyclic $
plam $ \mdh datums -> unTermCont $ do
let dh = passertPDJust # "Given TxOut dones't have a datum" # mdh
dt = passertPJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
(d, _) <- ptryFromC $ pforgetData $ pdata dt
pure d
{- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'. {- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
@since 0.1.0 @since 0.1.0
@ -130,3 +115,123 @@ newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy
newtype CompiledEffect (datum :: Type) = CompiledEffect newtype CompiledEffect (datum :: Type) = CompiledEffect
{ getCompiledEffect :: Validator { getCompiledEffect :: Validator
} }
-- @since 0.3.0
presolveOutputDatum ::
forall s.
Term
s
( POutputDatum
:--> PMap 'Unsorted PDatumHash PDatum
:--> PMaybe PDatum
)
presolveOutputDatum = phoistAcyclic $
plam $ \od m -> pmatch od $ \case
PNoOutputDatum _ ->
ptrace "no datum" pnothing
POutputDatum ((pfield @"outputDatum" #) -> datum) ->
ptrace "datum hash" pjust # datum
POutputDatumHash ((pfield @"datumHash" #) -> hash) ->
PAssocMap.plookup
# hash
# m
-- | @since 0.3.0
pfindDatum ::
forall datum s.
PTryFrom PData datum =>
Term
s
( POutputDatum
:--> PMap 'Unsorted PDatumHash PDatum
:--> PMaybe datum
)
pfindDatum = phoistAcyclic $
plam $ \od m ->
pfmap
# phoistAcyclic (plam $ flip ptryFrom fst . pto)
# (presolveOutputDatum # od # m)
-- | @since 0.3.0
pmustFindDatum ::
forall datum s.
(PIsData datum, PTryFrom PData datum) =>
Term
s
( POutputDatum
:--> PMap 'Unsorted PDatumHash PDatum
:--> datum
)
pmustFindDatum =
phoistAcyclic $
plam $
(passertPJust # "datum not found") #.* pfindDatum
-- | @since 0.3.0
pfromDatumHash :: forall s. Term s (POutputDatum :--> PDatumHash)
pfromDatumHash = phoistAcyclic $
plam $
flip pmatch $ \case
POutputDatumHash ((pfield @"datumHash" #) -> hash) -> hash
_ -> ptraceError "not a datum hash"
-- | @since 0.3.0
pfromInlineDatum :: forall s. Term s (POutputDatum :--> PDatum)
pfromInlineDatum = phoistAcyclic $
plam $
flip pmatch $ \case
POutputDatum ((pfield @"outputDatum" #) -> datum) -> datum
_ -> ptraceError "not an inline datum"
{- | Find a datum with the given hash, and 'ptryFrom' it.
@since 0.3.0
-}
ptryFindDatum ::
forall datum (s :: S).
PTryFrom PData datum =>
Term
s
( PDatumHash
:--> PMap 'Unsorted PDatumHash PDatum
:--> PMaybe datum
)
ptryFindDatum =
phoistAcyclic $
plam $
(pfmap # ptryFromDatum)
#.* PAssocMap.plookup
{- | Convert a 'PDatum' to the given datum type.
@since 0.3.0
-}
ptryFromDatum ::
forall datum s.
(PTryFrom PData datum) =>
Term s (PDatum :--> datum)
ptryFromDatum = phoistAcyclic $ plam $ flip ptryFrom fst . pto
infixr 8 #.*
infixr 8 #.**
-- | @since 0.3.0
(#.*) ::
forall d c b a s.
Term s (c :--> d) ->
Term s (a :--> b :--> c) ->
Term s a ->
Term s b ->
Term s d
(#.*) f g x y = f #$ g # x # y
-- | @since 0.3.0
(#.**) ::
forall e d c b a s.
Term s (d :--> e) ->
Term s (a :--> b :--> c :--> d) ->
Term s a ->
Term s b ->
Term s c ->
Term s e
(#.**) f g x y z = f #$ g # x # y # z