Return code to describe-module

- Added DModuleSource for storing module source code, as well as new table
- Added PactSerialise for Module source
- Retrofitted Existing PactDbs to store module source
- Add Module source slicing to `Evaluate`

gasmodel/Pact/Core/GasModel/ContractBench.hs

@@ -142,7 +142,7 @@ runPactTxFromSource
   -> IO (Either (PactError Info) [CompileValue Info],EvalState CoreBuiltin Info)
 runPactTxFromSource ee source interpreter = runEvalM (ExecEnv ee) def $ do
   program <- liftEither $ compileOnlyLineInfo (RawCode source)
-  traverse (interpretTopLevel interpreter) program
+  traverse (interpretTopLevel interpreter (RawCode mempty)) program
 
 setupBenchEvalEnv
   :: PactDb CoreBuiltin i

gasmodel/Pact/Core/GasModel/Utils.hs

@@ -214,7 +214,9 @@ gmModule = Module
   , _mGovernance=KeyGov gmKeysetName
   , _mDefs=gmModuleDefns
   , _mTxHash = Hash mempty
-  , _mBlessed=mempty}
+  , _mBlessed=mempty
+  , _mCode = ModuleCode mempty
+  }
 
 gmModuleData :: ModuleData CoreBuiltin Info
 gmModuleData = ModuleData gmModule mempty

pact-lsp/Pact/Core/LanguageServer.hs

@@ -381,7 +381,7 @@ processFile replEnv nuri source = do
         (ds, deps) <- compileDesugarOnly replEnv tl
         constEvaled <- ConstEval.evalTLConsts replEnv ds
         let tlFinal = MHash.hashTopLevel constEvaled
-        let act = M.singleton nuri [ds] <$ evalTopLevel replEnv tlFinal deps
+        let act = M.singleton nuri [ds] <$ evalTopLevel replEnv (RawCode mempty) tlFinal deps
         catchError act (const (pure mempty))
       _ ->  pure mempty
 

pact-lsp/Pact/Core/LanguageServer/Renaming.hs

@@ -25,15 +25,15 @@ matchingDefs tls mn n = (interfaceDef, moduleDef)
   where
     interfaceDef = do
       let p = \case
