{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:remove-trace #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}
module Cardano.Constitution.Validator.Sorted
( constitutionValidator
, defaultConstitutionValidator
, mkConstitutionCode
, defaultConstitutionCode
) where
import Cardano.Constitution.Config
import Cardano.Constitution.Validator.Common as Common
import PlutusCore.Version (plcVersion110)
import PlutusTx as Tx
import PlutusTx.Builtins as B
import PlutusTx.Prelude as Tx
constitutionValidator :: ConstitutionConfig -> ConstitutionValidator
constitutionValidator :: ConstitutionConfig -> ConstitutionValidator
constitutionValidator (ConstitutionConfig [Param]
cfg) =
(ChangedParams -> Bool) -> ConstitutionValidator
Common.withChangedParams ([Param] -> ChangedParams -> Bool
runRules [Param]
cfg)
runRules :: [Param]
-> ChangedParams
-> Bool
runRules :: [Param] -> ChangedParams -> Bool
runRules ((Integer
expectedPid, ParamValue
paramValue) : [Param]
cfgRest)
cparams :: ChangedParams
cparams@((BuiltinData -> Integer
B.unsafeDataAsI -> Integer
actualPid, BuiltinData
actualValueData) : ChangedParams
cparamsRest) =
case Integer
actualPid 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
Bool -> Bool -> Bool
&& [Param] -> ChangedParams -> Bool
runRules [Param]
cfgRest ChangedParams
cparamsRest
Ordering
GT ->
[Param] -> ChangedParams -> Bool
runRules [Param]
cfgRest ChangedParams
cparams
Ordering
LT ->
Bool
False
runRules [Param]
_ ChangedParams
cparams = ChangedParams -> Bool
forall a. [a] -> Bool
Tx.null ChangedParams
cparams
defaultConstitutionValidator :: ConstitutionValidator
defaultConstitutionValidator :: ConstitutionValidator
defaultConstitutionValidator = ConstitutionConfig -> ConstitutionValidator
constitutionValidator ConstitutionConfig
defaultConstitutionConfig
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, ThrowableBuiltins uni fun,
Typecheckable uni fun, 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
defaultConstitutionCode :: CompiledCode ConstitutionValidator
defaultConstitutionCode :: CompiledCode ConstitutionValidator
defaultConstitutionCode = $$(compile [|| defaultConstitutionValidator ||])