Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Moved samples to PCB

Browse source 
* Cleaner imports
This commit is contained in:
Seungheon Oh 2022-06-17 12:35:33 -05:00
parent 96fbb24c29
commit 50b89107ed
No known key found for this signature in database
GPG key ID: 9B0E12D357369B66
17 changed files with 701 additions and 1004 deletions
Download patch file Download diff file Expand all files Collapse all files

24
agora-specs/Property/MultiSig.hs
View file

@ -12,23 +12,18 @@ import Agora.MultiSig (
PMultiSig,
pvalidatedByMultisig,
)
import Data.Maybe (fromJust)
import Plutarch.Extra.TermCont (pletC)
import Data.Tagged (Tagged (Tagged))
import Data.Universe (Finite (..), Universe (..))
import Plutarch.Api.V1 (PScriptContext)
import Plutarch.Context.Config (defaultConfig)
import Plutarch.Context.Spending (
ValidatorUTXO (ValidatorUTXO),
inputSelfExtra,
signedWith,
spendingContext,
)
import Plutarch.Extra.TermCont (pletC)
import Plutarch.Context
import PlutusLedgerApi.V1 (
ScriptContext (scriptContextTxInfo),
ScriptContext (..),
ScriptPurpose (..),
TxInfo (txInfoSignatories),
TxOutRef (..),
)
import Property.Generator (genPubKeyHash, genSingletonValue)
import Property.Generator (genPubKeyHash)
import Test.Tasty (TestTree)
import Test.Tasty.Plutarch.Property (classifiedPropertyNative)
import Test.Tasty.QuickCheck (
@ -63,7 +58,6 @@ genMultiSigProp :: MultiSigProp -> Gen MultiSigModel
genMultiSigProp prop = do
size <- chooseInt (4, 20)
pkhs <- vectorOf size genPubKeyHash
vutxo <- ValidatorUTXO () <$> genSingletonValue
minSig <- chooseInt (1, length pkhs)
othersigners <- take 20 <$> listOf genPubKeyHash
@ -73,9 +67,9 @@ genMultiSigProp prop = do
MeetsMinSigs -> chooseInt (minSig, length pkhs)
DoesNotMeetMinSigs -> chooseInt (0, minSig - 1)
let builder = foldr (<>) (inputSelfExtra mempty ()) (signedWith <$> take n pkhs <> othersigners)
ctx = fromJust $ spendingContext defaultConfig builder vutxo
pure (ms, ctx)
let builder = mconcat $ signedWith <$> take n pkhs <> othersigners
txinfo = either error id $ buildTxInfo builder
pure (ms, ScriptContext txinfo (Spending (TxOutRef "" 0)))
-- | Classify model into propositions.
classifyMultiSigProp :: MultiSigModel -> MultiSigProp

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

@ -11,17 +11,13 @@ module Sample.Effect.GovernorMutation (
mkEffectDatum,
) where
--------------------------------------------------------------------------------
import Agora.Effect.GovernorMutation (
MutateGovernorDatum (..),
mutateGovernorValidator,
)
import Agora.Governor (GovernorDatum (..))
import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
--------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..))
import Plutarch.Api.V1 (mkValidator, validatorHash)
import PlutusLedgerApi.V1 (
@ -36,13 +32,13 @@ import PlutusLedgerApi.V1 (
Validator,
ValidatorHash (..),
)
import PlutusLedgerApi.V1 qualified as Interval
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
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import Sample.Shared (
authorityTokenSymbol,
govAssetClass,
@ -53,12 +49,6 @@ import Sample.Shared (
)
import Test.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
--------------------------------------------------------------------------------
-- | The effect validator instance.
effectValidator :: Validator
effectValidator = mkValidator $ mutateGovernorValidator governor

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

@ -19,6 +19,12 @@ module Sample.Effect.TreasuryWithdrawal (
buildScriptContext,
) where
import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
treasuryWithdrawalValidator,
)
import Data.ByteString.Char8 qualified as C (pack)
import Data.ByteString.Hash (sha2_256)
import Plutarch.Api.V1 (mkValidator, validatorHash)
import PlutusLedgerApi.V1 (
Address (Address),
@ -50,16 +56,8 @@ import PlutusLedgerApi.V1 (
Value,
toBuiltin,
)
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Value qualified as Value
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Hash (sha2_256)
import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
treasuryWithdrawalValidator,
)
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
-- | A sample Currency Symbol.
currSymbol :: CurrencySymbol

596
agora-specs/Sample/Governor.hs
View file

@ -12,40 +12,6 @@ module Sample.Governor (
mintGST,
) where
--------------------------------------------------------------------------------
import Data.Tagged (Tagged (..), untag)
import Plutarch.Api.V1 (mkValidator, validatorHash)
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (
Address (..),
BuiltinData (BuiltinData),
Credential (ScriptCredential),
Data (I),
Datum (..),
ScriptContext (..),
ScriptPurpose (Minting, Spending),
ToData (toBuiltinData),
TokenName (..),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (..),
TxOutRef (..),
Validator,
ValidatorHash (..),
)
import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Value (
AssetClass (..),
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
import Agora.Effect.NoOp (noOpValidator)
import Agora.Governor (GovernorDatum (..), getNextProposalId)
import Agora.Proposal (
@ -56,42 +22,70 @@ import Agora.Proposal (
ResultTag (..),
emptyVotesFor,
)
import Agora.Proposal qualified as P
import Agora.Proposal qualified as P (ProposalDatum (proposalId))
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (..),
)
import Agora.Stake (
ProposalLock (..),
Stake (..),
StakeDatum (..),
import Agora.Stake (ProposalLock (..), Stake (..), StakeDatum (..))
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..), untag)
import Plutarch.Api.V1 (mkValidator, validatorHash)
import Plutarch.Context (
MintingBuilder,
SpendingBuilder,
buildMinting,
buildSpending,
fee,
input,
mint,
output,
script,
signedWith,
timeRange,
txId,
withDatum,
withRefIndex,
withSpending,
withTxId,
withValue,
)
import PlutusLedgerApi.V1 (
BuiltinData (BuiltinData),
Data (I),
Datum (Datum),
ScriptContext,
TokenName (TokenName),
TxOutRef (txOutRefId),
Validator,
ValidatorHash (..),
)
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import PlutusTx.AssocMap qualified as AssocMap (
empty,
fromList,
singleton,
)
--------------------------------------------------------------------------------
import Sample.Shared (
authorityTokenSymbol,
govAssetClass,
govSymbol,
govValidatorAddress,
govValidatorHash,
gstUTXORef,
minAda,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorAddress,
proposalValidatorHash,
signer,
signer2,
stake,
stakeAddress,
stakeAssetClass,
stakeValidatorHash,
)
import Test.Util (closedBoundedInterval, datumPair, toDatumHash)
--------------------------------------------------------------------------------
import Data.Default.Class (Default (def))
--------------------------------------------------------------------------------
import Test.Util (closedBoundedInterval, toDatumHash)
-- | Unit datum
unitDatum :: Datum
@ -118,65 +112,34 @@ mintGST :: ScriptContext
mintGST =
let gst = Value.assetClassValue govAssetClass 1
---
governorOutputDatum' :: GovernorDatum
governorOutputDatum' =
governorOutputDatum :: GovernorDatum
governorOutputDatum =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 0
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
governorOutputDatum :: Datum
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
governorOutput :: TxOut
governorOutput =
TxOut
{ txOutAddress = govValidatorAddress
, txOutValue = gst <> minAda
, txOutDatumHash = Just $ toDatumHash governorOutputDatum
}
---
witness :: ValidatorHash
witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924"
witnessAddress :: Address
witnessAddress = Address (ScriptCredential witness) Nothing
---
-- The witness UTXO must be consumed.
witnessInput :: TxOut
witnessInput =
TxOut
{ txOutAddress = witnessAddress
, txOutValue = mempty
, txOutDatumHash = Nothing
}
initialSpend :: TxInInfo
initialSpend = TxInInfo gstUTXORef witnessInput
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ initialSpend
]
, txInfoOutputs = [governorOutput]
, -- Some ada to cover the transaction fee
txInfoFee = Value.singleton "" "" 2
, -- Exactly one GST is minted
txInfoMint = gst
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData = [datumPair governorOutputDatum]
, txInfoId = "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4"
}
, scriptContextPurpose = Minting govSymbol
}
builder :: MintingBuilder
builder =
mconcat
[ txId "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4"
, signedWith signer
, mint gst
, input $
script witness
. withTxId (txOutRefId gstUTXORef)
. withRefIndex 0
, output $
script govValidatorHash
. withValue (gst <> minAda)
. withDatum governorOutputDatum
]
in either error id $ buildMinting builder
{- | A valid script context to create a proposal.
@ -213,143 +176,90 @@ createProposal =
stackedGTs = 424242424242
thisProposalId = ProposalId 0
---
governorInputDatum' :: GovernorDatum
governorInputDatum' =
governorInputDatum :: GovernorDatum
governorInputDatum =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = thisProposalId
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
governorInput :: TxOut
governorInput =
TxOut
{ txOutAddress = govValidatorAddress
, txOutValue = gst
, txOutDatumHash = Just $ toDatumHash governorInputDatum
}
---
effects =
AssocMap.fromList
[ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty)
]
proposalDatum :: Datum
proposalDatum :: ProposalDatum
proposalDatum =
Datum
( toBuiltinData $
ProposalDatum
{ P.proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = def
, votes = emptyVotesFor effects
, timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
}
)
proposalOutput :: TxOut
proposalOutput =
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = pst <> minAda
, txOutDatumHash = Just (toDatumHash proposalDatum)
ProposalDatum
{ P.proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = def
, votes = emptyVotesFor effects
, timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
}
---
stakeInputDatum' :: StakeDatum
stakeInputDatum' =
stakeInputDatum :: StakeDatum
stakeInputDatum =
StakeDatum
{ stakedAmount = Tagged stackedGTs
, owner = signer
, lockedBy = []
}
stakeInputDatum :: Datum
stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
stakeInput :: TxOut
stakeInput =
TxOut
{ txOutAddress = stakeAddress
, txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs
, txOutDatumHash = Just (toDatumHash stakeInputDatum)
}
---
governorOutputDatum' :: GovernorDatum
governorOutputDatum' = governorInputDatum' {nextProposalId = getNextProposalId thisProposalId}
governorOutputDatum :: Datum
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
governorOutput :: TxOut
governorOutput =
governorInput
{ txOutDatumHash = Just $ toDatumHash governorOutputDatum
, txOutValue = gst <> minAda
}
---
governorOutputDatum :: GovernorDatum
governorOutputDatum = governorInputDatum {nextProposalId = getNextProposalId thisProposalId}
proposalLocks :: [ProposalLock]
proposalLocks =
[ ProposalLock (ResultTag 0) thisProposalId
, ProposalLock (ResultTag 1) thisProposalId
]
stakeOutputDatum' :: StakeDatum
stakeOutputDatum' = stakeInputDatum' {lockedBy = proposalLocks}
stakeOutputDatum :: Datum
stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
stakeOutput :: TxOut
stakeOutput =
stakeInput
{ txOutDatumHash = Just $ toDatumHash stakeOutputDatum
, txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda
}
---
ownInputRef :: TxOutRef
ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
---
stakeOutputDatum :: StakeDatum
stakeOutputDatum = stakeInputDatum {lockedBy = proposalLocks}
validTimeRange = closedBoundedInterval 10 15
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
ownInputRef
governorInput
, TxInInfo
(TxOutRef "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f" 1)
stakeInput
]
, txInfoOutputs = [proposalOutput, governorOutput, stakeOutput]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = pst
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = validTimeRange
, txInfoSignatories = [signer]
, txInfoData =
datumPair
<$> [ governorInputDatum
, governorOutputDatum
, proposalDatum
, stakeInputDatum
, stakeOutputDatum
]
, txInfoId = "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a"
}
, scriptContextPurpose = Spending ownInputRef
}
builder :: SpendingBuilder
builder =
mconcat
[ txId "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a"
, fee $ Value.singleton "" "" 2
, timeRange $ closedBoundedInterval 10 15
, signedWith signer
, mint pst
, input $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
. withTxId "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865"
, input $
script stakeValidatorHash
. withValue (sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs)
. withDatum stakeInputDatum
. withTxId "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f"
, output $
script proposalValidatorHash
. withValue (pst <> minAda)
. withDatum proposalDatum
, output $
script govValidatorHash
. withValue (gst <> minAda)
. withDatum governorOutputDatum
, output $
script stakeValidatorHash
. withValue (sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda)
. withDatum stakeOutputDatum
, withSpending $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
]
in either error id $ buildSpending builder
{- This script context should be a valid transaction for minting authority for the effect scrips.
@ -374,14 +284,10 @@ mintGATs =
gst = Value.assetClassValue govAssetClass 1
gat = Value.assetClassValue atAssetClass 1
---
mockEffect :: Validator
mockEffect = mkValidator $ noOpValidator ""
mockEffectHash :: ValidatorHash
mockEffectHash = validatorHash mockEffect
mockEffectAddress :: Address
mockEffectAddress = scriptHashAddress mockEffectHash
mockEffectOutputDatum :: Datum
mockEffectOutputDatum = unitDatum
atTokenName :: TokenName
@ -391,27 +297,14 @@ mintGATs =
atAssetClass :: AssetClass
atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
---
governorInputDatum' :: GovernorDatum
governorInputDatum' =
governorInputDatum :: GovernorDatum
governorInputDatum =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 5
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
governorInput :: TxOut
governorInput =
TxOut
{ txOutAddress = govValidatorAddress
, txOutValue = gst
, txOutDatumHash = Just $ toDatumHash governorInputDatum
}
---
effects =
AssocMap.fromList
@ -425,8 +318,8 @@ mintGATs =
[ (ResultTag 0, 100)
, (ResultTag 1, 2000) -- The winner
]
proposalInputDatum' :: ProposalDatum
proposalInputDatum' =
proposalInputDatum :: ProposalDatum
proposalInputDatum =
ProposalDatum
{ P.proposalId = ProposalId 0
, effects = effects
@ -437,94 +330,55 @@ mintGATs =
, timingConfig = def
, startingTime = ProposalStartingTime 10
}
proposalInputDatum :: Datum
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
proposalInput :: TxOut
proposalInput =
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = pst
, txOutDatumHash = Just (toDatumHash proposalInputDatum)
}
---
governorOutputDatum :: GovernorDatum
governorOutputDatum = governorInputDatum
governorOutputDatum' :: GovernorDatum
governorOutputDatum' = governorInputDatum'
governorOutputDatum :: Datum
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
governorOutput :: TxOut
governorOutput =
governorInput
{ txOutDatumHash = Just $ toDatumHash governorOutputDatum
, txOutValue = gst <> minAda
}
proposalOutputDatum :: ProposalDatum
proposalOutputDatum = proposalInputDatum {status = Finished}
---
proposalOutputDatum' :: ProposalDatum
proposalOutputDatum' = proposalInputDatum' {status = Finished}
proposalOutputDatum :: Datum
proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
proposalOutput :: TxOut
proposalOutput =
proposalInput
{ txOutDatumHash = Just $ toDatumHash proposalOutputDatum
, txOutValue = pst <> minAda
}
--
mockEffectOutput :: TxOut
mockEffectOutput =
TxOut
{ txOutAddress = mockEffectAddress
, txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
, txOutValue = gat <> minAda
}
--
ownInputRef :: TxOutRef
ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
--
validTimeRange =
closedBoundedInterval
((def :: ProposalTimingConfig).lockingTime + 11)
((def :: ProposalTimingConfig).executingTime - 11)
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo ownInputRef governorInput
, TxInInfo
(TxOutRef "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7" 1)
proposalInput
]
, txInfoOutputs =
[ governorOutput
, proposalOutput
, mockEffectOutput
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = gat
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = validTimeRange
, txInfoSignatories = [signer, signer2]
, txInfoData =
datumPair
<$> [ governorInputDatum
, governorOutputDatum
, proposalInputDatum
, proposalOutputDatum
, mockEffectOutputDatum
]
, txInfoId = "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7"
}
, scriptContextPurpose = Spending ownInputRef
}
builder :: SpendingBuilder
builder =
mconcat
[ txId "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7"
, signedWith signer
, signedWith signer2
, timeRange validTimeRange
, fee (Value.singleton "" "" 2)
, mint gat
, input $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
. withTxId "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865"
, input $
script proposalValidatorHash
. withValue pst
. withDatum proposalInputDatum
. withTxId "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7"
, output $
script govValidatorHash
. withValue (gst <> minAda)
. withDatum governorOutputDatum
, output $
script proposalValidatorHash
. withValue (pst <> minAda)
. withDatum proposalOutputDatum
, output $
script mockEffectHash
. withValue (gat <> minAda)
. withDatum mockEffectOutputDatum
, withSpending $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
]
in either error id $ buildSpending builder
{- | A valid script context for changing the state datum of the governor.
@ -546,110 +400,62 @@ mutateState =
gat = Value.assetClassValue atAssetClass 1
burntGAT = Value.assetClassValue atAssetClass (-1)
---
-- TODO: Use the *real* effect, see https://github.com/Liqwid-Labs/agora/pull/62
mockEffect :: Validator
mockEffect = mkValidator $ noOpValidator ""
mockEffectHash :: ValidatorHash
mockEffectHash = validatorHash mockEffect
mockEffectAddress :: Address
mockEffectAddress = scriptHashAddress mockEffectHash
atTokenName :: TokenName
atTokenName = TokenName hash
where
ValidatorHash hash = mockEffectHash
atAssetClass :: AssetClass
atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
--
mockEffectInputDatum :: Datum
mockEffectInputDatum = unitDatum
mockEffectInput :: TxOut
mockEffectInput =
TxOut
{ txOutAddress = mockEffectAddress
, txOutValue = gat -- Will be burnt
, txOutDatumHash = Just $ toDatumHash mockEffectInputDatum
}
--
mockEffectOutputDatum :: Datum
mockEffectOutputDatum = mockEffectInputDatum
mockEffectOutput :: TxOut
mockEffectOutput =
mockEffectInput
{ txOutValue = minAda
, txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
}
--
governorInputDatum' :: GovernorDatum
governorInputDatum' =
governorInputDatum :: GovernorDatum
governorInputDatum =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 5
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
governorInputDatum :: Datum
governorInputDatum = Datum $ toBuiltinData governorInputDatum'
governorInput :: TxOut
governorInput =
TxOut
{ txOutAddress = govValidatorAddress
, txOutValue = gst
, txOutDatumHash = Just $ toDatumHash governorInputDatum
}
--
governorOutputDatum :: GovernorDatum
governorOutputDatum = governorInputDatum
governorOutputDatum' :: GovernorDatum
governorOutputDatum' = governorInputDatum'
governorOutputDatum :: Datum
governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
governorOutput :: TxOut
governorOutput =
governorInput
{ txOutDatumHash = Just $ toDatumHash governorOutputDatum
, txOutValue = gst <> minAda
}
--
ownInputRef :: TxOutRef
ownInputRef = TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo ownInputRef governorInput
, TxInInfo
(TxOutRef "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089" 1)
mockEffectInput
]
, txInfoOutputs =
[ governorOutput
, mockEffectOutput
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = burntGAT
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData =
datumPair
<$> [ governorInputDatum
, governorOutputDatum
, mockEffectInputDatum
, mockEffectOutputDatum
]
, txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9"
}
, scriptContextPurpose = Spending ownInputRef
}
builder :: SpendingBuilder
builder =
mconcat
[ txId "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9"
, signedWith signer
, mint burntGAT
, fee $ Value.singleton "" "" 2
, input $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
. withTxId "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff"
, input $
script mockEffectHash
. withValue gat
. withDatum mockEffectInputDatum
. withTxId "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089"
, output $
script govValidatorHash
. withValue (gst <> minAda)
. withDatum governorOutputDatum
, input $
script mockEffectHash
. withValue minAda
. withDatum mockEffectOutputDatum
, withSpending $
script govValidatorHash
. withValue gst
. withDatum governorInputDatum
]
in either error id $ buildSpending builder

