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

Merge pull request #204 from Liqwid-Labs/emiflake/update-docs

Browse source 
Update docs
This commit is contained in:
emiflake 2022-10-31 14:09:45 +01:00 • committed by GitHub
commit 9a9f6d0642
15 changed files with 299 additions and 186 deletions
Download patch file Download diff file Expand all files Collapse all files

11
.github/pull_request_template.md vendored Normal file
View file

@ -0,0 +1,11 @@
## Describe your changes
## Relevant issues
## Checklist before requesting a review.
- [ ] I have ensured documentation and testing are thorough.
- [ ] I have updated the changelog.
- [ ] I have read [CONTRIBUTING.md][../CONTRIBUTING.md]
- [ ] I have made sure the CI checks run using `nix run .#ci`.
- [ ] I have followed the code standards to the best of my ability or have documented carefully where and why I haven't.

15
CONTRIBUTING.md
View file

@ -11,6 +11,7 @@ Please follow the [Git policy](https://liqwid.notion.site/Git-Policy-9a7979b2fd5
This document will make reference to the _Agora core team_. These are the people who work on Agora professionally and will be responsible for maintaining the project in its open source life. They include: This document will make reference to the _Agora core team_. These are the people who work on Agora professionally and will be responsible for maintaining the project in its open source life. They include:
- [Emily Martins](https://github.com/emiflake) - [Emily Martins](https://github.com/emiflake)
- [Connor Fang](https://github.com/chfanghr)
- [Jack Hodgkinson](https://github.com/jhodgdev) - [Jack Hodgkinson](https://github.com/jhodgdev)
## Issues ## Issues
@ -33,7 +34,7 @@ If you wish to work to resolve the issue, the Agora team would invite you to sub
Only those within the core Agora team may contribute work to the project directly. If you wish to work on the project, you must [fork](https://docs.github.com/en/get-started/quickstart/fork-a-repo) the repository and submit your changes to your fork. Instructions for getting started with the project may be found in the [README](./README.md). Once the work on your fork is completed, you may submit a PR [here](https://github.com/Liqwid-Labs/agora/pulls). Only those within the core Agora team may contribute work to the project directly. If you wish to work on the project, you must [fork](https://docs.github.com/en/get-started/quickstart/fork-a-repo) the repository and submit your changes to your fork. Instructions for getting started with the project may be found in the [README](./README.md). Once the work on your fork is completed, you may submit a PR [here](https://github.com/Liqwid-Labs/agora/pulls).
Before submitting a PR, please write an issue pertaining to the problem that your PR would solve e.g. a bug in the codebase or a missing feature. Read this document's section on _Issues_ and pay particular heed to the paragraph asking contributors to _look for pre-existing issues_. The prior experiences of existing contributors could save you a significant amount of time and effort. It is possible that a number of issues could be solved by your PR. Please reference any issues that would be ameliorated by your PR - including your own issue, if you have written one - clearly. Please label your PR using GitHub's tagging feature. Please state plainly: If your PR fixes an issue that isn't a very obvious bug, or has not previously been discussed, please write an issue pertaining to the problem that your PR would solve. Read this document's section on _Issues_ and pay particular heed to the paragraph asking contributors to _look for pre-existing issues_. The prior experiences of existing contributors could save you a significant amount of time and effort. It is possible that a number of issues could be solved by your PR. Please reference any issues that would be ameliorated by your PR - including your own issue, if you have written one - clearly. Please label your PR using GitHub's tagging feature. Please state plainly:
- What your PR achieves. - What your PR achieves.
- How your PR works. - How your PR works.
@ -48,17 +49,9 @@ Agora utilises [Plutarch](https://github.com/plutonomicon/plutarch) and your wor
### Continuous integration ### Continuous integration
For your PR to be merged it must pass three automated checks: For your PR to be merged it must pass the CI checks.
1. A [`fourmolu`](https://github.com/fourmolu/fourmolu) formatting check. These can be run locally by running `nix run .#ci`. If you are making a PR through a fork of the repository, they might not be run in CI. When this is the case, please ensure the CI checks run fine locally before you request a review.
2. A [`hlint`](https://github.com/ndmitchell/hlint) linting check.
3. A Cabal build check.
Our custom `fourmolu` rules may be found in the [base of the repository](./fourmolu.yaml). You can ensure that your work will pass CI by:
1. Running `make format` from the included `Makefile`.
2. Running `make lint` from the included `Makefile` and applying any recommendations.
3. Ensuring that `cabal build` terminates successfully on your machine in the provided Nix environment.
## Standards ## Standards

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

@ -616,7 +616,8 @@ mkInTimeTimeRange advanceFrom =
+ (def :: ProposalTimingConfig).draftTime + (def :: ProposalTimingConfig).draftTime
+ (def :: ProposalTimingConfig).votingTime + (def :: ProposalTimingConfig).votingTime
+ (def :: ProposalTimingConfig).lockingTime + (def :: ProposalTimingConfig).lockingTime
+ (def :: ProposalTimingConfig).executingTime - 1 + (def :: ProposalTimingConfig).executingTime
- 1
) )
Finished -> error "Cannot advance 'Finished' proposal" Finished -> error "Cannot advance 'Finished' proposal"
@ -632,7 +633,8 @@ mkTooLateTimeRange advanceFrom =
(proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1) (proposalStartingTime + (def :: ProposalTimingConfig).draftTime + 1)
( proposalStartingTime ( proposalStartingTime
+ (def :: ProposalTimingConfig).draftTime + (def :: ProposalTimingConfig).draftTime
+ (def :: ProposalTimingConfig).votingTime - 1 + (def :: ProposalTimingConfig).votingTime
- 1
) )
-- [S + D + V + L + 1, S + D + V + L + E -1] -- [S + D + V + L + 1, S + D + V + L + E -1]
VotingReady -> VotingReady ->
@ -682,7 +684,8 @@ compPerStakeGTsForDraft :: NumStake -> Tagged GTTag Integer
compPerStakeGTsForDraft nCosigners = compPerStakeGTsForDraft nCosigners =
Tagged $ Tagged $
untag (def :: ProposalThresholds).toVoting untag (def :: ProposalThresholds).toVoting
`div` fromIntegral nCosigners + 1 `div` fromIntegral nCosigners
+ 1
dummyDatum :: () dummyDatum :: ()
dummyDatum = () dummyDatum = ()
@ -948,7 +951,8 @@ mkInsufficientCosignsBundle nCosigners nEffects =
insuffcientPerStakeGTs = insuffcientPerStakeGTs =
Tagged $ Tagged $
untag (def :: ProposalThresholds).toVoting untag (def :: ProposalThresholds).toVoting
`div` fromIntegral nCosigners - 1 `div` fromIntegral nCosigners
- 1
template = mkValidToNextStateBundle nCosigners nEffects False Draft template = mkValidToNextStateBundle nCosigners nEffects False Draft
-- * From VotingReady -- * From VotingReady

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

@ -294,7 +294,8 @@ cosign ps = builder
closedBoundedInterval closedBoundedInterval
(coerce proposalInputDatum.startingTime + 1) (coerce proposalInputDatum.startingTime + 1)
( coerce proposalInputDatum.startingTime ( coerce proposalInputDatum.startingTime
+ proposalInputDatum.timingConfig.draftTime - 1 + proposalInputDatum.timingConfig.draftTime
- 1
) )
sig = sig =

3
agora-specs/Sample/Proposal/Unlock.hs
View file

@ -348,7 +348,8 @@ unlock ps = builder
in closedBoundedInterval (lb + 1) (ub - 1) in closedBoundedInterval (lb + 1) (ub - 1)
AfterVoting -> AfterVoting ->
let lb = let lb =
s + (def :: ProposalTimingConfig).draftTime s
+ (def :: ProposalTimingConfig).draftTime
+ (def :: ProposalTimingConfig).votingTime + (def :: ProposalTimingConfig).votingTime
ub = lb + (def :: ProposalTimingConfig).lockingTime ub = lb + (def :: ProposalTimingConfig).lockingTime
in closedBoundedInterval (lb + 1) (ub - 1) in closedBoundedInterval (lb + 1) (ub - 1)

8
agora-specs/Spec/Effect/TreasuryWithdrawal.hs
View file

@ -45,8 +45,8 @@ specs =
, inputCollateral 10 , inputCollateral 10
, inputTreasury 1 (asset1 10) , inputTreasury 1 (asset1 10)
] ]
$ outputTreasury 1 (asset1 7) : $ outputTreasury 1 (asset1 7)
buildReceiversOutputFromDatum datum1 : buildReceiversOutputFromDatum datum1
) )
, effectSucceedsWith , effectSucceedsWith
"Simple with multiple treasuries " "Simple with multiple treasuries "
@ -120,8 +120,8 @@ specs =
, inputCollateral 10 , inputCollateral 10
, inputTreasury 999 (asset1 20) , inputTreasury 999 (asset1 20)
] ]
$ outputTreasury 999 (asset1 17) : $ outputTreasury 999 (asset1 17)
buildReceiversOutputFromDatum datum3 : buildReceiversOutputFromDatum datum3
) )
, effectFailsWith , effectFailsWith
"Prevent transactions besides the withdrawal" "Prevent transactions besides the withdrawal"