-            TLInterface (Interface mn' _ _ _ _ _) -> mn == mn'
+            TLInterface (Interface mn' _ _ _ _ _ _) -> mn == mn'
             _ -> False
 
       TLInterface interf <- find p tls
       find (\x -> ifDefName x == n) (_ifDefns interf)
 
     moduleDef = do
       let p = \case
-            TLModule (Module mn' _ _ _ _ _ _ _ _) -> mn == mn'
+            TLModule (Module mn' _ _ _ _ _ _ _ _ _) -> mn == mn'
             _ -> False
 
       TLModule module' <- find p tls

pact-lsp/Pact/Core/LanguageServer/Utils.hs

@@ -22,7 +22,7 @@ termAt p term
       t@(App tm1 tm2 _) ->
         termAt p tm1 <|> getAlt (foldMap (Alt . termAt p) tm2) <|> Just t
       t@(Let _ tm1 tm2 _) -> termAt p tm1 <|> termAt p tm2 <|> Just t
-      -- Note: no term will ever match `Sequence`. It is generated by the compiler 
+      -- Note: no term will ever match `Sequence`. It is generated by the compiler
       Sequence tm1 tm2 _ -> termAt p tm1 <|> termAt p tm2
       t@(BuiltinForm op' _) ->
         case op' of
@@ -66,7 +66,7 @@ topLevelTermAt p = \case
     | p `inside` i -> Just (UseMatch imp i)
     | otherwise -> Nothing
   where
-    goInterface iface@(Interface _ _idefs _ _ _ i)
+    goInterface iface@(Interface _ _idefs _ _ _ _ i)
       | p `inside` i = Just (InterfaceMatch iface) -- TODO add interace defs
       | otherwise = Nothing
     goDefs = \case
@@ -98,7 +98,7 @@ topLevelTermAt p = \case
       DPact dp@(DefPact _ _ steps i)
         | p `inside` i -> getAlt (foldMap (Alt . goStep) steps) <|> Just (DefPactMatch dp)
         | otherwise -> Nothing
-    goModule m@(Module _ _ defs _ _ _ _ _ i)
+    goModule m@(Module _ _ defs _ _ _ _ _ _ i)
       | p `inside` i = getAlt (foldMap (Alt . goDefs) defs) <|> Just (ModuleMatch m)
       | otherwise = Nothing
 

pact-request-api/Pact/Core/Command/Server.hs

@@ -73,7 +73,6 @@ import Servant.Server
 import System.Directory
 import System.FilePath
 import System.Log.FastLogger.Date
-import Pact.Core.Info (spanInfoToLineInfo)
 
 -- | Temporarily pretend our Log type in CommandResult is unit.
 type Log = ()
@@ -297,14 +296,14 @@ computeResultAndUpdateState runtime requestKey cmd =
       pure $ pactErrorToCommandResult requestKey pe (Gas 0)
 
     ProcSucc (Command (Payload (Exec (ExecMsg code d)) _ _ signer mverif _) _ h) -> do
-      let parsedCode = fmap spanInfoToLineInfo <$> _pcExps code
+      let parsedCode = _pcExps code
           msgData = MsgData
             { mdData = d
             , mdHash = h
             , mdSigners = signer
             , mdVerifiers = maybe [] (fmap void) mverif
             }
-      evalExec Transactional (_srDbEnv runtime) (_srSPVSupport runtime) freeGasModel mempty SimpleNamespacePolicy
+      evalExec (RawCode (_pcCode code)) Transactional (_srDbEnv runtime) (_srSPVSupport runtime) freeGasModel mempty SimpleNamespacePolicy
         def msgData def parsedCode >>= \case
         Left pe ->
           pure $ pactErrorToCommandResult requestKey pe (Gas 0)

pact-tests/Pact/Core/Test/ServerUtils.hs

@@ -15,9 +15,7 @@ import Pact.Core.Command.Server
 import Pact.Core.Command.Server.Config
 import Pact.Core.Command.Server.History
 import Pact.Core.Environment
-import Pact.Core.Persistence.SQLite
 import Pact.Core.SPV
-import Pact.Core.Serialise
 import qualified Pact.JSON.Encode as J
 import Servant
 import Servant.Client

pact-tests/gas-goldens/builtinGas.golden

@@ -11,7 +11,7 @@
 >=: 114
 ^: 5000
 abs: 50
-acquire-module-admin: 60045303
+acquire-module-admin: 60045304
 add-time: 5000
 and?: 253
 at: 2500
@@ -20,38 +20,38 @@ base64-encode: 1061
 bind: 1300
 ceiling: 50
 chain-data: 500
-compose-capability: 60003939
+compose-capability: 60003940
 compose: 1461
 concat: 721
 cond: 2102
 contains: 231
-continue: 60222618
-create-capability-guard: 60000300
-create-capability-pact-guard: 60046369
-create-module-guard: 60000245
-create-pact-guard: 60046314
+continue: 60222619
+create-capability-guard: 60000302
+create-capability-pact-guard: 60046370
+create-module-guard: 60000246
+create-pact-guard: 60046315
 create-principal: 1752
-create-table: 60250173
+create-table: 60250174
 days: 4000
 dec: 25
 define-keyset: 37210
 define-namespace: 99295
 describe-keyset: 137210
-describe-module: 60100164
+describe-module: 60100165
 describe-namespace: 199710
-describe-table: 60350173
+describe-table: 60350174
 diff-time: 12164
 distinct: 1402
 drop: 725
-emit-event: 60001326
+emit-event: 60001327
 enforce-guard: 9816
 enforce-keyset: 9816
 enforce-verifier: 10150
 enumerate: 230
 exp: 10000
 filter: 1461
 floor: 50
-fold-db: 100383578
+fold-db: 100383579
 fold: 790
 format-time: 6041
 format: 1801
@@ -61,12 +61,12 @@ hyperlane-decode-token-message: 2175
 hyperlane-encode-token-message: 2475
 hyperlane-message-id: 2743
 identity: 25
-insert: 60383378
-install-capability: 60002696
+insert: 60383379
+install-capability: 60002697
 int-to-str: 602
 is-charset: 1788
 is-principal: 447
-keys: 100383378
+keys: 100383379
 keyset-ref-guard: 44231
 length: 576
 list-modules: 100000
@@ -81,8 +81,8 @@ negate: 50
 not: 139
 not?: 139
 or?: 139
-pact-id: 60046298
-pairing-check: 67003097
+pact-id: 60046299
+pairing-check: 67003098
 parse-time: 2102
 point-add: 5425
 poseidon-hash-hack-a-chain: 6393700
@@ -91,14 +91,14 @@ read-integer: 128
 read-keyset: 37239
 read-msg: 128
 read-string: 128
-read: 60393713
+read: 60393714
 remove: 261
-require-capability: 60002677
-resume: 60123740
+require-capability: 60002678
+resume: 60123741
 reverse: 601
 round: 50
 scalar-mult: 360225
-select: 100383528
+select: 100383529
 shift: 4
 show: 4002
 sort: 1002
@@ -110,14 +110,14 @@ time: 2000
 tx-hash: 25
 typeof-principal: 647
 typeof: 25
-update: 60516583
+update: 60516584
 validate-principal: 4940
 where: 1079
-with-default-read: 60406263
-with-read: 60394788
-write: 60383378
+with-default-read: 60406264
+with-read: 60394789
+write: 60383379
 xor: 2000
-yield: 60073485
+yield: 60073486
 zip: 3822
 |: 2000
 ~: 1000

pact/Pact/Core/Compile.hs

@@ -16,10 +16,12 @@ module Pact.Core.Compile
  , compileValueToPactValue
  , evalTopLevel
  , CompileValue(..)
+ , RawCode(..)
  ) where
 
 import Control.Lens
 import Control.Monad
+import Data.Text(Text)
 import Data.Maybe(mapMaybe)
 import Codec.Serialise(Serialise)
 import qualified Data.Map.Strict as M
@@ -59,7 +61,8 @@ type HasCompileEnv b i
     , Serialise (SerialiseV1 b)
     )
 
-
+newtype RawCode = RawCode { _rawCode :: Text }
+  deriving (Eq, Show)
 
 data CompileValue i
   = LoadedModule ModuleName ModuleHash
@@ -168,26 +171,28 @@ interpretTopLevel
   :: forall e b i
   .  (HasCompileEnv b i)
   => Interpreter e b i
+  -> RawCode
   -> Lisp.TopLevel i
   -> EvalM e b i (CompileValue i)
-interpretTopLevel interpreter tl = do
+interpretTopLevel interpreter code tl = do
   evalModuleGovernance interpreter tl
   -- Todo: pretty instance for modules and all of toplevel
   debugPrint (DPParser @b) tl
   (DesugarOutput ds deps) <- runDesugarTopLevel tl
   constEvaled <- ConstEval.evalTLConsts interpreter ds
   let tlFinal = MHash.hashTopLevel constEvaled
   debugPrint DPDesugar ds
-  evalTopLevel interpreter tlFinal deps
+  evalTopLevel interpreter code tlFinal deps
 
 evalTopLevel
   :: forall e b i
   .  (HasCompileEnv b i)
   => Interpreter e b i
+  -> RawCode
   -> EvalTopLevel b i
   -> S.Set ModuleName
   -> EvalM e b i (CompileValue i)
-evalTopLevel interpreter tlFinal deps = do
+evalTopLevel interpreter (RawCode code) tlFinal deps = do
   lo0 <- use esLoaded
   pdb <- viewEvalEnv eePactDb
   case tlFinal of
@@ -208,6 +213,8 @@ evalTopLevel interpreter tlFinal deps = do
       mSize <- sizeOf (_mInfo m) SizeOfV0 m
       chargeGasArgs (_mInfo m) (GModuleMemory mSize)
       evalWrite (_mInfo m) pdb Write DModules (view mName m) mdata
+      -- Write sliced modules to the pact db
+      evalWrite (_mInfo m) pdb Write DModuleSource (getHashedModuleName m) (ModuleCode code)
       let fqDeps = toFqDep (_mName m) (_mHash m) <$> _mDefs m
           newLoaded = M.fromList fqDeps
           newTopLevel = M.fromList $ (\(fqn, d) -> (_fqName fqn, (fqn, defKind (_mName m) d))) <$> fqDeps
@@ -224,6 +231,8 @@ evalTopLevel interpreter tlFinal deps = do
       ifaceSize <- sizeOf (_ifInfo iface) SizeOfV0 iface
       chargeGasArgs (_ifInfo iface) (GModuleMemory ifaceSize)
       evalWrite (_ifInfo iface) pdb Write DModules (view ifName iface) mdata
+     -- Write sliced interface code to the pact db
+      evalWrite (_ifInfo iface) pdb Write DModuleSource (getHashedModuleNameIface iface) (ModuleCode code)
       let fqDeps = toFqDep (_ifName iface) (_ifHash iface)
                   <$> mapMaybe ifDefToDef (_ifDefns iface)
           newLoaded = M.fromList fqDeps