add NoFieldSelectors flag globally
This commit is contained in:
parent
3c2ea60273
commit
e3eab7de7e
12 changed files with 54 additions and 57 deletions
|
|
@ -151,11 +151,11 @@ data AgoraScripts = AgoraScripts
|
|||
@since 0.2.0
|
||||
-}
|
||||
mkPolicyInfo' :: forall redeemer. CompiledMintingPolicy redeemer -> ScriptInfo
|
||||
mkPolicyInfo' = mkScriptInfo . getMintingPolicy . getCompiledMintingPolicy
|
||||
mkPolicyInfo' = mkScriptInfo . getMintingPolicy . (.getCompiledMintingPolicy)
|
||||
|
||||
{- | Turn a precompiled validator to a 'ScriptInfo'.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
mkValidatorInfo' :: forall redeemer datum. CompiledValidator datum redeemer -> ScriptInfo
|
||||
mkValidatorInfo' = mkScriptInfo . getValidator . getCompiledValidator
|
||||
mkValidatorInfo' = mkScriptInfo . getValidator . (.getCompiledValidator)
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@ governorDatumValidProperty =
|
|||
classifiedPropertyNative gen (const []) expected classifier pisGovernorDatumValid
|
||||
where
|
||||
classifier :: GovernorDatum -> GovernorDatumCases
|
||||
classifier (proposalThresholds -> ProposalThresholds e c v)
|
||||
classifier ((.proposalThresholds) -> ProposalThresholds e c v)
|
||||
| e < 0 = ExecuteLE0
|
||||
| c < 0 = CreateLE0
|
||||
| v < 0 = VoteLE0
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ mkProposalOutputDatum ps =
|
|||
mkStakeInputDatums :: Parameters -> [StakeDatum]
|
||||
mkStakeInputDatums =
|
||||
fmap (\pk -> StakeDatum perStakedGTs pk Nothing [])
|
||||
. newCosigners
|
||||
. (.newCosigners)
|
||||
|
||||
-- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
|
||||
cosign :: forall b. CombinableBuilder b => Parameters -> b
|
||||
|
|
@ -231,7 +231,7 @@ mkStakeRef idx =
|
|||
|
||||
-- | Create a proposal redeemer which cosigns with the new cosginers.
|
||||
mkProposalRedeemer :: Parameters -> ProposalRedeemer
|
||||
mkProposalRedeemer = Cosign . sort . newCosigners
|
||||
mkProposalRedeemer = Cosign . sort . (.newCosigners)
|
||||
|
||||
---
|
||||
|
||||
|
|
|
|||
|
|
@ -245,12 +245,12 @@ mkProposalDatumPair params pid =
|
|||
mkInputVotes Creator _ =
|
||||
ProposalVotes $
|
||||
StrictMap.adjust (const 1000) defVoteFor $
|
||||
getProposalVotes votesTemplate
|
||||
votesTemplate.getProposalVotes
|
||||
mkInputVotes Irrelevant _ = votesTemplate
|
||||
mkInputVotes _ vc =
|
||||
ProposalVotes $
|
||||
StrictMap.adjust (const vc) defVoteFor $
|
||||
getProposalVotes votesTemplate
|
||||
votesTemplate.getProposalVotes
|
||||
|
||||
-- | Create a 'TxInfo' that tries to unlock a stake.
|
||||
unlockStake :: forall b. CombinableBuilder b => Parameters -> b
|
||||
|
|
|
|||
|
|
@ -151,11 +151,11 @@ mkStakeInputDatum params =
|
|||
|
||||
-- | Create the proposal redeemer. In this case @'Vote' _@ will always be used.
|
||||
mkProposalRedeemer :: Parameters -> ProposalRedeemer
|
||||
mkProposalRedeemer = Vote . voteFor
|
||||
mkProposalRedeemer params = Vote params.voteFor
|
||||
|
||||
-- | Place new proposal locks on the stake.
|
||||
mkNewLock :: Parameters -> ProposalLock
|
||||
mkNewLock = Voted proposalInputDatum.proposalId . voteFor
|
||||
mkNewLock params = Voted proposalInputDatum.proposalId params.voteFor
|
||||
|
||||
{- | The stake redeemer that is used in 'mkTestTree'. In this case it'll always be
|
||||
'PermitVote'.
|
||||
|
|
|
|||
|
|
@ -147,10 +147,10 @@ gstUTXORef :: TxOutRef
|
|||
gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
|
||||
|
||||
govPolicy :: MintingPolicy
|
||||
govPolicy = getCompiledMintingPolicy $ agoraScripts.compiledGovernorPolicy
|
||||
govPolicy = agoraScripts.compiledGovernorPolicy.getCompiledMintingPolicy
|
||||
|
||||
govValidator :: Validator
|
||||
govValidator = getCompiledValidator $ agoraScripts.compiledGovernorValidator
|
||||
govValidator = agoraScripts.compiledGovernorValidator.getCompiledValidator
|
||||
|
||||
govSymbol :: CurrencySymbol
|
||||
govSymbol = mintingPolicySymbol govPolicy
|
||||
|
|
|
|||
|
|
@ -75,7 +75,7 @@ data Parameters = Parameters
|
|||
|
||||
-- | Select the correct stake redeemer based on the existence of the new delegate.
|
||||
mkStakeRedeemer :: Parameters -> StakeRedeemer
|
||||
mkStakeRedeemer = maybe ClearDelegate (DelegateTo . PubKeyCredential) . newDelegate
|
||||
mkStakeRedeemer params = maybe ClearDelegate (DelegateTo . PubKeyCredential) params.newDelegate
|
||||
|
||||
-- | The owner of the input stake.
|
||||
stakeOwner :: PubKeyHash
|
||||
|
|
|
|||
|
|
@ -198,7 +198,7 @@ applyMintingPolicy' ::
|
|||
applyMintingPolicy' policy redeemer scriptContext =
|
||||
applyMintingPolicyScript
|
||||
(mkContext scriptContext)
|
||||
(getCompiledMintingPolicy policy)
|
||||
policy.getCompiledMintingPolicy
|
||||
(mkRedeemer redeemer)
|
||||
|
||||
applyValidator' ::
|
||||
|
|
@ -213,7 +213,7 @@ applyValidator' ::
|
|||
applyValidator' validator datum redeemer scriptContext =
|
||||
applyValidator
|
||||
(mkContext scriptContext)
|
||||
(getCompiledValidator validator)
|
||||
validator.getCompiledValidator
|
||||
(mkDatum datum)
|
||||
(mkRedeemer redeemer)
|
||||
|
||||
|
|
|
|||
|
|
@ -81,6 +81,7 @@ common lang
|
|||
TypeSynonymInstances
|
||||
UndecidableInstances
|
||||
ViewPatterns
|
||||
NoFieldSelectors
|
||||
OverloadedRecordDot
|
||||
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ data AgoraScripts = AgoraScripts
|
|||
@since 0.2.0
|
||||
-}
|
||||
governorSTSymbol :: AgoraScripts -> CurrencySymbol
|
||||
governorSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledGovernorPolicy
|
||||
governorSTSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledGovernorPolicy)
|
||||
|
||||
{- | Get the asset class of the governor state token.
|
||||
|
||||
|
|
@ -78,14 +78,14 @@ governorSTAssetClass as = AssetClass (governorSTSymbol as, "")
|
|||
@since 0.2.0
|
||||
-}
|
||||
governorValidatorHash :: AgoraScripts -> ValidatorHash
|
||||
governorValidatorHash = validatorHash . getCompiledValidator . compiledGovernorValidator
|
||||
governorValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledGovernorValidator)
|
||||
|
||||
{- | Get the currency symbol of the propsoal state token.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
proposalSTSymbol :: AgoraScripts -> CurrencySymbol
|
||||
proposalSTSymbol as = mintingPolicySymbol $ getCompiledMintingPolicy as.compiledProposalPolicy
|
||||
proposalSTSymbol as = mintingPolicySymbol $ (.getCompiledMintingPolicy) as.compiledProposalPolicy
|
||||
|
||||
{- | Get the asset class of the governor state token.
|
||||
|
||||
|
|
@ -99,14 +99,14 @@ proposalSTAssetClass as = AssetClass (proposalSTSymbol as, "")
|
|||
@since 0.2.0
|
||||
-}
|
||||
proposalValidatoHash :: AgoraScripts -> ValidatorHash
|
||||
proposalValidatoHash = validatorHash . getCompiledValidator . compiledProposalValidator
|
||||
proposalValidatoHash = validatorHash . (.getCompiledValidator) . (.compiledProposalValidator)
|
||||
|
||||
{- | Get the script hash of the governor validator.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
stakeSTSymbol :: AgoraScripts -> CurrencySymbol
|
||||
stakeSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledStakePolicy
|
||||
stakeSTSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledStakePolicy)
|
||||
|
||||
{- | Get the asset class of the stake state token.
|
||||
|
||||
|
|
@ -125,18 +125,18 @@ stakeSTAssetClass as =
|
|||
@since 0.2.0
|
||||
-}
|
||||
stakeValidatorHash :: AgoraScripts -> ValidatorHash
|
||||
stakeValidatorHash = validatorHash . getCompiledValidator . compiledStakeValidator
|
||||
stakeValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledStakeValidator)
|
||||
|
||||
{- | Get the currency symbol of the authority token.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
authorityTokenSymbol :: AgoraScripts -> CurrencySymbol
|
||||
authorityTokenSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledAuthorityTokenPolicy
|
||||
authorityTokenSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledAuthorityTokenPolicy)
|
||||
|
||||
{- | Get the script hash of the treasury validator.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
treasuryValidatorHash :: AgoraScripts -> ValidatorHash
|
||||
treasuryValidatorHash = validatorHash . getCompiledValidator . compiledTreasuryValidator
|
||||
treasuryValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledTreasuryValidator)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE NoFieldSelectors #-}
|
||||
|
||||
{- |
|
||||
Module : Agora.Stake
|
||||
|
|
@ -27,6 +28,7 @@ module Agora.Stake (
|
|||
PStakeRedeemerHandlerContext (..),
|
||||
PProposalContext (..),
|
||||
PStakeRedeemerHandler,
|
||||
PStakeRedeemerHandlerTerm (..),
|
||||
StakeRedeemerImpl (..),
|
||||
|
||||
-- * Utility functions
|
||||
|
|
@ -38,6 +40,7 @@ module Agora.Stake (
|
|||
pisCreator,
|
||||
pisPureCreator,
|
||||
pisIrrelevant,
|
||||
runStakeRedeemerHandler,
|
||||
) where
|
||||
|
||||
import Agora.Proposal (PProposalId, PProposalRedeemer, PResultTag, ProposalId, ResultTag)
|
||||
|
|
@ -583,22 +586,27 @@ instance DerivePlutusType PStakeRedeemerHandlerContext where
|
|||
-}
|
||||
type PStakeRedeemerHandler = PStakeRedeemerHandlerContext :--> PUnit
|
||||
|
||||
newtype PStakeRedeemerHandlerTerm = PStakeRedeemerHandlerTerm (ClosedTerm PStakeRedeemerHandler)
|
||||
|
||||
runStakeRedeemerHandler :: PStakeRedeemerHandlerTerm -> ClosedTerm PStakeRedeemerHandler
|
||||
runStakeRedeemerHandler (PStakeRedeemerHandlerTerm t) = t
|
||||
|
||||
{- | A collection of stake redeemer handlers for each stake redeemers.
|
||||
|
||||
@since 1.0.0
|
||||
-}
|
||||
data StakeRedeemerImpl = StakeRedeemerImpl
|
||||
{ onDepositWithdraw :: ClosedTerm PStakeRedeemerHandler
|
||||
{ onDepositWithdraw :: PStakeRedeemerHandlerTerm
|
||||
-- ^ Handler for 'DepositWithdraw'.
|
||||
, onDestroy :: ClosedTerm PStakeRedeemerHandler
|
||||
, onDestroy :: PStakeRedeemerHandlerTerm
|
||||
-- ^ Handler for 'Destroy'.
|
||||
, onPermitVote :: ClosedTerm PStakeRedeemerHandler
|
||||
, onPermitVote :: PStakeRedeemerHandlerTerm
|
||||
-- ^ Handler for 'permitVotes'.
|
||||
, onRetractVote :: ClosedTerm PStakeRedeemerHandler
|
||||
, onRetractVote :: PStakeRedeemerHandlerTerm
|
||||
-- ^ Handler for 'RetractVotes'.
|
||||
, onDelegateTo :: ClosedTerm PStakeRedeemerHandler
|
||||
, onDelegateTo :: PStakeRedeemerHandlerTerm
|
||||
-- ^ Handler for 'DelegateTo'.
|
||||
, onClearDelegate :: ClosedTerm PStakeRedeemerHandler
|
||||
, onClearDelegate :: PStakeRedeemerHandlerTerm
|
||||
-- ^ handler for 'ClearDelegate'.
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -33,14 +33,7 @@ import Agora.Stake (
|
|||
PStakeDatum,
|
||||
PStakeInputContext (PStakeInput),
|
||||
PStakeOutputContext (PStakeBurnt, PStakeOutput),
|
||||
PStakeRedeemer (
|
||||
PClearDelegate,
|
||||
PDelegateTo,
|
||||
PDepositWithdraw,
|
||||
PDestroy,
|
||||
PPermitVote,
|
||||
PRetractVotes
|
||||
),
|
||||
PStakeRedeemer (PClearDelegate, PDelegateTo, PDepositWithdraw, PDestroy, PPermitVote, PRetractVotes),
|
||||
PStakeRedeemerContext (
|
||||
PDepositWithdrawDelta,
|
||||
PNoMetadata,
|
||||
|
|
@ -49,16 +42,10 @@ import Agora.Stake (
|
|||
PStakeRedeemerHandlerContext (
|
||||
PStakeRedeemerHandlerContext
|
||||
),
|
||||
StakeRedeemerImpl (
|
||||
StakeRedeemerImpl,
|
||||
onClearDelegate,
|
||||
onDelegateTo,
|
||||
onDepositWithdraw,
|
||||
onDestroy,
|
||||
onPermitVote,
|
||||
onRetractVote
|
||||
),
|
||||
PStakeRedeemerHandlerTerm (PStakeRedeemerHandlerTerm),
|
||||
StakeRedeemerImpl (..),
|
||||
pstakeLocked,
|
||||
runStakeRedeemerHandler,
|
||||
)
|
||||
import Agora.Stake.Redeemers (
|
||||
pclearDelegate,
|
||||
|
|
@ -463,16 +450,17 @@ mkStakeValidator
|
|||
pure $
|
||||
popaque $
|
||||
pmatch stakeRedeemer $ \case
|
||||
PDestroy _ -> onDestroy impl # noMetadataContext
|
||||
PPermitVote _ -> onPermitVote impl # noMetadataContext
|
||||
PRetractVotes _ -> onRetractVote impl # noMetadataContext
|
||||
PClearDelegate _ -> onClearDelegate impl # noMetadataContext
|
||||
PDestroy _ -> runStakeRedeemerHandler impl.onDestroy # noMetadataContext
|
||||
PPermitVote _ -> runStakeRedeemerHandler impl.onPermitVote # noMetadataContext
|
||||
PRetractVotes _ -> runStakeRedeemerHandler impl.onRetractVote # noMetadataContext
|
||||
PClearDelegate _ -> runStakeRedeemerHandler impl.onClearDelegate # noMetadataContext
|
||||
PDelegateTo ((pfield @"pkh" #) -> pkh) ->
|
||||
onDelegateTo impl #$ mkRedeemerhandlerContext
|
||||
runStakeRedeemerHandler impl.onDelegateTo
|
||||
#$ mkRedeemerhandlerContext
|
||||
#$ pcon
|
||||
$ PSetDelegateTo pkh
|
||||
PDepositWithdraw ((pfield @"delta" #) -> delta) ->
|
||||
onDepositWithdraw impl #$ mkRedeemerhandlerContext
|
||||
runStakeRedeemerHandler impl.onDepositWithdraw #$ mkRedeemerhandlerContext
|
||||
#$ pcon
|
||||
$ PDepositWithdrawDelta delta
|
||||
|
||||
|
|
@ -527,10 +515,10 @@ stakeValidator ::
|
|||
stakeValidator =
|
||||
mkStakeValidator $
|
||||
StakeRedeemerImpl
|
||||
{ onDepositWithdraw = pdepositWithdraw
|
||||
, onDestroy = pdestroy
|
||||
, onPermitVote = ppermitVote
|
||||
, onRetractVote = pretractVote
|
||||
, onDelegateTo = pdelegateTo
|
||||
, onClearDelegate = pclearDelegate
|
||||
{ onDepositWithdraw = PStakeRedeemerHandlerTerm pdepositWithdraw
|
||||
, onDestroy = PStakeRedeemerHandlerTerm pdestroy
|
||||
, onPermitVote = PStakeRedeemerHandlerTerm ppermitVote
|
||||
, onRetractVote = PStakeRedeemerHandlerTerm pretractVote
|
||||
, onDelegateTo = PStakeRedeemerHandlerTerm pdelegateTo
|
||||
, onClearDelegate = PStakeRedeemerHandlerTerm pclearDelegate
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue