{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}
-- Following is for tx compilation
{-# 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

-- | 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 ((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
            -- 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 no cparams left: success
-- if cparams left: it means we reached the end of config without validating all cparams
runRules [Param]
_ ChangedParams
cparams = ChangedParams -> Bool
forall a. [a] -> Bool
Tx.null 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, 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

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