-- Following is for tx compilation
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.Unsorted
  ( 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.BuiltinList qualified as BuiltinList
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
cfg =
  (ChangedParams -> Bool) -> ConstitutionValidator
Common.withChangedParams
    ((BuiltinPair BuiltinData BuiltinData -> Bool)
-> ChangedParams -> Bool
forall a. (a -> Bool) -> BuiltinList a -> Bool
BuiltinList.all (ConstitutionConfig -> BuiltinPair BuiltinData BuiltinData -> Bool
validateParam ConstitutionConfig
cfg))

validateParam :: ConstitutionConfig -> BI.BuiltinPair BuiltinData BuiltinData -> Bool
validateParam :: ConstitutionConfig -> BuiltinPair BuiltinData BuiltinData -> Bool
validateParam (ConstitutionConfig [Param]
cfg) BuiltinPair BuiltinData BuiltinData
cparam =
  BuiltinPair BuiltinData BuiltinData
-> (BuiltinData -> BuiltinData -> Bool) -> Bool
forall a b r. BuiltinPair a b -> (a -> b -> r) -> r
BI.casePair BuiltinPair BuiltinData BuiltinData
cparam ((BuiltinData -> BuiltinData -> Bool) -> Bool)
-> (BuiltinData -> BuiltinData -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \BuiltinData
actualPidData BuiltinData
actualValueData ->
    ParamValue -> BuiltinData -> Bool
Common.validateParamValue
      -- If param not found, it will error
      (Integer -> [Param] -> ParamValue
forall v. Integer -> [(Integer, v)] -> v
lookupUnsafe (BuiltinData -> Integer
B.unsafeDataAsI BuiltinData
actualPidData) [Param]
cfg)
      BuiltinData
actualValueData

-- | An unsafe version of PlutusTx.AssocMap.lookup, specialised to Integer keys
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 #-}

-- | 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||])