7
agora/Agora/AuthorityToken.hs
View file

@ -112,10 +112,11 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
PTxInInfo txInInfo -> unTermCont $ do PTxInInfo txInInfo -> unTermCont $ do
resolved <- pletC $ pfield @"resolved" # txInInfo resolved <- pletC $ pfield @"resolved" # txInInfo
pguardC "While counting GATs at inputs: all GATs must be valid" $ pguardC "While counting GATs at inputs: all GATs must be valid"
authorityTokensValidIn # gatCs $ authorityTokensValidIn
# gatCs
#$ pfromData #$ pfromData
$ resolved $ resolved
pure . pcon . PSum $ pure . pcon . PSum $
psymbolValueOf psymbolValueOf

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

@ -164,7 +164,8 @@ mutateGovernorValidator =
( \inInfo -> ( \inInfo ->
pisScriptAddress pisScriptAddress
#$ pfield @"address" #$ pfield @"address"
#$ pfield @"resolved" # inInfo #$ pfield @"resolved"
# inInfo
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
@ -192,7 +193,8 @@ mutateGovernorValidator =
, ptraceIfFalse "Can only modify the pinned governor" $ , ptraceIfFalse "Can only modify the pinned governor" $
inputF.outRef #== effectDatumF.governorRef inputF.outRef #== effectDatumF.governorRef
, ptraceIfFalse "Governor validator run" $ , ptraceIfFalse "Governor validator run" $
pfield @"address" # inputF.resolved pfield @"address"
# inputF.resolved
#== governorAddress #== governorAddress
] ]
in isGovernorInput in isGovernorInput
@ -201,10 +203,11 @@ mutateGovernorValidator =
let governorRedeemer = let governorRedeemer =
pfromData $ pfromData $
passertPJust # "Govenor redeemer should be resolved" passertPJust
# "Govenor redeemer should be resolved"
#$ ptryFromRedeemer @(PAsData PGovernorRedeemer) #$ ptryFromRedeemer @(PAsData PGovernorRedeemer)
# mkRecordConstr PSpending (#_0 .= effectDatumF.governorRef) # mkRecordConstr PSpending (#_0 .= effectDatumF.governorRef)
# txInfoF.redeemers # txInfoF.redeemers
pguardC "Spend governor with redeemer MutateGovernor" $ pguardC "Spend governor with redeemer MutateGovernor" $
governorRedeemer #== pconstant MutateGovernor governorRedeemer #== pconstant MutateGovernor

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

