{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.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

-- | 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
                            (((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
      -- If param not found, it will error
      (Integer -> [Param] -> ParamValue
forall v. Integer -> [(Integer, v)] -> v
lookupUnsafe Integer
actualPid [Param]
cfg)
      BuiltinData
actualValueData

{-# INLINEABLE lookupUnsafe #-}
-- | 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'

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