diff --git a/agora-scripts/Main.hs b/agora-scripts/Main.hs index 1be422d..745b1fe 100644 --- a/agora-scripts/Main.hs +++ b/agora-scripts/Main.hs @@ -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) diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index 511e099..5226637 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -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 diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index 30e3225..19ce974 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -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) --- diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index 60c4178..510de7c 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -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 diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 209ace0..56a0dd4 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -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'. diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index 6274218..9a572f3 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -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 diff --git a/agora-specs/Sample/Stake/SetDelegate.hs b/agora-specs/Sample/Stake/SetDelegate.hs index 48cd6b6..c8e7f54 100644 --- a/agora-specs/Sample/Stake/SetDelegate.hs +++ b/agora-specs/Sample/Stake/SetDelegate.hs @@ -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 diff --git a/agora-testlib/Test/Specification.hs b/agora-testlib/Test/Specification.hs index e2c40c8..f74ed66 100644 --- a/agora-testlib/Test/Specification.hs +++ b/agora-testlib/Test/Specification.hs @@ -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) diff --git a/agora.cabal b/agora.cabal index f5f6c28..ff6275d 100644 --- a/agora.cabal +++ b/agora.cabal @@ -81,6 +81,7 @@ common lang TypeSynonymInstances UndecidableInstances ViewPatterns + NoFieldSelectors OverloadedRecordDot default-language: Haskell2010 diff --git a/agora/Agora/Scripts.hs b/agora/Agora/Scripts.hs index 9443b17..933401a 100644 --- a/agora/Agora/Scripts.hs +++ b/agora/Agora/Scripts.hs @@ -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) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 81ddee8..eeaaa52 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -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'. } diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 11e9db9..bc3e60f 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -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 }