{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.Unsorted
( 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
cfg = (ChangedParams -> Bool) -> ConstitutionValidator
Common.withChangedParams
(((BuiltinData, BuiltinData) -> Bool) -> ChangedParams -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all (ConstitutionConfig -> (BuiltinData, BuiltinData) -> Bool
validateParam ConstitutionConfig
cfg))
validateParam :: ConstitutionConfig -> (BuiltinData, BuiltinData) -> Bool
validateParam :: ConstitutionConfig -> (BuiltinData, BuiltinData) -> Bool
validateParam (ConstitutionConfig [Param]
cfg) (BuiltinData -> Integer
B.unsafeDataAsI -> Integer
actualPid, BuiltinData
actualValueData) =
ParamValue -> BuiltinData -> Bool
Common.validateParamValue
(Integer -> [Param] -> ParamValue
forall v. Integer -> [(Integer, v)] -> v
lookupUnsafe Integer
actualPid [Param]
cfg)
BuiltinData
actualValueData
lookupUnsafe :: Integer -> [(Integer, v)] -> v
lookupUnsafe :: forall v. Integer -> [(Integer, v)] -> v
lookupUnsafe Integer
k = [(Integer, v)] -> v
forall {a}. [(Integer, a)] -> a
go
where
go :: [(Integer, a)] -> a
go [] = BuiltinString -> a
forall a. BuiltinString -> a
traceError BuiltinString
"Unsorted lookup failed"
go ((Integer
k', a
i) : [(Integer, a)]
xs') = if Integer
k Integer -> Integer -> Bool
`B.equalsInteger` Integer
k'
then a
i
else [(Integer, a)] -> a
go [(Integer, a)]
xs'
{-# INLINEABLE lookupUnsafe #-}
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 ||])