Merge pull request #231 from Liqwid-Labs/connor/consistent-data-encoding

Encode data as list instead of constr wherever we can
This commit is contained in:
方泓睿 2023-03-11 00:43:21 +08:00 committed by GitHub
commit b2181e10aa
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
8 changed files with 666 additions and 600 deletions

View file

@ -6,6 +6,17 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
### Modified
- For consistency and performance, the following data types are encoded as flat
product as opposed to SoP now:
- `GovernorDatum`
- `ProposalThresholds`
- `ProposalTimingConfig`
- `MutateGovernorDatum`
- `TreasuryWithdrawalDatum`
Included by [#231](https://github.com/Liqwid-Labs/agora/pull/231)
- Fix several vulnerabilities and bugs found by auditors.
Including:

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

@ -116,8 +116,6 @@ newtype ProposalId = ProposalId {proposalTag :: Integer}
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
{- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this:
@ -212,8 +210,6 @@ data ProposalStatus
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
via (EnumIsData ProposalStatus)
@ -246,8 +242,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 +590,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),
@ -86,8 +90,6 @@ newtype ProposalStartingTime = ProposalStartingTime
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
)
-- | Represents the maximum width of a 'PlutusLedgerApi.V1.Time.POSIXTimeRange'.
@ -107,8 +109,6 @@ newtype MaxTimeRangeWidth = MaxTimeRangeWidth {getMaxWidth :: POSIXTime}
PlutusTx.ToData
, -- | @since 0.1.0
PlutusTx.FromData
, -- | @since 0.1.0
PlutusTx.UnsafeFromData
, -- | @since 1.0.0
Num
)
@ -141,8 +141,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 +248,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 +259,7 @@ instance PUnsafeLiftDecl PProposalTimingConfig where
-- | @since 0.1.0
deriving via
(DerivePConstantViaData ProposalTimingConfig PProposalTimingConfig)
(DerivePConstantViaDataList ProposalTimingConfig PProposalTimingConfig)
instance
(PConstantDecl ProposalTimingConfig)

1070
bench.csv

File diff suppressed because it is too large Load diff