Bump integer thresholds (#1272)

* bump int threhold

* add tests for gas pre/post fork

src/Pact/Gas/Table.hs

@@ -248,8 +248,8 @@ tableGasModel gasConfig =
         GUserApp t -> case t of
           Defpact -> gasToMilliGas $ _gasCostConfig_defPactCost gasConfig * _gasCostConfig_functionApplicationCost gasConfig
           _ -> gasToMilliGas $ _gasCostConfig_functionApplicationCost gasConfig
-        GIntegerOpCost i j ->
-          gasToMilliGas $ intCost (fst i) + intCost (fst j)
+        GIntegerOpCost i j ts ->
+          gasToMilliGas $ intCost ts (fst i) + intCost ts (fst j)
         GDecimalOpCost _ _ -> mempty
         GMakeList v -> gasToMilliGas $ expLengthPenalty v
         GSort len -> gasToMilliGas $ expLengthPenalty len
@@ -310,9 +310,9 @@ tableGasModel gasConfig =
         GInterfaceDecl _interfaceName _iCode -> gasToMilliGas (_gasCostConfig_interfaceCost gasConfig)
         GModuleMemory i -> gasToMilliGas $ moduleMemoryCost i
         GPrincipal g -> gasToMilliGas $ fromIntegral g * _gasCostConfig_principalCost gasConfig
-        GMakeList2 len msz ->
+        GMakeList2 len msz ts ->
           let glen = fromIntegral len
-          in gasToMilliGas $ glen + maybe 0 ((* glen) . intCost) msz
+          in gasToMilliGas $ glen + maybe 0 ((* glen) . intCost ts) msz
         GZKArgs arg -> gasToMilliGas $ case arg of
           PointAdd g -> pointAddGas g
           ScalarMult g -> scalarMulGas g
@@ -374,16 +374,16 @@ defaultGasModel = tableGasModel defaultGasConfig
 
 #if !defined(ghcjs_HOST_OS)
 -- | Costing function for binary integer ops
-intCost :: Integer -> Gas
-intCost !a
-  | (abs a) < threshold = 0
+intCost :: IntOpThreshold -> Integer -> Gas
+intCost ts !a
+  | (abs a) < threshold ts = 0
   | otherwise =
     let !nbytes = (I# (IntLog.integerLog2# (abs a)) + 1) `quot` 8
     in fromIntegral (nbytes * nbytes `quot` 100)
   where
-  threshold :: Integer
-  threshold = (10 :: Integer) ^ (30 :: Integer)
-
+  threshold :: IntOpThreshold -> Integer
+  threshold Pact43IntThreshold = (10 :: Integer) ^ (30 :: Integer)
+  threshold Pact48IntThreshold = (10 :: Integer) ^ (80 :: Integer)
 
 _intCost :: Integer -> Int
 _intCost !a =

src/Pact/Native.hs

@@ -912,7 +912,8 @@ list i as = return $ TList (V.fromList as) TyAny (_faInfo i) -- TODO, could set
 makeList :: GasRNativeFun e
 makeList i [TLitInteger len,value] = case typeof value of
   Right ty -> do
-    ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing)
+    ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold
+    ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing ts)
     computeGas' i ga $ return $
       toTListV ty def $ V.replicate (fromIntegral len) value
   Left ty -> evalError' i $ "make-list: invalid value type: " <> pretty ty
@@ -936,7 +937,8 @@ enumerate i = \case
       -- ^ The generated vector
       -> Eval e (Term Name)
     computeList len sz v = do
-      ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len (Just sz))
+      ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold
+      ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len (Just sz) ts)
       computeGas' i ga $ pure $ toTListV tTyInteger def $ fmap toTerm v
 
     step to' inc acc
@@ -1315,7 +1317,8 @@ stringToCharList t = V.fromList $ tLit . LString . T.singleton <$> T.unpack t
 strToList :: GasRNativeFun e
 strToList i [TLitString s] = do
   let len = fromIntegral $ T.length s
-  ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing)
+  ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold
+  ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing ts)
   computeGas' i ga $ return $ toTListV tTyString def $ stringToCharList s
 strToList i as = argsError i as
 

src/Pact/Native/Ops.hs

@@ -162,15 +162,18 @@ powImpl i as@[TLiteral a _,TLiteral b _] = do
 powImpl i as = argsError i as
 
 twoArgIntOpGas :: Integer -> Integer -> Eval e ()
-twoArgIntOpGas loperand roperand =
-  computeGasCommit def "" (GIntegerOpCost (loperand, Nothing) (roperand, Nothing))
+twoArgIntOpGas loperand roperand = do
+  ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold
+  computeGasCommit def "" (GIntegerOpCost (loperand, Nothing) (roperand, Nothing) ts)
 
 twoArgDecOpGas :: Decimal -> Decimal -> Eval e ()
