Merge pull request #180 from Liqwid-Labs/emiflake/no-field-selectors

add NoFieldSelectors flag globally
This commit is contained in:
emiflake 2022-09-19 09:09:50 +02:00 committed by GitHub
commit faa82b0a7e
12 changed files with 58 additions and 57 deletions

View file

@ -151,11 +151,11 @@ data AgoraScripts = AgoraScripts
@since 0.2.0 @since 0.2.0
-} -}
mkPolicyInfo' :: forall redeemer. CompiledMintingPolicy redeemer -> ScriptInfo mkPolicyInfo' :: forall redeemer. CompiledMintingPolicy redeemer -> ScriptInfo
mkPolicyInfo' = mkScriptInfo . getMintingPolicy . getCompiledMintingPolicy mkPolicyInfo' = mkScriptInfo . getMintingPolicy . (.getCompiledMintingPolicy)
{- | Turn a precompiled validator to a 'ScriptInfo'. {- | Turn a precompiled validator to a 'ScriptInfo'.
@since 0.2.0 @since 0.2.0
-} -}
mkValidatorInfo' :: forall redeemer datum. CompiledValidator datum redeemer -> ScriptInfo mkValidatorInfo' :: forall redeemer datum. CompiledValidator datum redeemer -> ScriptInfo
mkValidatorInfo' = mkScriptInfo . getValidator . getCompiledValidator mkValidatorInfo' = mkScriptInfo . getValidator . (.getCompiledValidator)

View file

@ -88,7 +88,7 @@ governorDatumValidProperty =
classifiedPropertyNative gen (const []) expected classifier pisGovernorDatumValid classifiedPropertyNative gen (const []) expected classifier pisGovernorDatumValid
where where
classifier :: GovernorDatum -> GovernorDatumCases classifier :: GovernorDatum -> GovernorDatumCases
classifier (proposalThresholds -> ProposalThresholds e c v) classifier ((.proposalThresholds) -> ProposalThresholds e c v)
| e < 0 = ExecuteLE0 | e < 0 = ExecuteLE0
| c < 0 = CreateLE0 | c < 0 = CreateLE0
| v < 0 = VoteLE0 | v < 0 = VoteLE0

View file

@ -128,7 +128,7 @@ mkProposalOutputDatum ps =
mkStakeInputDatums :: Parameters -> [StakeDatum] mkStakeInputDatums :: Parameters -> [StakeDatum]
mkStakeInputDatums = mkStakeInputDatums =
fmap (\pk -> StakeDatum perStakedGTs pk Nothing []) fmap (\pk -> StakeDatum perStakedGTs pk Nothing [])
. newCosigners . (.newCosigners)
-- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners. -- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
cosign :: forall b. CombinableBuilder b => Parameters -> b cosign :: forall b. CombinableBuilder b => Parameters -> b
@ -231,7 +231,7 @@ mkStakeRef idx =
-- | Create a proposal redeemer which cosigns with the new cosginers. -- | Create a proposal redeemer which cosigns with the new cosginers.
mkProposalRedeemer :: Parameters -> ProposalRedeemer mkProposalRedeemer :: Parameters -> ProposalRedeemer
mkProposalRedeemer = Cosign . sort . newCosigners mkProposalRedeemer = Cosign . sort . (.newCosigners)
--- ---

View file

@ -245,12 +245,12 @@ mkProposalDatumPair params pid =
mkInputVotes Creator _ = mkInputVotes Creator _ =
ProposalVotes $ ProposalVotes $
StrictMap.adjust (const 1000) defVoteFor $ StrictMap.adjust (const 1000) defVoteFor $
getProposalVotes votesTemplate votesTemplate.getProposalVotes
mkInputVotes Irrelevant _ = votesTemplate mkInputVotes Irrelevant _ = votesTemplate
mkInputVotes _ vc = mkInputVotes _ vc =
ProposalVotes $ ProposalVotes $
StrictMap.adjust (const vc) defVoteFor $ StrictMap.adjust (const vc) defVoteFor $
getProposalVotes votesTemplate votesTemplate.getProposalVotes
-- | Create a 'TxInfo' that tries to unlock a stake. -- | Create a 'TxInfo' that tries to unlock a stake.
unlockStake :: forall b. CombinableBuilder b => Parameters -> b unlockStake :: forall b. CombinableBuilder b => Parameters -> b

