-- Following is for tx compilation
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fplugin Plinth.Plugin #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:defer-errors #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:remove-trace #-}
{-# OPTIONS_GHC -fplugin-opt Plinth.Plugin:target-version=1.1.0 #-}

module Cardano.Constitution.Validator.Data.Sorted
  ( constitutionValidator
  , defaultConstitutionValidator
  , mkConstitutionCode
  , defaultConstitutionCode
  ) where

import Cardano.Constitution.Config
import Cardano.Constitution.Validator.Data.Common as Common
import PlutusCore.Version (plcVersion110)
import PlutusTx as Tx
import PlutusTx.Builtins as B
import PlutusTx.Builtins.Internal qualified as BI
import PlutusTx.Prelude as Tx

-- | Expects a constitution-configuration, statically *OR* at runtime via Tx.liftCode
constitutionValidator :: ConstitutionConfig -> ConstitutionValidator
constitutionValidator :: ConstitutionConfig -> ConstitutionValidator
constitutionValidator (ConstitutionConfig [Param]
cfg) =
  (ChangedParams -> Bool) -> ConstitutionValidator
Common.withChangedParams ([Param] -> ChangedParams -> Bool
runRules [Param]
cfg)

-- | The `runRules` is a loop that works element-wise from left-to-right on the 2 sorted maps.
runRules
  :: [Param]
  -- ^ the config (sorted by default)
  -> ChangedParams
  -- ^ the params (came sorted by the ledger)
  -> Bool
runRules :: [Param] -> ChangedParams -> Bool
runRules [Param]
cfg ChangedParams
cparams =
  Bool
-> (BuiltinPair BuiltinData BuiltinData -> ChangedParams -> Bool)
-> ChangedParams
-> Bool
forall a r. r -> (a -> BuiltinList a -> r) -> BuiltinList a -> r
BI.caseList'
    -- if no cparams left: success
    Bool
True
    ( \BuiltinPair BuiltinData BuiltinData
cparamsHd ChangedParams
cparamsRest ->
        case [Param]
cfg of
          (Integer
expectedPid, ParamValue
paramValue) : [Param]
cfgRest ->
            BuiltinPair BuiltinData BuiltinData
-> (BuiltinData -> BuiltinData -> Bool) -> Bool
forall a b r. BuiltinPair a b -> (a -> b -> r) -> r
BI.casePair BuiltinPair BuiltinData BuiltinData
cparamsHd ((BuiltinData -> BuiltinData -> Bool) -> Bool)
-> (BuiltinData -> BuiltinData -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \BuiltinData
actualPidData BuiltinData
actualValueData ->
              case BuiltinData -> Integer
B.unsafeDataAsI BuiltinData
actualPidData Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
expectedPid of
                Ordering
EQ ->
                  ParamValue -> BuiltinData -> Bool
Common.validateParamValue ParamValue
paramValue BuiltinData
actualValueData
                    -- drop both heads, and continue checking the next changed param
                    Bool -> Bool -> Bool
&& [Param] -> ChangedParams -> Bool
runRules [Param]
cfgRest ChangedParams
cparamsRest
                Ordering
GT ->
                  -- skip configHead pointing to a parameter not being proposed
                  [Param] -> ChangedParams -> Bool
runRules [Param]
cfgRest ChangedParams
cparams
                Ordering
LT ->
                  -- actualPid not found in json config, the constitution fails
                  Bool
False
          -- if cparams left: it means we reached the end of config without validating all cparams
          [] -> Bool
False
    )
    ChangedParams
cparams

-- | Statically configure the validator with the `defaultConstitutionConfig`.
defaultConstitutionValidator :: ConstitutionValidator
defaultConstitutionValidator :: ConstitutionValidator
defaultConstitutionValidator = ConstitutionConfig -> ConstitutionValidator
constitutionValidator ConstitutionConfig
defaultConstitutionConfig

{-| Make a constitution code by supplied the config at runtime.

See Note [Manually constructing a Configuration value] -}
mkConstitutionCode :: ConstitutionConfig -> CompiledCode ConstitutionValidator
mkConstitutionCode :: ConstitutionConfig -> CompiledCode ConstitutionValidator
mkConstitutionCode ConstitutionConfig
cCfg =
  $$(compile [||constitutionValidator||])
    CompiledCode (ConstitutionConfig -> ConstitutionValidator)
-> CompiledCodeIn DefaultUni DefaultFun ConstitutionConfig
-> CompiledCode ConstitutionValidator
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun, Pretty fun,
 Everywhere uni PrettyConst,
 PrettyBy RenderContext (SomeTypeIn uni)) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`unsafeApplyCode` Version
-> ConstitutionConfig
-> CompiledCodeIn DefaultUni DefaultFun ConstitutionConfig
forall (uni :: * -> *) a fun.
(Lift uni a, GEq uni, Everywhere uni Eq, ThrowableBuiltins uni fun,
 Typecheckable uni fun, CaseBuiltin uni,
 Default (CostingPart uni fun), Default (BuiltinsInfo uni fun),
 Default (RewriteRules uni fun), Hashable fun) =>
Version -> a -> CompiledCodeIn uni fun a
liftCode Version
plcVersion110 ConstitutionConfig
cCfg

-- | The code of the constitution statically configured with the `defaultConstitutionConfig`.
defaultConstitutionCode :: CompiledCode ConstitutionValidator
defaultConstitutionCode :: CompiledCode ConstitutionValidator
defaultConstitutionCode = $$(compile [||defaultConstitutionValidator||])