514
agora-specs/Sample/Proposal.hs
View file

@ -21,39 +21,7 @@ module Sample.Proposal (
advancePropsoalWithsStake,
) where
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
validatorHash,
)
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (
Address (Address),
Credential (ScriptCredential),
Datum (Datum),
DatumHash,
POSIXTime,
POSIXTimeRange,
PubKeyHash,
ScriptContext (..),
ScriptPurpose (..),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
TxOutRef (TxOutRef),
ValidatorHash,
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
import Agora.Governor (
GovernorDatum (..),
)
import Agora.Governor (GovernorDatum (..))
import Agora.Proposal (
Proposal (..),
ProposalDatum (..),
@ -64,19 +32,78 @@ import Agora.Proposal (
ResultTag (..),
emptyVotesFor,
)
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
import Data.Tagged (Tagged (..), untag)
import Sample.Shared
import Test.Util (closedBoundedInterval, datumPair, toDatumHash, updateMap)
--------------------------------------------------------------------------------
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
ProposalTimingConfig (..),
)
import Agora.Stake (
ProposalLock (ProposalLock),
Stake (..),
StakeDatum (..),
)
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..), untag)
import Plutarch.Context (
BaseBuilder,
MintingBuilder,
buildMinting,
buildTxInfo,
input,
mint,
output,
script,
signedWith,
timeRange,
txId,
withDatum,
withRefIndex,
withTxId,
withValue,
)
import PlutusLedgerApi.V1 (
Datum (Datum),
DatumHash,
POSIXTime,
POSIXTimeRange,
PubKeyHash,
ScriptContext (..),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
TxOutRef (..),
ValidatorHash,
)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import PlutusTx.AssocMap qualified as AssocMap (
Map,
empty,
fromList,
)
import Sample.Shared (
govValidatorHash,
minAda,
proposal,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer,
signer2,
stake,
stakeAddress,
stakeAssetClass,
stakeValidatorHash,
)
import Test.Util (
closedBoundedInterval,
datumPair,
toDatumHash,
updateMap,
)
--------------------------------------------------------------------------------
-- | This script context should be a valid transaction.
proposalCreation :: ScriptContext
proposalCreation =
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
@ -85,93 +112,57 @@ proposalCreation =
[ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty)
]
proposalDatum :: Datum
proposalDatum :: ProposalDatum
proposalDatum =
Datum
( toBuiltinData $
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = def
, votes = emptyVotesFor effects
, timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
}
)
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = def
, votes = emptyVotesFor effects
, timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
}
govBefore :: Datum
govBefore :: GovernorDatum
govBefore =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 0
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
)
govAfter :: Datum
govAfter =
Datum
( toBuiltinData $
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 1
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
)
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 0
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
}
govAfter :: GovernorDatum
govAfter = govBefore {nextProposalId = ProposalId 1}
validTimeRange = closedBoundedInterval 10 15
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
, txOutValue = Value.assetClassValue proposal.governorSTAssetClass 1
, txOutDatumHash = Just (toDatumHash govBefore)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalDatum)
}
, TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing
, txOutValue =
mconcat
[ Value.assetClassValue proposal.governorSTAssetClass 1
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash govAfter)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = validTimeRange
, txInfoSignatories = [signer]
, txInfoData =
[ datumPair proposalDatum
, datumPair govBefore
, datumPair govAfter
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting proposalPolicySymbol
}
builder :: MintingBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, signedWith signer
, mint st
, input $
script govValidatorHash
. withValue (Value.assetClassValue proposal.governorSTAssetClass 1)
. withDatum govBefore
. withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, output $
script proposalValidatorHash
. withValue (st <> Value.singleton "" "" 10_000_000)
. withDatum proposalDatum
, output $
script govValidatorHash
. withValue
( Value.assetClassValue proposal.governorSTAssetClass 1
<> Value.singleton "" "" 10_000_000
)
. withDatum govAfter
]
in either error id $ buildMinting builder
proposalRef :: TxOutRef
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
@ -209,66 +200,43 @@ cosignProposal newSigners =
closedBoundedInterval
10
((def :: ProposalTimingConfig).draftTime - 10)
in TxInfo
{ txInfoInputs =
[ TxInInfo
proposalRef
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash proposalBefore)
}
, TxInInfo
stakeRef
TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.assetClassValue stakeAssetClass 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential proposalValidatorHash) Nothing
, txOutValue =
mconcat
[ st
, Value.singleton "" "" 10_000_000
]
, txOutDatumHash = Just (toDatumHash . Datum $ toBuiltinData proposalAfter)
}
, TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ Value.singleton "" "" 10_000_000
, Value.assetClassValue (untag stake.gtClassRef) 50_000_000
, Value.assetClassValue stakeAssetClass 1
]
, txOutDatumHash = Just (toDatumHash stakeDatum)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = validTimeRange
, txInfoSignatories = newSigners
, txInfoData =
[ datumPair . Datum $ toBuiltinData proposalBefore
, datumPair . Datum $ toBuiltinData proposalAfter
, datumPair . Datum $ toBuiltinData stakeDatum
]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
builder :: BaseBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, mint st
, mconcat $ signedWith <$> newSigners
, timeRange validTimeRange
, input $
script proposalValidatorHash
. withValue (st <> Value.singleton "" "" 10_000_000)
. withDatum proposalBefore
. withTxId (txOutRefId proposalRef)
. withRefIndex (txOutRefIdx proposalRef)
, input $
script stakeValidatorHash
. withValue
( Value.singleton "" "" 10_000_000
<> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
<> Value.assetClassValue stakeAssetClass 1
)
. withDatum stakeDatum
. withTxId (txOutRefId stakeRef)
. withRefIndex (txOutRefIdx stakeRef)
, output $
script proposalValidatorHash
. withValue (st <> Value.singleton "" "" 10_000_000)
. withDatum proposalAfter
, output $
script stakeValidatorHash
. withValue
( Value.singleton "" "" 10_000_000
<> Value.assetClassValue (untag stake.gtClassRef) 50_000_000
<> Value.assetClassValue stakeAssetClass 1
)
. withDatum stakeDatum
]
in either error id $ buildTxInfo builder
--------------------------------------------------------------------------------
@ -309,8 +277,8 @@ voteOnProposal params =
---
proposalInputDatum' :: ProposalDatum
proposalInputDatum' =
proposalInputDatum :: ProposalDatum
proposalInputDatum =
ProposalDatum
{ proposalId = ProposalId 42
, effects = effects
@ -321,15 +289,6 @@ voteOnProposal params =
, timingConfig = def
, startingTime = ProposalStartingTime 0
}
proposalInputDatum :: Datum
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
proposalInput :: TxOut
proposalInput =
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = pst
, txOutDatumHash = Just $ toDatumHash proposalInputDatum
}
---
@ -341,27 +300,13 @@ voteOnProposal params =
---
stakeInputDatum' :: StakeDatum
stakeInputDatum' =
stakeInputDatum :: StakeDatum
stakeInputDatum =
StakeDatum
{ stakedAmount = Tagged params.voteCount
, owner = stakeOwner
, lockedBy = existingLocks
}
stakeInputDatum :: Datum
stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
stakeInput :: TxOut
stakeInput =
TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ sst
, Value.assetClassValue (untag stake.gtClassRef) params.voteCount
, minAda
]
, txOutDatumHash = Just $ toDatumHash stakeInputDatum
}
---
@ -370,39 +315,25 @@ voteOnProposal params =
---
proposalOutputDatum' :: ProposalDatum
proposalOutputDatum' =
proposalInputDatum'
proposalOutputDatum :: ProposalDatum
proposalOutputDatum =
proposalInputDatum
{ votes = ProposalVotes updatedVotes
}
proposalOutputDatum :: Datum
proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
proposalOutput :: TxOut
proposalOutput =
proposalInput
{ txOutDatumHash = Just $ toDatumHash proposalOutputDatum
}
---
-- Off-chain code should do exactly like this: prepend new lock toStatus the list.
updatedLocks :: [ProposalLock]
updatedLocks = ProposalLock params.voteFor proposalInputDatum'.proposalId : existingLocks
updatedLocks = ProposalLock params.voteFor proposalInputDatum.proposalId : existingLocks
---
stakeOutputDatum' :: StakeDatum
stakeOutputDatum' =
stakeInputDatum'
stakeOutputDatum :: StakeDatum
stakeOutputDatum =
stakeInputDatum
{ lockedBy = updatedLocks
}
stakeOutputDatum :: Datum
stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
stakeOutput :: TxOut
stakeOutput =
stakeInput
{ txOutDatumHash = Just $ toDatumHash stakeOutputDatum
}
---
@ -410,21 +341,43 @@ voteOnProposal params =
closedBoundedInterval
((def :: ProposalTimingConfig).draftTime + 1)
((def :: ProposalTimingConfig).votingTime - 1)
in TxInfo
{ txInfoInputs =
[ TxInInfo proposalRef proposalInput
, TxInInfo stakeRef stakeInput
]
, txInfoOutputs = [proposalOutput, stakeOutput]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = mempty
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = validTimeRange
, txInfoSignatories = [stakeOwner]
, txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum]
, txInfoId = "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
}
builder :: BaseBuilder
builder =
mconcat
[ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
, signedWith stakeOwner
, timeRange validTimeRange
, input $
script proposalValidatorHash
. withValue pst
. withDatum proposalInputDatum
. withTxId (txOutRefId proposalRef)
. withRefIndex (txOutRefIdx proposalRef)
, input $
script stakeValidatorHash
. withValue
( sst
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
<> minAda
)
. withDatum stakeInputDatum
. withTxId (txOutRefId stakeRef)
. withRefIndex (txOutRefIdx stakeRef)
, output $
script proposalValidatorHash
. withValue pst
. withDatum proposalOutputDatum
, output $
script stakeValidatorHash
. withValue
( sst
<> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
<> minAda
)
. withDatum stakeOutputDatum
]
in either error id $ buildTxInfo builder
--------------------------------------------------------------------------------
@ -451,13 +404,11 @@ mkTransitionTxInfo ::
-- | Valid time range of the transaction.
POSIXTimeRange ->
TxInfo
mkTransitionTxInfo from to effects votes startingTime timeRange =
mkTransitionTxInfo from to effects votes startingTime validTime =
let pst = Value.singleton proposalPolicySymbol "" 1
---
proposalInputDatum' :: ProposalDatum
proposalInputDatum' =
proposalInputDatum :: ProposalDatum
proposalInputDatum =
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
@ -468,43 +419,30 @@ mkTransitionTxInfo from to effects votes startingTime timeRange =
, timingConfig = def
, startingTime = startingTime
}
proposalInputDatum :: Datum
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
proposalInput :: TxOut
proposalInput =
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = pst
, txOutDatumHash = Just $ toDatumHash proposalInputDatum
}
---
proposalOutputDatum' :: ProposalDatum
proposalOutputDatum' =
proposalInputDatum'
proposalOutputDatum :: ProposalDatum
proposalOutputDatum =
proposalInputDatum
{ status = to
}
proposalOutputDatum :: Datum
proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
proposalOutput :: TxOut
proposalOutput =
proposalInput
{ txOutValue = proposalInput.txOutValue <> minAda
, txOutDatumHash = Just $ toDatumHash proposalOutputDatum
}
in TxInfo
{ txInfoInputs = [TxInInfo proposalRef proposalInput]
, txInfoOutputs = [proposalOutput]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = mempty
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = timeRange
, txInfoSignatories = [signer]
, txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum]
, txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
}
builder :: BaseBuilder
builder =
mconcat
[ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
, signedWith signer
, timeRange validTime
, input $
script proposalValidatorHash
. withValue pst
. withDatum proposalInputDatum
. withTxId (txOutRefId proposalRef)
, output $
script proposalValidatorHash
. withValue (pst <> minAda)
. withDatum proposalOutputDatum
]
in either error id $ buildTxInfo builder
{- | Create a valid 'TxInfo' that advances a proposal, given the parameters.
Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'.

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

@ -48,15 +48,14 @@ module Sample.Shared (
gatTn,
gatCs,
mockTrEffect,
mockTrEffectHash,
trCredential,
wrongEffHash,
) where
import Agora.AuthorityToken
import Agora.AuthorityToken (AuthorityToken)
import Agora.Effect.NoOp (noOpValidator)
import Agora.Governor (
Governor (Governor),
)
import Agora.Governor (Governor (Governor))
import Agora.Governor.Scripts (
authorityTokenFromGovernor,
authorityTokenSymbolFromGovernor,
@ -72,10 +71,7 @@ import Agora.Governor.Scripts (
stakeSTSymbolFromGovernor,
stakeValidatorHashFromGovernor,
)
import Agora.Proposal (
Proposal (..),
ProposalThresholds (..),
)
import Agora.Proposal (Proposal (..), ProposalThresholds (..))
import Agora.Proposal.Time (
MaxTimeRangeWidth (..),
ProposalStartingTime (ProposalStartingTime),
@ -107,14 +103,13 @@ import PlutusLedgerApi.V1 (
Value,
)
import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Contexts (
TxOut (..),
)
import PlutusLedgerApi.V1.Contexts (TxOut (..))
import PlutusLedgerApi.V1.Scripts (Validator, ValidatorHash (..))
import PlutusLedgerApi.V1.Value (AssetClass, TokenName)
import PlutusLedgerApi.V1.Value qualified as Value
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1.Value qualified as Value (
assetClass,
singleton,
)
stake :: Stake
stake = stakeFromGovernor governor
@ -258,6 +253,10 @@ gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
mockTrEffect :: Validator
mockTrEffect = mkValidator $ noOpValidator gatCs
-- | Mock treasury effect validator hash
mockTrEffectHash :: ValidatorHash
mockTrEffectHash = validatorHash mockTrEffect
{- | A SHA-256 hash which (in all certainty) should not match the
hash of the dummy effect script.
-}

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

@ -20,39 +20,50 @@ module Sample.Stake (
DepositWithdrawExample (..),
) where
--------------------------------------------------------------------------------
import Plutarch.Api.V1 (
mkValidator,
validatorHash,
import Agora.SafeMoney (GTTag)
import Agora.Stake (
Stake (gtClassRef),
StakeDatum (StakeDatum, stakedAmount),
)
import Agora.Stake.Scripts (stakeValidator)
import Data.Tagged (Tagged, untag)
import Plutarch.Api.V1 (mkValidator, validatorHash)
import Plutarch.Context (
MintingBuilder,
SpendingBuilder,
buildMinting,
buildSpending,
input,
mint,
output,
script,
signedWith,
txId,
withDatum,
withSpending,
withTxId,
withValue,
)
import PlutusLedgerApi.V1 (
Address (Address),
Credential (ScriptCredential),
Datum (Datum),
DatumHash (DatumHash),
ScriptContext (..),
ScriptPurpose (..),
ScriptPurpose (Minting),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (txOutAddress, txOutDatumHash, txOutValue),
TokenName (TokenName),
TxInfo (txInfoData, txInfoSignatories),
ValidatorHash (ValidatorHash),
)
import PlutusLedgerApi.V1.Contexts (TxOut (TxOut), TxOutRef (TxOutRef))
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Value (TokenName (TokenName))
import PlutusLedgerApi.V1.Value qualified as Value
--------------------------------------------------------------------------------
import Agora.SafeMoney (GTTag)
import Agora.Stake
import Agora.Stake.Scripts (stakeValidator)
import Data.Tagged (Tagged (..), untag)
import Sample.Shared
import Test.Util (datumPair, toDatumHash)
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import Sample.Shared (
signer,
stake,
stakeAssetClass,
stakeSymbol,
stakeValidatorHash,
)
-- | 'TokenName' that represents the hash of the 'Stake' validator.
validatorHashTN :: TokenName
@ -62,30 +73,21 @@ validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValid
stakeCreation :: ScriptContext
stakeCreation =
let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer [])
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs = []
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue = st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242
, txOutDatumHash = Just (DatumHash "")
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData = [("", datum)]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Minting stakeSymbol
}
datum :: StakeDatum
datum = StakeDatum 424242424242 signer []
builder :: MintingBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, signedWith signer
, mint st
, output $
script stakeValidatorHash
. withValue (st <> Value.singleton "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24" "LQ" 424242424242)
. withDatum datum
]
in either error id $ buildMinting builder
-- | This ScriptContext should fail because the datum has too much GT.
stakeCreationWrongDatum :: ScriptContext
@ -127,36 +129,25 @@ stakeDepositWithdraw config =
stakeAfter :: StakeDatum
stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta}
in ScriptContext
{ scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st
<> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)
, txOutDatumHash = Just (toDatumHash stakeAfter)
}
]
, txInfoOutputs =
[ TxOut
{ txOutAddress = Address (ScriptCredential stakeValidatorHash) Nothing
, txOutValue =
st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)
, txOutDatumHash = Just (toDatumHash stakeAfter)
}
]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = st
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData = [datumPair stakeAfter]
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
}
, scriptContextPurpose = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
}
builder :: SpendingBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, signedWith signer
, mint st
, input $
script stakeValidatorHash
. withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
. withDatum stakeAfter
. withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, output $
script stakeValidatorHash
. withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount))
. withDatum stakeAfter
, withSpending $
script stakeValidatorHash
. withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount))
. withDatum stakeAfter
]
in either error id $ buildSpending builder

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

