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

bump liqwid-nix to 1.1

Browse source
This commit is contained in:
Emily Martins 2022-10-28 22:54:09 +02:00 • committed by emiflake
parent c269af8caf
commit bf8290be46
9 changed files with 266 additions and 164 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

@ -174,7 +174,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 +204,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 +265,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 +291,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 +352,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 +365,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 +382,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
$ pif $ pif
delegateSignsTransaction delegateSignsTransaction
(pcon PSignedByDelegate) (pcon PSignedByDelegate)
$ pcon PUnknownSig $ pcon PUnknownSig
sigContext <- sigContext <-
pletC $ pletC $
@ -427,7 +434,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 +450,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 +462,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 +522,10 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
txInfo txInfo
noMetadataContext <- noMetadataContext <-
pletC $ pletC
mkRedeemerhandlerContext $ mkRedeemerhandlerContext
#$ pcon #$ pcon
$ PNoMetadata $ PNoMetadata
-------------------------------------------------------------------------- --------------------------------------------------------------------------
@ -535,7 +546,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
])) ]))