View file

@ -151,11 +151,11 @@ mkStakeInputDatum params =
-- | Create the proposal redeemer. In this case @'Vote' _@ will always be used. -- | Create the proposal redeemer. In this case @'Vote' _@ will always be used.
mkProposalRedeemer :: Parameters -> ProposalRedeemer mkProposalRedeemer :: Parameters -> ProposalRedeemer
mkProposalRedeemer = Vote . voteFor mkProposalRedeemer params = Vote params.voteFor
-- | Place new proposal locks on the stake. -- | Place new proposal locks on the stake.
mkNewLock :: Parameters -> ProposalLock 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 {- | The stake redeemer that is used in 'mkTestTree'. In this case it'll always be
'PermitVote'. 'PermitVote'.

View file

@ -147,10 +147,10 @@ gstUTXORef :: TxOutRef
gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
govPolicy :: MintingPolicy govPolicy :: MintingPolicy
govPolicy = getCompiledMintingPolicy $ agoraScripts.compiledGovernorPolicy govPolicy = agoraScripts.compiledGovernorPolicy.getCompiledMintingPolicy
govValidator :: Validator govValidator :: Validator
govValidator = getCompiledValidator $ agoraScripts.compiledGovernorValidator govValidator = agoraScripts.compiledGovernorValidator.getCompiledValidator
govSymbol :: CurrencySymbol govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy govSymbol = mintingPolicySymbol govPolicy

View file

@ -75,7 +75,7 @@ data Parameters = Parameters
-- | Select the correct stake redeemer based on the existence of the new delegate. -- | Select the correct stake redeemer based on the existence of the new delegate.
mkStakeRedeemer :: Parameters -> StakeRedeemer mkStakeRedeemer :: Parameters -> StakeRedeemer
mkStakeRedeemer = maybe ClearDelegate (DelegateTo . PubKeyCredential) . newDelegate mkStakeRedeemer params = maybe ClearDelegate (DelegateTo . PubKeyCredential) params.newDelegate
-- | The owner of the input stake. -- | The owner of the input stake.
stakeOwner :: PubKeyHash stakeOwner :: PubKeyHash

View file

@ -198,7 +198,7 @@ applyMintingPolicy' ::
applyMintingPolicy' policy redeemer scriptContext = applyMintingPolicy' policy redeemer scriptContext =
applyMintingPolicyScript applyMintingPolicyScript
(mkContext scriptContext) (mkContext scriptContext)
(getCompiledMintingPolicy policy) policy.getCompiledMintingPolicy
(mkRedeemer redeemer) (mkRedeemer redeemer)
applyValidator' :: applyValidator' ::
@ -213,7 +213,7 @@ applyValidator' ::
applyValidator' validator datum redeemer scriptContext = applyValidator' validator datum redeemer scriptContext =
applyValidator applyValidator
(mkContext scriptContext) (mkContext scriptContext)
(getCompiledValidator validator) validator.getCompiledValidator
(mkDatum datum) (mkDatum datum)
(mkRedeemer redeemer) (mkRedeemer redeemer)

View file

@ -81,6 +81,7 @@ common lang
TypeSynonymInstances TypeSynonymInstances
UndecidableInstances UndecidableInstances
ViewPatterns ViewPatterns
NoFieldSelectors
OverloadedRecordDot OverloadedRecordDot
default-language: Haskell2010 default-language: Haskell2010

View file

@ -64,7 +64,7 @@ data AgoraScripts = AgoraScripts
@since 0.2.0 @since 0.2.0
-} -}
governorSTSymbol :: AgoraScripts -> CurrencySymbol governorSTSymbol :: AgoraScripts -> CurrencySymbol
governorSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledGovernorPolicy governorSTSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledGovernorPolicy)
{- | Get the asset class of the governor state token. {- | Get the asset class of the governor state token.
@ -78,14 +78,14 @@ governorSTAssetClass as = AssetClass (governorSTSymbol as, "")
@since 0.2.0 @since 0.2.0
-} -}
governorValidatorHash :: AgoraScripts -> ValidatorHash governorValidatorHash :: AgoraScripts -> ValidatorHash
governorValidatorHash = validatorHash . getCompiledValidator . compiledGovernorValidator governorValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledGovernorValidator)
{- | Get the currency symbol of the propsoal state token. {- | Get the currency symbol of the propsoal state token.
@since 0.2.0 @since 0.2.0
-} -}
proposalSTSymbol :: AgoraScripts -> CurrencySymbol proposalSTSymbol :: AgoraScripts -> CurrencySymbol
proposalSTSymbol as = mintingPolicySymbol $ getCompiledMintingPolicy as.compiledProposalPolicy proposalSTSymbol as = mintingPolicySymbol $ (.getCompiledMintingPolicy) as.compiledProposalPolicy
{- | Get the asset class of the governor state token. {- | Get the asset class of the governor state token.
@ -99,14 +99,14 @@ proposalSTAssetClass as = AssetClass (proposalSTSymbol as, "")
@since 0.2.0 @since 0.2.0
-} -}
proposalValidatoHash :: AgoraScripts -> ValidatorHash proposalValidatoHash :: AgoraScripts -> ValidatorHash
proposalValidatoHash = validatorHash . getCompiledValidator . compiledProposalValidator proposalValidatoHash = validatorHash . (.getCompiledValidator) . (.compiledProposalValidator)
{- | Get the script hash of the governor validator. {- | Get the script hash of the governor validator.
@since 0.2.0 @since 0.2.0
-} -}
stakeSTSymbol :: AgoraScripts -> CurrencySymbol stakeSTSymbol :: AgoraScripts -> CurrencySymbol
stakeSTSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledStakePolicy stakeSTSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledStakePolicy)
{- | Get the asset class of the stake state token. {- | Get the asset class of the stake state token.
@ -125,18 +125,18 @@ stakeSTAssetClass as =
@since 0.2.0 @since 0.2.0
-} -}
stakeValidatorHash :: AgoraScripts -> ValidatorHash stakeValidatorHash :: AgoraScripts -> ValidatorHash
stakeValidatorHash = validatorHash . getCompiledValidator . compiledStakeValidator stakeValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledStakeValidator)
{- | Get the currency symbol of the authority token. {- | Get the currency symbol of the authority token.
@since 0.2.0 @since 0.2.0
-} -}
authorityTokenSymbol :: AgoraScripts -> CurrencySymbol authorityTokenSymbol :: AgoraScripts -> CurrencySymbol
authorityTokenSymbol = mintingPolicySymbol . getCompiledMintingPolicy . compiledAuthorityTokenPolicy authorityTokenSymbol = mintingPolicySymbol . (.getCompiledMintingPolicy) . (.compiledAuthorityTokenPolicy)
{- | Get the script hash of the treasury validator. {- | Get the script hash of the treasury validator.
@since 0.2.0 @since 0.2.0
-} -}
treasuryValidatorHash :: AgoraScripts -> ValidatorHash treasuryValidatorHash :: AgoraScripts -> ValidatorHash
treasuryValidatorHash = validatorHash . getCompiledValidator . compiledTreasuryValidator treasuryValidatorHash = validatorHash . (.getCompiledValidator) . (.compiledTreasuryValidator)

View file

@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoFieldSelectors #-}
{- | {- |
Module : Agora.Stake Module : Agora.Stake
@ -27,6 +28,7 @@ module Agora.Stake (
PStakeRedeemerHandlerContext (..), PStakeRedeemerHandlerContext (..),
PProposalContext (..), PProposalContext (..),
PStakeRedeemerHandler, PStakeRedeemerHandler,
PStakeRedeemerHandlerTerm (..),
StakeRedeemerImpl (..), StakeRedeemerImpl (..),
-- * Utility functions -- * Utility functions
@ -38,6 +40,7 @@ module Agora.Stake (
pisCreator, pisCreator,
pisPureCreator, pisPureCreator,
pisIrrelevant, pisIrrelevant,
runStakeRedeemerHandler,
) where ) where
import Agora.Proposal (PProposalId, PProposalRedeemer, PResultTag, ProposalId, ResultTag) import Agora.Proposal (PProposalId, PProposalRedeemer, PResultTag, ProposalId, ResultTag)
@ -583,22 +586,31 @@ instance DerivePlutusType PStakeRedeemerHandlerContext where
-} -}
type PStakeRedeemerHandler = PStakeRedeemerHandlerContext :--> PUnit type PStakeRedeemerHandler = PStakeRedeemerHandlerContext :--> PUnit
{- | Newtype wrapper around @'ClosedTerm' 'PStakeRedeemerHandler'@ to allow type inference to work.
@since 1.0.0
-}
newtype PStakeRedeemerHandlerTerm = PStakeRedeemerHandlerTerm (ClosedTerm PStakeRedeemerHandler)
runStakeRedeemerHandler :: PStakeRedeemerHandlerTerm -> ClosedTerm PStakeRedeemerHandler
runStakeRedeemerHandler (PStakeRedeemerHandlerTerm t) = t
{- | A collection of stake redeemer handlers for each stake redeemers. {- | A collection of stake redeemer handlers for each stake redeemers.
@since 1.0.0 @since 1.0.0
-} -}
data StakeRedeemerImpl = StakeRedeemerImpl data StakeRedeemerImpl = StakeRedeemerImpl
{ onDepositWithdraw :: ClosedTerm PStakeRedeemerHandler { onDepositWithdraw :: PStakeRedeemerHandlerTerm
-- ^ Handler for 'DepositWithdraw'. -- ^ Handler for 'DepositWithdraw'.
, onDestroy :: ClosedTerm PStakeRedeemerHandler , onDestroy :: PStakeRedeemerHandlerTerm
-- ^ Handler for 'Destroy'. -- ^ Handler for 'Destroy'.
, onPermitVote :: ClosedTerm PStakeRedeemerHandler , onPermitVote :: PStakeRedeemerHandlerTerm
-- ^ Handler for 'permitVotes'. -- ^ Handler for 'permitVotes'.
, onRetractVote :: ClosedTerm PStakeRedeemerHandler , onRetractVote :: PStakeRedeemerHandlerTerm
-- ^ Handler for 'RetractVotes'. -- ^ Handler for 'RetractVotes'.
, onDelegateTo :: ClosedTerm PStakeRedeemerHandler , onDelegateTo :: PStakeRedeemerHandlerTerm
-- ^ Handler for 'DelegateTo'. -- ^ Handler for 'DelegateTo'.
, onClearDelegate :: ClosedTerm PStakeRedeemerHandler , onClearDelegate :: PStakeRedeemerHandlerTerm
-- ^ handler for 'ClearDelegate'. -- ^ handler for 'ClearDelegate'.
} }