-twoArgDecOpGas loperand roperand =
+twoArgDecOpGas loperand roperand = do
+  ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold
   computeGasCommit def ""
-  (GIntegerOpCost
-    (decimalMantissa loperand, Just (fromIntegral (decimalPlaces loperand)))
-    (decimalMantissa roperand, Just (fromIntegral (decimalPlaces roperand))))
+    (GIntegerOpCost
+      (decimalMantissa loperand, Just (fromIntegral (decimalPlaces loperand)))
+      (decimalMantissa roperand, Just (fromIntegral (decimalPlaces roperand)))
+      ts)
 
 legalLogArg :: Literal -> Bool
 legalLogArg = \case

src/Pact/Types/Gas.hs

@@ -28,6 +28,7 @@ module Pact.Types.Gas
   , MilliGasLimit(..)
   , ZKGroup(..)
   , ZKArg(..)
+  , IntOpThreshold(..)
   , gasLimitToMilliGasLimit
     -- * optics
   , geGasLimit
@@ -166,18 +167,29 @@ data GasArgs
   -- ^ The cost of the in-memory representation of the module
   | GPrincipal !Int
   -- ^ the cost of principal creation and validation
-  | GIntegerOpCost !(Integer, Maybe Integer) !(Integer, Maybe Integer)
+  | GIntegerOpCost !(Integer, Maybe Integer) !(Integer, Maybe Integer) IntOpThreshold
   -- ^ Integer costs
   | GDecimalOpCost !Decimal !Decimal
   -- ^ Decimal costs
-  | GMakeList2 !Integer !(Maybe Integer)
+  | GMakeList2 !Integer !(Maybe Integer) IntOpThreshold
   -- ^ List versioning 2
   | GZKArgs !ZKArg
   | GReverse !Int
   -- ^ Cost of reversing a list of a given length
   | GFormatValues !Text !(V.Vector PactValue)
   -- ^ Cost of formatting with the given format string and args
 
+data IntOpThreshold
+  = Pact43IntThreshold
+  | Pact48IntThreshold
+  deriving (Eq, Show, Enum, Bounded)
+
+instance Pretty IntOpThreshold where
+  pretty = \case
+    Pact43IntThreshold -> "Pact43IntThreshold"
+    Pact48IntThreshold -> "Pact48IntThreshold"
+
+
 -- | The elliptic curve pairing group we are
 -- handling
 data ZKGroup
@@ -227,9 +239,9 @@ instance Pretty GasArgs where
     GFoldDB -> "GFoldDB"
     GModuleMemory i -> "GModuleMemory: " <> pretty i
     GPrincipal i -> "GPrincipal: " <> pretty i
-    GIntegerOpCost i j -> "GIntegerOpCost:" <> pretty i <> colon <> pretty j
+    GIntegerOpCost i j ts -> "GIntegerOpCost:" <> pretty i <> colon <> pretty j <> colon <> pretty ts
     GDecimalOpCost i j -> "GDecimalOpCost:" <> pretty (show i) <> colon <> pretty (show j)
-    GMakeList2 i k -> "GMakeList2:" <> pretty i <> colon <> pretty k
+    GMakeList2 i k ts -> "GMakeList2:" <> pretty i <> colon <> pretty k <> colon <> pretty ts
     GZKArgs arg -> "GZKArgs:" <> pretty arg
     GReverse len -> "GReverse:" <> pretty len
     GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args)

tests/pact/gas.repl

@@ -848,3 +848,31 @@ d.G3
 (expect "gas of formatting a sample list" 10014 (env-gas))
 
 (commit-tx)
+
+; tests for pre/post integer ops
+(begin-tx)
+(module m G (defcap G () true)
+  (defconst i79:integer (+ (^ 10 79) 1))
+  (defconst i80:integer (+ (^ 10 80) 1))
+)
+(env-exec-config ["DisablePact48"])
+(env-gas 0)
+(+ i79 i79)
+(expect "gas of + pre-fork 10^79" (env-gas) 21)
+
+(env-gas 0)
+(+ i80 i80)
+(expect "gas of + pre-fork 10^80" (env-gas) 21)
+
+; post-fork
+(env-gas 0)
+(env-exec-config [])
+(env-gas 0)
+(+ i79 i79)
+(expect "gas of + post-fork 10^79" (env-gas) 1)
+
+(env-gas 0)
+(+ i80 i80)
+(expect "gas of + post-fork 10^80" (env-gas) 21)
+
+(commit-tx)