-- editorconfig-checker-disable-file
{-# 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 -- ^ 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
type ChangedParams = [(BuiltinData, BuiltinData)]

{- HLINT ignore "Redundant lambda" -} -- I like to see until where it supposed to be first applied.
{- HLINT ignore "Collapse lambdas" -} -- I like to see and comment on each arg
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 -- this is a treasury withdrawal, we just accept it
{-# 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
    -- accept the actual proposed value without examining it
    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 ->
              -- if actualValueData is not a cons, it will error
              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)
          -- if reached the end of list of param-values to check, ensure no more proposed data are left
          [] -> 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
          -- we find the meaning (function) from the PredKey
          meaning :: a -> a -> Bool
meaning = PredKey -> PredMeaning a
forall a. PredKey -> PredMeaning a
defaultPredMeanings PredKey
predKey
          -- apply the meaning to actual value: expectedValue is 1st argument, actualValue is 2nd argument
          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 -- aka ScriptContext -> ScriptInfo
    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 -- Constructor Index of `ProposingScript`
        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))
        -- Constructor Index of `ChangedParams` is 0
        | 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))))
        -- Constructor Index of `TreasuryWithdrawals` is 2
        | Integer
govActionConstr Integer -> Integer -> Bool
`B.equalsInteger` Integer
2 = Maybe ChangedParams
forall a. Maybe a
Nothing -- means treasurywithdrawal
        | 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 #-}