module Plutus.V1.Ledger.EvaluationContext
    ( EvaluationContext
    , mkEvaluationContext
    , CostModelParams
    , assertWellFormedCostModelParams
    , machineParametersImmediate
    , machineParametersDeferred
    , toMachineParameters
    , costModelParamNames
    , costModelParamsForTesting
    , evalCtxForTesting
    , CostModelApplyError (..)
    ) where

import Plutus.ApiCommon
import PlutusCore as Plutus
import PlutusCore.Evaluation.Machine.BuiltinCostModel as Plutus
import PlutusCore.Evaluation.Machine.CostModelInterface as Plutus
import PlutusCore.Evaluation.Machine.MachineParameters as Plutus

import Barbies
import Control.Exception
import Control.Lens
import Data.Map as Map
import Data.Maybe
import Data.Set as Set
import Data.Text qualified as Text

-- | The set of valid names that a cost model parameter can take for this language version.
-- It is used for the deserialization of `CostModelParams`.
costModelParamNames :: Set.Set Text.Text
costModelParamNames :: Set Text
costModelParamNames = Map Text Integer -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (Map Text Integer -> Set Text) -> Map Text Integer -> Set Text
forall a b. (a -> b) -> a -> b
$ Maybe (Map Text Integer) -> Map Text Integer
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Map Text Integer) -> Map Text Integer)
-> Maybe (Map Text Integer) -> Map Text Integer
forall a b. (a -> b) -> a -> b
$ CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)
-> Maybe (Map Text Integer)
forall machinecosts builtincosts.
(ToJSON machinecosts, ToJSON builtincosts) =>
CostModel machinecosts builtincosts -> Maybe (Map Text Integer)
extractCostModelParams (CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)
 -> Maybe (Map Text Integer))
-> CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)
-> Maybe (Map Text Integer)
forall a b. (a -> b) -> a -> b
$
   CostModel CekMachineCosts BuiltinCostModel
defaultCekCostModel
   CostModel CekMachineCosts BuiltinCostModel
-> (CostModel CekMachineCosts BuiltinCostModel
    -> CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun))
-> CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)
forall a b. a -> (a -> b) -> b
& (BuiltinCostModel -> Identity (BuiltinCostModelBase MCostingFun))
-> CostModel CekMachineCosts BuiltinCostModel
-> Identity
     (CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun))
forall machinecosts builtincosts1 builtincosts2.
Lens
  (CostModel machinecosts builtincosts1)
  (CostModel machinecosts builtincosts2)
  builtincosts1
  builtincosts2
builtinCostModel
   -- here we rely on 'Deriving.Aeson.OmitNothingFields'
   -- to skip jsonifying any fields which are cleared.
   ((BuiltinCostModel -> Identity (BuiltinCostModelBase MCostingFun))
 -> CostModel CekMachineCosts BuiltinCostModel
 -> Identity
      (CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)))
-> (BuiltinCostModel -> BuiltinCostModelBase MCostingFun)
-> CostModel CekMachineCosts BuiltinCostModel
-> CostModel CekMachineCosts (BuiltinCostModelBase MCostingFun)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ BuiltinCostModel -> BuiltinCostModelBase MCostingFun
omitV2Builtins
  where
    -- "clears" some fields of builtincostmodel by setting them to Nothing. See 'MCostingFun'.
    omitV2Builtins :: BuiltinCostModel -> BuiltinCostModelBase MCostingFun
    omitV2Builtins :: BuiltinCostModel -> BuiltinCostModelBase MCostingFun
omitV2Builtins BuiltinCostModel
bcm =
            -- transform all costing-functions to (Just costingFun)
            ((forall a. CostingFun a -> MCostingFun a)
-> BuiltinCostModel -> BuiltinCostModelBase MCostingFun
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
bmap (Maybe (CostingFun a) -> MCostingFun a
forall a. Maybe (CostingFun a) -> MCostingFun a
MCostingFun (Maybe (CostingFun a) -> MCostingFun a)
-> (CostingFun a -> Maybe (CostingFun a))
-> CostingFun a
-> MCostingFun a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostingFun a -> Maybe (CostingFun a)
forall a. a -> Maybe a
Just) BuiltinCostModel
bcm)
            {
              -- 'SerialiseData','EcdsaSecp256k1',SchnorrSecp256k1 builtins not available in V1
              paramSerialiseData :: MCostingFun ModelOneArgument
paramSerialiseData = MCostingFun ModelOneArgument
forall a. Monoid a => a
mempty
            , paramVerifyEcdsaSecp256k1Signature :: MCostingFun ModelThreeArguments
paramVerifyEcdsaSecp256k1Signature = MCostingFun ModelThreeArguments
forall a. Monoid a => a
mempty
            , paramVerifySchnorrSecp256k1Signature :: MCostingFun ModelThreeArguments
paramVerifySchnorrSecp256k1Signature = MCostingFun ModelThreeArguments
forall a. Monoid a => a
mempty
            }

-- | The raw cost model params, only to be used for testing purposes.
costModelParamsForTesting :: Plutus.CostModelParams
costModelParamsForTesting :: Map Text Integer
costModelParamsForTesting = Maybe (Map Text Integer) -> Map Text Integer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map Text Integer)
Plutus.defaultCostModelParams

-- | only to be for testing purposes: make an evaluation context by applying an empty set of protocol parameters
evalCtxForTesting :: EvaluationContext
evalCtxForTesting :: EvaluationContext
evalCtxForTesting = (CostModelApplyError -> EvaluationContext)
-> (EvaluationContext -> EvaluationContext)
-> Either CostModelApplyError EvaluationContext
-> EvaluationContext
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CostModelApplyError -> EvaluationContext
forall a e. Exception e => e -> a
throw EvaluationContext -> EvaluationContext
forall a. a -> a
id (Either CostModelApplyError EvaluationContext -> EvaluationContext)
-> Either CostModelApplyError EvaluationContext
-> EvaluationContext
forall a b. (a -> b) -> a -> b
$ Map Text Integer -> Either CostModelApplyError EvaluationContext
forall (m :: * -> *).
MonadError CostModelApplyError m =>
Map Text Integer -> m EvaluationContext
mkEvaluationContext Map Text Integer
forall a. Monoid a => a
mempty