{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Cardano.Constitution.Validator.Common
( withChangedParams
, ChangedParams
, ConstitutionValidator
, validateParamValue
) where
import Control.Category hiding ((.))
import Cardano.Constitution.Config
import Data.Coerce
import PlutusLedgerApi.V3 as V3
import PlutusTx.Builtins qualified as B
import PlutusTx.Builtins.Internal qualified as BI
import PlutusTx.NonCanonicalRational as NCRatio
import PlutusTx.Prelude as Tx hiding (toList)
type ConstitutionValidator = BuiltinData
-> BuiltinUnit
type ChangedParams = [(BuiltinData, BuiltinData)]
withChangedParams :: (ChangedParams -> Bool) -> ConstitutionValidator
withChangedParams :: (ChangedParams -> Bool) -> ConstitutionValidator
withChangedParams ChangedParams -> Bool
fun (BuiltinData -> Maybe ChangedParams
scriptContextToValidGovAction -> Maybe ChangedParams
validGovAction) =
case Maybe ChangedParams
validGovAction of
Just ChangedParams
cparams -> if ChangedParams -> Bool
fun ChangedParams
cparams
then BuiltinUnit
BI.unitval
else BuiltinString -> BuiltinUnit
forall a. BuiltinString -> a
traceError BuiltinString
"ChangedParams failed to validate"
Maybe ChangedParams
Nothing -> BuiltinUnit
BI.unitval
{-# INLINABLE withChangedParams #-}
validateParamValue :: ParamValue -> BuiltinData -> Bool
validateParamValue :: ParamValue -> BuiltinData -> Bool
validateParamValue = \case
ParamInteger Predicates Integer
preds -> Predicates Integer -> Integer -> Bool
forall a. Ord a => Predicates a -> a -> Bool
validatePreds Predicates Integer
preds (Integer -> Bool)
-> (BuiltinData -> Integer) -> BuiltinData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Integer
B.unsafeDataAsI
ParamRational Predicates Rational
preds -> Predicates Rational -> Rational -> Bool
forall a. Ord a => Predicates a -> a -> Bool
validatePreds Predicates Rational
preds (Rational -> Bool)
-> (BuiltinData -> Rational) -> BuiltinData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonCanonicalRational -> Rational
forall a b. Coercible a b => a -> b
coerce (NonCanonicalRational -> Rational)
-> (BuiltinData -> NonCanonicalRational) -> BuiltinData -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData @NonCanonicalRational
ParamList [ParamValue]
paramValues -> [ParamValue] -> BuiltinList BuiltinData -> Bool
validateParamValues [ParamValue]
paramValues (BuiltinList BuiltinData -> Bool)
-> (BuiltinData -> BuiltinList BuiltinData) -> BuiltinData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> BuiltinList BuiltinData
BI.unsafeDataAsList
ParamValue
ParamAny -> Bool -> BuiltinData -> Bool
forall a b. a -> b -> a
const Bool
True
where
validateParamValues :: [ParamValue] -> BI.BuiltinList BuiltinData -> Bool
validateParamValues :: [ParamValue] -> BuiltinList BuiltinData -> Bool
validateParamValues = \case
(ParamValue
paramValueHd : [ParamValue]
paramValueTl) -> \BuiltinList BuiltinData
actualValueData ->
ParamValue -> BuiltinData -> Bool
validateParamValue ParamValue
paramValueHd (BuiltinList BuiltinData -> BuiltinData
forall a. BuiltinList a -> a
BI.head BuiltinList BuiltinData
actualValueData)
Bool -> Bool -> Bool
&& [ParamValue] -> BuiltinList BuiltinData -> Bool
validateParamValues [ParamValue]
paramValueTl (BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail BuiltinList BuiltinData
actualValueData)
[] -> BuiltinBool -> Bool
forall arep a. HasFromOpaque arep a => arep -> a
B.fromOpaque (BuiltinBool -> Bool)
-> (BuiltinList BuiltinData -> BuiltinBool)
-> BuiltinList BuiltinData
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinList BuiltinData -> BuiltinBool
forall a. BuiltinList a -> BuiltinBool
BI.null
validatePreds :: forall a. Tx.Ord a => Predicates a -> a -> Bool
validatePreds :: forall a. Ord a => Predicates a -> a -> Bool
validatePreds (Predicates [Predicate a]
preds) (a -> Predicate a -> Bool
forall a. Ord a => a -> Predicate a -> Bool
validatePred -> Predicate a -> Bool
validatePredAppliedToActual) =
(Predicate a -> Bool) -> [Predicate a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
Tx.all Predicate a -> Bool
validatePredAppliedToActual [Predicate a]
preds
validatePred :: forall a. Tx.Ord a => a -> Predicate a -> Bool
validatePred :: forall a. Ord a => a -> Predicate a -> Bool
validatePred a
actualValue (PredKey
predKey, [a]
expectedPredValues) =
(a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
Tx.all a -> Bool
meaningWithActual [a]
expectedPredValues
where
meaning :: a -> a -> Bool
meaning = PredKey -> PredMeaning a
forall a. PredKey -> PredMeaning a
defaultPredMeanings PredKey
predKey
meaningWithActual :: a -> Bool
meaningWithActual = (a -> a -> Bool
`meaning` a
actualValue)
{-# INLINABLE validateParamValue #-}
scriptContextToValidGovAction :: BuiltinData -> Maybe ChangedParams
scriptContextToValidGovAction :: BuiltinData -> Maybe ChangedParams
scriptContextToValidGovAction = BuiltinData -> BuiltinData
scriptContextToScriptInfo
(BuiltinData -> BuiltinData)
-> (BuiltinData -> Maybe ChangedParams)
-> BuiltinData
-> Maybe ChangedParams
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinData -> BuiltinData
scriptInfoToProposalProcedure
(BuiltinData -> BuiltinData)
-> (BuiltinData -> Maybe ChangedParams)
-> BuiltinData
-> Maybe ChangedParams
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinData -> BuiltinData
proposalProcedureToGovernanceAction
(BuiltinData -> BuiltinData)
-> (BuiltinData -> Maybe ChangedParams)
-> BuiltinData
-> Maybe ChangedParams
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinData -> Maybe ChangedParams
governanceActionToValidGovAction
where
scriptContextToScriptInfo :: BuiltinData -> BuiltinData
scriptContextToScriptInfo :: BuiltinData -> BuiltinData
scriptContextToScriptInfo = BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData)
BI.unsafeDataAsConstr
(BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData))
-> (BuiltinPair Integer (BuiltinList BuiltinData) -> BuiltinData)
-> BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData
forall a b. BuiltinPair a b -> b
BI.snd
(BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail
(BuiltinList BuiltinData -> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinList BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail
(BuiltinList BuiltinData -> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinList BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinData
forall a. BuiltinList a -> a
BI.head
scriptInfoToProposalProcedure :: BuiltinData -> BuiltinData
scriptInfoToProposalProcedure :: BuiltinData -> BuiltinData
scriptInfoToProposalProcedure (BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData)
BI.unsafeDataAsConstr -> BuiltinPair Integer (BuiltinList BuiltinData)
si) =
if BuiltinPair Integer (BuiltinList BuiltinData) -> Integer
forall a b. BuiltinPair a b -> a
BI.fst BuiltinPair Integer (BuiltinList BuiltinData)
si Integer -> Integer -> Bool
`B.equalsInteger` Integer
5
then BuiltinList BuiltinData -> BuiltinData
forall a. BuiltinList a -> a
BI.head (BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail (BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData
forall a b. BuiltinPair a b -> b
BI.snd BuiltinPair Integer (BuiltinList BuiltinData)
si))
else BuiltinString -> BuiltinData
forall a. BuiltinString -> a
traceError BuiltinString
"Not a ProposalProcedure. This should not ever happen, because ledger should guard before, against it."
proposalProcedureToGovernanceAction :: BuiltinData -> BuiltinData
proposalProcedureToGovernanceAction :: BuiltinData -> BuiltinData
proposalProcedureToGovernanceAction = BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData)
BI.unsafeDataAsConstr
(BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData))
-> (BuiltinPair Integer (BuiltinList BuiltinData) -> BuiltinData)
-> BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData
forall a b. BuiltinPair a b -> b
BI.snd
(BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail
(BuiltinList BuiltinData -> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinList BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail
(BuiltinList BuiltinData -> BuiltinList BuiltinData)
-> (BuiltinList BuiltinData -> BuiltinData)
-> BuiltinList BuiltinData
-> BuiltinData
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> BuiltinList BuiltinData -> BuiltinData
forall a. BuiltinList a -> a
BI.head
governanceActionToValidGovAction :: BuiltinData -> Maybe ChangedParams
governanceActionToValidGovAction :: BuiltinData -> Maybe ChangedParams
governanceActionToValidGovAction (BuiltinData -> BuiltinPair Integer (BuiltinList BuiltinData)
BI.unsafeDataAsConstr -> govAction :: BuiltinPair Integer (BuiltinList BuiltinData)
govAction@(BuiltinPair Integer (BuiltinList BuiltinData) -> Integer
forall a b. BuiltinPair a b -> a
BI.fst -> Integer
govActionConstr))
| Integer
govActionConstr Integer -> Integer -> Bool
`B.equalsInteger` Integer
0 = ChangedParams -> Maybe ChangedParams
forall a. a -> Maybe a
Just (BuiltinData -> ChangedParams
B.unsafeDataAsMap (BuiltinList BuiltinData -> BuiltinData
forall a. BuiltinList a -> a
BI.head (BuiltinList BuiltinData -> BuiltinList BuiltinData
forall a. BuiltinList a -> BuiltinList a
BI.tail (BuiltinPair Integer (BuiltinList BuiltinData)
-> BuiltinList BuiltinData
forall a b. BuiltinPair a b -> b
BI.snd BuiltinPair Integer (BuiltinList BuiltinData)
govAction))))
| Integer
govActionConstr Integer -> Integer -> Bool
`B.equalsInteger` Integer
2 = Maybe ChangedParams
forall a. Maybe a
Nothing
| Bool
otherwise = BuiltinString -> Maybe ChangedParams
forall a. BuiltinString -> a
traceError BuiltinString
"Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it."
{-# INLINABLE scriptContextToValidGovAction #-}