From c410306c28b140628ac664e05094b028797864f0 Mon Sep 17 00:00:00 2001 From: jmcardon Date: Mon, 4 Nov 2024 12:52:49 -0500 Subject: [PATCH] Unify gas charging for all Blake2b Hashes --- pact-tests/gas-goldens/builtinGas.golden | 2 +- pact/Pact/Core/Evaluate.hs | 9 +++++++-- pact/Pact/Core/Gas/TableGasModel.hs | 4 ++-- pact/Pact/Core/Gas/Types.hs | 4 ++-- pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs | 10 +++++++--- pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs | 8 ++++++-- pact/Pact/Core/IR/Eval/Direct/Evaluator.hs | 1 - pact/Pact/Core/IR/Eval/Runtime/Utils.hs | 18 +++++++----------- pact/Pact/Core/IR/ModuleHashing.hs | 4 ++-- pact/Pact/Core/PactValue.hs | 2 +- 10 files changed, 35 insertions(+), 27 deletions(-) diff --git a/pact-tests/gas-goldens/builtinGas.golden b/pact-tests/gas-goldens/builtinGas.golden index a50b3494..3aeb539e 100644 --- a/pact-tests/gas-goldens/builtinGas.golden +++ b/pact-tests/gas-goldens/builtinGas.golden @@ -55,7 +55,7 @@ fold-db: 40453150 fold: 1090 format-time: 1041 format: 1900 -hash: 300 +hash: 3500 hours: 277 hyperlane-decode-token-message: 2175 hyperlane-encode-token-message: 2475 diff --git a/pact/Pact/Core/Evaluate.hs b/pact/Pact/Core/Evaluate.hs index e055f298..c0345b25 100644 --- a/pact/Pact/Core/Evaluate.hs +++ b/pact/Pact/Core/Evaluate.hs @@ -73,24 +73,29 @@ import qualified Data.Text as T import qualified Data.ByteString as BS import qualified Pact.Core.Serialise.LegacyPact as Legacy +import Pact.Core.Serialise import Pact.Core.Pretty import Pact.Core.IR.Term -- | Function for debugging legacy serialized module data. -- feel free to delete after mainnet launch -- It's only useful for debugging some code paths in the legacy serialization. + _decodeDbgModule :: FilePath -> IO () _decodeDbgModule fp = do x <- BS.readFile fp let y = either error id $ Legacy.decodeModuleData' x - let m = unsafeAsModuleData y + let (m, deps) = unsafeAsModuleData y let (ModuleCode code) = _mCode m putStrLn $ T.unpack code putStrLn "\n\nPRETTYIED REPR\n\n" putStrLn $ show $ pretty m + putStrLn $ "\n\nPRETTY DEPS\n\n" + () <$ traverse (putStrLn . show . pretty) (M.toList deps) + BS.writeFile (T.unpack (renderModuleName (_mName m))) $ _encodeModuleData serialisePact_lineinfo (def <$ (ModuleData m deps)) where unsafeAsModuleData = \case - ModuleData m _ -> m + ModuleData m deps -> (m, deps) _ -> error "not a module data" type Eval = EvalM ExecRuntime CoreBuiltin Info diff --git a/pact/Pact/Core/Gas/TableGasModel.hs b/pact/Pact/Core/Gas/TableGasModel.hs index 15dc87e2..f64d853b 100644 --- a/pact/Pact/Core/Gas/TableGasModel.hs +++ b/pact/Pact/Core/Gas/TableGasModel.hs @@ -399,8 +399,6 @@ runTableModel nativeTable GasCostConfig{..} = \case MOpDesugarModule sz -> -- This is a pretty expensive traversal, so we will charge a bit more of a hefty price for it MilliGas (sz * _gcDesugarBytePenalty) - MOpHashModule w -> - MilliGas $ w * _gcMHashBytePenalty GStrOp op -> case op of StrOpLength len -> let charsPerMg = 100 @@ -457,6 +455,8 @@ runTableModel nativeTable GasCostConfig{..} = \case let !n = numberOfBits p !n_flt = (fromIntegral n :: Double) in fromIntegral n * ceiling ((log n_flt) ** 2) * ceiling (log (log n_flt)) + GHash w -> + MilliGas $ w * _gcMHashBytePenalty GCapOp op -> case op of CapOpRequire cnt -> let mgPerCap = 100 diff --git a/pact/Pact/Core/Gas/Types.hs b/pact/Pact/Core/Gas/Types.hs index 910cf28a..304fbd3b 100644 --- a/pact/Pact/Core/Gas/Types.hs +++ b/pact/Pact/Core/Gas/Types.hs @@ -315,6 +315,8 @@ data GasArgs b | GStrOp !StrOp | GObjOp !ObjOp | GCapOp !CapOp + | GHash !SatWord + -- ^ The cost of Blake2b hashing a particular value in bytes deriving (Show, Eq, Generic, NFData) data TranscendentalCost @@ -332,8 +334,6 @@ data ModuleOp -- ^ Cost of adding deps to the symbol table | MOpDesugarModule !SatWord -- Size of the tree -- ^ the cost of module desugar - | MOpHashModule !SatWord -- Size of the tree - -- ^ the cost of module desugar deriving (Show, Eq, Generic, NFData) instance Show b => Pretty (GasArgs b) where diff --git a/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs b/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs index a59bafb7..be9cd547 100644 --- a/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs +++ b/pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs @@ -1437,10 +1437,14 @@ coreWhere info b cont handler _env = \case coreHash :: (IsBuiltin b) => NativeFunction e b i coreHash = \info b cont handler _env -> \case - [VString s] -> - returnCEKValue cont handler (go (T.encodeUtf8 s)) + [VString s] -> do + let bytes = T.encodeUtf8 s + chargeGasArgs info $ GHash $ fromIntegral $ BS.length bytes + returnCEKValue cont handler $ go bytes [VPactValue pv] -> do - returnCEKValue cont handler (go (encodeStable pv)) + sz <- sizeOf info SizeOfV0 pv + chargeGasArgs info (GHash sz) + returnCEKValue cont handler $ go (encodeStable pv) args -> argsError info b args where go = VString . hashToText . pactHash diff --git a/pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs b/pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs index 0aed2103..fd5de887 100644 --- a/pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs +++ b/pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs @@ -1431,9 +1431,13 @@ coreWhere info b _env = \case coreHash :: (IsBuiltin b) => NativeFunction e b i coreHash = \info b _env -> \case - [VString s] -> - return (go (T.encodeUtf8 s)) + [VString s] -> do + let bytes = T.encodeUtf8 s + chargeGasArgs info $ GHash $ fromIntegral $ BS.length bytes + return (go bytes) [VPactValue pv] -> do + sz <- sizeOf info SizeOfV0 pv + chargeGasArgs info (GHash sz) return (go (encodeStable pv)) args -> argsError info b args where diff --git a/pact/Pact/Core/IR/Eval/Direct/Evaluator.hs b/pact/Pact/Core/IR/Eval/Direct/Evaluator.hs index 305234dd..ddc40f5f 100644 --- a/pact/Pact/Core/IR/Eval/Direct/Evaluator.hs +++ b/pact/Pact/Core/IR/Eval/Direct/Evaluator.hs @@ -45,7 +45,6 @@ module Pact.Core.IR.Eval.Direct.Evaluator import Control.Lens hiding (op, from, to, parts) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader import Control.Monad.State.Strict import Data.Text(Text) import Data.Foldable diff --git a/pact/Pact/Core/IR/Eval/Runtime/Utils.hs b/pact/Pact/Core/IR/Eval/Runtime/Utils.hs index 364e9177..4764901c 100644 --- a/pact/Pact/Core/IR/Eval/Runtime/Utils.hs +++ b/pact/Pact/Core/IR/Eval/Runtime/Utils.hs @@ -75,7 +75,6 @@ import qualified Data.Text.Encoding as T import qualified Data.Map.Strict as M import qualified Data.Vector as V import qualified Data.Set as S -import qualified Data.ByteString as BS import Pact.Core.Names import Pact.Core.PactValue @@ -590,13 +589,14 @@ createPrincipalForGuard info = \case Pr.R ksn <$ chargeGas 1_000 GModuleGuard (ModuleGuard mn n) -> Pr.M mn n <$ chargeGas 1_000 - GUserGuard (UserGuard f args) -> do + GUserGuard ug@(UserGuard f args) -> do + sz <- sizeOf info SizeOfV0 ug + chargeGasArgs info (GHash sz) h <- mkHash $ map encodeStable args pure $ Pr.U (renderQualName f) (hashToText h) - -- TODO orig pact gets here ^^^^ a Name - -- which can be any of QualifiedName/BareName/DynamicName/FQN, - -- and uses the rendered string here. Need to double-check equivalence. - GCapabilityGuard (CapabilityGuard f args pid) -> do + GCapabilityGuard cg@(CapabilityGuard f args pid) -> do + sz <- sizeOf info SizeOfV0 cg + chargeGasArgs info (GHash sz) let args' = map encodeStable args f' = T.encodeUtf8 $ renderQualName f pid' = T.encodeUtf8 . renderDefPactId <$> pid @@ -605,11 +605,7 @@ createPrincipalForGuard info = \case GDefPactGuard (DefPactGuard dpid name) -> Pr.P dpid name <$ chargeGas 1_000 where chargeGas mg = chargeGasArgs info (GAConstant (MilliGas mg)) - mkHash bss = do - let bs = mconcat bss - gasChargeAmt = 1_000 + fromIntegral (BS.length bs `quot` 64) * 1_000 - chargeGas gasChargeAmt - pure $ pactHash bs + mkHash bss = pactHash (mconcat bss) <$ chargeGas 1_000 createEnumerateList :: i diff --git a/pact/Pact/Core/IR/ModuleHashing.hs b/pact/Pact/Core/IR/ModuleHashing.hs index 1219ea4a..5164ffe8 100644 --- a/pact/Pact/Core/IR/ModuleHashing.hs +++ b/pact/Pact/Core/IR/ModuleHashing.hs @@ -42,7 +42,7 @@ hashModuleAndReplace m@(Module mname mgov defs mblessed imports mimps _mh txh mc mkNewModuleHash = do let m' = void m sz <- sizeOf info SizeOfV0 m' - chargeGasArgs info (GModuleOp (MOpHashModule sz)) + chargeGasArgs info (GHash sz) pure $ ModuleHash $ hash $ encodeModule m' gov' newMHash = case mgov of KeyGov n -> KeyGov n @@ -57,7 +57,7 @@ hashInterfaceAndReplace iface@(Interface ifn defs imps _mh txh mcode info) = do mkNewMhash = do let iface' = void iface sz <- sizeOf info SizeOfV0 iface' - chargeGasArgs info (GModuleOp (MOpHashModule sz)) + chargeGasArgs info (GHash sz) pure $ ModuleHash $ hash $ encodeInterface iface' updateDefHashes :: ModuleName -> ModuleHash -> Def Name Type b i -> Def Name Type b i diff --git a/pact/Pact/Core/PactValue.hs b/pact/Pact/Core/PactValue.hs index 0137ff88..a2c281b0 100644 --- a/pact/Pact/Core/PactValue.hs +++ b/pact/Pact/Core/PactValue.hs @@ -184,7 +184,7 @@ instance Pretty (AbbrevPretty PactValue) where pretty (CapToken fqn (AbbrevPretty <$> args)) PTime t -> pretty (PactTime.formatTime "%Y-%m-%d %H:%M:%S%Q %Z" t) PList l -> - brackets (prettyAbbrevText' 15 (hsep (pretty . AbbrevPretty <$> V.toList l))) + brackets (prettyAbbrevText' 15 (hsep (pretty . AbbrevPretty <$> V.toList (V.take 10 l)))) synthesizePvType :: PactValue -> Type synthesizePvType = \case