diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 515e04e83..44068e459 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -39,6 +39,9 @@ data GasCostConfig = GasCostConfig , _gasCostConfig_sortFactor :: Gas , _gasCostConfig_distinctFactor :: Gas , _gasCostConfig_concatenationFactor :: Gas + , _gasCostConfig_textConcatenationFactorOffset :: MilliGas -- up-front cost of text concatenation + , _gasCostConfig_textConcatenationFactorStringLen :: MilliGas -- additional cost of concatenation per character in the average string + , _gasCostConfig_textConcatenationFactorStrings :: MilliGas -- additional cost of concatenation per list item , _gasCostConfig_moduleCost :: Gas , _gasCostConfig_moduleMemberCost :: Gas , _gasCostConfig_useModuleCost :: Gas @@ -58,6 +61,9 @@ defaultGasConfig = GasCostConfig , _gasCostConfig_sortFactor = 1 , _gasCostConfig_distinctFactor = 1 , _gasCostConfig_concatenationFactor = 1 -- TODO benchmark + , _gasCostConfig_textConcatenationFactorOffset = MilliGas 50000 + , _gasCostConfig_textConcatenationFactorStringLen = MilliGas 20 + , _gasCostConfig_textConcatenationFactorStrings = MilliGas 40 , _gasCostConfig_moduleCost = 1 -- TODO benchmark , _gasCostConfig_moduleMemberCost = 1 , _gasCostConfig_useModuleCost = 1 -- TODO benchmark @@ -248,10 +254,21 @@ tableGasModel gasConfig = Just cs -> _gasCostConfig_selectColumnCost gasConfig * fromIntegral (length cs) GSortFieldLookup n -> gasToMilliGas $ fromIntegral n * _gasCostConfig_sortFactor gasConfig - GConcatenation i j -> - gasToMilliGas $ fromIntegral (i + j) * _gasCostConfig_concatenationFactor gasConfig - GFoldDB -> - gasToMilliGas $ _gasCostConfig_foldDBCost gasConfig + GConcatenation i j -> gasToMilliGas $ + fromIntegral (i + j) * _gasCostConfig_concatenationFactor gasConfig + GTextConcatenation nChars nStrings -> + let + MilliGas offsetCost = _gasCostConfig_textConcatenationFactorOffset gasConfig + MilliGas charCost = _gasCostConfig_textConcatenationFactorStringLen gasConfig + MilliGas stringCost = _gasCostConfig_textConcatenationFactorStrings gasConfig + + costForAverageStringLength = + (fromIntegral nChars * charCost) `div` fromIntegral nStrings + costForNumberOfStrings = + fromIntegral nStrings * stringCost + in + MilliGas $ offsetCost + costForAverageStringLength + costForNumberOfStrings + GFoldDB -> gasToMilliGas $ _gasCostConfig_foldDBCost gasConfig GPostRead r -> gasToMilliGas $ case r of ReadData cols -> _gasCostConfig_readColumnCost gasConfig * fromIntegral (Map.size (_objectMap $ _rdData cols)) ReadKey _rowKey -> _gasCostConfig_readColumnCost gasConfig diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index d69815ffc..4bd041cf2 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -1259,15 +1259,35 @@ identity _ [a'] = return a' identity i as = argsError i as concat' :: GasRNativeFun e -concat' i [TList ls _ _] = computeGas' i (GMakeList $ fromIntegral $ V.length ls) $ let - -- Use GMakeList because T.concat is O(n) on the number of strings in the list - ls' = V.toList ls - concatTextList = flip TLiteral def . LString . T.concat - in fmap concatTextList $ forM ls' $ \case - TLitString s -> return s - t -> isOffChainForkedError FlagDisablePact47 >>= \case - OffChainError -> evalError' i $ "concat: expecting list of strings: " <> pretty t - OnChainError -> evalError' i $ "concat: expected list of strings, received value of type: " <> pretty (typeof' t) +concat' i [TList ls _ _] = do + + disablePact48 <- isExecutionFlagSet FlagDisablePact48 + let concatGasCost = + if disablePact48 + then + -- Prior to pact-4.8, gas cost is proportional to the number of + -- strings being concatenated. + GMakeList $ fromIntegral $ V.length ls + else + -- Beginning with pact-4.8, gas cost in proportional to the number of + -- characters being concatinated and the length of the list. + let nChars = sum $ termLen <$> ls + where + termLen t = case t of + TLitString s -> T.length s + _ -> 0 + nStrings = V.length ls + in + GTextConcatenation nChars nStrings + computeGas' i concatGasCost $ + let + ls' = V.toList ls + concatTextList = flip TLiteral def . LString . T.concat + in fmap concatTextList $ forM ls' $ \case + TLitString s -> return s + t -> isOffChainForkedError FlagDisablePact47 >>= \case + OffChainError -> evalError' i $ "concat: expecting list of strings: " <> pretty t + OnChainError -> evalError' i $ "concat: expected list of strings, received value of type: " <> pretty (typeof' t) concat' i as = argsError i as -- | Converts a string to a vector of single character strings diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index 81e79c828..385437a2c 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -137,7 +137,10 @@ data GasArgs | GSortFieldLookup !Int -- ^ Cost of sorting by lookup fields | GConcatenation !Int !Int - -- ^ Cost of concatenating two strings, lists, and objects + -- ^ Cost of concatenating two strings before pact 4.8, lists, and objects + | GTextConcatenation !Int !Int + -- ^ Cost of concatenating a list of strings with the given total character + -- count and list length after pact 4.8 | GUnreduced ![Term Ref] -- ^ Cost of using a native function | GPostRead !ReadValue @@ -204,6 +207,7 @@ instance Pretty GasArgs where GSelect {} -> "GSelect" GSortFieldLookup i -> "GSortFieldLookup:" <> pretty i GConcatenation i j -> "GConcatenation:" <> pretty i <> colon <> pretty j + GTextConcatenation nChars nStrings -> "GTextConcatenation:" <> pretty nChars <> colon <> pretty nStrings GUnreduced {} -> "GUnreduced" GPostRead rv -> "GPostRead:" <> pretty rv GPreWrite wv szVer -> "GWrite:" <> pretty wv <> colon <> pretty szVer diff --git a/tests/GasModelSpec.hs b/tests/GasModelSpec.hs index b6f7544ae..96118dc80 100644 --- a/tests/GasModelSpec.hs +++ b/tests/GasModelSpec.hs @@ -166,7 +166,7 @@ runTest t = runGasUnitTests t run run let flags = mkExecutionConfig [ FlagDisableInlineMemCheck, FlagDisablePactEvents - , FlagDisablePact43, FlagDisablePact44, FlagDisablePact45] + , FlagDisablePact43, FlagDisablePact44, FlagDisablePact45, FlagDisablePact48] r' = set eeExecutionConfig flags r pure (r', s) diff --git a/tests/pact/gas.repl b/tests/pact/gas.repl index 97cdea6d1..0f570d2b2 100644 --- a/tests/pact/gas.repl +++ b/tests/pact/gas.repl @@ -798,3 +798,34 @@ d.G3 (str-to-list "0123456789") (expect "gas of str-to-list post-fork" 11 (env-gas)) (commit-tx) + + +; Test that `concat` is gassed by the number of characters +; at pact-4.8. +(begin-tx) +(env-gaslimit 1000000) +(module m G + (defcap G () true) + (defun ten_x_string (n) + (fold (lambda (acc unused) (+ acc "aaaaaaaaaa")) "" (enumerate 1 n))) + (defconst strings_1000_1000:[string] (make-list 1000 (ten_x_string 100))) + (defconst strings_1000_2000:[string] (make-list 2000 (ten_x_string 100))) + (defconst strings_2000_1000:[string] (make-list 1000 (ten_x_string 200))) + ) + +; ============================================================ ; +;; TEST: cost of running concat on large strings. +;; +(env-gas 0) +(concat strings_1000_1000) +(expect "calling (concat strings_1000_1000)" 111 (env-gas)) + +(env-gas 0) +(concat strings_2000_1000) +(expect "calling (concat strings_2000_1000)" 131 (env-gas)) + +(env-gas 0) +(concat strings_1000_2000) +(expect "calling (concat strings_1000_2000)" 151 (env-gas)) + +(commit-tx)