@ -17,147 +17,111 @@ module Sample.Treasury (
trCtxGATNameNotAddress,
) where
import Plutarch.Api.V1 (validatorHash)
import Plutarch.Context (
MintingBuilder,
UTXO,
buildMinting,
credential,
input,
mint,
output,
script,
signedWith,
txId,
withTxId,
withValue,
)
import PlutusLedgerApi.V1 (
BuiltinByteString,
Credential (PubKeyCredential),
PubKeyHash (PubKeyHash),
)
import PlutusLedgerApi.V1.Address (Address (..))
import PlutusLedgerApi.V1.Contexts (
ScriptContext (..),
ScriptPurpose (Minting),
TxInInfo (..),
TxInfo (..),
TxOut (..),
TxOutRef (..),
)
import PlutusLedgerApi.V1.Credential (Credential (ScriptCredential))
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Scripts (
ValidatorHash (ValidatorHash),
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V1.Scripts (ValidatorHash (ValidatorHash))
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import Sample.Shared (
gatCs,
gatTn,
minAda,
mockTrEffect,
mockTrEffectHash,
signer,
treasuryOut,
trCredential,
wrongEffHash,
)
import Test.Util (datumPair)
baseCtxBuilder :: MintingBuilder
baseCtxBuilder =
let treasury :: UTXO -> UTXO
treasury =
credential trCredential
. withValue minAda
. withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
in mconcat
[ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
, signedWith signer
, mint (Value.singleton gatCs gatTn (-1))
, input treasury
, output treasury
]
{- | A `ScriptContext` that should be compatible with treasury
transactions.
-}
validCtx :: ScriptContext
validCtx =
ScriptContext
{ scriptContextPurpose = Minting gatCs
, scriptContextTxInfo =
TxInfo
{ txInfoInputs =
[ treasuryIn
, effectIn
]
, txInfoOutputs =
[ treasuryOut
]
, -- Ensure sufficient ADA for transaction costs.
txInfoFee = Value.singleton "" "" 2 -- 2 ADA.
, -- Burn the GAT.
txInfoMint = Value.singleton gatCs gatTn (-1)
, txInfoDCert = []
, txInfoWdrl = []
, txInfoValidRange = Interval.always
, txInfoSignatories = [signer]
, txInfoData =
[ datumPair treasuryIn
, datumPair treasuryOut
, datumPair effectIn
]
, txInfoId =
"73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
}
}
where
treasuryIn =
TxInInfo
{ txInInfoOutRef = treasuryRef
, txInInfoResolved = treasuryOut
}
effectIn =
TxInInfo
{ txInInfoOutRef = effectRef
, txInInfoResolved =
TxOut
{ txOutAddress =
Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
, txOutValue =
mconcat
[ Value.singleton gatCs gatTn 1
, minAda
]
, txOutDatumHash = Nothing
}
}
let builder :: MintingBuilder
builder =
mconcat
[ baseCtxBuilder
, input $
script mockTrEffectHash
. withValue (Value.singleton gatCs gatTn 1 <> minAda)
. withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
]
in either error id $ buildMinting builder
-- | Reference to treasury output.
treasuryRef :: TxOutRef
treasuryRef =
TxOutRef
"73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
1
-- | Reference to dummy effect output.
effectRef :: TxOutRef
effectRef =
TxOutRef
"52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
0
-- | Input representing a user wallet with a valid GAT.
{- | Input representing a user wallet with a valid GAT.
TODO: Resturcture this part of test.
-}
walletIn :: TxInInfo
walletIn =
TxInInfo
{ txInInfoOutRef =
TxOutRef
"cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
0
, txInInfoResolved =
TxOut
{ txOutDatumHash = Nothing
, txOutValue = Value.singleton gatCs gatTn 1
, txOutAddress =
Address
(PubKeyCredential $ PubKeyHash addressBs)
Nothing
}
}
addressBs :: BuiltinByteString
(ValidatorHash addressBs) = validatorHash mockTrEffect
let (ValidatorHash addressBs) = mockTrEffectHash
in TxInInfo
{ txInInfoOutRef =
TxOutRef
"cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
0
, txInInfoResolved =
TxOut
{ txOutDatumHash = Nothing
, txOutValue = Value.singleton gatCs gatTn 1
, txOutAddress =
Address
(PubKeyCredential $ PubKeyHash addressBs)
Nothing
}
}
trCtxGATNameNotAddress :: ScriptContext
trCtxGATNameNotAddress =
let txInfo = validCtx.scriptContextTxInfo
inputs = txInfo.txInfoInputs
effectIn = inputs !! 1
invalidEff =
effectIn
{ txInInfoResolved =
effectIn.txInInfoResolved
{ txOutAddress = Address (ScriptCredential wrongEffHash) Nothing
}
}
in validCtx
{ scriptContextTxInfo =
txInfo
{ txInfoInputs =
[ head inputs
, invalidEff
]
}
}
let builder :: MintingBuilder
builder =
mconcat
[ baseCtxBuilder
, input $
script wrongEffHash
. withValue (Value.singleton gatCs gatTn 1 <> minAda)
. withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
]
in either error id $ buildMinting builder

26
agora-specs/Spec/AuthorityToken.hs
View file

@ -9,14 +9,8 @@ Tests for Authority token functions
-}
module Spec.AuthorityToken (specs) where
--------------------------------------------------------------------------------
import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Plutarch
import Prelude
--------------------------------------------------------------------------------
import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
import PlutusLedgerApi.V1 (
Address (Address),
Credential (PubKeyCredential, ScriptCredential),
@ -29,15 +23,27 @@ import PlutusLedgerApi.V1 (
ValidatorHash (ValidatorHash),
Value,
)
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
import PlutusLedgerApi.V1.Value qualified as Value (
Value (Value),
singleton,
)
import PlutusTx.AssocMap qualified as AssocMap (empty)
import Test.Specification (
SpecificationTree,
group,
scriptFails,
scriptSucceeds,
)
import Prelude (
Functor (fmap),
Maybe (Nothing),
PBool,
Semigroup ((<>)),
pconstant,
pconstantData,
pif,
)
currencySymbol :: CurrencySymbol
currencySymbol = "deadbeef"

2
agora-specs/Spec/Governor.hs
View file

@ -26,8 +26,6 @@ import Test.Specification (
validatorSucceedsWith,
)
--------------------------------------------------------------------------------
-- | The SpecificationTree exported by this module.
specs :: [SpecificationTree]
specs =

34
agora-specs/Spec/Proposal.hs
View file

@ -9,8 +9,6 @@ Tests for Proposal policy and validator
-}
module Spec.Proposal (specs) where
--------------------------------------------------------------------------------
import Agora.Proposal (
Proposal (..),
ProposalDatum (..),
@ -28,11 +26,10 @@ import Agora.Proposal (
thresholds,
votes,
)
import Agora.Proposal.Scripts (
proposalPolicy,
proposalValidator,
import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
import Agora.Proposal.Time (
ProposalStartingTime (ProposalStartingTime),
)
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
import Agora.Stake (
ProposalLock (ProposalLock),
StakeDatum (StakeDatum),
@ -42,10 +39,27 @@ import Agora.Stake.Scripts (stakeValidator)
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (Tagged), untag)
import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..))
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal qualified as Proposal
import PlutusTx.AssocMap qualified as AssocMap (empty, fromList)
import Sample.Proposal qualified as Proposal (
TransitionParameters (
TransitionParameters,
initialProposalStatus,
proposalStartingTime
),
VotingParameters (VotingParameters, voteCount, voteFor),
advanceFinishedPropsoal,
advanceProposalFailureTimeout,
advanceProposalInsufficientVotes,
advanceProposalSuccess,
advancePropsoalWithsStake,
cosignProposal,
proposalCreation,
proposalRef,
stakeRef,
voteOnProposal,
)
import Sample.Shared (signer, signer2)
import Sample.Shared qualified as Shared
import Sample.Shared qualified as Shared (proposal, stake)
import Test.Specification (
SpecificationTree,
group,
@ -54,8 +68,6 @@ import Test.Specification (
validatorSucceedsWith,
)
--------------------------------------------------------------------------------
-- | Stake specs.
specs :: [SpecificationTree]
specs =

35
agora-specs/Spec/Stake.hs
View file

@ -9,19 +9,27 @@ Tests for Stake policy and validator
-}
module Spec.Stake (specs) where
--------------------------------------------------------------------------------
import Prelude
--------------------------------------------------------------------------------
import Agora.Stake (Stake (..), StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw))
import Agora.Stake (
Stake (..),
StakeDatum (StakeDatum),
StakeRedeemer (DepositWithdraw),
)
import Agora.Stake.Scripts (stakePolicy, stakeValidator)
--------------------------------------------------------------------------------
import Sample.Stake (DepositWithdrawExample (DepositWithdrawExample, delta, startAmount), signer)
import Sample.Stake qualified as Stake
import Sample.Stake (
DepositWithdrawExample (
DepositWithdrawExample,
delta,
startAmount
),
signer,
)
import Sample.Stake qualified as Stake (
stake,
stakeCreation,
stakeCreationUnsigned,
stakeCreationWrongDatum,
stakeDepositWithdraw,
)
import Test.Specification (
SpecificationTree,
group,
@ -31,8 +39,7 @@ import Test.Specification (
validatorSucceedsWith,
)
import Test.Util (toDatum)
--------------------------------------------------------------------------------
import Prelude (Num (negate), ($))
-- | The SpecificationTree exported by this module.
specs :: [SpecificationTree]

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

@ -25,9 +25,7 @@ import Agora.Treasury (
TreasuryRedeemer (SpendTreasuryGAT),
treasuryValidator,
)
import PlutusLedgerApi.V1 (
DCert (DCertDelegRegKey),
)
import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey))
import PlutusLedgerApi.V1.Contexts (
ScriptContext (scriptContextPurpose, scriptContextTxInfo),
ScriptPurpose (Certifying, Rewarding, Spending),
@ -36,10 +34,8 @@ import PlutusLedgerApi.V1.Contexts (
import PlutusLedgerApi.V1.Credential (
StakingCredential (StakingHash),
)
import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared (
trCredential,
)
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import Sample.Shared (trCredential)
import Sample.Treasury (
gatCs,
gatTn,

2
agora-specs/Spec/Utils.hs
View file

@ -9,7 +9,5 @@ module Spec.Utils (tests) where
import Test.Tasty (TestTree)
--------------------------------------------------------------------------------
tests :: [TestTree]
tests = []