Unify gas charging for all Blake2b Hashes

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

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

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

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

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

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

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

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

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

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