derive list encoded types with PlutusTypeDataList
This commit is contained in:
parent
b2aefbe502
commit
f6b36abfc6
3 changed files with 84 additions and 14 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue