Add static redeploy native

docs/builtins/General/acquire-module-admin.md

@@ -23,8 +23,6 @@ It will attempt to acquire the governance cap and if successful, it will grant m
 
 ### Arguments
 
-Use one of the following argument to define the value you want to retrieve using the `at` Pact function.
-
 | Argument | Type | Description
 | -------- | ---- | -----------
 | `ref` | modref | Specifies the module to acquire administrative capabilities for.

docs/builtins/General/static-redeploy.md

@@ -0,0 +1,39 @@
+## static-redeploy
+
+Use `static-redeploy` to redeploy any module, without _any_ code changes. Roundtripping a legacy module will store the new module in our new, more compact storage format, which will result in less gas on loads.
+
+Note: this leaves governance unchanged.
+
+### Basic syntax
+
+Assume you have some module
+```pact
+(module m g
+  (defcap g () true)
+
+  (defun f () 1)
+
+  (defun gg () 2)
+  )
+```
+
+To redeploy using the new pact-5, call
+
+```pact
+(static-redeploy "m")
+```
+
+### Arguments
+
+
+| Argument | Type | Description
+| -------- | ---- | -----------
+| `module` | string | Specifies the module to redeploy
+
+### Return values
+
+The unit value `()` will be returned if successful.
+
+### Examples
+
+See: Basic Syntax.

gasmodel/Pact/Core/GasModel/BuiltinsGas.hs

@@ -920,6 +920,7 @@ benchesForBuiltin bn = case bn of
   CoreHyperlaneDecodeMessage -> todo
   CoreHyperlaneEncodeMessage -> todo
   CoreHyperlaneMessageId -> todo
+  CoreStaticRedeploy -> omittedDeliberately
   where
   omittedDeliberately = const []
   alreadyCovered = const []

pact-tests/gas-goldens/static-redeploy.repl

@@ -0,0 +1,9 @@
+(module m g
+  (defcap g () true)
+
+  (defun f () 1)
+
+  (defun gg () 2)
+  )
+
+(static-redeploy 'm)

pact/Pact/Core/Builtin.hs

@@ -236,6 +236,7 @@ data CoreBuiltin
   -- | BackCompat: read with filtering columns
   | CoreReadWithFields
   | CoreListModules
+  | CoreStaticRedeploy
   deriving (Eq, Show, Ord, Bounded, Enum, Generic)
 
 instance NFData CoreBuiltin
@@ -409,6 +410,7 @@ coreBuiltinToText = \case
   CoreHyperlaneEncodeMessage -> "hyperlane-encode-token-message"
   CoreReadWithFields -> "read-with-fields"
   CoreListModules -> "list-modules"
+  CoreStaticRedeploy -> "static-redeploy"
 
 -- | Our `CoreBuiltin` user-facing representation.
 -- note: `coreBuiltinToUserText` is primarily for pretty printing
@@ -560,6 +562,7 @@ coreBuiltinToUserText = \case
   CoreAcquireModuleAdmin -> "acquire-module-admin"
   CoreReadWithFields -> "read"
   CoreListModules -> "list-modules"
+  CoreStaticRedeploy -> "static-redeploy"
 
 instance IsBuiltin CoreBuiltin where
   builtinName = NativeName . coreBuiltinToText
@@ -714,6 +717,7 @@ instance IsBuiltin CoreBuiltin where
     CoreHyperlaneEncodeMessage -> 1
     CoreReadWithFields -> 3
     CoreListModules -> 0
+    CoreStaticRedeploy -> 1
 
 coreBuiltinNames :: [Text]
 coreBuiltinNames =

pact/Pact/Core/Evaluate.hs

@@ -83,7 +83,7 @@ data EnableGasLogs
   | GasLogsDisabled
   deriving (Eq, Show, Ord)
 
-evalInterpreter :: Interpreter ExecRuntime CoreBuiltin i
+evalInterpreter :: Interpreter ExecRuntime CoreBuiltin Info
 evalInterpreter =
   Interpreter runGuard runTerm resume evalWithCap
   where
@@ -93,10 +93,10 @@ evalInterpreter =
   evalWithCap info purity ct term =
     CEK.evalWithinCap info purity cekEnv ct term
 
-cekEnv :: CEK.BuiltinEnv ExecRuntime CoreBuiltin i
+cekEnv :: CEK.BuiltinEnv ExecRuntime CoreBuiltin Info
 cekEnv = coreBuiltinEnv @ExecRuntime
 
-evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin i
+evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin Info
 evalDirectInterpreter =
   Interpreter runGuard runTerm resume evalWithCap
   where

pact/Pact/Core/Gas/TableGasModel.hs

@@ -626,7 +626,7 @@ coreBuiltinGasCost GasCostConfig{..} = MilliGas . \case
   CoreSelectWithFields ->
     _gcSelectPenalty
   -- Update same gas penalty as write and insert
-  CoreUpdate -> 100_000
+  CoreUpdate -> _gcWritePenalty
   -- note: with-default read and read
   -- should cost the same.
   CoreWithDefaultRead ->
@@ -703,6 +703,7 @@ coreBuiltinGasCost GasCostConfig{..} = MilliGas . \case
   CoreAcquireModuleAdmin -> 20_000
   CoreReadWithFields -> _gcReadPenalty
   CoreListModules -> _gcMetadataTxPenalty
+  CoreStaticRedeploy -> _gcNativeBasicWork
 {-# INLINABLE runTableModel #-}
 
 

pact/Pact/Core/IR/Eval/CEK/CoreBuiltin.hs

@@ -67,6 +67,7 @@ import Pact.Core.Namespace
 import Pact.Core.Gas
 import Pact.Core.Type
 import Pact.Core.ModRefs
+import Pact.Core.Info
 #ifndef WITHOUT_CRYPTO
 import Pact.Core.Crypto.Pairing
 import Pact.Core.Crypto.Hash.Poseidon
@@ -1986,23 +1987,56 @@ coreListModules info b cont handler env = \case
     returnCEKValue cont handler $ VList $ V.fromList (PString . renderModuleName <$> mns)
   args -> argsError info b args
 
+coreStaticRedeploy :: (IsBuiltin b, SizeOf b, SizeOf i) => NativeFunction e b i
+coreStaticRedeploy info b cont handler env = \case
+  [VString m] -> do
+    enforceTopLevelOnly info b
+    case parseModuleName m of
+      Just mname -> do
+        mdata <- getModuleData info mname
+        let code@(ModuleCode mcode) = moduleDataCode mdata
+        let mdFqn = HashedModuleName mname (view mdModuleHash mdata)
+        -- Write the module code to SYS:ModuleSources
+        -- so we don't break tooling on redeploys, because we definitely won't write it out
+        -- to CBOR
+        if T.null mcode then pure ()
+        else do
+          wtSize <- sizeOf info SizeOfV0 (ModuleCode mcode)
+          chargeGasArgs info (GWrite wtSize)
+          evalWrite info (_cePactDb env) Write DModuleSource mdFqn code
+        msize <- sizeOf info SizeOfV0 mdata
+        chargeGasArgs info (GWrite msize)
+        evalWrite info (_cePactDb env) Write DModules mname mdata
+        -- There is no meaningful return value here
+        returnCEKValue cont handler VUnit
+      Nothing -> throwNativeExecutionError info b $ "invalid module name format"
+  args -> argsError info b args
+  where
+  moduleDataCode = \case
+    ModuleData m _ -> _mCode m
+    InterfaceData iface _ -> _ifCode iface
+
 -----------------------------------
 -- Builtin exports
 -----------------------------------
 
 
 coreBuiltinEnv
-  :: BuiltinEnv e CoreBuiltin i
+  :: forall e i. SizeOf i => BuiltinEnv e CoreBuiltin i
 coreBuiltinEnv i b env = mkBuiltinFn i b env (coreBuiltinRuntime b)
 {-# INLINEABLE coreBuiltinEnv #-}
 
 
 {-# SPECIALIZE coreBuiltinRuntime
    :: CoreBuiltin
-   -> NativeFunction ExecRuntime CoreBuiltin i
+   -> NativeFunction ExecRuntime CoreBuiltin LineInfo
+    #-}
+{-# SPECIALIZE coreBuiltinRuntime
+   :: CoreBuiltin
+   -> NativeFunction ExecRuntime CoreBuiltin SpanInfo
     #-}
 coreBuiltinRuntime
-  :: (IsBuiltin b)
+  :: (IsBuiltin b, SizeOf b, SizeOf i)
   => CoreBuiltin
   -> NativeFunction e b i
 coreBuiltinRuntime = \case
@@ -2143,3 +2177,4 @@ coreBuiltinRuntime = \case
   CoreAcquireModuleAdmin -> coreAcquireModuleAdmin
   CoreReadWithFields -> dbRead
   CoreListModules -> coreListModules
+  CoreStaticRedeploy -> coreStaticRedeploy

pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs

@@ -1990,18 +1990,47 @@ coreListModules info b env = \case
     return $ VList $ V.fromList (PString . renderModuleName <$> mns)
   args -> argsError info b args
 
+coreStaticRedeploy :: (IsBuiltin b, SizeOf b, SizeOf i) => NativeFunction e b i
+coreStaticRedeploy info b env = \case
+  [VString m] -> do
+    enforceTopLevelOnly info b
+    case parseModuleName m of
+      Just mname -> do
+        mdata <- getModuleData info mname
+        let code@(ModuleCode mcode) = moduleDataCode mdata
+        let mdFqn = HashedModuleName mname (view mdModuleHash mdata)
+        -- Write the module code to SYS:ModuleSources
+        -- so we don't break tooling on redeploys, because we definitely won't write it out
+        -- to CBOR
+        if T.null mcode then pure ()
+        else do
+          wtSize <- sizeOf info SizeOfV0 (ModuleCode mcode)
+          chargeGasArgs info (GWrite wtSize)
+          evalWrite info (_cePactDb env) Write DModuleSource mdFqn code
+        msize <- sizeOf info SizeOfV0 mdata
+        chargeGasArgs info (GWrite msize)
+        evalWrite info (_cePactDb env) Write DModules mname mdata
+        -- There is no meaningful return value here
+        return VUnit
+      Nothing -> throwNativeExecutionError info b $ "invalid module name format"
+  args -> argsError info b args
+  where
+  moduleDataCode = \case
+    ModuleData m _ -> _mCode m
+    InterfaceData iface _ -> _ifCode iface
+
 -----------------------------------
 -- Builtin exports
 -----------------------------------
 
 
 coreBuiltinEnv
-  :: forall e i
-  . BuiltinEnv e CoreBuiltin i
+  :: forall e i.
+  (SizeOf i) => BuiltinEnv e CoreBuiltin i
 coreBuiltinEnv i b env = mkDirectBuiltinFn i b env (coreBuiltinRuntime b)
 
 coreBuiltinRuntime
-  :: (IsBuiltin b)
+  :: (IsBuiltin b, SizeOf b, SizeOf i)
   => CoreBuiltin
   -> NativeFunction e b i
 coreBuiltinRuntime =
@@ -2158,3 +2187,4 @@ coreBuiltinRuntime =
     CoreAcquireModuleAdmin -> coreAcquireModuleAdmin
     CoreReadWithFields -> dbRead
     CoreListModules -> coreListModules
+    CoreStaticRedeploy -> coreStaticRedeploy