use liqwid-nix 2.0
This commit is contained in:
Emily Martins
parent
b6ab3762ce
commit
7e628328da
35 changed files with 458 additions and 564 deletions
|
|
@ -27,8 +27,9 @@ import Agora.Governor (
|
|||
)
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
|
||||
import Agora.Utils (ptaggedSymbolValueOf)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol)
|
||||
import Plutarch.Api.V2 (
|
||||
PScriptHash,
|
||||
PScriptPurpose (PSpending),
|
||||
PTxOutRef,
|
||||
PValidator,
|
||||
|
|
@ -43,9 +44,9 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust)
|
|||
import Plutarch.Extra.Record (mkRecordConstr, (.=))
|
||||
import Plutarch.Extra.ScriptContext (
|
||||
pisScriptAddress,
|
||||
pscriptHashFromAddress,
|
||||
ptryFromOutputDatum,
|
||||
ptryFromRedeemer,
|
||||
pvalidatorHashFromAddress,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
|
||||
|
|
@ -150,7 +151,7 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
|
|||
-}
|
||||
mutateGovernorValidator ::
|
||||
ClosedTerm
|
||||
( PValidatorHash
|
||||
( PScriptHash
|
||||
:--> PTagged GovernorSTTag PCurrencySymbol
|
||||
:--> PTagged AuthorityTokenTag PCurrencySymbol
|
||||
:--> PValidator
|
||||
|
|
@ -194,12 +195,12 @@ mutateGovernorValidator =
|
|||
, ptraceIfFalse "Can only modify the pinned governor" $
|
||||
inputF.outRef #== effectDatumF.governorRef
|
||||
, ptraceIfFalse "Governor validator run" $
|
||||
let inputValidatorHash =
|
||||
let inputScriptHash =
|
||||
pfromJust
|
||||
#$ pvalidatorHashFromAddress
|
||||
#$ pscriptHashFromAddress
|
||||
#$ pfield @"address"
|
||||
# inputF.resolved
|
||||
in inputValidatorHash #== govValidatorHash
|
||||
in inputScriptHash #== govValidatorHash
|
||||
]
|
||||
in isGovernorInput
|
||||
)
|
||||
|
|
|
|||
|
|
@ -43,11 +43,12 @@ import Agora.Stake (
|
|||
)
|
||||
import Agora.Utils (ptaggedSymbolValueOf, ptoScottEncodingT, puntag)
|
||||
import Data.Function (on)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash)
|
||||
import Plutarch.Api.V1 (PCurrencySymbol)
|
||||
import Plutarch.Api.V1.AssocMap (plookup)
|
||||
import Plutarch.Api.V1.AssocMap qualified as AssocMap
|
||||
import Plutarch.Api.V2 (
|
||||
PMintingPolicy,
|
||||
PScriptHash,
|
||||
PScriptPurpose (PMinting, PSpending),
|
||||
PTxOut,
|
||||
PTxOutRef,
|
||||
|
|
@ -67,7 +68,6 @@ import Plutarch.Extra.ScriptContext (
|
|||
pscriptHashToTokenName,
|
||||
ptryFromDatumHash,
|
||||
ptryFromOutputDatum,
|
||||
pvalidatorHashFromAddress,
|
||||
pvalueSpent,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
|
|
@ -264,7 +264,7 @@ governorPolicy =
|
|||
governorValidator ::
|
||||
-- | Lazy precompiled scripts.
|
||||
ClosedTerm
|
||||
( PValidatorHash
|
||||
( PScriptHash
|
||||
:--> PTagged StakeSTTag PAssetClassData
|
||||
:--> PTagged GovernorSTTag PCurrencySymbol
|
||||
:--> PTagged ProposalSTTag PCurrencySymbol
|
||||
|
|
@ -272,7 +272,7 @@ governorValidator ::
|
|||
:--> PValidator
|
||||
)
|
||||
governorValidator =
|
||||
plam $ \proposalValidatorHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
|
||||
plam $ \proposalScriptHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
|
||||
ctxF <- pletAllC ctx
|
||||
txInfo <- pletC $ pfromData ctxF.txInfo
|
||||
txInfoF <-
|
||||
|
|
@ -317,7 +317,7 @@ governorValidator =
|
|||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Own by governor validator" $
|
||||
((#==) `on` (pvalidatorHashFromAddress #))
|
||||
((#==) `on` (pscriptHashFromAddress #))
|
||||
outputF.address
|
||||
governorInputF.address
|
||||
, ptraceIfFalse "Has governor ST" $
|
||||
|
|
@ -345,8 +345,8 @@ governorValidator =
|
|||
plam $
|
||||
flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
|
||||
let isProposalUTxO =
|
||||
(pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address)
|
||||
#== proposalValidatorHash
|
||||
(pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address)
|
||||
#== proposalScriptHash
|
||||
#&& passetClassValueOf
|
||||
# pstClass
|
||||
# txOutF.value
|
||||
|
|
@ -500,82 +500,83 @@ governorValidator =
|
|||
-- The effects of the winner outcome.
|
||||
effectGroup <- pletC $ ptryLookup # finalResultTag #$ proposalInputDatumF.effects
|
||||
|
||||
let -- For a given output, check if it contains a single valid GAT.
|
||||
getReceiverScriptHash =
|
||||
plam
|
||||
( \output -> unTermCont $ do
|
||||
outputF <- pletFieldsC @'["address", "datum", "value"] output
|
||||
let
|
||||
-- For a given output, check if it contains a single valid GAT.
|
||||
getReceiverScriptHash =
|
||||
plam
|
||||
( \output -> unTermCont $ do
|
||||
outputF <- pletFieldsC @'["address", "datum", "value"] output
|
||||
|
||||
let atAmount =
|
||||
ptaggedSymbolValueOf
|
||||
# atSymbol
|
||||
# outputF.value
|
||||
let atAmount =
|
||||
ptaggedSymbolValueOf
|
||||
# atSymbol
|
||||
# outputF.value
|
||||
|
||||
handleAuthorityUTxO =
|
||||
do
|
||||
receiverScriptHash <-
|
||||
pletC $
|
||||
passertPJust
|
||||
# "GAT receiver should be a script"
|
||||
#$ pscriptHashFromAddress
|
||||
# outputF.address
|
||||
handleAuthorityUTxO =
|
||||
do
|
||||
receiverScriptHash <-
|
||||
pletC $
|
||||
passertPJust
|
||||
# "GAT receiver should be a script"
|
||||
#$ pscriptHashFromAddress
|
||||
# outputF.address
|
||||
|
||||
effect <-
|
||||
pletAllC $
|
||||
passertPJust
|
||||
# "Receiver should be in the effect group"
|
||||
#$ AssocMap.plookup
|
||||
# receiverScriptHash
|
||||
# effectGroup
|
||||
effect <-
|
||||
pletAllC $
|
||||
passertPJust
|
||||
# "Receiver should be in the effect group"
|
||||
#$ AssocMap.plookup
|
||||
# receiverScriptHash
|
||||
# effectGroup
|
||||
|
||||
let tagToken =
|
||||
pmaybeData
|
||||
# pconstant ""
|
||||
# plam (pscriptHashToTokenName . pfromData)
|
||||
# effect.scriptHash
|
||||
gatAssetClass = passetClass # puntag atSymbol # tagToken
|
||||
valueGATCorrect =
|
||||
passetClassValueOf
|
||||
# gatAssetClass
|
||||
# outputF.value
|
||||
#== 1
|
||||
let tagToken =
|
||||
pmaybeData
|
||||
# pconstant ""
|
||||
# plam (pscriptHashToTokenName . pfromData)
|
||||
# effect.scriptHash
|
||||
gatAssetClass = passetClass # puntag atSymbol # tagToken
|
||||
valueGATCorrect =
|
||||
passetClassValueOf
|
||||
# gatAssetClass
|
||||
# outputF.value
|
||||
#== 1
|
||||
|
||||
let hasCorrectDatum =
|
||||
effect.datumHash #== ptryFromDatumHash # outputF.datum
|
||||
let hasCorrectDatum =
|
||||
effect.datumHash #== ptryFromDatumHash # outputF.datum
|
||||
|
||||
pguardC "Authority output valid" $
|
||||
foldr1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output
|
||||
, ptraceIfFalse "Correct datum" hasCorrectDatum
|
||||
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
|
||||
]
|
||||
pguardC "Authority output valid" $
|
||||
foldr1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output
|
||||
, ptraceIfFalse "Correct datum" hasCorrectDatum
|
||||
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
|
||||
]
|
||||
|
||||
pure $ pjust # receiverScriptHash
|
||||
pure $ pjust # receiverScriptHash
|
||||
|
||||
pmatchC
|
||||
( pcompareBy
|
||||
# pfromOrd
|
||||
# atAmount
|
||||
# 1
|
||||
)
|
||||
>>= \case
|
||||
-- atAmount == 1
|
||||
PEQ -> handleAuthorityUTxO
|
||||
-- atAmount < 1
|
||||
PLT -> pure pnothing
|
||||
-- atAmount > 1
|
||||
PGT -> pure $ ptraceError "More than one GAT in one UTxO"
|
||||
)
|
||||
pmatchC
|
||||
( pcompareBy
|
||||
# pfromOrd
|
||||
# atAmount
|
||||
# 1
|
||||
)
|
||||
>>= \case
|
||||
-- atAmount == 1
|
||||
PEQ -> handleAuthorityUTxO
|
||||
-- atAmount < 1
|
||||
PLT -> pure pnothing
|
||||
-- atAmount > 1
|
||||
PGT -> pure $ ptraceError "More than one GAT in one UTxO"
|
||||
)
|
||||
|
||||
-- The sorted hashes of all the GAT receivers.
|
||||
actualReceivers =
|
||||
psort
|
||||
#$ pmapMaybe @PList
|
||||
# getReceiverScriptHash
|
||||
# pfromData txInfoF.outputs
|
||||
-- The sorted hashes of all the GAT receivers.
|
||||
actualReceivers =
|
||||
psort
|
||||
#$ pmapMaybe @PList
|
||||
# getReceiverScriptHash
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
expectedReceivers = pkeys @PList # effectGroup
|
||||
expectedReceivers = pkeys @PList # effectGroup
|
||||
|
||||
-- This check ensures that it's impossible to send more than one GATs
|
||||
-- to a validator in the winning effect group.
|
||||
|
|
|
|||
|
|
@ -7,14 +7,12 @@ import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag,
|
|||
import Data.Aeson qualified as Aeson
|
||||
import Data.Map (fromList)
|
||||
import Data.Tagged (Tagged (Tagged))
|
||||
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
|
||||
import Plutarch.Api.V1 (scriptHash)
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
|
||||
import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
|
||||
import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash)
|
||||
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
|
||||
import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), ScriptHash, TxOutRef, getScriptHash)
|
||||
import Ply (
|
||||
ScriptRole (MintingPolicyRole, ValidatorRole),
|
||||
toMintingPolicy,
|
||||
toValidator,
|
||||
(#),
|
||||
)
|
||||
import ScriptExport.ScriptInfo (
|
||||
|
|
@ -23,6 +21,7 @@ import ScriptExport.ScriptInfo (
|
|||
fetchTS,
|
||||
getParam,
|
||||
toRoledScript,
|
||||
toScript,
|
||||
)
|
||||
import Prelude hiding ((#))
|
||||
|
||||
|
|
@ -54,7 +53,7 @@ linker = do
|
|||
govVal <-
|
||||
fetchTS
|
||||
@ValidatorRole
|
||||
@'[ ValidatorHash
|
||||
@'[ ScriptHash
|
||||
, Tagged StakeSTTag AssetClass
|
||||
, Tagged GovernorSTTag CurrencySymbol
|
||||
, Tagged ProposalSTTag CurrencySymbol
|
||||
|
|
@ -110,7 +109,7 @@ linker = do
|
|||
mutateGovVal <-
|
||||
fetchTS
|
||||
@ValidatorRole
|
||||
@'[ ValidatorHash
|
||||
@'[ ScriptHash
|
||||
, Tagged GovernorSTTag CurrencySymbol
|
||||
, Tagged AuthorityTokenTag CurrencySymbol
|
||||
]
|
||||
|
|
@ -126,16 +125,13 @@ linker = do
|
|||
# Tagged gstSymbol
|
||||
# Tagged pstSymbol
|
||||
# Tagged atSymbol
|
||||
gstSymbol =
|
||||
mintingPolicySymbol $
|
||||
toMintingPolicy
|
||||
govPol'
|
||||
gstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript govPol'
|
||||
gstAssetClass =
|
||||
AssetClass gstSymbol ""
|
||||
govValHash = validatorHash $ toValidator govVal'
|
||||
govValHash = scriptHash $ toScript govVal'
|
||||
|
||||
atPol' = atkPol # Tagged gstAssetClass
|
||||
atSymbol = mintingPolicySymbol $ toMintingPolicy atPol'
|
||||
atSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript atPol'
|
||||
|
||||
propPol' = prpPol # Tagged gstAssetClass
|
||||
propVal' =
|
||||
|
|
@ -144,8 +140,8 @@ linker = do
|
|||
# Tagged gstSymbol
|
||||
# Tagged pstSymbol
|
||||
# governor.maximumCosigners
|
||||
propValHash = validatorHash $ toValidator propVal'
|
||||
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
|
||||
propValHash = scriptHash $ toScript propVal'
|
||||
pstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript propPol'
|
||||
pstAssetClass = AssetClass pstSymbol ""
|
||||
|
||||
stakPol' = stkPol # governor.gtClassRef
|
||||
|
|
@ -154,9 +150,9 @@ linker = do
|
|||
# Tagged sstSymbol
|
||||
# Tagged pstAssetClass
|
||||
# governor.gtClassRef
|
||||
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol'
|
||||
sstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript stakPol'
|
||||
stakValTokenName =
|
||||
validatorHashToTokenName $ validatorHash $ toValidator stakVal'
|
||||
scriptHashToTokenName $ scriptHash $ toScript stakVal'
|
||||
sstAssetClass = AssetClass sstSymbol stakValTokenName
|
||||
|
||||
treaVal' = treVal # Tagged atSymbol
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ import Agora.SafeMoney (GTTag)
|
|||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Tagged (Tagged)
|
||||
import Generics.SOP qualified as SOP
|
||||
import Plutarch.Api.V1 (PCredential, PMap, PValidatorHash)
|
||||
import Plutarch.Api.V1 (PCredential, PMap)
|
||||
import Plutarch.Api.V1.AssocMap qualified as PAssocMap
|
||||
import Plutarch.Api.V2 (
|
||||
KeyGuarantees (Sorted),
|
||||
|
|
@ -88,7 +88,7 @@ import Plutarch.Lift (
|
|||
PUnsafeLiftDecl (type PLifted),
|
||||
)
|
||||
import Plutarch.Orphans ()
|
||||
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
|
||||
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash)
|
||||
import PlutusTx qualified
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -315,7 +315,7 @@ data ProposalEffectMetadata = ProposalEffectMetadata
|
|||
via (ProductIsData ProposalEffectMetadata)
|
||||
|
||||
-- | @since 1.0.0
|
||||
type ProposalEffectGroup = StrictMap.Map ValidatorHash ProposalEffectMetadata
|
||||
type ProposalEffectGroup = StrictMap.Map ScriptHash ProposalEffectMetadata
|
||||
|
||||
{- | Haskell-level datum for Proposal scripts.
|
||||
|
||||
|
|
@ -695,7 +695,7 @@ instance PTryFrom PData (PAsData PProposalEffectMetadata)
|
|||
type PProposalEffectGroup =
|
||||
PMap
|
||||
'Sorted
|
||||
PValidatorHash
|
||||
PScriptHash
|
||||
PProposalEffectMetadata
|
||||
|
||||
{- | Plutarch-level version of 'ProposalDatum'.
|
||||
|
|
|
|||
|
|
@ -71,8 +71,8 @@ import Plutarch.Extra.Ord (pfromOrdBy, pinsertUniqueBy, psort)
|
|||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import Plutarch.Extra.ScriptContext (
|
||||
pfindTxInByTxOutRef,
|
||||
pscriptHashFromAddress,
|
||||
ptryFromOutputDatum,
|
||||
pvalidatorHashFromAddress,
|
||||
)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
|
|
@ -285,7 +285,7 @@ proposalValidator =
|
|||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Own by proposal validator" $
|
||||
((#==) `on` (pvalidatorHashFromAddress #))
|
||||
((#==) `on` (pscriptHashFromAddress #))
|
||||
outputF.address
|
||||
proposalInputF.address
|
||||
, ptraceIfFalse "Has proposal ST" $
|
||||
|
|
@ -523,39 +523,40 @@ proposalValidator =
|
|||
pguardC "Vote option should be valid" $
|
||||
pisJust #$ plookup # voteFor # voteMap
|
||||
|
||||
let -- The amount of new votes should be the 'stakedAmount'.
|
||||
-- Update the vote counter of the proposal, and leave other stuff as is.
|
||||
expectedNewVotes =
|
||||
pcon $
|
||||
PProposalVotes $
|
||||
pupdate
|
||||
# plam
|
||||
( \votes ->
|
||||
pcon $ PJust $ votes + pto totalStakeAmount
|
||||
)
|
||||
# voteFor
|
||||
# pto (pfromData proposalInputDatumF.votes)
|
||||
let
|
||||
-- The amount of new votes should be the 'stakedAmount'.
|
||||
-- Update the vote counter of the proposal, and leave other stuff as is.
|
||||
expectedNewVotes =
|
||||
pcon $
|
||||
PProposalVotes $
|
||||
pupdate
|
||||
# plam
|
||||
( \votes ->
|
||||
pcon $ PJust $ votes + pto totalStakeAmount
|
||||
)
|
||||
# voteFor
|
||||
# pto (pfromData proposalInputDatumF.votes)
|
||||
|
||||
expectedProposalOut =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId
|
||||
.= proposalInputDatumF.proposalId
|
||||
.& #effects
|
||||
.= proposalInputDatumF.effects
|
||||
.& #status
|
||||
.= proposalInputDatumF.status
|
||||
.& #cosigners
|
||||
.= proposalInputDatumF.cosigners
|
||||
.& #thresholds
|
||||
.= proposalInputDatumF.thresholds
|
||||
.& #votes
|
||||
.= pdata expectedNewVotes
|
||||
.& #timingConfig
|
||||
.= proposalInputDatumF.timingConfig
|
||||
.& #startingTime
|
||||
.= proposalInputDatumF.startingTime
|
||||
)
|
||||
expectedProposalOut =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId
|
||||
.= proposalInputDatumF.proposalId
|
||||
.& #effects
|
||||
.= proposalInputDatumF.effects
|
||||
.& #status
|
||||
.= proposalInputDatumF.status
|
||||
.& #cosigners
|
||||
.= proposalInputDatumF.cosigners
|
||||
.& #thresholds
|
||||
.= proposalInputDatumF.thresholds
|
||||
.& #votes
|
||||
.= pdata expectedNewVotes
|
||||
.& #timingConfig
|
||||
.= proposalInputDatumF.timingConfig
|
||||
.& #startingTime
|
||||
.= proposalInputDatumF.startingTime
|
||||
)
|
||||
|
||||
pguardC "Output proposal should be valid" $
|
||||
proposalOutputDatum #== expectedProposalOut
|
||||
|
|
@ -615,34 +616,36 @@ proposalValidator =
|
|||
pguardC "Proposal output correct" $
|
||||
pif
|
||||
shouldUpdateVotes
|
||||
( let -- Remove votes and leave other parts of the proposal as it.
|
||||
expectedProposalOut =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId
|
||||
.= proposalInputDatumF.proposalId
|
||||
.& #effects
|
||||
.= proposalInputDatumF.effects
|
||||
.& #status
|
||||
.= proposalInputDatumF.status
|
||||
.& #cosigners
|
||||
.= proposalInputDatumF.cosigners
|
||||
.& #thresholds
|
||||
.= proposalInputDatumF.thresholds
|
||||
.& #votes
|
||||
.= expectedVotes
|
||||
.& #timingConfig
|
||||
.= proposalInputDatumF.timingConfig
|
||||
.& #startingTime
|
||||
.= proposalInputDatumF.startingTime
|
||||
)
|
||||
in foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Votes changed" $
|
||||
pnot #$ expectedVotes #== proposalInputDatumF.votes
|
||||
, ptraceIfFalse "Proposal update correct" $
|
||||
expectedProposalOut #== proposalOutputDatum
|
||||
]
|
||||
( let
|
||||
-- Remove votes and leave other parts of the proposal as it.
|
||||
expectedProposalOut =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId
|
||||
.= proposalInputDatumF.proposalId
|
||||
.& #effects
|
||||
.= proposalInputDatumF.effects
|
||||
.& #status
|
||||
.= proposalInputDatumF.status
|
||||
.& #cosigners
|
||||
.= proposalInputDatumF.cosigners
|
||||
.& #thresholds
|
||||
.= proposalInputDatumF.thresholds
|
||||
.& #votes
|
||||
.= expectedVotes
|
||||
.& #timingConfig
|
||||
.= proposalInputDatumF.timingConfig
|
||||
.& #startingTime
|
||||
.= proposalInputDatumF.startingTime
|
||||
)
|
||||
in
|
||||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Votes changed" $
|
||||
pnot #$ expectedVotes #== proposalInputDatumF.votes
|
||||
, ptraceIfFalse "Proposal update correct" $
|
||||
expectedProposalOut #== proposalOutputDatum
|
||||
]
|
||||
)
|
||||
-- No change to the proposal is allowed.
|
||||
( ptraceIfFalse "Proposal unchanged" $
|
||||
|
|
|
|||
|
|
@ -90,9 +90,9 @@ import Plutarch.Extra.Maybe (
|
|||
import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd)
|
||||
import Plutarch.Extra.ScriptContext (
|
||||
pfindTxInByTxOutRef,
|
||||
pscriptHashFromAddress,
|
||||
pscriptHashToTokenName,
|
||||
ptryFromOutputDatum,
|
||||
pvalidatorHashFromAddress,
|
||||
pvalidatorHashToTokenName,
|
||||
pvalueSpent,
|
||||
)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
|
|
@ -122,7 +122,7 @@ import Prelude hiding (Num ((+)))
|
|||
- Check that exactly one state thread is minted.
|
||||
- Check that an output exists with a state thread and a valid datum.
|
||||
- Check that no state thread is an input.
|
||||
- assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ValidatorHash'@
|
||||
- assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ScriptHash'@
|
||||
of the script that we pay to.
|
||||
|
||||
=== For burning:
|
||||
|
|
@ -290,14 +290,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
|
|||
# (pfield @"_0" # stakeInputRef)
|
||||
# txInfoF.inputs
|
||||
|
||||
stakeValidatorHash <-
|
||||
stakeScriptHash <-
|
||||
pletC $
|
||||
pfromJust
|
||||
#$ pvalidatorHashFromAddress
|
||||
#$ pscriptHashFromAddress
|
||||
#$ pfield @"address"
|
||||
# validatedInput
|
||||
|
||||
let sstName = pvalidatorHashToTokenName stakeValidatorHash
|
||||
let sstName = pscriptHashToTokenName stakeScriptHash
|
||||
|
||||
sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
|
||||
|
||||
|
|
@ -321,11 +321,11 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
|
|||
PEQ ->
|
||||
let ownerValidatoHash =
|
||||
pfromJust
|
||||
#$ pvalidatorHashFromAddress
|
||||
#$ pscriptHashFromAddress
|
||||
# txOutF.address
|
||||
|
||||
isOwnedByStakeValidator =
|
||||
ownerValidatoHash #== stakeValidatorHash
|
||||
ownerValidatoHash #== stakeScriptHash
|
||||
|
||||
datum =
|
||||
ptrace "Resolve stake datum" $
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ Description: Plutarch utility functions that should be upstreamed or don't belon
|
|||
Plutarch utility functions that should be upstreamed or don't belong anywhere else.
|
||||
-}
|
||||
module Agora.Utils (
|
||||
validatorHashToAddress,
|
||||
scriptHashToAddress,
|
||||
pstringIntercalate,
|
||||
punwords,
|
||||
pisNothing,
|
||||
|
|
@ -33,15 +33,15 @@ import Plutarch.Unsafe (punsafeDowncast)
|
|||
import PlutusLedgerApi.V2 (
|
||||
Address (Address),
|
||||
Credential (ScriptCredential),
|
||||
ValidatorHash,
|
||||
ScriptHash,
|
||||
)
|
||||
|
||||
{- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
|
||||
{- | Create an 'Address' from a given 'ScriptHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
|
||||
|
||||
@since 0.1.0
|
||||
@since 1.0.0
|
||||
-}
|
||||
validatorHashToAddress :: ValidatorHash -> Address
|
||||
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing
|
||||
scriptHashToAddress :: ScriptHash -> Address
|
||||
scriptHashToAddress vh = Address (ScriptCredential vh) Nothing
|
||||
|
||||
-- | @since 1.0.0
|
||||
pstringIntercalate ::
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue