derive list encoded types with PlutusTypeDataList

This commit is contained in:
Hongrui Fang 2022-09-02 19:08:55 +08:00 committed by 方泓睿
parent b2aefbe502
commit f6b36abfc6
3 changed files with 84 additions and 14 deletions

View file

@ -87,7 +87,6 @@ import Plutarch.Extra.ScriptContext (
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Extra.Tuple (pfstTuple, psndTuple)
import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf) import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
@ -519,7 +518,7 @@ governorValidator as =
let tagToken :: Term _ PTokenName let tagToken :: Term _ PTokenName
tagToken = tagToken =
pmaybeData # pconstant "" # plam (pscriptHashToTokenName . pfromData) pmaybeData # pconstant "" # plam (pscriptHashToTokenName . pfromData)
#$ psndTuple # effect #$ pfield @"scriptHash" # effect
receiverScriptHash = receiverScriptHash =
passertPJust # "GAT receiver should be a script" passertPJust # "GAT receiver should be a script"
#$ pscriptHashFromAddress # outputF.address #$ pscriptHashFromAddress # outputF.address
@ -530,7 +529,7 @@ governorValidator as =
authorityTokens authorityTokens
#== psingleton # (ppairDataBuiltin # pdata tagToken # pdata 1) #== psingleton # (ppairDataBuiltin # pdata tagToken # pdata 1)
hasCorrectDatum = hasCorrectDatum =
pfstTuple # effect #== pfromDatumHash # outputF.datum pfield @"datumHash" # effect #== pfromDatumHash # outputF.datum
pure $ pure $
foldr1 foldr1

View file

