encode data as list instead of constr wherever we can
This commit is contained in:
parent
b78b08759e
commit
12920e6cdc
6 changed files with 120 additions and 57 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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'.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue