use lpe's AssetClass; fix errors
This commit is contained in:
Hongrui Fang
parent
25c6d9a1ae
commit
f1166adc82
24 changed files with 195 additions and 196 deletions
|
|
@ -34,7 +34,7 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value (assetClassValue)
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V2 (
|
||||
ScriptContext (scriptContextTxInfo),
|
||||
TxInInfo (txInInfoOutRef),
|
||||
|
|
|
|||
|
|
@ -16,16 +16,16 @@ import Agora.Effect.GovernorMutation (
|
|||
)
|
||||
import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
|
||||
import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
|
||||
import Agora.SafeMoney (AuthorityTokenTag)
|
||||
import Agora.Utils (validatorHashToTokenName)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Map
|
||||
import Data.Map ((!))
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Plutarch.Api.V2 (validatorHash)
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue)
|
||||
import PlutusLedgerApi.V1 qualified as Interval (always)
|
||||
import PlutusLedgerApi.V1.Address (scriptHashAddress)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass, assetClass)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||
assetClassValue,
|
||||
singleton,
|
||||
)
|
||||
import PlutusLedgerApi.V2 (
|
||||
|
|
@ -66,8 +66,8 @@ effectValidatorAddress :: Address
|
|||
effectValidatorAddress = scriptHashAddress effectValidatorHash
|
||||
|
||||
-- | The assetclass of the authority token.
|
||||
atAssetClass :: AssetClass
|
||||
atAssetClass = assetClass authorityTokenSymbol tokenName
|
||||
atAssetClass :: Tagged AuthorityTokenTag AssetClass
|
||||
atAssetClass = Tagged $ AssetClass authorityTokenSymbol tokenName
|
||||
where
|
||||
tokenName = validatorHashToTokenName effectValidatorHash
|
||||
|
||||
|
|
@ -99,11 +99,11 @@ mkEffectDatum newGovDatum =
|
|||
-}
|
||||
mkEffectTxInfo :: GovernorDatum -> TxInfo
|
||||
mkEffectTxInfo newGovDatum =
|
||||
let gst = Value.assetClassValue governorAssetClass 1
|
||||
at = Value.assetClassValue atAssetClass 1
|
||||
let gst = assetClassValue governorAssetClass 1
|
||||
at = assetClassValue atAssetClass 1
|
||||
|
||||
-- One authority token is burnt in the process.
|
||||
burnt = Value.assetClassValue atAssetClass (-1)
|
||||
burnt = assetClassValue atAssetClass (-1)
|
||||
|
||||
--
|
||||
|
||||
|
|
|
|||
|
|
@ -32,6 +32,7 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusLedgerApi.V2 (
|
||||
CurrencySymbol (CurrencySymbol),
|
||||
|
|
@ -145,7 +146,7 @@ governorRedeemer = MutateGovernor
|
|||
|
||||
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
|
||||
mkGovernorBuilder ps =
|
||||
let gst = Value.assetClassValue governorAssetClass 1
|
||||
let gst = assetClassValue governorAssetClass 1
|
||||
value = sortValue $ gst <> minAda
|
||||
gstOutput =
|
||||
if ps.stealGST
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@ import Agora.Proposal.Time (
|
|||
votingTime
|
||||
),
|
||||
)
|
||||
import Agora.SafeMoney (AuthorityTokenTag, GTTag)
|
||||
import Agora.Stake (
|
||||
StakeDatum (..),
|
||||
)
|
||||
|
|
@ -73,7 +74,7 @@ import Data.Default (def)
|
|||
import Data.List (singleton, sort)
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged (Tagged), untag)
|
||||
import Plutarch.Context (
|
||||
input,
|
||||
mint,
|
||||
|
|
@ -87,9 +88,8 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue)
|
||||
import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (..))
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import PlutusLedgerApi.V2 (
|
||||
Credential (PubKeyCredential),
|
||||
DatumHash,
|
||||
|
|
@ -113,7 +113,7 @@ import Sample.Shared (
|
|||
governorValidator,
|
||||
governorValidatorHash,
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalAssetClass,
|
||||
proposalValidator,
|
||||
proposalValidatorHash,
|
||||
signer,
|
||||
|
|
@ -217,7 +217,7 @@ data ProposalParameters = ProposalParameters
|
|||
-- | Everything about the generated stake stuff.
|
||||
data StakeParameters = StakeParameters
|
||||
{ numStake :: NumStake
|
||||
, perStakeGTs :: Integer
|
||||
, perStakeGTs :: Tagged GTTag Integer
|
||||
, transactionSignedByOwners :: Bool
|
||||
}
|
||||
|
||||
|
|
@ -319,7 +319,7 @@ proposalRef = TxOutRef proposalTxRef 1
|
|||
-}
|
||||
mkProposalBuilder :: forall b. CombinableBuilder b => ProposalParameters -> b
|
||||
mkProposalBuilder ps =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
let pst = assetClassValue proposalAssetClass 1
|
||||
value = sortValue $ minAda <> pst
|
||||
in mconcat
|
||||
[ input $
|
||||
|
|
@ -356,7 +356,7 @@ mkStakeInputDatums :: StakeParameters -> [StakeDatum]
|
|||
mkStakeInputDatums ps =
|
||||
let template =
|
||||
StakeDatum
|
||||
{ stakedAmount = fromInteger ps.perStakeGTs
|
||||
{ stakedAmount = ps.perStakeGTs
|
||||
, owner = PubKeyCredential ""
|
||||
, delegatedTo = Nothing
|
||||
, lockedBy = []
|
||||
|
|
@ -376,9 +376,9 @@ mkStakeBuilder ps =
|
|||
let perStakeValue =
|
||||
sortValue $
|
||||
minAda
|
||||
<> Value.assetClassValue stakeAssetClass 1
|
||||
<> Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
<> assetClassValue stakeAssetClass 1
|
||||
<> assetClassValue
|
||||
governor.gtClassRef
|
||||
ps.perStakeGTs
|
||||
perStake idx i =
|
||||
let withSig =
|
||||
|
|
@ -432,7 +432,7 @@ governorRef = TxOutRef governorTxRef 2
|
|||
-}
|
||||
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
|
||||
mkGovernorBuilder ps =
|
||||
let gst = Value.assetClassValue governorAssetClass 1
|
||||
let gst = assetClassValue governorAssetClass 1
|
||||
value = sortValue $ gst <> minAda
|
||||
in mconcat
|
||||
[ input $
|
||||
|
|
@ -476,8 +476,8 @@ mkAuthorityTokenBuilder ps@AuthorityTokenParameters {carryDatum} =
|
|||
(True, Nothing) -> "deadbeef"
|
||||
(False, Just as) -> scriptHashToTokenName as
|
||||
(False, Nothing) -> ""
|
||||
ac = AssetClass (authorityTokenSymbol, tn)
|
||||
minted = Value.assetClassValue ac 1
|
||||
ac = Tagged @AuthorityTokenTag $ AssetClass authorityTokenSymbol tn
|
||||
minted = assetClassValue ac 1
|
||||
value = sortValue $ minAda <> minted
|
||||
in mconcat
|
||||
[ mint minted
|
||||
|
|
@ -678,10 +678,11 @@ getNextState = \case
|
|||
Finished -> error "Cannot advance 'Finished' proposal"
|
||||
|
||||
-- | Calculate the number of GTs per stake in order to exceed the minimum limit.
|
||||
compPerStakeGTsForDraft :: NumStake -> Integer
|
||||
compPerStakeGTsForDraft :: NumStake -> Tagged GTTag Integer
|
||||
compPerStakeGTsForDraft nCosigners =
|
||||
untag (def :: ProposalThresholds).toVoting
|
||||
`div` fromIntegral nCosigners + 1
|
||||
Tagged $
|
||||
untag (def :: ProposalThresholds).toVoting
|
||||
`div` fromIntegral nCosigners + 1
|
||||
|
||||
dummyDatum :: ()
|
||||
dummyDatum = ()
|
||||
|
|
@ -945,8 +946,9 @@ mkInsufficientCosignsBundle nCosigners nEffects =
|
|||
}
|
||||
where
|
||||
insuffcientPerStakeGTs =
|
||||
untag (def :: ProposalThresholds).toVoting
|
||||
`div` fromIntegral nCosigners - 1
|
||||
Tagged $
|
||||
untag (def :: ProposalThresholds).toVoting
|
||||
`div` fromIntegral nCosigners - 1
|
||||
template = mkValidToNextStateBundle nCosigners nEffects False Draft
|
||||
|
||||
-- * From VotingReady
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ import Data.Coerce (coerce)
|
|||
import Data.Default (def)
|
||||
import Data.List (sort)
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged)
|
||||
import Plutarch.Context (
|
||||
input,
|
||||
normalizeValue,
|
||||
|
|
@ -63,8 +63,7 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.SafeMoney (Discrete (Discrete))
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V2 (
|
||||
Credential (PubKeyCredential),
|
||||
POSIXTime (POSIXTime),
|
||||
|
|
@ -73,10 +72,9 @@ import PlutusLedgerApi.V2 (
|
|||
)
|
||||
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
|
||||
import Sample.Shared (
|
||||
fromDiscrete,
|
||||
governor,
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalAssetClass,
|
||||
proposalValidator,
|
||||
proposalValidatorHash,
|
||||
stakeAssetClass,
|
||||
|
|
@ -130,8 +128,8 @@ data Validity = Validity
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
mkStakeAmount :: StakedAmount -> Discrete GTTag
|
||||
mkStakeAmount Sufficient = Discrete $ (def @ProposalThresholds).cosign
|
||||
mkStakeAmount :: StakedAmount -> Tagged GTTag Integer
|
||||
mkStakeAmount Sufficient = (def @ProposalThresholds).cosign
|
||||
mkStakeAmount Insufficient = mkStakeAmount Sufficient - 1
|
||||
|
||||
mkStakeOwner :: StakeOwner -> PubKeyHash
|
||||
|
|
@ -229,8 +227,8 @@ stakeRef = TxOutRef stakeTxRef 0
|
|||
cosign :: forall b. CombinableBuilder b => ParameterBundle -> b
|
||||
cosign ps = builder
|
||||
where
|
||||
pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
pst = assetClassValue proposalAssetClass 1
|
||||
sst = assetClassValue stakeAssetClass 1
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -240,11 +238,9 @@ cosign ps = builder
|
|||
stakeValue =
|
||||
normalizeValue $
|
||||
minAda
|
||||
<> Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
( fromDiscrete $
|
||||
mkStakeAmount ps.stakeParameters.gtAmount
|
||||
)
|
||||
<> assetClassValue
|
||||
governor.gtClassRef
|
||||
(mkStakeAmount ps.stakeParameters.gtAmount)
|
||||
<> sst
|
||||
|
||||
stakeBuilder =
|
||||
|
|
|
|||
|
|
@ -47,10 +47,11 @@ import Agora.Stake (
|
|||
import Data.Coerce (coerce)
|
||||
import Data.Default (Default (def))
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged)
|
||||
import Plutarch.Context (
|
||||
input,
|
||||
mint,
|
||||
normalizeValue,
|
||||
output,
|
||||
script,
|
||||
signedWith,
|
||||
|
|
@ -60,8 +61,7 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.SafeMoney (Discrete)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V2 (
|
||||
Credential (PubKeyCredential),
|
||||
POSIXTime (POSIXTime),
|
||||
|
|
@ -71,12 +71,12 @@ import PlutusLedgerApi.V2 (
|
|||
)
|
||||
import Sample.Proposal.Shared (stakeTxRef)
|
||||
import Sample.Shared (
|
||||
fromDiscrete,
|
||||
governor,
|
||||
governorAssetClass,
|
||||
governorValidator,
|
||||
governorValidatorHash,
|
||||
minAda,
|
||||
proposalAssetClass,
|
||||
proposalPolicy,
|
||||
proposalPolicySymbol,
|
||||
proposalStartingTimeFromTimeRange,
|
||||
|
|
@ -127,7 +127,7 @@ thisProposalId :: ProposalId
|
|||
thisProposalId = ProposalId 25
|
||||
|
||||
-- | The arbitrary staked amount. Doesn;t really matter in this case.
|
||||
stakedGTs :: Discrete GTTag
|
||||
stakedGTs :: Tagged GTTag Integer
|
||||
stakedGTs = 5
|
||||
|
||||
-- | The owner of the stake.
|
||||
|
|
@ -282,9 +282,9 @@ governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be
|
|||
createProposal :: forall b. CombinableBuilder b => Parameters -> b
|
||||
createProposal ps = builder
|
||||
where
|
||||
pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
gst = Value.assetClassValue governorAssetClass 1
|
||||
pst = assetClassValue proposalAssetClass 1
|
||||
sst = assetClassValue stakeAssetClass 1
|
||||
gst = assetClassValue governorAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
|
|
@ -292,7 +292,7 @@ createProposal ps = builder
|
|||
stakeValue =
|
||||
sortValue $
|
||||
sst
|
||||
<> Value.assetClassValue (untag governor.gtClassRef) (fromDiscrete stakedGTs)
|
||||
<> assetClassValue governor.gtClassRef stakedGTs
|
||||
<> minAda
|
||||
proposalValue = sortValue $ pst <> minAda
|
||||
|
||||
|
|
@ -314,11 +314,8 @@ createProposal ps = builder
|
|||
withSig
|
||||
, ---
|
||||
mint $
|
||||
sortValue $
|
||||
normalizeValue
|
||||
pst
|
||||
<>
|
||||
-- 0 Ada entry, see #174
|
||||
Value.singleton "" "" 0
|
||||
, ---
|
||||
timeRange $ mkTimeRange ps
|
||||
, input $
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ import Agora.Proposal (
|
|||
ResultTag (..),
|
||||
)
|
||||
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..))
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
ProposalLock (..),
|
||||
StakeDatum (..),
|
||||
|
|
@ -48,7 +49,7 @@ import Agora.Stake (
|
|||
)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Tagged (Tagged (Tagged), untag)
|
||||
import Data.Tagged (Tagged, untag)
|
||||
import Plutarch.Context (
|
||||
input,
|
||||
normalizeValue,
|
||||
|
|
@ -62,8 +63,7 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.SafeMoney (Discrete (Discrete))
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V2 (
|
||||
Credential (PubKeyCredential),
|
||||
PubKeyHash,
|
||||
|
|
@ -73,7 +73,7 @@ import Sample.Proposal.Shared (stakeTxRef)
|
|||
import Sample.Shared (
|
||||
governor,
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalAssetClass,
|
||||
proposalValidator,
|
||||
proposalValidatorHash,
|
||||
stakeAssetClass,
|
||||
|
|
@ -106,10 +106,10 @@ defVoteFor :: ResultTag
|
|||
defVoteFor = ResultTag 0
|
||||
|
||||
-- | The default number of GTs the stake will have.
|
||||
defStakedGTs :: Integer
|
||||
defStakedGTs :: Tagged GTTag Integer
|
||||
defStakedGTs = 100000
|
||||
|
||||
alteredStakedGTs :: Integer
|
||||
alteredStakedGTs :: Tagged GTTag Integer
|
||||
alteredStakedGTs = 100
|
||||
|
||||
-- | Default owner of the stakes.
|
||||
|
|
@ -186,7 +186,7 @@ stakeRedeemer = RetractVotes
|
|||
mkStakeInputDatum :: StakeParameters -> StakeDatum
|
||||
mkStakeInputDatum ps =
|
||||
StakeDatum
|
||||
{ stakedAmount = Discrete $ Tagged defStakedGTs
|
||||
{ stakedAmount = defStakedGTs
|
||||
, owner = PubKeyCredential defOwner
|
||||
, delegatedTo = Just $ PubKeyCredential defDelegatee
|
||||
, lockedBy = stakeLocks
|
||||
|
|
@ -231,7 +231,7 @@ mkProposalInputDatum sps pps =
|
|||
updatVotes (ProposalVotes vt) =
|
||||
ProposalVotes $
|
||||
StrictMap.adjust
|
||||
(+ sps.numStakes * defStakedGTs)
|
||||
(+ sps.numStakes * untag defStakedGTs)
|
||||
defVoteFor
|
||||
vt
|
||||
|
||||
|
|
@ -240,7 +240,7 @@ mkProposalInputDatum sps pps =
|
|||
unlock :: forall b. CombinableBuilder b => ParameterBundle -> b
|
||||
unlock ps = builder
|
||||
where
|
||||
pst = Value.singleton proposalPolicySymbol "" 1
|
||||
pst = assetClassValue proposalAssetClass 1
|
||||
|
||||
proposalInputDatum =
|
||||
mkProposalInputDatum
|
||||
|
|
@ -275,7 +275,7 @@ unlock ps = builder
|
|||
|
||||
---
|
||||
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
sst = assetClassValue stakeAssetClass 1
|
||||
|
||||
stakeInputDatum = mkStakeInputDatum ps.stakeParameters
|
||||
|
||||
|
|
@ -302,8 +302,8 @@ unlock ps = builder
|
|||
mconcat
|
||||
[ minAda
|
||||
, sst
|
||||
, Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
, assetClassValue
|
||||
governor.gtClassRef
|
||||
gt
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -42,6 +42,7 @@ import Agora.Proposal.Time (
|
|||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (draftTime, votingTime),
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
ProposalLock (Voted),
|
||||
StakeDatum (..),
|
||||
|
|
@ -50,7 +51,7 @@ import Agora.Stake (
|
|||
import Data.Default (Default (def))
|
||||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged, untag)
|
||||
import Plutarch.Context (
|
||||
input,
|
||||
mint,
|
||||
|
|
@ -64,14 +65,14 @@ import Plutarch.Context (
|
|||
withRef,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import Plutarch.Extra.AssetClass (adaClass, assetClassValue)
|
||||
import PlutusLedgerApi.V2 (Credential (PubKeyCredential), PubKeyHash)
|
||||
import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef))
|
||||
import Sample.Proposal.Shared (proposalTxRef)
|
||||
import Sample.Shared (
|
||||
governor,
|
||||
minAda,
|
||||
proposalPolicySymbol,
|
||||
proposalAssetClass,
|
||||
proposalValidator,
|
||||
proposalValidatorHash,
|
||||
stakeAssetClass,
|
||||
|
|
@ -102,7 +103,7 @@ data StakeParameters = StakeParameters
|
|||
}
|
||||
|
||||
newtype StakeInputParameters = StakeInputParameters
|
||||
{ perStakeGTs :: Integer
|
||||
{ perStakeGTs :: Tagged GTTag Integer
|
||||
}
|
||||
|
||||
data StakeOutputParameters = StakeOutputParameters
|
||||
|
|
@ -189,7 +190,7 @@ mkStakeRedeemer params =
|
|||
mkStakeInputDatum :: StakeInputParameters -> StakeDatum
|
||||
mkStakeInputDatum params =
|
||||
StakeDatum
|
||||
{ stakedAmount = fromInteger params.perStakeGTs
|
||||
{ stakedAmount = params.perStakeGTs
|
||||
, owner = PubKeyCredential stakeOwner
|
||||
, delegatedTo = Just (PubKeyCredential delegatee)
|
||||
, lockedBy =
|
||||
|
|
@ -205,8 +206,8 @@ mkStakeRef o i = TxOutRef proposalTxRef $ o + i
|
|||
|
||||
vote :: forall b. CombinableBuilder b => ParameterBundle -> b
|
||||
vote params =
|
||||
let pst = Value.singleton proposalPolicySymbol "" 1
|
||||
sst = Value.assetClassValue stakeAssetClass 1
|
||||
let pst = assetClassValue proposalAssetClass 1
|
||||
sst = assetClassValue stakeAssetClass 1
|
||||
|
||||
---
|
||||
|
||||
|
|
@ -217,8 +218,8 @@ vote params =
|
|||
stakeInputValue =
|
||||
normalizeValue $
|
||||
sst
|
||||
<> Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
<> assetClassValue
|
||||
governor.gtClassRef
|
||||
params.stakeParameters.stakeInputParameters.perStakeGTs
|
||||
<> minAda
|
||||
|
||||
|
|
@ -246,11 +247,11 @@ vote params =
|
|||
10_000_000
|
||||
in normalizeValue $
|
||||
sst
|
||||
<> Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
<> assetClassValue
|
||||
governor.gtClassRef
|
||||
gtAmount
|
||||
<> minAda
|
||||
<> Value.singleton "" "" adaAmount
|
||||
<> assetClassValue adaClass adaAmount
|
||||
|
||||
stakeRedeemer =
|
||||
mkStakeRedeemer params.stakeParameters.stakeOutputParameters
|
||||
|
|
@ -269,7 +270,7 @@ vote params =
|
|||
, withRef $ mkStakeRef numProposals' i
|
||||
]
|
||||
, if params.stakeParameters.stakeOutputParameters.burnStakes
|
||||
then mint $ Value.assetClassValue stakeAssetClass (-1)
|
||||
then mint $ assetClassValue stakeAssetClass (-1)
|
||||
else
|
||||
output $
|
||||
mconcat
|
||||
|
|
@ -292,7 +293,7 @@ vote params =
|
|||
else id
|
||||
)
|
||||
. ( +
|
||||
params.stakeParameters.stakeInputParameters.perStakeGTs
|
||||
untag params.stakeParameters.stakeInputParameters.perStakeGTs
|
||||
* params.stakeParameters.numStakes
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@ module Sample.Shared (
|
|||
minAda,
|
||||
deterministicTracingConfing,
|
||||
mkRedeemer,
|
||||
fromDiscrete,
|
||||
|
||||
-- * Agora Scripts
|
||||
agoraScripts,
|
||||
|
|
@ -46,6 +45,7 @@ module Sample.Shared (
|
|||
proposalValidatorHash,
|
||||
proposalValidatorAddress,
|
||||
proposalStartingTimeFromTimeRange,
|
||||
proposalAssetClass,
|
||||
|
||||
-- ** Authority
|
||||
authorityTokenPolicy,
|
||||
|
|
@ -71,10 +71,10 @@ import Agora.Proposal.Time (
|
|||
ProposalStartingTime (ProposalStartingTime),
|
||||
ProposalTimingConfig (..),
|
||||
)
|
||||
import Agora.SafeMoney (GovernorSTTag, ProposalSTTag, StakeSTTag)
|
||||
import Agora.Utils (
|
||||
validatorHashToTokenName,
|
||||
)
|
||||
import Data.Coerce (coerce)
|
||||
import Data.Default.Class (Default (..))
|
||||
import Data.Map (Map, (!))
|
||||
import Data.Tagged (Tagged (..))
|
||||
|
|
@ -85,11 +85,10 @@ import Plutarch.Api.V2 (
|
|||
mintingPolicySymbol,
|
||||
validatorHash,
|
||||
)
|
||||
import Plutarch.SafeMoney (Discrete (Discrete))
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
|
||||
import PlutusLedgerApi.V1.Address (scriptHashAddress)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass), TokenName, Value)
|
||||
import PlutusLedgerApi.V1.Value (TokenName, Value)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||
assetClass,
|
||||
singleton,
|
||||
)
|
||||
import PlutusLedgerApi.V2 (
|
||||
|
|
@ -133,7 +132,7 @@ governor = Governor oref gt mc
|
|||
oref = gstUTXORef
|
||||
gt =
|
||||
Tagged $
|
||||
Value.assetClass
|
||||
AssetClass
|
||||
"da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
|
||||
"LQ"
|
||||
mc = 20
|
||||
|
|
@ -155,8 +154,8 @@ stakePolicy = MintingPolicy $ agoraScripts ! "agora:stakePolicy"
|
|||
stakeSymbol :: CurrencySymbol
|
||||
stakeSymbol = mintingPolicySymbol stakePolicy
|
||||
|
||||
stakeAssetClass :: AssetClass
|
||||
stakeAssetClass = AssetClass (stakeSymbol, validatorHashToTokenName stakeValidatorHash)
|
||||
stakeAssetClass :: Tagged StakeSTTag AssetClass
|
||||
stakeAssetClass = Tagged $ AssetClass stakeSymbol (validatorHashToTokenName stakeValidatorHash)
|
||||
|
||||
stakeValidator :: Validator
|
||||
stakeValidator = Validator $ agoraScripts ! "agora:stakeValidator"
|
||||
|
|
@ -179,8 +178,8 @@ governorValidator = Validator $ agoraScripts ! "agora:governorValidator"
|
|||
governorSymbol :: CurrencySymbol
|
||||
governorSymbol = mintingPolicySymbol governorPolicy
|
||||
|
||||
governorAssetClass :: AssetClass
|
||||
governorAssetClass = AssetClass (governorSymbol, "")
|
||||
governorAssetClass :: Tagged GovernorSTTag AssetClass
|
||||
governorAssetClass = Tagged $ AssetClass governorSymbol ""
|
||||
|
||||
governorValidatorHash :: ValidatorHash
|
||||
governorValidatorHash = validatorHash governorValidator
|
||||
|
|
@ -194,6 +193,9 @@ proposalPolicy = MintingPolicy $ agoraScripts ! "agora:proposalPolicy"
|
|||
proposalPolicySymbol :: CurrencySymbol
|
||||
proposalPolicySymbol = mintingPolicySymbol proposalPolicy
|
||||
|
||||
proposalAssetClass :: Tagged ProposalSTTag AssetClass
|
||||
proposalAssetClass = Tagged $ AssetClass proposalPolicySymbol ""
|
||||
|
||||
-- | A sample 'PubKeyHash'.
|
||||
signer :: PubKeyHash
|
||||
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
|
||||
|
|
@ -260,9 +262,6 @@ proposalStartingTimeFromTimeRange _ = error "Given time range should be finite a
|
|||
mkRedeemer :: forall redeemer. PlutusTx.ToData redeemer => redeemer -> Redeemer
|
||||
mkRedeemer = Redeemer . toBuiltinData
|
||||
|
||||
fromDiscrete :: forall tag. Discrete tag -> Integer
|
||||
fromDiscrete = coerce
|
||||
|
||||
------------------------------------------------------------------
|
||||
|
||||
treasuryOut :: TxOut
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import Agora.SafeMoney (GTTag)
|
|||
import Agora.Stake (
|
||||
StakeDatum (StakeDatum, stakedAmount),
|
||||
)
|
||||
import Data.Tagged (untag)
|
||||
import Data.Tagged (Tagged)
|
||||
import Plutarch.Context (
|
||||
MintingBuilder,
|
||||
SpendingBuilder,
|
||||
|
|
@ -41,10 +41,9 @@ import Plutarch.Context (
|
|||
withSpendingOutRef,
|
||||
withValue,
|
||||
)
|
||||
import Plutarch.SafeMoney (Discrete)
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V1.Contexts (TxOutRef (..))
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||
assetClassValue,
|
||||
singleton,
|
||||
)
|
||||
import PlutusLedgerApi.V2 (
|
||||
|
|
@ -57,7 +56,6 @@ import PlutusLedgerApi.V2 (
|
|||
)
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Shared (
|
||||
fromDiscrete,
|
||||
governor,
|
||||
signer,
|
||||
stakeAssetClass,
|
||||
|
|
@ -69,7 +67,7 @@ import Test.Util (sortValue)
|
|||
-- | This script context should be a valid transaction.
|
||||
stakeCreation :: ScriptContext
|
||||
stakeCreation =
|
||||
let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
let st = assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
datum :: StakeDatum
|
||||
datum = StakeDatum 424242424242 (PubKeyCredential signer) Nothing []
|
||||
|
||||
|
|
@ -114,16 +112,16 @@ stakeCreationUnsigned =
|
|||
|
||||
-- | Config for creating a ScriptContext that deposits or withdraws.
|
||||
data DepositWithdrawExample = DepositWithdrawExample
|
||||
{ startAmount :: Discrete GTTag
|
||||
{ startAmount :: Tagged GTTag Integer
|
||||
-- ^ The amount of GT stored before the transaction.
|
||||
, delta :: Discrete GTTag
|
||||
, delta :: Tagged GTTag Integer
|
||||
-- ^ The amount of GT deposited or withdrawn from the Stake.
|
||||
}
|
||||
|
||||
-- | Create a ScriptContext that deposits or withdraws, given the config for it.
|
||||
stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
|
||||
stakeDepositWithdraw config =
|
||||
let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
let st = assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
stakeBefore :: StakeDatum
|
||||
stakeBefore = StakeDatum config.startAmount (PubKeyCredential signer) Nothing []
|
||||
|
||||
|
|
@ -144,7 +142,7 @@ stakeDepositWithdraw config =
|
|||
, withValue
|
||||
( sortValue $
|
||||
st
|
||||
<> Value.assetClassValue (untag governor.gtClassRef) (fromDiscrete stakeBefore.stakedAmount)
|
||||
<> assetClassValue governor.gtClassRef stakeBefore.stakedAmount
|
||||
)
|
||||
, withDatum stakeBefore
|
||||
, withRef stakeRef
|
||||
|
|
@ -155,7 +153,7 @@ stakeDepositWithdraw config =
|
|||
, withValue
|
||||
( sortValue $
|
||||
st
|
||||
<> Value.assetClassValue (untag governor.gtClassRef) (fromDiscrete stakeAfter.stakedAmount)
|
||||
<> assetClassValue governor.gtClassRef stakeAfter.stakedAmount
|
||||
)
|
||||
, withDatum stakeAfter
|
||||
]
|
||||
|
|
|
|||
|
|
@ -24,7 +24,6 @@ import Agora.Stake (
|
|||
StakeDatum (..),
|
||||
StakeRedeemer (ClearDelegate, DelegateTo),
|
||||
)
|
||||
import Data.Tagged (untag)
|
||||
import Plutarch.Context (
|
||||
SpendingBuilder,
|
||||
buildSpending',
|
||||
|
|
@ -38,7 +37,7 @@ import Plutarch.Context (
|
|||
withSpendingOutRef,
|
||||
withValue,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value
|
||||
import Plutarch.Extra.AssetClass (assetClassValue)
|
||||
import PlutusLedgerApi.V2 (
|
||||
Credential (PubKeyCredential),
|
||||
PubKeyHash,
|
||||
|
|
@ -46,7 +45,6 @@ import PlutusLedgerApi.V2 (
|
|||
TxOutRef (TxOutRef),
|
||||
)
|
||||
import Sample.Shared (
|
||||
fromDiscrete,
|
||||
governor,
|
||||
minAda,
|
||||
signer,
|
||||
|
|
@ -116,14 +114,14 @@ setDelegate ps = buildSpending' builder
|
|||
_ -> signer2
|
||||
else signer2
|
||||
|
||||
st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
st = assetClassValue stakeAssetClass 1 -- Stake ST
|
||||
stakeValue =
|
||||
sortValue $
|
||||
mconcat
|
||||
[ st
|
||||
, Value.assetClassValue
|
||||
(untag governor.gtClassRef)
|
||||
(fromDiscrete stakeInput.stakedAmount)
|
||||
, assetClassValue
|
||||
governor.gtClassRef
|
||||
stakeInput.stakedAmount
|
||||
, minAda
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ import Plutarch.Api.V2 (
|
|||
PTxInfo (PTxInfo),
|
||||
PTxOut (PTxOut),
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (PAssetClass, passetClass, passetClassValueOf)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData, ptoScottEncoding)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
|
||||
import Plutarch.Extra.ScriptContext (pisTokenSpent)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
|
|
@ -132,7 +132,7 @@ singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
|||
|
||||
@since 0.1.0
|
||||
-}
|
||||
authorityTokenPolicy :: ClosedTerm (PAssetClass :--> PMintingPolicy)
|
||||
authorityTokenPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
authorityTokenPolicy =
|
||||
plam $ \atAssetClass _redeemer ctx' ->
|
||||
pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
|
||||
|
|
@ -141,12 +141,16 @@ authorityTokenPolicy =
|
|||
txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
|
||||
let inputs = txInfo.inputs
|
||||
mintedValue = pfromData txInfo.mint
|
||||
govTokenSpent = pisTokenSpent # atAssetClass # inputs
|
||||
govTokenSpent = pisTokenSpent # (ptoScottEncoding # atAssetClass) # inputs
|
||||
|
||||
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
|
||||
|
||||
let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
|
||||
mintedATs = passetClassValueOf # mintedValue # (passetClass # ownSymbol # pconstant "")
|
||||
mintedATs =
|
||||
psymbolValueOf
|
||||
# ownSymbol
|
||||
# mintedValue
|
||||
|
||||
pure $
|
||||
pif
|
||||
(0 #< mintedATs)
|
||||
|
|
|
|||
|
|
@ -17,15 +17,10 @@ import Agora.Treasury (treasuryValidator)
|
|||
import Data.Map (fromList)
|
||||
import Data.Text (Text, unpack)
|
||||
import Plutarch (Config)
|
||||
import Plutarch.Extra.AssetClass (PAssetClass)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import Ply (TypedScriptEnvelope)
|
||||
import Ply.Plutarch.Class (PlyArgOf)
|
||||
import Ply.Plutarch.TypedWriter (TypedWriter, mkEnvelope)
|
||||
import ScriptExport.ScriptInfo (RawScriptExport (..))
|
||||
|
||||
type instance PlyArgOf PAssetClass = AssetClass
|
||||
|
||||
{- | Parameterize core scripts, given the 'Agora.Governor.Governor'
|
||||
parameters and plutarch configurations.
|
||||
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ mutateGovernorValidator =
|
|||
effectDatumF <- pletAllC effectDatum
|
||||
txInfoF <- pletFieldsC @'["inputs", "outputs", "datums", "redeemers"] txInfo
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
--------------------------------------------------------------------------
|
||||
|
||||
scriptInputs <-
|
||||
pletC $
|
||||
|
|
@ -184,13 +184,13 @@ mutateGovernorValidator =
|
|||
isGovernorInput =
|
||||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Can only modify the pinned governor" $
|
||||
inputF.outRef #== effectDatumF.governorRef
|
||||
, ptraceIfFalse "Governor UTxO should carry GST" $
|
||||
[ ptraceIfFalse "Governor UTxO should carry GST" $
|
||||
psymbolValueOf
|
||||
# gstSymbol
|
||||
# (pfield @"value" # inputF.resolved)
|
||||
#== 1
|
||||
, ptraceIfFalse "Can only modify the pinned governor" $
|
||||
inputF.outRef #== effectDatumF.governorRef
|
||||
, ptraceIfFalse "Governor validator run" $
|
||||
pfield @"address" # inputF.resolved
|
||||
#== governorAddress
|
||||
|
|
|
|||
|
|
@ -46,6 +46,7 @@ import Plutarch.DataRepr (
|
|||
DerivePConstantViaData (DerivePConstantViaData),
|
||||
PDataFields,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (AssetClass)
|
||||
import Plutarch.Extra.IsData (
|
||||
DerivePConstantViaEnum (DerivePConstantEnum),
|
||||
EnumIsData (EnumIsData),
|
||||
|
|
@ -54,7 +55,6 @@ import Plutarch.Extra.IsData (
|
|||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pletFieldsC)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import PlutusTx qualified
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -55,10 +55,10 @@ import Plutarch.Api.V2 (
|
|||
PTxOutRef,
|
||||
PValidator,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
|
||||
import Plutarch.Extra.AssetClass (passetClass)
|
||||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust, pmapMaybe)
|
||||
import Plutarch.Extra.Map (pkeys, ptryLookup)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.Map (pkeys, ptryLookup)
|
||||
import Plutarch.Extra.Maybe (passertPJust, pjust, pmaybe, pmaybeData, pnothing)
|
||||
import Plutarch.Extra.Ord (psort)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
|
|
@ -77,7 +77,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
pmatchC,
|
||||
ptryFromC,
|
||||
)
|
||||
import Plutarch.Extra.Value (psymbolValueOf)
|
||||
import Plutarch.Extra.Value (passetClassValueOf, psymbolValueOf)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -490,7 +490,7 @@ governorValidator =
|
|||
proposalInputDatumF.status #== pconstantData Locked
|
||||
|
||||
-- Find the highest votes and the corresponding tag.
|
||||
let quorum = pto $ pto $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
|
||||
let quorum = pto $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
|
||||
neutralOption = pneutralOption # proposalInputDatumF.effects
|
||||
finalResultTag = pwinner # proposalInputDatumF.votes # quorum # neutralOption
|
||||
|
||||
|
|
@ -528,8 +528,8 @@ governorValidator =
|
|||
gatAssetClass = passetClass # atSymbol # tagToken
|
||||
valueGATCorrect =
|
||||
passetClassValueOf
|
||||
# outputF.value
|
||||
# gatAssetClass #== 1
|
||||
# gatAssetClass
|
||||
# outputF.value #== 1
|
||||
|
||||
let hasCorrectDatum =
|
||||
effect.datumHash #== pfromDatumHash # outputF.datum
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@ import Data.Aeson qualified as Aeson
|
|||
import Data.Map (fromList)
|
||||
import Data.Tagged (untag)
|
||||
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash)
|
||||
import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
|
||||
import PlutusLedgerApi.V1 (Address, CurrencySymbol, TxOutRef, ValidatorHash)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (AssetClass))
|
||||
import Ply (
|
||||
ScriptRole (MintingPolicyRole, ValidatorRole),
|
||||
toMintingPolicy,
|
||||
|
|
@ -72,7 +72,7 @@ linker = do
|
|||
toMintingPolicy
|
||||
govPol'
|
||||
gstAssetClass =
|
||||
AssetClass (gstSymbol, "")
|
||||
AssetClass gstSymbol ""
|
||||
govValHash = validatorHash $ toValidator govVal'
|
||||
|
||||
at = gstAssetClass
|
||||
|
|
@ -89,14 +89,14 @@ linker = do
|
|||
propValAddress =
|
||||
validatorHashToAddress $ validatorHash $ toValidator propVal'
|
||||
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
|
||||
pstAssetClass = AssetClass (pstSymbol, "")
|
||||
pstAssetClass = AssetClass pstSymbol ""
|
||||
|
||||
stakPol' = stkPol # untag governor.gtClassRef
|
||||
stakVal' = stkVal # sstSymbol # pstAssetClass # untag governor.gtClassRef
|
||||
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol'
|
||||
stakValTokenName =
|
||||
validatorHashToTokenName $ validatorHash $ toValidator stakVal'
|
||||
sstAssetClass = AssetClass (sstSymbol, stakValTokenName)
|
||||
sstAssetClass = AssetClass sstSymbol stakValTokenName
|
||||
|
||||
treaVal' = treVal # atSymbol
|
||||
|
||||
|
|
|
|||
|
|
@ -8,8 +8,6 @@ import Data.Bifunctor (Bifunctor (bimap))
|
|||
import Data.Map.Strict qualified as StrictMap
|
||||
import Data.Traversable (for)
|
||||
import Plutarch.Api.V1 (KeyGuarantees (Sorted), PMap)
|
||||
import Plutarch.Num (PNum)
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import PlutusTx qualified
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
|
||||
|
|
@ -76,6 +74,3 @@ instance
|
|||
isSorted [] = True
|
||||
isSorted [_] = True
|
||||
isSorted (x : y : xs) = x < y && isSorted (y : xs)
|
||||
|
||||
-- | @since 1.0.0
|
||||
deriving anyclass instance PNum (PDiscrete tag)
|
||||
|
|
|
|||
|
|
@ -78,8 +78,9 @@ import Plutarch.Extra.IsData (
|
|||
ProductIsData (ProductIsData),
|
||||
)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust)
|
||||
import Plutarch.Extra.Map qualified as PM
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.Map qualified as PM
|
||||
import Plutarch.Extra.Maybe (pfromJust)
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC)
|
||||
import Plutarch.Lift (
|
||||
DerivePConstantViaNewtype (DerivePConstantViaNewtype),
|
||||
|
|
@ -87,7 +88,6 @@ import Plutarch.Lift (
|
|||
PUnsafeLiftDecl (type PLifted),
|
||||
)
|
||||
import Plutarch.Orphans ()
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
|
||||
import PlutusTx qualified
|
||||
|
||||
|
|
@ -560,11 +560,11 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
|
|||
Term
|
||||
s
|
||||
( PDataRecord
|
||||
'[ "execute" ':= PDiscrete GTTag
|
||||
, "create" ':= PDiscrete GTTag
|
||||
, "toVoting" ':= PDiscrete GTTag
|
||||
, "vote" ':= PDiscrete GTTag
|
||||
, "cosign" ':= PDiscrete GTTag
|
||||
'[ "execute" ':= PTagged GTTag PInteger
|
||||
, "create" ':= PTagged GTTag PInteger
|
||||
, "toVoting" ':= PTagged GTTag PInteger
|
||||
, "vote" ':= PTagged GTTag PInteger
|
||||
, "cosign" ':= PTagged GTTag PInteger
|
||||
]
|
||||
)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -50,12 +50,11 @@ import Plutarch.Api.V2 (
|
|||
PTxOut,
|
||||
PValidator,
|
||||
)
|
||||
import Plutarch.Extra.AssetClass (PAssetClass, passetClass, passetClassValueOf)
|
||||
import Plutarch.Extra.AssetClass (PAssetClassData, passetClass, ptoScottEncoding)
|
||||
import Plutarch.Extra.Category (PCategory (pidentity))
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.Field (pletAll, pletAllC)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust)
|
||||
import Plutarch.Extra.Map (pupdate)
|
||||
import "plutarch-extra" Plutarch.Extra.Map (pupdate)
|
||||
import Plutarch.Extra.Maybe (
|
||||
passertPJust,
|
||||
pisJust,
|
||||
|
|
@ -80,8 +79,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
ptryFromC,
|
||||
)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Extra.Value (psymbolValueOf)
|
||||
import Plutarch.SafeMoney (PDiscrete (PDiscrete))
|
||||
import Plutarch.Extra.Value (passetClassValueOf, psymbolValueOf)
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
|
||||
{- | Policy for Proposals.
|
||||
|
|
@ -109,7 +107,7 @@ import Plutarch.Unsafe (punsafeCoerce)
|
|||
|
||||
@since 1.0.0
|
||||
-}
|
||||
proposalPolicy :: ClosedTerm (PAssetClass :--> PMintingPolicy)
|
||||
proposalPolicy :: ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
proposalPolicy =
|
||||
plam $ \gtAssetClass _redeemer ctx' -> unTermCont $ do
|
||||
PScriptContext ctx' <- pmatchC ctx'
|
||||
|
|
@ -120,12 +118,12 @@ proposalPolicy =
|
|||
PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
|
||||
let mintedProposalST =
|
||||
passetClassValueOf
|
||||
# pfromData txInfo.mint
|
||||
# (passetClass # (pfield @"_0" # ownSymbol') # pconstant "")
|
||||
# txInfo.mint
|
||||
|
||||
pguardC "Governance state-thread token must move" $
|
||||
pisTokenSpent
|
||||
# gtAssetClass
|
||||
# (ptoScottEncoding # gtAssetClass)
|
||||
# txInfo.inputs
|
||||
|
||||
pguardC "Minted exactly one proposal ST" $
|
||||
|
|
@ -211,7 +209,7 @@ instance DerivePlutusType PStakeInputsContext where
|
|||
-}
|
||||
proposalValidator ::
|
||||
ClosedTerm
|
||||
( PAssetClass
|
||||
( PAssetClassData
|
||||
:--> PCurrencySymbol
|
||||
:--> PCurrencySymbol
|
||||
:--> PInteger
|
||||
|
|
@ -304,8 +302,8 @@ proposalValidator =
|
|||
let isStakeUTxO =
|
||||
-- A stake UTxO is a UTxO that carries SST.
|
||||
passetClassValueOf
|
||||
# (ptoScottEncoding # sstClass)
|
||||
# txOutF.value
|
||||
# sstClass
|
||||
#== 1
|
||||
|
||||
stake =
|
||||
|
|
@ -495,9 +493,8 @@ proposalValidator =
|
|||
PProposalVotes $
|
||||
pupdate
|
||||
# plam
|
||||
( \votes -> unTermCont $ do
|
||||
PDiscrete v <- pmatchC totalStakeAmount
|
||||
pure $ pcon $ PJust $ votes + (pextract # v)
|
||||
( \votes ->
|
||||
pcon $ PJust $ votes + pto totalStakeAmount
|
||||
)
|
||||
# voteFor
|
||||
# pto (pfromData proposalInputDatumF.votes)
|
||||
|
|
@ -546,9 +543,8 @@ proposalValidator =
|
|||
pisVoter # stakeRoles
|
||||
|
||||
voteCount =
|
||||
pextract
|
||||
#$ pto
|
||||
$ pfromData stakeF.stakedAmount
|
||||
pto $
|
||||
pfromData stakeF.stakedAmount
|
||||
|
||||
newVotes =
|
||||
pretractVotes
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ module Agora.SafeMoney (
|
|||
GovernorSTTag,
|
||||
StakeSTTag,
|
||||
ProposalSTTag,
|
||||
AuthorityTokenTag,
|
||||
adaRef,
|
||||
) where
|
||||
|
||||
|
|
@ -47,6 +48,12 @@ data StakeSTTag
|
|||
-}
|
||||
data ProposalSTTag
|
||||
|
||||
{- | Authority token.
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
data AuthorityTokenTag
|
||||
|
||||
{- | Resolves ada tags.
|
||||
|
||||
@since 0.1.0
|
||||
|
|
|
|||
|
|
@ -64,16 +64,15 @@ import Plutarch.DataRepr (
|
|||
import Plutarch.Extra.Field (pletAll)
|
||||
import Plutarch.Extra.IsData (
|
||||
DerivePConstantViaDataList (DerivePConstantViaDataList),
|
||||
PlutusTypeDataList,
|
||||
ProductIsData (ProductIsData),
|
||||
)
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust)
|
||||
import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing)
|
||||
import Plutarch.Extra.Sum (PSum (PSum))
|
||||
import Plutarch.Extra.Tagged (PTagged)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
|
||||
import Plutarch.Orphans ()
|
||||
import Plutarch.SafeMoney (Discrete, PDiscrete)
|
||||
import PlutusLedgerApi.V2 (Credential)
|
||||
import PlutusTx qualified
|
||||
|
||||
|
|
@ -193,7 +192,7 @@ PlutusTx.makeIsDataIndexed
|
|||
@since 0.1.0
|
||||
-}
|
||||
data StakeDatum = StakeDatum
|
||||
{ stakedAmount :: Discrete GTTag
|
||||
{ stakedAmount :: Tagged GTTag Integer
|
||||
-- ^ Tracks the amount of governance token staked in the datum.
|
||||
-- This also acts as the voting weight for 'Agora.Proposal.Proposal's.
|
||||
, owner :: Credential
|
||||
|
|
@ -236,7 +235,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum
|
|||
Term
|
||||
s
|
||||
( PDataRecord
|
||||
'[ "stakedAmount" ':= PDiscrete GTTag
|
||||
'[ "stakedAmount" ':= PTagged GTTag PInteger
|
||||
, "owner" ':= PCredential
|
||||
, "delegatedTo" ':= PMaybeData (PAsData PCredential)
|
||||
, "lockedBy" ':= PBuiltinList (PAsData PProposalLock)
|
||||
|
|
@ -261,7 +260,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum
|
|||
)
|
||||
|
||||
instance DerivePlutusType PStakeDatum where
|
||||
type DPTStrat _ = PlutusTypeDataList
|
||||
type DPTStrat _ = PlutusTypeNewtype
|
||||
|
||||
-- | @since 1.0.0
|
||||
instance PUnsafeLiftDecl PStakeDatum where
|
||||
|
|
@ -282,7 +281,7 @@ instance PTryFrom PData (PAsData PStakeDatum)
|
|||
-}
|
||||
data PStakeRedeemer (s :: S)
|
||||
= -- | Deposit or withdraw a discrete amount of the staked governance token.
|
||||
PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag]))
|
||||
PDepositWithdraw (Term s (PDataRecord '["delta" ':= PTagged GTTag PInteger]))
|
||||
| -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets.
|
||||
PDestroy (Term s (PDataRecord '[]))
|
||||
| PPermitVote (Term s (PDataRecord '[]))
|
||||
|
|
@ -493,7 +492,7 @@ instance DerivePlutusType PSigContext where
|
|||
-}
|
||||
data PStakeRedeemerContext (s :: S)
|
||||
= -- | See also 'DepositWithdraw'.
|
||||
PDepositWithdrawDelta (Term s (PDiscrete GTTag))
|
||||
PDepositWithdrawDelta (Term s (PTagged GTTag PInteger))
|
||||
| -- | See also 'DelegateTo'.
|
||||
PSetDelegateTo (Term s PCredential)
|
||||
| PNoMetadata
|
||||
|
|
|
|||
|
|
@ -55,8 +55,6 @@ import Plutarch.Extra.Field (pletAll, pletAllC)
|
|||
import Plutarch.Extra.Maybe (pdjust, pdnothing, pmaybeData)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
|
||||
import Plutarch.Numeric.Additive (AdditiveMonoid (zero), AdditiveSemigroup ((+)))
|
||||
import Prelude hiding (Num ((+)))
|
||||
|
||||
-- | A wrapper which ensures that no proposal is presented in the transaction.
|
||||
pwithoutProposal ::
|
||||
|
|
@ -393,7 +391,7 @@ pdepositWithdraw = phoistAcyclic $
|
|||
|
||||
newStakedAmount <- pletC $ stakeInputDatumF.stakedAmount + delta
|
||||
|
||||
pguardC "Non-negative staked amount" $ zero #<= newStakedAmount
|
||||
pguardC "Non-negative staked amount" $ 0 #<= newStakedAmount
|
||||
|
||||
let expectedDatum =
|
||||
mkRecordConstr
|
||||
|
|
|
|||
|
|
@ -60,6 +60,7 @@ import Plutarch.Api.V1 (
|
|||
PTokenName,
|
||||
)
|
||||
import Plutarch.Api.V1.AssocMap (plookup)
|
||||
import Plutarch.Api.V1.Value (pvalueOf)
|
||||
import Plutarch.Api.V2 (
|
||||
PMintingPolicy,
|
||||
PScriptPurpose (PMinting, PSpending),
|
||||
|
|
@ -69,8 +70,8 @@ import Plutarch.Api.V2 (
|
|||
)
|
||||
import Plutarch.Extra.AssetClass (
|
||||
PAssetClass,
|
||||
passetClassValueOf,
|
||||
pvalueOf,
|
||||
PAssetClassData,
|
||||
ptoScottEncoding,
|
||||
)
|
||||
import Plutarch.Extra.Field (pletAll)
|
||||
import Plutarch.Extra.Functor (PFunctor (pfmap))
|
||||
|
|
@ -98,12 +99,10 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
|
|||
)
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Extra.Value (
|
||||
passetClassValueOf,
|
||||
psymbolValueOf,
|
||||
)
|
||||
import Plutarch.Num (PNum (pnegate))
|
||||
import Plutarch.SafeMoney (
|
||||
pvalueDiscrete,
|
||||
)
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import Prelude hiding (Num ((+)))
|
||||
|
||||
|
|
@ -133,7 +132,7 @@ import Prelude hiding (Num ((+)))
|
|||
-}
|
||||
stakePolicy ::
|
||||
-- | The (governance) token that a Stake can store.
|
||||
ClosedTerm (PAssetClass :--> PMintingPolicy)
|
||||
ClosedTerm (PAssetClassData :--> PMintingPolicy)
|
||||
stakePolicy =
|
||||
plam $ \gstClass _redeemer ctx' -> unTermCont $ do
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
|
|
@ -217,7 +216,8 @@ stakePolicy =
|
|||
|
||||
let hasExpectedStake =
|
||||
ptraceIfFalse "Stake ouput has expected amount of stake token" $
|
||||
pvalueDiscrete # gstClass # outputF.value #== datumF.stakedAmount
|
||||
passetClassValueOf # (ptoScottEncoding # gstClass) # outputF.value
|
||||
#== pto (pfromData datumF.stakedAmount)
|
||||
let ownerSignsTransaction =
|
||||
ptraceIfFalse "Stake Owner should sign the transaction" $
|
||||
pauthorizedBy
|
||||
|
|
@ -400,10 +400,13 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
# plam
|
||||
( \output ->
|
||||
let validateGT = plam $ \stakeDatum ->
|
||||
let expected = pfield @"stakedAmount" # stakeDatum
|
||||
let expected =
|
||||
pto $
|
||||
pfromData $
|
||||
pfield @"stakedAmount" # stakeDatum
|
||||
|
||||
actual =
|
||||
pvalueDiscrete
|
||||
passetClassValueOf
|
||||
# gstClass
|
||||
# (pfield @"value" # output)
|
||||
in pif
|
||||
|
|
@ -438,8 +441,8 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
flip pletAll $ \txOutF ->
|
||||
let isProposalUTxO =
|
||||
passetClassValueOf
|
||||
# txOutF.value
|
||||
# pstClass #== 1
|
||||
# pstClass
|
||||
# txOutF.value #== 1
|
||||
proposalDatum =
|
||||
pfromData $
|
||||
pfromOutputDatum @(PAsData PProposalDatum)
|
||||
|
|
@ -448,7 +451,7 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
in pif isProposalUTxO (pjust # proposalDatum) pnothing
|
||||
|
||||
let pstMinted =
|
||||
passetClassValueOf # txInfoF.mint # pstClass #== 1
|
||||
passetClassValueOf # pstClass # txInfoF.mint #== 1
|
||||
|
||||
newProposalContext =
|
||||
pcon $
|
||||
|
|
@ -601,15 +604,25 @@ mkStakeValidator impl sstSymbol pstClass gstClass =
|
|||
|
||||
@since 1.0.0
|
||||
-}
|
||||
stakeValidator :: ClosedTerm (PCurrencySymbol :--> PAssetClass :--> PAssetClass :--> PValidator)
|
||||
stakeValidator ::
|
||||
ClosedTerm
|
||||
( PCurrencySymbol
|
||||
:--> PAssetClassData
|
||||
:--> PAssetClassData
|
||||
:--> PValidator
|
||||
)
|
||||
stakeValidator =
|
||||
plam $
|
||||
mkStakeValidator $
|
||||
StakeRedeemerImpl
|
||||
{ onDepositWithdraw = pdepositWithdraw
|
||||
, onDestroy = pdestroy
|
||||
, onPermitVote = ppermitVote
|
||||
, onRetractVote = pretractVote
|
||||
, onDelegateTo = pdelegateTo
|
||||
, onClearDelegate = pclearDelegate
|
||||
}
|
||||
plam $ \cs pstClass gstClass ->
|
||||
mkStakeValidator
|
||||
( StakeRedeemerImpl
|
||||
{ onDepositWithdraw = pdepositWithdraw
|
||||
, onDestroy = pdestroy
|
||||
, onPermitVote = ppermitVote
|
||||
, onRetractVote = pretractVote
|
||||
, onDelegateTo = pdelegateTo
|
||||
, onClearDelegate = pclearDelegate
|
||||
}
|
||||
)
|
||||
cs
|
||||
(ptoScottEncoding # pstClass)
|
||||
(ptoScottEncoding # gstClass)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue