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 b78b08759e
commit 12920e6cdc
No known key found for this signature in database
GPG key ID: F2D0D08AF77AC599
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.Utils (ptaggedSymbolValueOf)
import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V2 (
PScriptHash,
@ -35,10 +36,14 @@ import Plutarch.Api.V2 (
PValidator,
)
import Plutarch.DataRepr (
DerivePConstantViaData (DerivePConstantViaData),
PDataFields,
)
import Plutarch.Extra.Field (pletAll, pletAllC)
import Plutarch.Extra.IsData (
DerivePConstantViaDataList (DerivePConstantViaDataList),
PlutusTypeDataList,
ProductIsData (ProductIsData),
)
import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.Record (mkRecordConstr, (.=))
import Plutarch.Extra.ScriptContext (
@ -72,8 +77,17 @@ data MutateGovernorDatum = MutateGovernorDatum
, -- | @since 0.1.ç
Generic
)
PlutusTx.makeIsDataIndexed ''MutateGovernorDatum [('MutateGovernorDatum, 0)]
deriving anyclass
( -- | @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
type DPTStrat _ = PlutusTypeData
type DPTStrat _ = PlutusTypeDataList
-- | @since 0.1.0
instance PUnsafeLiftDecl PMutateGovernorDatum where
@ -115,12 +129,12 @@ instance PUnsafeLiftDecl PMutateGovernorDatum where
-- | @since 0.1.0
deriving via
(DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum)
(DerivePConstantViaDataList MutateGovernorDatum PMutateGovernorDatum)
instance
(PConstantDecl MutateGovernorDatum)
-- | @since 0.1.0
deriving anyclass instance PTryFrom PData PMutateGovernorDatum
deriving anyclass instance PTryFrom PData (PAsData PMutateGovernorDatum)
--------------------------------------------------------------------------------
@ -157,8 +171,8 @@ mutateGovernorValidator ::
:--> PValidator
)
mutateGovernorValidator =
plam $ \govValidatorHash gstSymbol -> makeEffect @PMutateGovernorDatum $
\_gatCs (effectDatum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do
plam $ \govValidatorHash gstSymbol -> makeEffect @(PAsData PMutateGovernorDatum) $
\_gatCs (pfromData -> effectDatum) _ txInfo -> unTermCont $ do
effectDatumF <- pletAllC effectDatum
txInfoF <- pletFieldsC @'["inputs", "outputs", "datums", "redeemers"] txInfo
@ -225,9 +239,10 @@ mutateGovernorValidator =
governorOutputDatum =
ptrace "Resolve governor outoput datum" $
ptryFromOutputDatum @PGovernorDatum
# (pfield @"datum" # governorOutput)
# txInfoF.datums
pfromData $
ptryFromOutputDatum @(PAsData PGovernorDatum)
# (pfield @"datum" # governorOutput)
# txInfoF.datums
pguardC "New governor datum correct" $
governorOutputDatum #== effectDatumF.newDatum

View file

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

View file

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

View file

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

View file

@ -246,8 +246,17 @@ data ProposalThresholds = ProposalThresholds
, -- | @since 0.1.0
Generic
)
PlutusTx.makeIsDataIndexed 'ProposalThresholds [('ProposalThresholds, 0)]
deriving anyclass
( -- | @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.
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
instance DerivePlutusType PProposalThresholds where
type DPTStrat _ = PlutusTypeData
type DPTStrat _ = PlutusTypeNewtype
-- | @since 0.1.0
instance PTryFrom PData PProposalThresholds
instance PTryFrom PData (PAsData PProposalThresholds)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
-- | @since 0.1.0
deriving via
(DerivePConstantViaData ProposalThresholds PProposalThresholds)
(DerivePConstantViaDataList ProposalThresholds PProposalThresholds)
instance
(PConstantDecl ProposalThresholds)

View file

@ -32,6 +32,7 @@ module Agora.Proposal.Time (
) where
import Data.Functor ((<&>))
import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (
PExtended (PFinite),
PInterval (PInterval),
@ -41,13 +42,16 @@ import Plutarch.Api.V1 (
)
import Plutarch.Api.V2 (PPOSIXTimeRange)
import Plutarch.DataRepr (
DerivePConstantViaData (..),
PDataFields,
)
import Plutarch.Extra.Applicative (PApply (pliftA2))
import Plutarch.Extra.Bool (passert)
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.Time (
PFullyBoundedTimeRange (PFullyBoundedTimeRange),
@ -141,8 +145,17 @@ data ProposalTimingConfig = ProposalTimingConfig
, -- | @since 0.1.0
Generic
)
PlutusTx.makeIsDataIndexed 'ProposalTimingConfig [('ProposalTimingConfig, 0)]
deriving anyclass
( -- | @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
type DPTStrat _ = PlutusTypeData
type DPTStrat _ = PlutusTypeNewtype
-- | @since 0.1.0
instance PTryFrom PData PProposalTimingConfig
instance PTryFrom PData (PAsData PProposalTimingConfig)
-- | @since 0.1.0
instance PUnsafeLiftDecl PProposalTimingConfig where
@ -250,7 +263,7 @@ instance PUnsafeLiftDecl PProposalTimingConfig where
-- | @since 0.1.0
deriving via
(DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig)
(DerivePConstantViaDataList ProposalTimingConfig PProposalTimingConfig)
instance
(PConstantDecl ProposalTimingConfig)