Implement InitialGasModel

Author: kdafriend

chainweb.cabal

@@ -343,6 +343,7 @@ library
         , Chainweb.Pact5.TransactionExec
         , Chainweb.Pact5.Types
         , Chainweb.Pact5.Validations
+        , Chainweb.Pact5.InitialGasModel
         , Chainweb.Pact.Transactions.FungibleV2Transactions
         , Chainweb.Pact.Transactions.CoinV3Transactions
         , Chainweb.Pact.Transactions.CoinV4Transactions

src/Chainweb/Pact/PactService.hs

@@ -918,7 +918,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do
                         lift (Pact5.liftPactServiceM (Pact5.assertPreflightMetadata (view Pact5.payloadObj <$> pact5Cmd) txCtx sigVerify)) >>= \case
                             Left err -> earlyReturn $ review _MetadataValidationFailure err
                             Right () -> return ()
-                        let initialGas = Pact5.initialGasOf v cid (Pact5.ctxCurrentBlockHeight txCtx) $ Pact5._cmdPayload pact5Cmd
+                        let initialGas = Pact5.initialGasOf v cid (Pact5.ctxCurrentBlockHeight txCtx) (Pact5.ctxParentForkNumber txCtx) pact5Cmd
                         applyCmdResult <- lift $ Pact5.pactTransaction Nothing (\dbEnv ->
                             Pact5.applyCmd
                                 _psLogger _psGasLogger dbEnv

src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs

@@ -359,7 +359,8 @@ applyPactCmd env miner txIdxInBlock tx = StateT $ \(blockHandle, blockGasRemaini
     (unsafeApplyPactCmd blockHandle
       (initialGasOf (_chainwebVersion env) (Chainweb.Version._chainId env)
         (env ^. psParentHeader . parentHeader . blockHeight)
-        (tx ^. Pact5.cmdPayload))
+        (env ^. psParentHeader . parentHeader . blockForkNumber)
+        tx)
       alteredTx)
     env
   case resultOrGasError of

src/Chainweb/Pact5/InitialGasModel.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Chainweb.Pact5.InitialGasModel
+  ( InitialGasModel(..)
+  , pre31GasModel
+  , post31GasModel
+  , post32GasModel
+  -- Lenses
+  , feePerByte
+  , rawPayloadSizeFactor
+  , proofSizeFactor
+  , signatureSizeFactor
+  , sizePenalty
+  , signatureCost
+  ) where
+
+import Control.DeepSeq
+import Pact.Core.Scheme
+import Control.Lens
+
+
+data InitialGasModel = InitialGasModel
+  { _feePerByte :: Rational
+      -- ^ Base Price charged per byte
+  , _rawPayloadSizeFactor :: Rational
+      -- ^ Multiplier for the raw payload (without continuation proof) size
+  , _proofSizeFactor :: Rational
+      -- ^ Multiplier for the proof size
+  , _signatureSizeFactor :: Rational
+      -- ^ Multiplier for signatures size
+  , _sizePenalty :: Rational -> Rational
+      -- ^ Function used to compute a penalty for big transactions
+  , _signatureCost :: PPKScheme -> Rational
+      -- ^ Function used to compute a fixed amount of gas per signature
+  }
+
+-- Required to be used as a rule
+instance NFData InitialGasModel where
+  rnf (InitialGasModel {}) = ()
+
+makeLenses ''InitialGasModel
+
+pre31GasModel :: InitialGasModel
+pre31GasModel = InitialGasModel
+  { _feePerByte = 0.01
+  , _rawPayloadSizeFactor = 1.0
+  , _proofSizeFactor = 0.0
+  , _signatureSizeFactor = 0.0
+  , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer)
+  , _signatureCost = const 0.0
+  }
+
+
+post31GasModel :: InitialGasModel
+post31GasModel = InitialGasModel
+  { _feePerByte = 0.01
+  , _rawPayloadSizeFactor = 1.0
+  , _proofSizeFactor = 1.0
+  , _signatureSizeFactor = 0.0
+  , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer)
+  , _signatureCost = const 0.0
+  }
+
+
+post32GasModel :: InitialGasModel
+post32GasModel = InitialGasModel
+  { _feePerByte = 0.01
+  , _rawPayloadSizeFactor = 1.0
+  , _proofSizeFactor = 1.0
+  , _signatureSizeFactor = 1.0
+  , _sizePenalty = \x -> (x / 512) ^ (7 :: Integer)
+  , _signatureCost = \case
+                        ED25519 -> 10.0     -- | TODO => Needs to be benchmarked
+                        WebAuthn -> 10.0    -- |
+  }

src/Chainweb/Pact5/TransactionExec.hs

@@ -86,6 +86,7 @@ import Pact.Core.Hash
 import Pact.Core.Info
 import Pact.Core.Names
 import Pact.Core.Namespace
