encode data as list instead of constr wherever we can

This commit is contained in:
Hongrui Fang 2023-03-10 23:48:40 +08:00
parent 8f201cb36d
commit 179ae4166e
6 changed files with 120 additions and 57 deletions

View file

@ -27,6 +27,7 @@ import Agora.Governor (
) )
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (ptaggedSymbolValueOf) import Agora.Utils (ptaggedSymbolValueOf)
import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCurrencySymbol) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PScriptHash, PScriptHash,
@ -35,10 +36,14 @@ import Plutarch.Api.V2 (
PValidator, PValidator,
) )
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (DerivePConstantViaData),
PDataFields, PDataFields,
) )
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList),
PlutusTypeDataList,
ProductIsData (ProductIsData),
)
import Plutarch.Extra.Maybe (passertPJust, pfromJust) import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
@ -72,8 +77,17 @@ data MutateGovernorDatum = MutateGovernorDatum
, -- | @since 0.1.ç , -- | @since 0.1.ç
Generic Generic
) )
deriving anyclass
PlutusTx.makeIsDataIndexed ''MutateGovernorDatum [('MutateGovernorDatum, 0)] ( -- | @since 1.0.0
SOP.Generic
)
deriving
( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData MutateGovernorDatum)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -107,7 +121,7 @@ newtype PMutateGovernorDatum (s :: S)
) )
instance DerivePlutusType PMutateGovernorDatum where instance DerivePlutusType PMutateGovernorDatum where
type DPTStrat _ = PlutusTypeData type DPTStrat _ = PlutusTypeDataList
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PMutateGovernorDatum where instance PUnsafeLiftDecl PMutateGovernorDatum where
@ -115,12 +129,12 @@ instance PUnsafeLiftDecl PMutateGovernorDatum where
-- | @since 0.1.0 -- | @since 0.1.0
deriving via deriving via
(DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) (DerivePConstantViaDataList MutateGovernorDatum PMutateGovernorDatum)
instance instance
(PConstantDecl MutateGovernorDatum) (PConstantDecl MutateGovernorDatum)
-- | @since 0.1.0 -- | @since 0.1.0
deriving anyclass instance PTryFrom PData PMutateGovernorDatum deriving anyclass instance PTryFrom PData (PAsData PMutateGovernorDatum)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -157,8 +171,8 @@ mutateGovernorValidator ::
:--> PValidator :--> PValidator
) )
mutateGovernorValidator = mutateGovernorValidator =
plam $ \govValidatorHash gstSymbol -> makeEffect @PMutateGovernorDatum $ plam $ \govValidatorHash gstSymbol -> makeEffect @(PAsData PMutateGovernorDatum) $
\_gatCs (effectDatum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do \_gatCs (pfromData -> effectDatum) _ txInfo -> unTermCont $ do
effectDatumF <- pletAllC effectDatum effectDatumF <- pletAllC effectDatum
txInfoF <- pletFieldsC @'["inputs", "outputs", "datums", "redeemers"] txInfo txInfoF <- pletFieldsC @'["inputs", "outputs", "datums", "redeemers"] txInfo
@ -225,9 +239,10 @@ mutateGovernorValidator =
governorOutputDatum = governorOutputDatum =
ptrace "Resolve governor outoput datum" $ ptrace "Resolve governor outoput datum" $
ptryFromOutputDatum @PGovernorDatum pfromData $
# (pfield @"datum" # governorOutput) ptryFromOutputDatum @(PAsData PGovernorDatum)
# txInfoF.datums # (pfield @"datum" # governorOutput)
# txInfoF.datums
pguardC "New governor datum correct" $ pguardC "New governor datum correct" $
governorOutputDatum #== effectDatumF.newDatum governorOutputDatum #== effectDatumF.newDatum

View file

@ -15,6 +15,7 @@ module Agora.Effect.TreasuryWithdrawal (
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.SafeMoney (AuthorityTokenTag) import Agora.SafeMoney (AuthorityTokenTag)
import Generics.SOP qualified as SOP
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PCredential, PCredential,
PCurrencySymbol, PCurrencySymbol,
@ -30,10 +31,15 @@ import Plutarch.Api.V2 (
PValidator, PValidator,
) )
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (DerivePConstantViaData),
PDataFields, PDataFields,
) )
import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.IsData (
DerivePConstantViaDataList (
DerivePConstantViaDataList
),
ProductIsData (ProductIsData),
)
import Plutarch.Extra.ScriptContext (pisPubKey) import Plutarch.Extra.ScriptContext (pisPubKey)
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
@ -41,7 +47,11 @@ import PlutusLedgerApi.V1.Credential (Credential)
import PlutusLedgerApi.V1.Value (Value) import PlutusLedgerApi.V1.Value (Value)
import PlutusTx qualified import PlutusTx qualified
import "liqwid-plutarch-extra" Plutarch.Extra.List (pdeleteFirst) import "liqwid-plutarch-extra" Plutarch.Extra.List (pdeleteFirst)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
pguardC,
pletC,
pletFieldsC,
)
{- | Datum that encodes behavior of Treasury Withdrawal effect. {- | Datum that encodes behavior of Treasury Withdrawal effect.
@ -63,12 +73,17 @@ data TreasuryWithdrawalDatum = TreasuryWithdrawalDatum
, -- | @since 0.1.0 , -- | @since 0.1.0
Generic Generic
) )
deriving anyclass
-- | @since 0.1.0 ( -- | @since 1.0.0
PlutusTx.makeLift ''TreasuryWithdrawalDatum SOP.Generic
)
-- | @since 0.1.0 deriving
PlutusTx.makeIsDataIndexed ''TreasuryWithdrawalDatum [('TreasuryWithdrawalDatum, 0)] ( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData TreasuryWithdrawalDatum)
{- | Haskell-level version of 'TreasuryWithdrawalDatum'. {- | Haskell-level version of 'TreasuryWithdrawalDatum'.
@ -98,7 +113,7 @@ newtype PTreasuryWithdrawalDatum (s :: S)
) )
instance DerivePlutusType PTreasuryWithdrawalDatum where instance DerivePlutusType PTreasuryWithdrawalDatum where
type DPTStrat _ = PlutusTypeData type DPTStrat _ = PlutusTypeNewtype
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where
@ -106,12 +121,12 @@ instance PUnsafeLiftDecl PTreasuryWithdrawalDatum where
-- | @since 0.1.0 -- | @since 0.1.0
deriving via deriving via
(DerivePConstantViaData TreasuryWithdrawalDatum PTreasuryWithdrawalDatum) (DerivePConstantViaDataList TreasuryWithdrawalDatum PTreasuryWithdrawalDatum)
instance instance
(PConstantDecl TreasuryWithdrawalDatum) (PConstantDecl TreasuryWithdrawalDatum)
-- | @since 0.1.0 -- | @since 0.1.0
instance PTryFrom PData PTreasuryWithdrawalDatum instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum)
{- | Withdraws given list of values to specific target addresses. {- | Withdraws given list of values to specific target addresses.
It can be evoked by burning GAT. The transaction should have correct It can be evoked by burning GAT. The transaction should have correct
@ -136,8 +151,8 @@ treasuryWithdrawalValidator ::
forall (s :: S). forall (s :: S).
Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator) Term s (PTagged AuthorityTokenTag PCurrencySymbol :--> PValidator)
treasuryWithdrawalValidator = plam $ treasuryWithdrawalValidator = plam $
makeEffect $ makeEffect @(PAsData PTreasuryWithdrawalDatum) $
\_cs (datum :: Term _ PTreasuryWithdrawalDatum) effectInputRef txInfo -> unTermCont $ do \_cs (pfromData -> datum) effectInputRef txInfo -> unTermCont $ do
datumF <- pletAllC datum datumF <- pletAllC datum
txInfoF <- pletFieldsC @'["outputs", "inputs"] txInfo txInfoF <- pletFieldsC @'["outputs", "inputs"] txInfo

View file

@ -43,22 +43,23 @@ import Agora.Proposal.Time (
import Agora.SafeMoney (GTTag, GovernorSTTag) import Agora.SafeMoney (GTTag, GovernorSTTag)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Tagged (Tagged) import Data.Tagged (Tagged)
import Generics.SOP qualified as SOP
import Optics.TH (makeFieldLabelsNoPrefix) import Optics.TH (makeFieldLabelsNoPrefix)
import Plutarch.Api.V1.Scripts (PRedeemer) import Plutarch.Api.V1.Scripts (PRedeemer)
import Plutarch.Api.V2 (KeyGuarantees (Unsorted), PMap, PScriptPurpose (PSpending), PTxInInfo) import Plutarch.Api.V2 (KeyGuarantees (Unsorted), PMap, PScriptPurpose (PSpending), PTxInInfo)
import Plutarch.DataRepr ( import Plutarch.DataRepr (PDataFields)
DerivePConstantViaData (DerivePConstantViaData),
PDataFields,
)
import Plutarch.Extra.AssetClass (AssetClass, PAssetClass) import Plutarch.Extra.AssetClass (AssetClass, PAssetClass)
import Plutarch.Extra.Bind (PBind ((#>>=))) import Plutarch.Extra.Bind (PBind ((#>>=)))
import Plutarch.Extra.Field (pletAll) import Plutarch.Extra.Field (pletAll)
import Plutarch.Extra.Function (pflip) import Plutarch.Extra.Function (pflip)
import Plutarch.Extra.Functor (PFunctor (pfmap)) import Plutarch.Extra.Functor (PFunctor (pfmap))
import Plutarch.Extra.IsData ( import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList),
DerivePConstantViaEnum (DerivePConstantEnum), DerivePConstantViaEnum (DerivePConstantEnum),
EnumIsData (EnumIsData), EnumIsData (EnumIsData),
PlutusTypeDataList,
PlutusTypeEnumData, PlutusTypeEnumData,
ProductIsData (ProductIsData),
) )
import Plutarch.Extra.Maybe (pjust, pnothing) import Plutarch.Extra.Maybe (pjust, pnothing)
import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.=))
@ -96,12 +97,17 @@ data GovernorDatum = GovernorDatum
, -- | @since 0.1.0 , -- | @since 0.1.0
Generic Generic
) )
deriving anyclass
-- | @since 0.2.1 ( -- | @since 1.0.0
makeFieldLabelsNoPrefix ''GovernorDatum SOP.Generic
)
-- | @since 0.1.0 deriving
PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] ( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData GovernorDatum)
{- | Redeemer for Governor script. The governor has two primary {- | Redeemer for Governor script. The governor has two primary
responsibilities: responsibilities:
@ -205,16 +211,19 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
-- | @since 0.2.0 -- | @since 0.2.0
instance DerivePlutusType PGovernorDatum where instance DerivePlutusType PGovernorDatum where
type DPTStrat _ = PlutusTypeData type DPTStrat _ = PlutusTypeDataList
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted _ = GovernorDatum
-- | @since 0.1.0 -- | @since 0.1.0
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum) deriving via
(DerivePConstantViaDataList GovernorDatum PGovernorDatum)
instance
(PConstantDecl GovernorDatum)
-- | @since 0.1.0 -- | @since 0.1.0
deriving anyclass instance PTryFrom PData PGovernorDatum deriving anyclass instance PTryFrom PData (PAsData PGovernorDatum)
{- | Plutarch-level version of 'GovernorRedeemer'. {- | Plutarch-level version of 'GovernorRedeemer'.

View file

@ -147,9 +147,10 @@ governorPolicy =
governorDatum = governorDatum =
ptrace "Resolve governor datum" $ ptrace "Resolve governor datum" $
ptryFromOutputDatum @PGovernorDatum pfromData $
# txOutF.datum ptryFromOutputDatum @(PAsData PGovernorDatum)
# txInfoF.datums # txOutF.datum
# txInfoF.datums
in pif isGovernorUTxO (pjust # governorDatum) pnothing in pif isGovernorUTxO (pjust # governorDatum) pnothing
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
@ -281,7 +282,7 @@ governorValidator =
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
governorInputDatum <- fst <$> ptryFromC @PGovernorDatum datum governorInputDatum <- pfromData . fst <$> ptryFromC @(PAsData PGovernorDatum) datum
governorInputDatumF <- pletAllC governorInputDatum governorInputDatumF <- pletAllC governorInputDatum
PSpending ((pfield @"_0" #) -> governorInputRef) <- PSpending ((pfield @"_0" #) -> governorInputRef) <-
@ -319,9 +320,10 @@ governorValidator =
datum = datum =
ptrace "Resolve governor datum" $ ptrace "Resolve governor datum" $
ptryFromOutputDatum @PGovernorDatum pfromData $
# outputF.datum ptryFromOutputDatum @(PAsData PGovernorDatum)
# txInfoF.datums # outputF.datum
# txInfoF.datums
in pif in pif
isGovernorUTxO isGovernorUTxO
(pjust # datum) (pjust # datum)

View file

@ -246,8 +246,17 @@ data ProposalThresholds = ProposalThresholds
, -- | @since 0.1.0 , -- | @since 0.1.0
Generic Generic
) )
deriving anyclass
PlutusTx.makeIsDataIndexed 'ProposalThresholds [('ProposalThresholds, 0)] ( -- | @since 1.0.0
SOP.Generic
)
deriving
( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData ProposalThresholds)
{- | Map which encodes the total tally for each result. {- | Map which encodes the total tally for each result.
It's important that the "shape" is consistent with the shape of 'effects'. It's important that the "shape" is consistent with the shape of 'effects'.
@ -585,17 +594,17 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
-- | @since 0.2.0 -- | @since 0.2.0
instance DerivePlutusType PProposalThresholds where instance DerivePlutusType PProposalThresholds where
type DPTStrat _ = PlutusTypeData type DPTStrat _ = PlutusTypeNewtype
-- | @since 0.1.0 -- | @since 0.1.0
instance PTryFrom PData PProposalThresholds instance PTryFrom PData (PAsData PProposalThresholds)
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
-- | @since 0.1.0 -- | @since 0.1.0
deriving via deriving via
(DerivePConstantViaData ProposalThresholds PProposalThresholds) (DerivePConstantViaDataList ProposalThresholds PProposalThresholds)
instance instance
(PConstantDecl ProposalThresholds) (PConstantDecl ProposalThresholds)

View file

@ -32,6 +32,7 @@ module Agora.Proposal.Time (
) where ) where
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Generics.SOP qualified as SOP
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PExtended (PFinite), PExtended (PFinite),
PInterval (PInterval), PInterval (PInterval),
@ -41,13 +42,16 @@ import Plutarch.Api.V1 (
) )
import Plutarch.Api.V2 (PPOSIXTimeRange) import Plutarch.Api.V2 (PPOSIXTimeRange)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..),
PDataFields, PDataFields,
) )
import Plutarch.Extra.Applicative (PApply (pliftA2)) import Plutarch.Extra.Applicative (PApply (pliftA2))
import Plutarch.Extra.Bool (passert) import Plutarch.Extra.Bool (passert)
import Plutarch.Extra.Field (pletAll, pletAllC) import Plutarch.Extra.Field (pletAll, pletAllC)
import Plutarch.Extra.IsData (PlutusTypeEnumData) import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList),
PlutusTypeEnumData,
ProductIsData (ProductIsData),
)
import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing) import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing)
import Plutarch.Extra.Time ( import Plutarch.Extra.Time (
PFullyBoundedTimeRange (PFullyBoundedTimeRange), PFullyBoundedTimeRange (PFullyBoundedTimeRange),
@ -141,8 +145,17 @@ data ProposalTimingConfig = ProposalTimingConfig
, -- | @since 0.1.0 , -- | @since 0.1.0
Generic Generic
) )
deriving anyclass
PlutusTx.makeIsDataIndexed 'ProposalTimingConfig [('ProposalTimingConfig, 0)] ( -- | @since 1.0.0
SOP.Generic
)
deriving
( -- | @since 1.0.0
PlutusTx.ToData
, -- | @since 1.0.0
PlutusTx.FromData
)
via (ProductIsData ProposalTimingConfig)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -239,10 +252,10 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
) )
instance DerivePlutusType PProposalTimingConfig where instance DerivePlutusType PProposalTimingConfig where
type DPTStrat _ = PlutusTypeData type DPTStrat _ = PlutusTypeNewtype
-- | @since 0.1.0 -- | @since 0.1.0
instance PTryFrom PData PProposalTimingConfig instance PTryFrom PData (PAsData PProposalTimingConfig)
-- | @since 0.1.0 -- | @since 0.1.0
instance PUnsafeLiftDecl PProposalTimingConfig where instance PUnsafeLiftDecl PProposalTimingConfig where
@ -250,7 +263,7 @@ instance PUnsafeLiftDecl PProposalTimingConfig where
-- | @since 0.1.0 -- | @since 0.1.0
deriving via deriving via
(DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig) (DerivePConstantViaDataList ProposalTimingConfig PProposalTimingConfig)
instance instance
(PConstantDecl ProposalTimingConfig) (PConstantDecl ProposalTimingConfig)