@ -60,7 +60,6 @@ import Plutarch.Api.V2 (
PDatumHash, PDatumHash,
PMaybeData, PMaybeData,
PScriptHash, PScriptHash,
PTuple,
) )
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData ( DerivePConstantViaData (
@ -75,6 +74,7 @@ import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList), DerivePConstantViaDataList (DerivePConstantViaDataList),
DerivePConstantViaEnum (DerivePConstantEnum), DerivePConstantViaEnum (DerivePConstantEnum),
EnumIsData (EnumIsData), EnumIsData (EnumIsData),
PlutusTypeDataList,
PlutusTypeEnumData, PlutusTypeEnumData,
ProductIsData (ProductIsData), ProductIsData (ProductIsData),
) )
@ -285,8 +285,35 @@ newtype ProposalVotes = ProposalVotes
emptyVotesFor :: forall a. StrictMap.Map ResultTag a -> ProposalVotes emptyVotesFor :: forall a. StrictMap.Map ResultTag a -> ProposalVotes
emptyVotesFor = ProposalVotes . StrictMap.mapWithKey (const . const 0) emptyVotesFor = ProposalVotes . StrictMap.mapWithKey (const . const 0)
-- | @since 1.0.0
data ProposalEffectMetadata = ProposalEffectMetadata
{ datumHash :: DatumHash
-- ^ Hash of datum sent to effect validator with GAT
, scriptHash :: Maybe ScriptHash
-- ^ A 'ScriptHash' that encodes the authority script.
}
deriving stock
( -- | @since 1.0.0
Generic
, -- | @since 1.0.0
Show
, -- | @since 1.0.0
Eq
)
deriving anyclass
( -- | @since 1.0.0
SOP.Generic
)
deriving
( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData ProposalEffectMetadata)
-- | @since 0.3.0 -- | @since 0.3.0
type ProposalEffectGroup = StrictMap.Map ValidatorHash (DatumHash, Maybe ScriptHash) type ProposalEffectGroup = StrictMap.Map ValidatorHash ProposalEffectMetadata
{- | Haskell-level datum for Proposal scripts. {- | Haskell-level datum for Proposal scripts.
@ -608,6 +635,52 @@ deriving via
instance instance
(PConstantDecl ProposalVotes) (PConstantDecl ProposalVotes)
{- | Plutarch-level version of 'ProposalEffectMetadata'.
@since 1.0.0
-}
newtype PProposalEffectMetadata (s :: S)
= PProposalEffectMetadata
( Term
s
( PDataRecord
'[ "datumHash" ':= PDatumHash
, "scriptHash" ':= PMaybeData (PAsData PScriptHash)
]
)
)
deriving stock
( -- | @since 1.0.0
Generic
)
deriving anyclass
( -- | @since 1.0.0
PlutusType
, -- | @since 1.0.0
PIsData
, -- | @since 1.0.0
PEq
, -- | @since 1.0.0
PDataFields
)
-- | @since 1.0.0
instance DerivePlutusType PProposalEffectMetadata where
type DPTStrat _ = PlutusTypeDataList
-- | @since 1.0.0
instance PUnsafeLiftDecl PProposalEffectMetadata where
type PLifted _ = ProposalEffectMetadata
-- | @since 1.0.0
deriving via
(DerivePConstantViaDataList ProposalEffectMetadata PProposalEffectMetadata)
instance
(PConstantDecl ProposalEffectMetadata)
-- | @since 1.0.0
instance PTryFrom PData (PAsData PProposalEffectMetadata)
{- | The effect script hashes and their associated datum hash and authority check script hash {- | The effect script hashes and their associated datum hash and authority check script hash
belonging to a particular effect group or result. belonging to a particular effect group or result.
@ -617,10 +690,7 @@ type PProposalEffectGroup =
PMap PMap
'Sorted 'Sorted
PValidatorHash PValidatorHash
( PTuple PProposalEffectMetadata
PDatumHash
(PMaybeData (PAsData PScriptHash))
)
{- | Plutarch-level version of 'ProposalDatum'. {- | Plutarch-level version of 'ProposalDatum'.
@ -657,12 +727,12 @@ newtype PProposalDatum (s :: S) = PProposalDatum
-- | @since 0.2.0 -- | @since 0.2.0
instance DerivePlutusType PProposalDatum where instance DerivePlutusType PProposalDatum where
type DPTStrat _ = PlutusTypeNewtype type DPTStrat _ = PlutusTypeDataList
instance PTryFrom PData (PAsData PProposalDatum) instance PTryFrom PData (PAsData PProposalDatum)
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PProposalDatum where type PLifted PProposalDatum = ProposalDatum instance PUnsafeLiftDecl PProposalDatum where type PLifted _ = ProposalDatum
-- | @since 0.1.0 -- | @since 0.1.0
deriving via (DerivePConstantViaDataList ProposalDatum PProposalDatum) instance (PConstantDecl ProposalDatum) deriving via (DerivePConstantViaDataList ProposalDatum PProposalDatum) instance (PConstantDecl ProposalDatum)

View file

@ -44,6 +44,7 @@ import Plutarch.DataRepr (
import Plutarch.Extra.Field (pletAll) import Plutarch.Extra.Field (pletAll)
import Plutarch.Extra.IsData ( import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList), DerivePConstantViaDataList (DerivePConstantViaDataList),
PlutusTypeDataList,
ProductIsData (ProductIsData), ProductIsData (ProductIsData),
) )
import Plutarch.Extra.List (pnotNull) import Plutarch.Extra.List (pnotNull)
@ -51,7 +52,7 @@ import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
import Plutarch.Orphans () import Plutarch.Orphans ()
import Plutarch.SafeMoney (PDiscrete) import Plutarch.SafeMoney (Discrete, PDiscrete)
import PlutusLedgerApi.V2 (Credential) import PlutusLedgerApi.V2 (Credential)
import PlutusTx qualified import PlutusTx qualified
import Prelude hiding (Num (..)) import Prelude hiding (Num (..))
@ -170,7 +171,7 @@ PlutusTx.makeIsDataIndexed
@since 0.1.0 @since 0.1.0
-} -}
data StakeDatum = StakeDatum data StakeDatum = StakeDatum
{ stakedAmount :: Tagged GTTag Integer { stakedAmount :: Discrete GTTag
-- ^ Tracks the amount of governance token staked in the datum. -- ^ Tracks the amount of governance token staked in the datum.
-- This also acts as the voting weight for 'Agora.Proposal.Proposal's. -- This also acts as the voting weight for 'Agora.Proposal.Proposal's.
, owner :: Credential , owner :: Credential
@ -234,7 +235,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum
) )
instance DerivePlutusType PStakeDatum where instance DerivePlutusType PStakeDatum where
type DPTStrat _ = PlutusTypeNewtype type DPTStrat _ = PlutusTypeDataList
-- | @since 0.1.0 -- | @since 0.1.0
instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where