Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Test: use data-backed SC in constitution script #6758

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Test: use data-backed SC in constitution script #6758

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ad249b5
Tests which fail on master
ana-pantilie Dec 19, 2024
57e74cd
Use data-backed SC
ana-pantilie Dec 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 12 additions & 35 deletions cardano-constitution/src/Cardano/Constitution/Validator/Common.hs
View file
Open in desktop
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
Open in desktop
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
Open in desktop
Original file line number Diff line number Diff line change
@@ -1 +1 @@
2132
2331
2 changes: 1 addition & 1 deletion ...o-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1 +1 @@
ExBudget {exBudgetCPU = ExCPU 601476171, exBudgetMemory = ExMemory 2971818}
ExBudget {exBudgetCPU = ExCPU 610315640, exBudgetMemory = ExMemory 3014402}
291 changes: 215 additions & 76 deletions cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -489,28 +489,54 @@ 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
!go : list (pair data data) -> List (Tuple2 data data)
= \(l : list (pair data data)) ->
chooseList
{pair data data}
{unit -> List (Tuple2 data data)}
l
(\(ds : unit) -> Nil {Tuple2 data data})
(\(ds : unit) ->
Cons
{Tuple2 data data}
(let
!p : pair data data = headList {pair data data} l
in
Tuple2
{data}
{data}
(fstPair {data} {data} p)
(sndPair {data} {data} p))
(go (tailList {pair data data} l)))
()
~caseData_go : list (pair data data) -> List (Tuple2 data data)
= (let
a = pair data data
in
/\r ->
\(z : r) (f : a -> list a -> r) (xs : list a) ->
chooseList
{a}
{all dead. r}
xs
(/\dead -> z)
(/\dead -> f (headList {a} xs) (tailList {a} xs))
{r})
{List (Tuple2 data data)}
(Nil {Tuple2 data data})
(\(x : pair data data) (xs : list (pair data data)) ->
Cons
{Tuple2 data data}
(Tuple2
{data}
{data}
(fstPair {data} {data} x)
(sndPair {data} {data} x))
(caseData_go xs))
in
let
!fun : List (Tuple2 data data) -> Bool
Expand Down Expand Up @@ -5277,71 +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)}
(go
(unMapData
(headList
{data}
(tailList {data} (sndPair {integer} {list data} ds))))))
(/\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
Loading
Loading