{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module PlutusLedgerApi.Test.V2.EvaluationContext
    ( costModelParamsForTesting
    , mCostModel
    , clearMachineCostModel
    , clearBuiltinCostModel
    ) where

import PlutusCore.Evaluation.Machine.BuiltinCostModel
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusLedgerApi.Test.Common.EvaluationContext as Common
import PlutusLedgerApi.Test.V3.EvaluationContext qualified as V3
import PlutusLedgerApi.V2 qualified as V2
import PlutusPrelude

import Data.Int (Int64)
import Data.Map qualified as Map
import Data.Maybe

-- | Example values of costs for @PlutusV2@, in expected ledger order.
-- Suitable to be used in testing.
costModelParamsForTesting :: [(V2.ParamName, Int64)]
costModelParamsForTesting :: [(ParamName, Int64)]
costModelParamsForTesting = Map ParamName Int64 -> [(ParamName, Int64)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ParamName Int64 -> [(ParamName, Int64)])
-> Map ParamName Int64 -> [(ParamName, Int64)]
forall a b. (a -> b) -> a -> b
$ Maybe (Map ParamName Int64) -> Map ParamName Int64
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Map ParamName Int64) -> Map ParamName Int64)
-> Maybe (Map ParamName Int64) -> Map ParamName Int64
forall a b. (a -> b) -> a -> b
$
    MCostModel -> Maybe (Map ParamName Int64)
forall p.
(IsParamName p, Ord p) =>
MCostModel -> Maybe (Map p Int64)
Common.extractCostModelParamsLedgerOrder MCostModel
mCostModel

-- | The PlutusV2 "cost model" is constructed by the v3 "cost model", by clearing v3 introductions.
mCostModel :: MCostModel
mCostModel :: MCostModel
mCostModel = CostModel CekMachineCosts BuiltinCostModel -> MCostModel
toMCostModel CostModel CekMachineCosts BuiltinCostModel
defaultCekCostModelForTestingB
           MCostModel -> (MCostModel -> MCostModel) -> MCostModel
forall a b. a -> (a -> b) -> b
& (MCekMachineCosts -> Identity MCekMachineCosts)
-> MCostModel -> Identity MCostModel
forall machinecosts1 builtincosts machinecosts2 (f :: * -> *).
Functor f =>
(machinecosts1 -> f machinecosts2)
-> CostModel machinecosts1 builtincosts
-> f (CostModel machinecosts2 builtincosts)
machineCostModel
           ((MCekMachineCosts -> Identity MCekMachineCosts)
 -> MCostModel -> Identity MCostModel)
-> (MCekMachineCosts -> MCekMachineCosts)
-> MCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MCekMachineCosts -> MCekMachineCosts
forall m. (m ~ MCekMachineCosts) => m -> m
V3.clearMachineCostModel
           MCostModel -> (MCostModel -> MCostModel) -> MCostModel
forall a b. a -> (a -> b) -> b
& (MBuiltinCostModel -> Identity MBuiltinCostModel)
-> MCostModel -> Identity MCostModel
forall machinecosts builtincosts1 builtincosts2 (f :: * -> *).
Functor f =>
(builtincosts1 -> f builtincosts2)
-> CostModel machinecosts builtincosts1
-> f (CostModel machinecosts builtincosts2)
builtinCostModel
           ((MBuiltinCostModel -> Identity MBuiltinCostModel)
 -> MCostModel -> Identity MCostModel)
-> (MBuiltinCostModel -> MBuiltinCostModel)
-> MCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MBuiltinCostModel -> MBuiltinCostModel
forall m. (m ~ MBuiltinCostModel) => m -> m
V3.clearBuiltinCostModel

{- | Assign to `mempty` those CEK constructs that @PlutusV2@ introduces (indirectly by introducing
a ledger language version with those CEK constructs).

This can be used to generate a (machine) cost model of the previous plutus version,
by omitting the generation of the costs concerning the missing @PlutusV2@ CEK constructs.
-}
clearMachineCostModel :: (m ~ MCekMachineCosts) => m -> m
clearMachineCostModel :: forall m. (m ~ MCekMachineCosts) => m -> m
clearMachineCostModel = m -> m
forall a. a -> a
id -- nothing changed, so nothing to clear

{- | Assign to `mempty` those builtins that the @PlutusV2@ introduces.

This can be used to generate a (builtin) cost model of the previous version
by omitting the generation of the costs concerning the missing @PlutusV2@ builtins.
-}
clearBuiltinCostModel :: (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel :: forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel m
r = m
r
               { paramSerialiseData = mempty
               , paramVerifyEcdsaSecp256k1Signature = mempty
               , paramVerifySchnorrSecp256k1Signature = mempty
               , paramIntegerToByteString = mempty
               , paramByteStringToInteger = mempty
               }