View file

@ -33,14 +33,7 @@ import Agora.Stake (
PStakeDatum, PStakeDatum,
PStakeInputContext (PStakeInput), PStakeInputContext (PStakeInput),
PStakeOutputContext (PStakeBurnt, PStakeOutput), PStakeOutputContext (PStakeBurnt, PStakeOutput),
PStakeRedeemer ( PStakeRedeemer (PClearDelegate, PDelegateTo, PDepositWithdraw, PDestroy, PPermitVote, PRetractVotes),
PClearDelegate,
PDelegateTo,
PDepositWithdraw,
PDestroy,
PPermitVote,
PRetractVotes
),
PStakeRedeemerContext ( PStakeRedeemerContext (
PDepositWithdrawDelta, PDepositWithdrawDelta,
PNoMetadata, PNoMetadata,
@ -49,16 +42,10 @@ import Agora.Stake (
PStakeRedeemerHandlerContext ( PStakeRedeemerHandlerContext (
PStakeRedeemerHandlerContext PStakeRedeemerHandlerContext
), ),
StakeRedeemerImpl ( PStakeRedeemerHandlerTerm (PStakeRedeemerHandlerTerm),
StakeRedeemerImpl, StakeRedeemerImpl (..),
onClearDelegate,
onDelegateTo,
onDepositWithdraw,
onDestroy,
onPermitVote,
onRetractVote
),
pstakeLocked, pstakeLocked,
runStakeRedeemerHandler,
) )
import Agora.Stake.Redeemers ( import Agora.Stake.Redeemers (
pclearDelegate, pclearDelegate,
@ -463,16 +450,17 @@ mkStakeValidator
pure $ pure $
popaque $ popaque $
pmatch stakeRedeemer $ \case pmatch stakeRedeemer $ \case
PDestroy _ -> onDestroy impl # noMetadataContext PDestroy _ -> runStakeRedeemerHandler impl.onDestroy # noMetadataContext
PPermitVote _ -> onPermitVote impl # noMetadataContext PPermitVote _ -> runStakeRedeemerHandler impl.onPermitVote # noMetadataContext
PRetractVotes _ -> onRetractVote impl # noMetadataContext PRetractVotes _ -> runStakeRedeemerHandler impl.onRetractVote # noMetadataContext
PClearDelegate _ -> onClearDelegate impl # noMetadataContext PClearDelegate _ -> runStakeRedeemerHandler impl.onClearDelegate # noMetadataContext
PDelegateTo ((pfield @"pkh" #) -> pkh) -> PDelegateTo ((pfield @"pkh" #) -> pkh) ->
onDelegateTo impl #$ mkRedeemerhandlerContext runStakeRedeemerHandler impl.onDelegateTo
#$ mkRedeemerhandlerContext
#$ pcon #$ pcon
$ PSetDelegateTo pkh $ PSetDelegateTo pkh
PDepositWithdraw ((pfield @"delta" #) -> delta) -> PDepositWithdraw ((pfield @"delta" #) -> delta) ->
onDepositWithdraw impl #$ mkRedeemerhandlerContext runStakeRedeemerHandler impl.onDepositWithdraw #$ mkRedeemerhandlerContext
#$ pcon #$ pcon
$ PDepositWithdrawDelta delta $ PDepositWithdrawDelta delta
@ -527,10 +515,10 @@ stakeValidator ::
stakeValidator = stakeValidator =
mkStakeValidator $ mkStakeValidator $
StakeRedeemerImpl StakeRedeemerImpl
{ onDepositWithdraw = pdepositWithdraw { onDepositWithdraw = PStakeRedeemerHandlerTerm pdepositWithdraw
, onDestroy = pdestroy , onDestroy = PStakeRedeemerHandlerTerm pdestroy
, onPermitVote = ppermitVote , onPermitVote = PStakeRedeemerHandlerTerm ppermitVote
, onRetractVote = pretractVote , onRetractVote = PStakeRedeemerHandlerTerm pretractVote
, onDelegateTo = pdelegateTo , onDelegateTo = PStakeRedeemerHandlerTerm pdelegateTo
, onClearDelegate = pclearDelegate , onClearDelegate = PStakeRedeemerHandlerTerm pclearDelegate
} }