@ -147,7 +147,8 @@ treasuryWithdrawalValidator = plam $
cred <- cred <-
pletC $ pletC $
pfield @"credential" pfield @"credential"
#$ pfield @"address" # inputF.resolved #$ pfield @"address"
# inputF.resolved
pure $ pure $
foldl1 foldl1

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

@ -132,26 +132,33 @@ governorPolicy =
pguardC "Exactly one token should be minted" $ pguardC "Exactly one token should be minted" $
let vMap = pfromData $ pto txInfoF.mint let vMap = pfromData $ pto txInfoF.mint
tnMap = tnMap =
passertPJust # "GST symbol entry" passertPJust
#$ plookup # gstSymbol # vMap # "GST symbol entry"
#$ plookup
# gstSymbol
# vMap
in tnMap #== AssocMap.psingleton # pconstant "" # 1 in tnMap #== AssocMap.psingleton # pconstant "" # 1
let governorOutputDatum = let governorOutputDatum =
passertPJust # "Governor output should present" passertPJust
# "Governor output should present"
#$ pfindJust #$ pfindJust
# plam # plam
( flip (pletFields @'["value", "datum"]) $ \txOutF -> ( flip (pletFields @'["value", "datum"]) $ \txOutF ->
let isGovernorUTxO = let isGovernorUTxO =
psymbolValueOf # gstSymbol psymbolValueOf
# txOutF.value #== 1 # gstSymbol
# txOutF.value
#== 1
governorDatum = governorDatum =
ptrace "Resolve governor datum" $ ptrace "Resolve governor datum" $
pfromOutputDatum @PGovernorDatum # txOutF.datum pfromOutputDatum @PGovernorDatum
# txInfoF.datums # txOutF.datum
in pif isGovernorUTxO (pjust # governorDatum) pnothing # txInfoF.datums
) in pif isGovernorUTxO (pjust # governorDatum) pnothing
# pfromData txInfoF.outputs )
# pfromData txInfoF.outputs
pguardC "Governor output datum valid" $ pguardC "Governor output datum valid" $
pisGovernorDatumValid # governorOutputDatum pisGovernorDatumValid # governorOutputDatum
@ -288,10 +295,11 @@ governorValidator =
let governorInput = let governorInput =
pfield @"resolved" pfield @"resolved"
#$ passertPJust # "Malformed script context: own input not found" #$ passertPJust
# "Malformed script context: own input not found"
#$ pfindTxInByTxOutRef #$ pfindTxInByTxOutRef
# governorInputRef # governorInputRef
# txInfoF.inputs # txInfoF.inputs
governorInputF <- pletFieldsC @'["address", "value"] governorInput governorInputF <- pletFieldsC @'["address", "value"] governorInput
@ -301,7 +309,7 @@ governorValidator =
pletC $ pletC $
passertPJust passertPJust
# "Own output should present" # "Own output should present"
#$ pfindJust #$ pfindJust
# plam # plam
( flip pletAll $ \outputF -> ( flip pletAll $ \outputF ->
let isGovernorUTxO = let isGovernorUTxO =
@ -334,7 +342,8 @@ governorValidator =
let isStakeUTxO = let isStakeUTxO =
psymbolValueOf psymbolValueOf
# sstSymbol # sstSymbol
# txOutF.value #== 1 # txOutF.value
#== 1
datum = datum =
ptrace "Resolve stake input datum" $ ptrace "Resolve stake input datum" $
@ -349,8 +358,12 @@ governorValidator =
plam $ plam $
flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
let isProposalUTxO = let isProposalUTxO =
txOutF.address #== pdata proposalValidatorAddress txOutF.address
#&& psymbolValueOf # pstSymbol # txOutF.value #== 1 #== pdata proposalValidatorAddress
#&& psymbolValueOf
# pstSymbol
# txOutF.value
#== 1
proposalDatum = proposalDatum =
ptrace "Resolve proposal output datum" $ ptrace "Resolve proposal output datum" $
@ -375,13 +388,16 @@ governorValidator =
expectedNewDatum = expectedNewDatum =
mkRecordConstr mkRecordConstr
PGovernorDatum PGovernorDatum
( #proposalThresholds .= governorInputDatumF.proposalThresholds ( #proposalThresholds
.& #nextProposalId .= pdata expectedNextProposalId .= governorInputDatumF.proposalThresholds
.& #proposalTimings .= governorInputDatumF.proposalTimings .& #nextProposalId
.= pdata expectedNextProposalId
.& #proposalTimings
.= governorInputDatumF.proposalTimings
.& #createProposalTimeRangeMaxWidth .& #createProposalTimeRangeMaxWidth
.= governorInputDatumF.createProposalTimeRangeMaxWidth .= governorInputDatumF.createProposalTimeRangeMaxWidth
.& #maximumProposalsPerStake .& #maximumProposalsPerStake
.= governorInputDatumF.maximumProposalsPerStake .= governorInputDatumF.maximumProposalsPerStake
) )
pguardC "Only next proposal id gets advanced" $ pguardC "Only next proposal id gets advanced" $
@ -405,15 +421,17 @@ governorValidator =
-- and the value it contains meets the requirement. -- and the value it contains meets the requirement.
let stakeInputDatum = let stakeInputDatum =
passertPJust # "Stake input should present" passertPJust
# "Stake input should present"
#$ pfindJust #$ pfindJust
# plam ((getStakeDatum #) . (pfield @"resolved" #)) # plam ((getStakeDatum #) . (pfield @"resolved" #))
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
stakeInputDatumF <- pletAllC stakeInputDatum stakeInputDatumF <- pletAllC stakeInputDatum
pguardC "Proposals created by the stake must not exceed the limit" $ pguardC "Proposals created by the stake must not exceed the limit" $
pnumCreatedProposals # stakeInputDatumF.lockedBy pnumCreatedProposals
# stakeInputDatumF.lockedBy
#< governorInputDatumF.maximumProposalsPerStake #< governorInputDatumF.maximumProposalsPerStake
let gtThreshold = let gtThreshold =
@ -428,10 +446,11 @@ governorValidator =
-- and the datum it carries is legal. -- and the datum it carries is legal.
let proposalOutputDatum = let proposalOutputDatum =
passertPJust # "Proposal output should present" passertPJust
# "Proposal output should present"
#$ pfindJust #$ pfindJust
# getProposalDatum # getProposalDatum
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
proposalOutputDatumF <- pletAllC proposalOutputDatum proposalOutputDatumF <- pletAllC proposalOutputDatum
@ -458,8 +477,10 @@ governorValidator =
# txInfoF.validRange # txInfoF.validRange
# proposalOutputDatumF.startingTime # proposalOutputDatumF.startingTime
, ptraceIfFalse "copy over configurations" $ , ptraceIfFalse "copy over configurations" $
proposalOutputDatumF.thresholds #== governorInputDatumF.proposalThresholds proposalOutputDatumF.thresholds
#&& proposalOutputDatumF.timingConfig #== governorInputDatumF.proposalTimings #== governorInputDatumF.proposalThresholds
#&& proposalOutputDatumF.timingConfig
#== governorInputDatumF.proposalTimings
] ]
pure $ popaque $ pconstant () pure $ popaque $ pconstant ()
@ -475,10 +496,11 @@ governorValidator =
(psymbolValueOf # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1 (psymbolValueOf # pstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
let proposalInputDatum = let proposalInputDatum =
passertPJust # "Proposal input not found" passertPJust
# "Proposal input not found"
#$ pfindJust #$ pfindJust
# plam ((getProposalDatum #) . (pfield @"resolved" #)) # plam ((getProposalDatum #) . (pfield @"resolved" #))
# pfromData txInfoF.inputs # pfromData txInfoF.inputs
proposalInputDatumF <- proposalInputDatumF <-
pletFieldsC @'["effects", "status", "thresholds", "votes"] pletFieldsC @'["effects", "status", "thresholds", "votes"]
@ -506,19 +528,25 @@ governorValidator =
let isAuthorityUTxO = let isAuthorityUTxO =
psymbolValueOf psymbolValueOf
# atSymbol # atSymbol
# outputF.value #== 1 # outputF.value
#== 1
handleAuthorityUTxO = handleAuthorityUTxO =
unTermCont $ do unTermCont $ do
receiverScriptHash <- receiverScriptHash <-
pletC $ pletC $
passertPJust # "GAT receiver should be a script" passertPJust
#$ pscriptHashFromAddress # outputF.address # "GAT receiver should be a script"
#$ pscriptHashFromAddress
# outputF.address
effect <- effect <-
pletAllC $ pletAllC $
passertPJust # "Receiver should be in the effect group" passertPJust
#$ AssocMap.plookup # receiverScriptHash # effectGroup # "Receiver should be in the effect group"
#$ AssocMap.plookup
# receiverScriptHash
# effectGroup
let tagToken = let tagToken =
pmaybeData pmaybeData
@ -529,7 +557,8 @@ governorValidator =
valueGATCorrect = valueGATCorrect =
passetClassValueOf passetClassValueOf
# gatAssetClass # gatAssetClass
# outputF.value #== 1 # outputF.value
#== 1
let hasCorrectDatum = let hasCorrectDatum =
effect.datumHash #== pfromDatumHash # outputF.datum effect.datumHash #== pfromDatumHash # outputF.datum
@ -555,8 +584,8 @@ governorValidator =
actualReceivers = actualReceivers =
psort psort
#$ pmapMaybe #$ pmapMaybe
# getReceiverScriptHash # getReceiverScriptHash
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
expectedReceivers = pkeys @PList # effectGroup expectedReceivers = pkeys @PList # effectGroup

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

@ -241,7 +241,7 @@ proposalValidator =
pfield @"resolved" pfield @"resolved"
#$ passertPJust #$ passertPJust
# "Own input should present" # "Own input should present"
#$ pfindTxInByTxOutRef #$ pfindTxInByTxOutRef
# propsalInputRef # propsalInputRef
# txInfoF.inputs # txInfoF.inputs
@ -261,40 +261,43 @@ proposalValidator =
-- We can handle only one proposal under current design. -- We can handle only one proposal under current design.
proposalOutputDatum <- proposalOutputDatum <-
pletC $ pletC $
passertPJust # "proposal input should present" passertPJust
# "proposal input should present"
#$ pfindJust #$ pfindJust
# plam # plam
( flip pletAll $ \outputF -> ( flip pletAll $ \outputF ->
let isProposalUTxO = let isProposalUTxO =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Own by proposal validator" $ [ ptraceIfFalse "Own by proposal validator" $
outputF.address #== proposalInputF.address outputF.address #== proposalInputF.address
, ptraceIfFalse "Has proposal ST" $ , ptraceIfFalse "Has proposal ST" $
psymbolValueOf # pstSymbol # outputF.value #== 1 psymbolValueOf # pstSymbol # outputF.value #== 1
] ]
handleProposalUTxO = handleProposalUTxO =
-- Using inline datum to avoid O(n^2) lookup. -- Using inline datum to avoid O(n^2) lookup.
pfromData $ pfromData $
ptrace "Resolve proposal datum" $ ptrace "Resolve proposal datum" $
pfromOutputDatum @(PAsData PProposalDatum) pfromOutputDatum @(PAsData PProposalDatum)
# outputF.datum # outputF.datum
# txInfoF.datums # txInfoF.datums
in pif in pif
isProposalUTxO isProposalUTxO
(pjust # handleProposalUTxO) (pjust # handleProposalUTxO)
pnothing pnothing
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
-------------------------------------------------------------------------- --------------------------------------------------------------------------
getTimingRelation' <- getTimingRelation' <-
pletC $ pletC $
let currentTime = let currentTime =
passertPJust # "Current time should be resolved" passertPJust
#$ currentProposalTime # txInfoF.validRange # "Current time should be resolved"
#$ currentProposalTime
# txInfoF.validRange
in pgetRelation in pgetRelation
# proposalInputDatumF.timingConfig # proposalInputDatumF.timingConfig
# proposalInputDatumF.startingTime # proposalInputDatumF.startingTime
@ -321,7 +324,8 @@ proposalValidator =
stake = stake =
pfromData $ pfromData $
-- If we can't resolve the stake datum, error out. -- If we can't resolve the stake datum, error out.
passertPJust # "Stake datum should present" passertPJust
# "Stake datum should present"
-- Use inline datum to avoid extra map lookup. -- Use inline datum to avoid extra map lookup.
#$ ptryFromOutputDatum @(PAsData PStakeDatum) #$ ptryFromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum # txOutF.datum
@ -370,7 +374,8 @@ proposalValidator =
+ punsafeCoerce + punsafeCoerce
(pfromData stakeF.stakedAmount) (pfromData stakeF.stakedAmount)
, orderedOwners = , orderedOwners =
pcons # stakeF.owner pcons
# stakeF.owner
# ctxF.orderedOwners # ctxF.orderedOwners
} }
@ -443,14 +448,22 @@ proposalValidator =
let expectedDatum = let expectedDatum =
mkRecordConstr mkRecordConstr
PProposalDatum PProposalDatum
( #proposalId .= proposalInputDatumF.proposalId ( #proposalId
.& #effects .= proposalInputDatumF.effects .= proposalInputDatumF.proposalId
.& #status .= proposalInputDatumF.status .& #effects
.& #cosigners .= pdata updatedSigs .= proposalInputDatumF.effects
.& #thresholds .= proposalInputDatumF.thresholds .& #status
.& #votes .= proposalInputDatumF.votes .= proposalInputDatumF.status
.& #timingConfig .= proposalInputDatumF.timingConfig .& #cosigners
.& #startingTime .= proposalInputDatumF.startingTime .= pdata updatedSigs
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= proposalInputDatumF.votes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
) )
pguardC "Signatures are correctly added to cosignature list" $ pguardC "Signatures are correctly added to cosignature list" $
@ -471,8 +484,8 @@ proposalValidator =
pnot pnot
#$ pisVoter #$ pisVoter
#$ pgetStakeRoles #$ pgetStakeRoles
# proposalInputDatumF.proposalId # proposalInputDatumF.proposalId
# stakeF.lockedBy # stakeF.lockedBy
pure $ pcon $ PSum $ pfromData stakeF.stakedAmount pure $ pcon $ PSum $ pfromData stakeF.stakedAmount
) )
@ -510,14 +523,22 @@ proposalValidator =
expectedProposalOut = expectedProposalOut =
mkRecordConstr mkRecordConstr
PProposalDatum PProposalDatum
( #proposalId .= proposalInputDatumF.proposalId ( #proposalId
.& #effects .= proposalInputDatumF.effects .= proposalInputDatumF.proposalId
.& #status .= proposalInputDatumF.status .& #effects
.& #cosigners .= proposalInputDatumF.cosigners .= proposalInputDatumF.effects
.& #thresholds .= proposalInputDatumF.thresholds .& #status
.& #votes .= pdata expectedNewVotes .= proposalInputDatumF.status
.& #timingConfig .= proposalInputDatumF.timingConfig .& #cosigners
.& #startingTime .= proposalInputDatumF.startingTime .= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= pdata expectedNewVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
) )
pguardC "Output proposal should be valid" $ pguardC "Output proposal should be valid" $
@ -570,7 +591,8 @@ proposalValidator =
-- The votes can only change when the proposal still allows voting. -- The votes can only change when the proposal still allows voting.
shouldUpdateVotes = shouldUpdateVotes =
currentStatus #== pconstant VotingReady currentStatus
#== pconstant VotingReady
#&& inVotingPeriod #&& inVotingPeriod
pguardC "Proposal output correct" $ pguardC "Proposal output correct" $
@ -580,14 +602,22 @@ proposalValidator =
expectedProposalOut = expectedProposalOut =
mkRecordConstr mkRecordConstr
PProposalDatum PProposalDatum
( #proposalId .= proposalInputDatumF.proposalId ( #proposalId
.& #effects .= proposalInputDatumF.effects .= proposalInputDatumF.proposalId
.& #status .= proposalInputDatumF.status .& #effects
.& #cosigners .= proposalInputDatumF.cosigners .= proposalInputDatumF.effects
.& #thresholds .= proposalInputDatumF.thresholds .& #status
.& #votes .= pdata expectedVotes .= proposalInputDatumF.status
.& #timingConfig .= proposalInputDatumF.timingConfig .& #cosigners
.& #startingTime .= proposalInputDatumF.startingTime .= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= pdata expectedVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
) )
in ptraceIfFalse "Update votes" $ in ptraceIfFalse "Update votes" $
expectedProposalOut #== proposalOutputDatum expectedProposalOut #== proposalOutputDatum
@ -609,14 +639,22 @@ proposalValidator =
let expectedProposalOutputDatum = let expectedProposalOutputDatum =
mkRecordConstr mkRecordConstr
PProposalDatum PProposalDatum
( #proposalId .= proposalInputDatumF.proposalId ( #proposalId
.& #effects .= proposalInputDatumF.effects .= proposalInputDatumF.proposalId
.& #status .= pdata proposalOutputStatus .& #effects
.& #cosigners .= proposalInputDatumF.cosigners .= proposalInputDatumF.effects
.& #thresholds .= proposalInputDatumF.thresholds .& #status
.& #votes .= proposalInputDatumF.votes .= pdata proposalOutputStatus
.& #timingConfig .= proposalInputDatumF.timingConfig .& #cosigners
.& #startingTime .= proposalInputDatumF.startingTime .= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= proposalInputDatumF.votes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
) )
in proposalOutputDatum #== expectedProposalOutputDatum in proposalOutputDatum #== expectedProposalOutputDatum
@ -652,10 +690,12 @@ proposalValidator =
pguardC "Proposal status set to Locked" $ pguardC "Proposal status set to Locked" $
proposalOutputStatus #== pconstant Locked proposalOutputStatus #== pconstant Locked
pguardC "Winner outcome not found" $ pguardC "Winner outcome not found"
pisJust #$ pwinner' # proposalInputDatumF.votes $ pisJust
#$ pwinner'
# proposalInputDatumF.votes
#$ punsafeCoerce #$ punsafeCoerce
$ pfromData thresholdsF.execute $ pfromData thresholdsF.execute
-- Too late: failed proposal, status set to 'Finished'. -- Too late: failed proposal, status set to 'Finished'.
PAfter -> PAfter ->
pguardC "Proposal should fail: not on time" $ pguardC "Proposal should fail: not on time" $