+import Pact.Core.Scheme (defPPKScheme)
 import Pact.Core.PactValue
 import Pact.Core.Persistence.Types hiding (GasM(..))
 import Pact.Core.Persistence.Utils (ignoreGas)
@@ -103,11 +104,13 @@ import Chainweb.BlockCreationTime
 import Chainweb.BlockHash
 import Chainweb.BlockHeader
 import Chainweb.BlockHeight
+import Chainweb.ForkState
 import Chainweb.Logger
 import Chainweb.Miner.Pact
 import Chainweb.Pact.Types
 import Chainweb.Pact5.Templates
 import Chainweb.Pact5.Types
+import Chainweb.Pact5.InitialGasModel
 
 import Chainweb.Time
 import Chainweb.Pact5.Transaction
@@ -977,33 +980,25 @@ redeemGas logger db txCtx gasUsed maybeFundTxPactId cmd
 -- -- Utilities
 
 -- | Initial gas charged for transaction size
---   ignoring the size of a continuation proof, if present
---
-initialGasOf :: ChainwebVersion -> V.ChainId -> BlockHeight -> PayloadWithText meta ParsedCode -> Gas
-initialGasOf v cid bh payload = Gas gasFee
-  where
-    feePerByte :: Rational = 0.01
-
-    contProofSize =
-      case payload ^. payloadObj . pPayload of
-        Continuation (ContMsg _ _ _ _ (Just (ContProof p))) -> B.length p
-        _ -> 0
-    txSize
-      | chainweb31 v cid bh = SB.length (payload ^. payloadBytes)
-      | otherwise = SB.length (payload ^. payloadBytes) - contProofSize
-
-    costPerByte = fromIntegral txSize * feePerByte
-    sizePenalty = txSizeAccelerationFee costPerByte
-    gasFee = ceiling (costPerByte + sizePenalty)
-{-# INLINE initialGasOf #-}
-
-txSizeAccelerationFee :: Rational -> Rational
-txSizeAccelerationFee costPerByte = total
+initialGasOf :: ChainwebVersion -> V.ChainId -> BlockHeight -> ForkNumber -> Transaction -> Gas
+initialGasOf v cid bh fn tx = Gas $ ceiling $ sizeCost + sizePenaltyCost + sigsCost
   where
-    total = (costPerByte / bytePenalty) ^ power
-    bytePenalty = 512
-    power :: Integer = 7
-{-# INLINE txSizeAccelerationFee #-}
+    model = activeInitialGasModel v cid fn bh
+    proofSize = case tx ^. cmdPayload . payloadObj . pPayload of
+                  Continuation (ContMsg _ _ _ _ (Just (ContProof p))) -> B.length p
+                  _ -> 0
+
+    rawSize = SB.length (tx ^. cmdPayload . payloadBytes) - proofSize
+    sigsSize = sum $ map (B.length . J.encodeStrict) $ tx ^. cmdSigs
+
+    sizeCost = model ^. feePerByte * ( model ^. rawPayloadSizeFactor * fromIntegral rawSize
+                                     + model ^. proofSizeFactor      * fromIntegral proofSize
+                                     + model ^. signatureSizeFactor  * fromIntegral sigsSize)
+    sizePenaltyCost  = (model ^. sizePenalty) sizeCost
+
+    sigsCost = sum $ map ((model ^. signatureCost) . fromMaybe defPPKScheme . view siScheme)
+                  $ tx ^. cmdPayload . payloadObj . pSigners
+
 
 -- | Chainweb's namespace policy for ordinary transactions.
 -- Doesn't allow installing modules in the root namespace.

src/Chainweb/Version.hs

@@ -70,6 +70,7 @@ module Chainweb.Version
     , versionGraphs
     , versionHeaderBaseSizeBytes
     , versionMaxBlockGasLimit
+    , versionInitialGasModel
     , versionSpvProofRootValidWindow
     , versionName
     , versionWindow
@@ -184,6 +185,7 @@ import Chainweb.MerkleUniverse
 import Chainweb.Payload
 import Chainweb.Pact4.Transaction qualified as Pact4
 import Chainweb.Pact5.Transaction qualified as Pact5
+import Chainweb.Pact5.InitialGasModel
 import Chainweb.ForkState
 import Chainweb.Utils
 import Chainweb.Utils.Rule
@@ -539,6 +541,8 @@ data ChainwebVersion
     , _versionSpvProofRootValidWindow :: Rule ForkHeight (Maybe Word64)
         -- ^ The minimum number of block headers a chainweb node should
         -- retain in its history at all times.
+    , _versionInitialGasModel :: ChainMap (Rule ForkHeight (InitialGasModel))
+        -- ^ The initial gas model used for Pact 5 transactions processing
     , _versionBootstraps :: [PeerInfo]
         -- ^ The locations of the bootstrap peers.
     , _versionGenesis :: VersionGenesis

src/Chainweb/Version/Development.hs

@@ -12,6 +12,7 @@ import qualified Data.Set as Set
 import Chainweb.BlockCreationTime
 import Chainweb.ChainId
 import Chainweb.Difficulty
+import Chainweb.Pact5.InitialGasModel
 import Chainweb.Graph
 import Chainweb.Time
 import Chainweb.Utils
@@ -52,6 +53,7 @@ devnet = ChainwebVersion
     -- defaultChainwebConfiguration._configBlockGasLimit
     , _versionMaxBlockGasLimit = Bottom (minBound, Nothing)
     , _versionSpvProofRootValidWindow = Bottom (minBound, Nothing)
+    , _versionInitialGasModel = AllChains $  Bottom (minBound, post32GasModel)
     , _versionCheats = VersionCheats
         { _disablePow = True
         , _fakeFirstEpochStart = True

src/Chainweb/Version/Guards.hs

@@ -57,6 +57,7 @@ module Chainweb.Version.Guards
     , pact4ParserVersion
     , maxBlockGasLimit
     , minimumBlockHeaderHistory
+    , activeInitialGasModel
     , validPPKSchemes
     , isWebAuthnPrefixLegal
     , validKeyFormats
@@ -75,6 +76,7 @@ import Chainweb.Pact4.Transaction qualified as Pact4
 import Chainweb.Utils.Rule
 import Chainweb.ForkState
 import Chainweb.Version
+import Chainweb.Pact5.InitialGasModel
 import Control.Lens
 import Data.Word (Word64)
 import Numeric.Natural
@@ -348,6 +350,12 @@ minimumBlockHeaderHistory v fn bh = snd $ ruleZipperHere $ snd
     where
         searchKey = ForkAtBlockHeight bh `max` ForkAtForkNumber fn
 
+activeInitialGasModel :: ChainwebVersion -> ChainId -> ForkNumber -> BlockHeight -> InitialGasModel
+activeInitialGasModel v cid fn bh = snd $ ruleZipperHere $ snd
+    $ ruleSeek (\h _ -> searchKey >= h) $ v ^?! versionInitialGasModel . atChain cid
+    where
+        searchKey = ForkAtBlockHeight bh `max` ForkAtForkNumber fn
+
 -- | Different versions of Chainweb allow different PPKSchemes.
 --
 validPPKSchemes :: ChainwebVersion -> ChainId -> BlockHeight -> [PPKScheme]

src/Chainweb/Version/Mainnet.hs

@@ -16,6 +16,7 @@ import Chainweb.BlockHeight
 import Chainweb.ChainId
 import Chainweb.Difficulty
 import Chainweb.Graph
+import Chainweb.Pact5.InitialGasModel
 import Chainweb.Time
 import Chainweb.Utils
 import Chainweb.Utils.Rule
@@ -166,6 +167,10 @@ mainnet = ChainwebVersion
     , _versionMaxBlockGasLimit =
         (succByHeight $ mainnet ^?! versionForks . at Chainweb216Pact . _Just . atChain (unsafeChainId 0), Just 180_000) `Above`
         Bottom (minBound, Nothing)
+    , _versionInitialGasModel = AllChains $
+        (ForkNever, post32GasModel) `Above`
+        (succByHeight $ mainnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0), post31GasModel) `Above`
+        Bottom (minBound, pre31GasModel)
     , _versionSpvProofRootValidWindow =
         (succByHeight $ mainnet ^?! versionForks . at Chainweb31 . _Just . atChain (unsafeChainId 0), Nothing) `Above`
         (succByHeight $ mainnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0) , Just 20_000) `Above`

src/Chainweb/Version/RecapDevelopment.hs

@@ -9,10 +9,12 @@ module Chainweb.Version.RecapDevelopment(recapDevnet, pattern RecapDevelopment)
 
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Set as Set
+import Control.Lens
 
 import Chainweb.BlockCreationTime
 import Chainweb.BlockHeight
 import Chainweb.ChainId
+import Chainweb.Pact5.InitialGasModel
 import Chainweb.Difficulty
 import Chainweb.Graph
 import Chainweb.Time
@@ -113,6 +115,11 @@ recapDevnet = ChainwebVersion
         }
 
     , _versionMaxBlockGasLimit = Bottom (minBound, Just 180_000)
+    , _versionInitialGasModel = AllChains $
+        (ForkNever, post32GasModel) `Above`
+        (succByHeight $ recapDevnet ^?! versionForks . at Chainweb231Pact . _Just . atChain (unsafeChainId 0), post31GasModel) `Above`
+        Bottom (minBound, pre31GasModel)
+
     , _versionSpvProofRootValidWindow = Bottom (minBound, Nothing)
     , _versionCheats = VersionCheats
         { _disablePow = False