Skip to content

Commit

Permalink
Use data-backed SC
Browse files Browse the repository at this point in the history
  • Loading branch information
@ana-pantilie
ana-pantilie committed Dec 20, 2024
1 parent ad249b5 commit 57e74cd
Show file tree
Hide file tree
Showing 17 changed files with 2,421 additions and 1,866 deletions.
47 changes: 12 additions & 35 deletions cardano-constitution/src/Cardano/Constitution/Validator/Common.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,13 +16,14 @@ import Control.Category hiding ((.))

import Cardano.Constitution.Config
import Data.Coerce
import PlutusLedgerApi.V3 as V3
import PlutusLedgerApi.Data.V3
import PlutusTx.Builtins qualified as B
import PlutusTx.Builtins.Internal qualified as BI
import PlutusTx.Data.AssocMap
import PlutusTx.NonCanonicalRational as NCRatio
import PlutusTx.Prelude as Tx hiding (toList)

type ConstitutionValidator = BuiltinData -- ^ ScriptContext, deep inside is the changed-parameters proposal
type ConstitutionValidator = ScriptContext -- ^ ScriptContext, deep inside is the changed-parameters proposal
-> BuiltinUnit -- ^ No-error means the proposal conforms to the constitution

-- OPTIMIZE: operate on BuiltinList<BuiltinPair> directly, needs major refactoring of sorted&unsorted Validators
Expand Down Expand Up @@ -70,37 +71,13 @@ validateParamValue = \case
meaningWithActual = (`meaning` actualValue)
{-# INLINABLE validateParamValue #-}

scriptContextToValidGovAction :: BuiltinData -> Maybe ChangedParams
scriptContextToValidGovAction = scriptContextToScriptInfo
>>> scriptInfoToProposalProcedure
>>> proposalProcedureToGovernanceAction
>>> governanceActionToValidGovAction
where
scriptContextToScriptInfo :: BuiltinData -> BuiltinData -- aka ScriptContext -> ScriptInfo
scriptContextToScriptInfo = BI.unsafeDataAsConstr
>>> BI.snd
>>> BI.tail
>>> BI.tail
>>> BI.head

scriptInfoToProposalProcedure :: BuiltinData -> BuiltinData
scriptInfoToProposalProcedure (BI.unsafeDataAsConstr -> si) =
if BI.fst si `B.equalsInteger` 5 -- Constructor Index of `ProposingScript`
then BI.head (BI.tail (BI.snd si))
else traceError "Not a ProposalProcedure. This should not ever happen, because ledger should guard before, against it."

proposalProcedureToGovernanceAction :: BuiltinData -> BuiltinData
proposalProcedureToGovernanceAction = BI.unsafeDataAsConstr
>>> BI.snd
>>> BI.tail
>>> BI.tail
>>> BI.head

governanceActionToValidGovAction :: BuiltinData -> Maybe ChangedParams
governanceActionToValidGovAction (BI.unsafeDataAsConstr -> govAction@(BI.fst -> govActionConstr))
-- Constructor Index of `ChangedParams` is 0
| govActionConstr `B.equalsInteger` 0 = Just (B.unsafeDataAsMap (BI.head (BI.tail (BI.snd govAction))))
-- Constructor Index of `TreasuryWithdrawals` is 2
| govActionConstr `B.equalsInteger` 2 = Nothing -- means treasurywithdrawal
| otherwise = traceError "Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it."
scriptContextToValidGovAction :: ScriptContext -> Maybe ChangedParams
scriptContextToValidGovAction ScriptContext {scriptContextScriptInfo = scriptInfo} =
case scriptInfo of
ProposingScript _ ProposalProcedure { ppGovernanceAction = ppGovAct } ->
case ppGovAct of
ParameterChange _ cparams _ -> Just (B.unsafeDataAsMap . toBuiltinData $ cparams)
TreasuryWithdrawals _ _ -> Nothing
_ -> traceError "Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it."
_ -> Nothing
{-# INLINABLE scriptContextToValidGovAction #-}
2 changes: 1 addition & 1 deletion cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,7 +85,7 @@ runForBudget :: (ToData ctx)
-> ExBudget
runForBudget v ctx =
let vPs = UPLC._progTerm $ getPlcNoAnn $ v
`unsafeApplyCode` liftCode110 (toBuiltinData ctx)
`unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx)
in case UPLC.runCekDeBruijn defaultCekParametersForTesting counting noEmitter vPs of
-- Here, we guard against the case that a ConstitutionValidator **FAILS EARLY** (for some reason),
-- resulting in misleading low budget costs.
Expand Down
2 changes: 1 addition & 1 deletion cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
2144
2331
2 changes: 1 addition & 1 deletion ...o-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
ExBudget {exBudgetCPU = ExCPU 604948171, exBudgetMemory = ExMemory 2993518}
ExBudget {exBudgetCPU = ExCPU 610315640, exBudgetMemory = ExMemory 3014402}
249 changes: 191 additions & 58 deletions cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden
View file
Original file line number Diff line number Diff line change
Expand Up @@ -489,6 +489,28 @@ program
data (Maybe :: * -> *) a | Maybe_match where
Just : a -> Maybe a
Nothing : Maybe a
!`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` :
all a. (\a -> data -> a) a -> data -> Maybe a
= /\a ->
\(`$dUnsafeFromData` : (\a -> data -> a) a) (d : data) ->
let
!tup : pair integer (list data) = unConstrData d
!index : integer = fstPair {integer} {list data} tup
!args : list data = sndPair {integer} {list data} tup
in
Bool_match
(ifThenElse {Bool} (equalsInteger 1 index) True False)
{all dead. Maybe a}
(/\dead -> Nothing {a})
(/\dead ->
Bool_match
(ifThenElse {Bool} (equalsInteger 0 index) True False)
{all dead. Maybe a}
(/\dead ->
Just {a} (`$dUnsafeFromData` (headList {data} args)))
(/\dead -> error {Maybe a})
{all dead. dead})
{all dead. dead}
in
letrec
~caseData_go : list (pair data data) -> List (Tuple2 data data)
Expand Down Expand Up @@ -5281,73 +5303,184 @@ program
\(ds : data) ->
Maybe_match
{List (Tuple2 data data)}
(let
!ds : data
= headList
{data}
(tailList
{data}
(tailList
{data}
(sndPair
{integer}
{list data}
(unConstrData
(let
!ds : data
= headList
{data}
(tailList
{data}
(tailList
{data}
(sndPair
{integer}
{list data}
(unConstrData ds))))
~si : pair integer (list data) = unConstrData ds
((let
r = Maybe (List (Tuple2 data data))
in
\(scrut : data)
(cont : data -> data -> data -> r)
(fail : unit -> r) ->
let
!tup : pair integer (list data) = unConstrData scrut
in
Bool_match
(ifThenElse
{Bool}
(equalsInteger 0 (fstPair {integer} {list data} tup))
True
False)
{all dead. r}
(/\dead ->
let
!l : list data = sndPair {integer} {list data} tup
!l : list data = tailList {data} l
in
cont
(headList {data} l)
(headList {data} l)
(headList {data} (tailList {data} l)))
(/\dead -> fail ())
{all dead. dead})
ds
(\(ds : data) (ds : data) (ds : data) ->
(let
r = Maybe (List (Tuple2 data data))
in
\(scrut : data)
(cont : integer -> data -> r)
(fail : unit -> r) ->
let
!tup : pair integer (list data) = unConstrData scrut
in
Bool_match
(ifThenElse
{Bool}
(equalsInteger 5 (fstPair {integer} {list data} tup))
True
False)
{all dead. r}
(/\dead ->
let
!l : list data = sndPair {integer} {list data} tup
in
cont
(unIData (headList {data} l))
(headList {data} (tailList {data} l)))
(/\dead -> fail ())
{all dead. dead})
ds
(\(ds : integer) (ds : data) ->
(let
r = Maybe (List (Tuple2 data data))
in
\(scrut : data)
(cont : integer -> data -> data -> r)
(fail : unit -> r) ->
let
!tup : pair integer (list data) = unConstrData scrut
in
Bool_match
(ifThenElse
{Bool}
(equalsInteger 0 (fstPair {integer} {list data} tup))
True
False)
{all dead. r}
(/\dead ->
let
!l : list data = sndPair {integer} {list data} tup
!l : list data = tailList {data} l
in
cont
(unIData (headList {data} l))
(headList {data} l)
(headList {data} (tailList {data} l)))
(/\dead -> fail ())
{all dead. dead})
ds
(\(ds : integer) (ds : data) (ds : data) ->
(let
r = Maybe (List (Tuple2 data data))
in
\(scrut : data)
(cont : Maybe data -> data -> Maybe bytestring -> r)
(fail : unit -> r) ->
let
!tup : pair integer (list data) = unConstrData scrut
in
Bool_match
(ifThenElse
{Bool}
(equalsInteger
5
(fstPair {integer} {list data} si))
0
(fstPair {integer} {list data} tup))
True
False)
{all dead. data}
{all dead. r}
(/\dead ->
headList
{data}
(tailList
let
!l : list data
= sndPair {integer} {list data} tup
!l : list data = tailList {data} l
in
cont
(`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData`
{data}
(sndPair {integer} {list data} si)))
(/\dead -> error {data})
{all dead. dead})))))
~ds : pair integer (list data) = unConstrData ds
!x : integer = fstPair {integer} {list data} ds
in
Bool_match
(ifThenElse {Bool} (equalsInteger 0 x) True False)
{all dead. Maybe (List (Tuple2 data data))}
(/\dead ->
Just
{List (Tuple2 data data)}
(let
!d : data
= headList
{data}
(tailList {data} (sndPair {integer} {list data} ds))
in
caseData_go (unMapData d)))
(/\dead ->
Bool_match
(ifThenElse {Bool} (equalsInteger 2 x) True False)
{all dead. Maybe (List (Tuple2 data data))}
(/\dead -> Nothing {List (Tuple2 data data)})
(/\dead -> error {Maybe (List (Tuple2 data data))})
{all dead. dead})
{all dead. dead})
(\(d : data) -> d)
(headList {data} l))
(headList {data} l)
(`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData`
{bytestring}
unBData
(headList {data} (tailList {data} l))))
(/\dead -> fail ())
{all dead. dead})
ds
(\(ds : Maybe data)
(cparams : data)
(ds : Maybe bytestring) ->
Just
{List (Tuple2 data data)}
(caseData_go (unMapData cparams)))
(\(void : unit) ->
(let
r = Maybe (List (Tuple2 data data))
in
\(scrut : data)
(cont :
(\k a -> list (pair data data)) data integer ->
Maybe bytestring ->
r)
(fail : unit -> r) ->
let
!tup : pair integer (list data)
= unConstrData scrut
in
Bool_match
(ifThenElse
{Bool}
(equalsInteger
2
(fstPair {integer} {list data} tup))
True
False)
{all dead. r}
(/\dead ->
let
!l : list data
= sndPair {integer} {list data} tup
in
cont
(unMapData (headList {data} l))
(`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData`
{bytestring}
unBData
(headList {data} (tailList {data} l))))
(/\dead -> fail ())
{all dead. dead})
ds
(\(ds :
(\k a -> list (pair data data)) data integer)
(ds : Maybe bytestring) ->
Nothing {List (Tuple2 data data)})
(\(void : unit) ->
error {Maybe (List (Tuple2 data data))})))
(\(void : unit) -> Nothing {List (Tuple2 data data)}))
(\(void : unit) -> Nothing {List (Tuple2 data data)}))
(\(void : unit) ->
Unit_match
(error {Unit})
{Maybe (List (Tuple2 data data))}
(error {Maybe (List (Tuple2 data data))})))
{all dead. unit}
(\(cparams : List (Tuple2 data data)) ->
/\dead ->
Expand Down
2 changes: 1 addition & 1 deletion ...o-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden
View file
Original file line number Diff line number Diff line change
@@ -1 +1 @@
ExBudget {exBudgetCPU = ExCPU 91749157, exBudgetMemory = ExMemory 415005}
ExBudget {exBudgetCPU = ExCPU 97116626, exBudgetMemory = ExMemory 435889}
Loading

0 comments on commit 57e74cd

Please sign in to comment.