45
agora/Agora/Stake/Redeemers.hs
View file

@ -85,7 +85,8 @@ pbatchUpdateInputs ::
) )
pbatchUpdateInputs = phoistAcyclic $ pbatchUpdateInputs = phoistAcyclic $
plam $ \f -> flip pmatch $ \ctxF -> plam $ \f -> flip pmatch $ \ctxF ->
pnull #$ pfoldr pnull
#$ pfoldr
# (pmustDeleteBy # f) # (pmustDeleteBy # f)
# ctxF.stakeOutputDatums # ctxF.stakeOutputDatums
# ctxF.stakeInputDatums # ctxF.stakeInputDatums
@ -135,10 +136,14 @@ ponlyLocksUpdated = phoistAcyclic $
expected = expected =
mkRecordConstr mkRecordConstr
PStakeDatum PStakeDatum
( #stakedAmount .= iF.stakedAmount ( #stakedAmount
.& #owner .= iF.owner .= iF.stakedAmount
.& #delegatedTo .= iF.delegatedTo .& #owner
.& #lockedBy .= pdata newLocks .= iF.owner
.& #delegatedTo
.= iF.delegatedTo
.& #lockedBy
.= pdata newLocks
) )
in expected #== o in expected #== o
@ -202,8 +207,10 @@ ppermitVote = pvoteHelper #$ phoistAcyclic $
PVote ((pfromData . (pfield @"resultTag" #)) -> voteFor) -> PVote ((pfromData . (pfield @"resultTag" #)) -> voteFor) ->
mkRecordConstr mkRecordConstr
PVoted PVoted
( #votedOn .= pdata pid ( #votedOn
.& #votedFor .= pdata voteFor .= pdata pid
.& #votedFor
.= pdata voteFor
) )
PCosign _ -> PCosign _ ->
withOnlyOneStakeInput withOnlyOneStakeInput
@ -306,10 +313,14 @@ pdelegateHelper = phoistAcyclic $
( \i o -> pletAll i $ \iF -> ( \i o -> pletAll i $ \iF ->
mkRecordConstr mkRecordConstr
PStakeDatum PStakeDatum
( #stakedAmount .= iF.stakedAmount ( #stakedAmount
.& #owner .= iF.owner .= iF.stakedAmount
.& #delegatedTo .= pdata newDelegate .& #owner
.& #lockedBy .= iF.lockedBy .= iF.owner
.& #delegatedTo
.= pdata newDelegate
.& #lockedBy
.= iF.lockedBy
) )
#== o #== o
) )
@ -399,10 +410,14 @@ pdepositWithdraw = phoistAcyclic $
let expectedDatum = let expectedDatum =
mkRecordConstr mkRecordConstr
PStakeDatum PStakeDatum
( #stakedAmount .= pdata newStakedAmount ( #stakedAmount
.& #owner .= stakeInputDatumF.owner .= pdata newStakedAmount
.& #delegatedTo .= stakeInputDatumF.delegatedTo .& #owner
.& #lockedBy .= stakeInputDatumF.lockedBy .= stakeInputDatumF.owner
.& #delegatedTo
.= stakeInputDatumF.delegatedTo
.& #lockedBy
.= stakeInputDatumF.lockedBy
) )
pguardC "Valid output datum" $ expectedDatum #== stakeOutputDatum pguardC "Valid output datum" $ expectedDatum #== stakeOutputDatum

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

@ -152,7 +152,8 @@ stakePolicy =
PPair mintedST burntST <- PPair mintedST burntST <-
pmatchC $ pmatchC $
pfromJust #$ psymbolValueOf' pfromJust
#$ psymbolValueOf'
# ownSymbol # ownSymbol
# txInfoF.mint # txInfoF.mint
@ -174,7 +175,7 @@ stakePolicy =
let scriptOutputWithStakeST = let scriptOutputWithStakeST =
passertPJust passertPJust
# "Output to script not found" # "Output to script not found"
#$ pfind #$ pfind
# plam # plam
( \output -> unTermCont $ do ( \output -> unTermCont $ do
outputF <- pletFieldsC @'["value", "address"] output outputF <- pletFieldsC @'["value", "address"] output
@ -204,7 +205,9 @@ stakePolicy =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Stake ouput has expected amount of stake token" $ [ ptraceIfFalse "Stake ouput has expected amount of stake token" $
passetClassValueOf # (ptoScottEncoding # gstClass) # outputF.value passetClassValueOf
# (ptoScottEncoding # gstClass)
# outputF.value
#== pto (pfromData datumF.stakedAmount) #== pto (pfromData datumF.stakedAmount)
, ptraceIfFalse "Stake Owner should sign the transaction" $ , ptraceIfFalse "Stake Owner should sign the transaction" $
pauthorizedBy pauthorizedBy
@ -263,15 +266,16 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
let validatedInput = let validatedInput =
pfield @"resolved" pfield @"resolved"
#$ passertPJust #$ passertPJust
# "Malformed script context: validated input not found" # "Malformed script context: validated input not found"
#$ pfindTxInByTxOutRef #$ pfindTxInByTxOutRef
# (pfield @"_0" # stakeInputRef) # (pfield @"_0" # stakeInputRef)
# txInfoF.inputs # txInfoF.inputs
stakeValidatorCredential <- stakeValidatorCredential <-
pletC $ pletC $
pfield @"credential" pfield @"credential"
#$ pfield @"address" # validatedInput #$ pfield @"address"
# validatedInput
let sstName = pvalidatorHashToTokenName #$ pmatch stakeValidatorCredential $ let sstName = pvalidatorHashToTokenName #$ pmatch stakeValidatorCredential $
\case \case
@ -288,7 +292,8 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
plam $ plam $
flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
pmatch pmatch
( pcompareBy # pfromOrd ( pcompareBy
# pfromOrd
# (passetClassValueOf # sstClass # txOutF.value) # (passetClassValueOf # sstClass # txOutF.value)
# 1 # 1
) )
@ -348,10 +353,12 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
pmatch p $ \(PPair allHaveSameOwner allHaveSameDelegatee) -> pmatch p $ \(PPair allHaveSameOwner allHaveSameDelegatee) ->
let allHaveSameOwner' = let allHaveSameOwner' =
allHaveSameOwner allHaveSameOwner
#&& dF.owner #== firstStakeInputDatumF.owner #&& dF.owner
#== firstStakeInputDatumF.owner
allHaveSameDelegatee' = allHaveSameDelegatee' =
allHaveSameDelegatee allHaveSameDelegatee
#&& dF.delegatedTo #== firstStakeInputDatumF.delegatedTo #&& dF.delegatedTo
#== firstStakeInputDatumF.delegatedTo
in pcon $ PPair allHaveSameOwner' allHaveSameDelegatee' in pcon $ PPair allHaveSameOwner' allHaveSameDelegatee'
) )
# pcon (PPair (pconstant True) (pconstant True)) # pcon (PPair (pconstant True) (pconstant True))
@ -359,14 +366,15 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
let ownerSignsTransaction = let ownerSignsTransaction =
allHaveSameOwner allHaveSameOwner
#&& authorizedBy # firstStakeInputDatumF.owner #&& authorizedBy
# firstStakeInputDatumF.owner
delegateSignsTransaction = delegateSignsTransaction =
allHaveSameDelegatee allHaveSameDelegatee
#&& pmaybeData #&& pmaybeData
# pconstant False # pconstant False
# plam ((authorizedBy #) . pfromData) # plam ((authorizedBy #) . pfromData)
# pfromData firstStakeInputDatumF.delegatedTo # pfromData firstStakeInputDatumF.delegatedTo
signedBy = signedBy =
pif pif
@ -375,7 +383,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
$ pif $ pif
delegateSignsTransaction delegateSignsTransaction
(pcon PSignedByDelegate) (pcon PSignedByDelegate)
$ pcon PUnknownSig $ pcon PUnknownSig
sigContext <- sigContext <-
pletC $ pletC $
@ -427,7 +435,8 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
let isProposalUTxO = let isProposalUTxO =
passetClassValueOf passetClassValueOf
# pstClass # pstClass
# txOutF.value #== 1 # txOutF.value
#== 1
proposalDatum = proposalDatum =
pfromData $ pfromData $
pfromOutputDatum @(PAsData PProposalDatum) pfromOutputDatum @(PAsData PProposalDatum)
@ -442,8 +451,11 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
pcon $ pcon $
PNewProposal $ PNewProposal $
pfield @"proposalId" pfield @"proposalId"
#$ passertPJust # "Proposal output should present" #$ passertPJust
#$ pfindJust # getProposalDatum # pfromData txInfoF.outputs # "Proposal output should present"
#$ pfindJust
# getProposalDatum
# pfromData txInfoF.outputs
spendProposalContext = spendProposalContext =
let getProposalRedeemer = plam $ \ref -> let getProposalRedeemer = plam $ \ref ->
@ -451,7 +463,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
pto $ pto $
passertPJust passertPJust
# "Malformed script context: propsoal input not found in redeemer map" # "Malformed script context: propsoal input not found in redeemer map"
#$ plookup #$ plookup
# pcon # pcon
( PSpending $ ( PSpending $
pdcons @_0 pdcons @_0
@ -511,10 +523,10 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
txInfo txInfo
noMetadataContext <- noMetadataContext <-
pletC $ pletC
mkRedeemerhandlerContext $ mkRedeemerhandlerContext
#$ pcon #$ pcon
$ PNoMetadata $ PNoMetadata
-------------------------------------------------------------------------- --------------------------------------------------------------------------
@ -535,7 +547,8 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
#$ pcon #$ pcon
$ PSetDelegateTo pkh $ PSetDelegateTo pkh
PDepositWithdraw ((pfield @"delta" #) -> delta) -> PDepositWithdraw ((pfield @"delta" #) -> delta) ->
impl.onDepositWithdraw #$ mkRedeemerhandlerContext impl.onDepositWithdraw
#$ mkRedeemerhandlerContext
#$ pcon #$ pcon
$ PDepositWithdrawDelta delta $ PDepositWithdrawDelta delta

8
flake.lock generated
View file

@ -540,11 +540,11 @@
] ]
}, },
"locked": { "locked": {
"lastModified": 1665587728, "lastModified": 1666695559,
"narHash": "sha256-Cz2594dfFxEGB3gCuXlQPGYtiQA7QTviBaUktoYrq9I=", "narHash": "sha256-v8DcNma4hAgLCbPHpsxNYzeMURfbxh20VXfFzUED6bs=",
"owner": "github:Liqwid-Labs", "owner": "Liqwid-Labs",
"repo": "liqwid-nix", "repo": "liqwid-nix",
"rev": "c17fef5826ae9e329818018a09302c69fee9a83c", "rev": "7add1f24e9360e96b2bab4a1fc7929d4fa649439",
"type": "github" "type": "github"
}, },
"original": { "original": {

1
flake.nix
View file

@ -163,6 +163,7 @@
liqwid-nix.enableCabalFormatCheck liqwid-nix.enableCabalFormatCheck
liqwid-nix.enableNixFormatCheck liqwid-nix.enableNixFormatCheck
liqwid-nix.addBuildChecks liqwid-nix.addBuildChecks
liqwid-nix.addCommonRunScripts
(liqwid-nix.addCommandLineTools (pkgs: _: [ (liqwid-nix.addCommandLineTools (pkgs: _: [
pkgs.haskellPackages.hasktags pkgs.haskellPackages.hasktags
])) ]))