module load from db (#482)

* Code-complete, tests TODO, bench TODO

* get bench working

* Almost done, unevaluated const in PactContinuationSpec

* fixed by correcting ConstVal JSON parser order

* make modules pre-loadable and add benchmarks

* add SQLite benchmarks

README.md

@@ -42,16 +42,29 @@ Once Homebrew is installed, run the following command to install `pact`:
 brew install kadena-io/pact/pact
 ```
 
+However, see note [below](#z3) about z3 compatibility.
+
 Installing Pact with Binary Distributions
 ---
 Pact can also be installed by following the instructions below:
-- Install [z3](https://github.com/Z3Prover/z3/wiki)
+- Install [z3](https://github.com/Z3Prover/z3/wiki). See note [below](#z3) about z3 compatibility.
 - Download the [prebuilt binaries](http://install.kadena.io/pact/downloads.html) for your distribution. Or see [Building](#Building) for instructions on how to build Pact from the source code.
 - Once you've downloaded the binary, make sure that it is marked as executable by running `chmod +x <executable-file>`.
 - Put the binary somewhere in your PATH.
 
 For installing `pact` on Linux distributions in the Arch family, refer to [this package on the AUR](https://aur.archlinux.org/packages/pact/).
 
+z3 Compatibility
+---
+
+Pact users generally can use the production versions of Z3. However, with the current version at time of writing, 4.8.4, use of the function `str-to-int` can cause problems, and for those building from source or hacking Pact Haskell code, a unit test will fail/hang indefinitely because of this.
+
+The fix is to use the older version 4.8.3:
+- For Mac homebrew users, 4.8.3 can be installed via `brew install https://raw.githubusercontent.com/Homebrew/homebrew-core/a7e7806193f7605c7fef6110655911012d3f1eb3/Formula/z3.rb`.
+- Z3 binaries are available [on github](https://github.com/Z3Prover/z3/releases/tag/z3-4.8.3) for manual installation (Pact uses the z3 in your `$PATH`).
+- Nix builds install the correct version.
+
+
 Verifying Install
 ---
 
@@ -110,19 +123,18 @@ verbose    - [True|False] Provide extra logging information
 When running pact-serve with persistence enabled, the server automatically replays from the database
 `commands.sqlite` in the persist dir. To prevent replay, simply delete this file before starting the server.
 
-Building
+Building Pact
 ---
 
-Building Pact used to require a working [Haskell Stack install](https://docs.haskellstack.org/en/stable/README/#how-to-install) . After which, building is as simple as 'stack build'.
+### Building with Stack
 
-To install for use with Atom and the command line, issue 'stack install' and then either add `$HOME/.local/bin` to your path, or symlink `$HOME/.local/bin/pact` somewhere in your PATH.
+[Install stack](https://docs.haskellstack.org/en/stable/README/#how-to-install)
 
-NOTE: We are currently transitioning to Nix build infrastructure.  Stack builds
-still work right now, but you should start transitioning to Nix using the
-instructions below.
+Issue `stack build` on the command line.
 
-Building with Nix / NixOS
----
+Use `stack install` to install on the command line and for Atom, ensuring that `$HOME/.local/bin` is on your PATH.
+
+### Building with Nix / NixOS
 
 1. Go to https://nixos.org/nix/, click "Get Nix", follow the instructions to install the Nix package manager.
 2. Edit `$NIX_CONF_DIR/nix.conf`.
@@ -156,7 +168,7 @@ sudo systemctl restart nix-daemon.service
 
 5. Run `nix-build` from the project root.
 
-### Incremental Builds
+#### Incremental Builds
 
 Building with `nix-build` does a full rebuild every time, which is usually not
 what you want when developing. To do incremental builds, you need to enter a nix
@@ -172,7 +184,7 @@ You can also build with stack inside this shell as follows:
 $ stack --stack-yaml stack-nix.yaml build
 ```
 
-### Hoogle Documentation
+#### Hoogle Documentation
 
 Nix has out-of-the-box Hoogle integration.  It allows you to run a local
 Hoogle server with docs for all of the project dependencies.  This is really
@@ -204,10 +216,6 @@ replace `[p.pact]` with a list of all the locally defined projects to include.
 For example: `[p.backend p.common p.frontend]` for a project that has those
 three separate local packages.
 
-### z3 Troubleshooting
-
-Note for users of property and invariant verification: z3 version 4.8.4 hangs when checking `str-to-int` calls (this causes one test to fail). The fix is to use the older version 4.8.3, or a newer version in the future (4.8.4 is the latest release at time of writing). Our Nix install uses a working version. For non-Nix Mac users, `brew install` defaults to 4.8.4, but 4.8.3 can be installed via `brew install https://raw.githubusercontent.com/Homebrew/homebrew-core/a7e7806193f7605c7fef6110655911012d3f1eb3/Formula/z3.rb`. For non-brew users, binaries are available [on github](https://github.com/Z3Prover/z3/releases/tag/z3-4.8.3) for manual installation (Pact uses the z3 in your `$PATH`).
-
 License
 ---
 

src-ghc/Pact/Bench.hs

@@ -4,16 +4,20 @@
 module Pact.Bench where
 
 import Control.Arrow
+import Control.Concurrent
 import Control.DeepSeq
 import Control.Exception
+import Control.Monad
 import Criterion.Main
 import Data.Aeson
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy (toStrict)
 import Data.Default
+import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import System.CPUTime
+import System.Directory
 import Unsafe.Coerce
 
 import Pact.Compile
@@ -30,6 +34,9 @@ import Pact.Types.Logger
 import Pact.Types.PactValue
 import Pact.Types.RPC
 import Pact.Types.Runtime
+import Pact.Native.Internal
+import Pact.Persist.SQLite
+import Pact.PersistPactDb hiding (db)
 
 longStr :: Int -> Text
 longStr n = pack $ "\"" ++ take n (cycle "abcdefghijklmnopqrstuvwxyz") ++ "\""
@@ -67,7 +74,7 @@ eitherDie = either (throwIO . userError) (return $!)
 entity :: Maybe EntityName
 entity = Just $ EntityName "entity"
 
-loadBenchModule :: PactDbEnv e -> IO RefStore
+loadBenchModule :: PactDbEnv e -> IO (ModuleData Ref,PersistModuleData)
 loadBenchModule db = do
   m <- pack <$> readFile "tests/bench/bench.pact"
   pc <- parseCode m
@@ -77,39 +84,45 @@ loadBenchModule db = do
            pactInitialHash
   let e = setupEvalEnv db entity (Transactional 1) md initRefStore
           freeGasEnv permissiveNamespacePolicy noSPVSupport def
-  _erRefStore <$> evalExec e pc
+  void $ evalExec e pc
+  (benchMod,_) <- runEval def e $ getModule (def :: Info) (ModuleName "bench" Nothing)
+  p <- either (throwIO . userError . show) (return $!) $ traverse (traverse toPersistDirect) benchMod
+  return (benchMod,p)
+
 
 parseCode :: Text -> IO ParsedCode
 parseCode m = ParsedCode m <$> eitherDie (parseExprs m)
 
 benchNFIO :: NFData a => String -> IO a -> Benchmark
 benchNFIO bname = bench bname . nfIO
 
-runPactExec :: PactDbEnv e -> RefStore -> ParsedCode -> IO Value
-runPactExec dbEnv refStore pc = do
+runPactExec :: Maybe (ModuleData Ref) -> PactDbEnv e -> ParsedCode -> IO Value
+runPactExec benchMod dbEnv pc = do
   t <- Transactional . fromIntegral <$> getCPUTime
   let e = setupEvalEnv dbEnv entity t (initMsgData pactInitialHash)
-          refStore freeGasEnv permissiveNamespacePolicy noSPVSupport def
-  toJSON . _erOutput <$> evalExec e pc
+          initRefStore freeGasEnv permissiveNamespacePolicy noSPVSupport def
+      s = maybe def (initStateModules . HM.singleton (ModuleName "bench" Nothing)) benchMod
+  toJSON . _erOutput <$> evalExecState s e pc
 
 benchKeySet :: KeySet
 benchKeySet = KeySet [PublicKey "benchadmin"] (Name ">" def)
 
 acctRow :: ObjectMap PactValue
 acctRow = ObjectMap $ M.fromList [("balance",PLiteral (LDecimal 100.0))]
 
-benchRead :: Domain k v -> k -> Method () (Maybe v)
-benchRead KeySets _ = rc (Just benchKeySet)
-benchRead UserTables {} _ = rc (Just acctRow)
-benchRead _ _ = rc Nothing
+benchRead :: PersistModuleData -> Domain k v -> k -> Method () (Maybe v)
+benchRead _ KeySets _ = rc (Just benchKeySet)
+benchRead _ UserTables {} _ = rc (Just acctRow)
+benchRead benchMod Modules _ = rc (Just benchMod)
+benchRead _ _ _ = rc Nothing
 
-benchReadValue :: Table k -> k -> Persist () (Maybe v)
-benchReadValue (DataTable t) _k
+benchReadValue :: PersistModuleData -> Table k -> k -> Persist () (Maybe v)
+benchReadValue benchMod (DataTable t) _k
   | t == "SYS_keysets" = rcp $ Just (unsafeCoerce benchKeySet)
   | t == "USER_bench_bench-accounts" = rcp $ Just (unsafeCoerce acctRow)
-  | t == "SYS_modules" = rcp Nothing
+  | t == "SYS_modules" = rcp $ Just (unsafeCoerce benchMod)
   | otherwise = error (show t)
-benchReadValue (TxTable _t) _k = rcp Nothing
+benchReadValue _ (TxTable _t) _k = rcp Nothing
 
 
 mkBenchCmd :: [SomeKeyPair] -> (String, Text) -> IO (String, Command ByteString)
@@ -127,24 +140,39 @@ main = do
   !parsedExps <- force <$> mapM (mapM (eitherDie . parseExprs)) exps
   !pureDb <- mkPureEnv neverLog
   initSchema pureDb
-  !refStore <- loadBenchModule pureDb
+  (benchMod',benchMod) <- loadBenchModule pureDb
   !benchCmd <- parseCode "(bench.bench)"
-  print =<< runPactExec pureDb refStore benchCmd
-  !mockDb <- mkMockEnv def { mockRead = MockRead benchRead }
-  !mdbRS <- loadBenchModule mockDb
-  print =<< runPactExec mockDb mdbRS benchCmd
-  !mockPersistDb <- mkMockPersistEnv neverLog def { mockReadValue = MockReadValue benchReadValue }
-  !mpdbRS <- loadBenchModule mockPersistDb
-  print =<< runPactExec mockPersistDb mpdbRS benchCmd
+  print =<< runPactExec Nothing pureDb benchCmd
+  !mockDb <- mkMockEnv def { mockRead = MockRead (benchRead benchMod) }
+  void $ loadBenchModule mockDb
+  print =<< runPactExec Nothing mockDb benchCmd
+  !mockPersistDb <- mkMockPersistEnv neverLog def { mockReadValue = MockReadValue (benchReadValue benchMod) }
+  void $ loadBenchModule mockPersistDb
+  print =<< runPactExec Nothing mockPersistDb benchCmd
   cmds_ <- traverse (mkBenchCmd [keyPair]) exps
   !cmds <- return $!! cmds_
-
-
-  defaultMain [
-    benchParse,
-    benchCompile parsedExps,
-    benchVerify cmds,
-    benchNFIO "puredb" (runPactExec pureDb refStore benchCmd),
-    benchNFIO "mockdb" (runPactExec mockDb mdbRS benchCmd),
-    benchNFIO "mockpersist" (runPactExec mockPersistDb mpdbRS benchCmd)
+  let sqliteFile = "log/bench.sqlite"
+  sqliteDb <- mkSQLiteEnv (newLogger neverLog "") True (SQLiteConfig sqliteFile []) neverLog
+  initSchema sqliteDb
+  void $ loadBenchModule sqliteDb
+  print =<< runPactExec Nothing sqliteDb benchCmd
+
+  let cleanupSqlite = do
+        c <- readMVar $ pdPactDbVar sqliteDb
+        void $ closeSQLite $ _db c
+        removeFile sqliteFile
+      sqlEnv b = envWithCleanup (return ()) (const cleanupSqlite) (const b)
+
+  defaultMain
+    [ benchParse
+    , benchCompile parsedExps
+    , benchVerify cmds
+    , benchNFIO "puredb" (runPactExec Nothing pureDb benchCmd)
+    , benchNFIO "mockdb" (runPactExec Nothing mockDb benchCmd)
+    , benchNFIO "mockpersist" (runPactExec Nothing mockPersistDb benchCmd)
+    , benchNFIO "sqlite" (runPactExec Nothing sqliteDb benchCmd)
+    , benchNFIO "puredb-withmod" (runPactExec (Just benchMod') pureDb benchCmd)
+    , benchNFIO "mockdb-withmod" (runPactExec (Just benchMod') mockDb benchCmd)
+    , benchNFIO "mockpersist-withmod" (runPactExec (Just benchMod') mockPersistDb benchCmd)
+    , sqlEnv $ benchNFIO "sqlite-withmod" (runPactExec (Just benchMod') sqliteDb benchCmd)
     ]

src-ghc/Pact/Interpreter.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | "Production" interpreter for Pact, as opposed to the REPL.
@@ -17,6 +18,7 @@ module Pact.Interpreter
   , MsgData(..)
   , EvalResult(..)
   , initMsgData
+  , initStateModules
   , evalExec
   , evalExecState
   , evalContinuation
@@ -33,10 +35,10 @@ module Pact.Interpreter
 import Control.Concurrent
 import Control.Monad.Catch
 import Control.Monad.Except
+import Control.Lens
 import Data.Aeson
 import Data.Default
-import qualified Data.HashMap.Strict as HM
-import Data.Maybe
+import Data.HashMap.Strict (HashMap)
 import qualified Data.Set as S
 import System.Directory
 
@@ -72,9 +74,9 @@ data EvalResult = EvalResult
   { _erInput :: !(Either PactContinuation [Term Name])
   , _erOutput :: ![PactValue]
   , _erLogs :: ![TxLog Value]
-  , _erRefStore :: !RefStore
   , _erExec :: !(Maybe PactExec)
   , _erGas :: Gas
+  , _erLoadedModules :: HashMap ModuleName (ModuleData Ref,Bool)
   } deriving (Eq,Show)
 
 
@@ -86,6 +88,9 @@ evalExecState initState evalEnv ParsedCode {..} = do
   terms <- throwEither $ compileExps (mkTextInfo _pcCode) _pcExps
   interpret initState evalEnv (Right terms)
 
+-- | For pre-installing modules into state.
+initStateModules :: HashMap ModuleName (ModuleData Ref) -> EvalState
+initStateModules modules = set (evalRefs . rsLoadedModules) (fmap (,False) modules) def
 
 evalContinuation :: EvalEnv e -> PactContinuation -> IO EvalResult
 evalContinuation ee pact = evalContinuationState def ee pact
@@ -125,7 +130,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd =
         modeToTx Local = Nothing
 
 initRefStore :: RefStore
-initRefStore = RefStore nativeDefs HM.empty
+initRefStore = RefStore nativeDefs
 
 mkSQLiteEnv :: Logger -> Bool -> PSL.SQLiteConfig -> Loggers -> IO (PactDbEnv (DbEnv PSL.SQLite))
 mkSQLiteEnv initLog deleteOldFile c loggers = do
@@ -153,12 +158,10 @@ interpret initState evalEnv terms = do
   ((rs,logs),state) <-
     runEval initState evalEnv $ evalTerms tx terms
   let gas = _evalGas state
-      refStore = newRefs . _eeRefStore $ evalEnv
       pactExec = _evalPactExec state
-      newRefs oldStore | isNothing tx = oldStore
-                       | otherwise = updateRefStore (_evalRefs state) oldStore
+      modules = _rsLoadedModules $ _evalRefs state
   -- output uses lenient conversion
-  return $! EvalResult terms (map toPactValueLenient rs) logs refStore pactExec gas
+  return $! EvalResult terms (map toPactValueLenient rs) logs pactExec gas modules
 
 evalTerms :: Maybe TxId -> Either PactContinuation [Term Name] -> Eval e ([Term Name],[TxLog Value])
 evalTerms tx terms = do

src-ghc/Pact/MockDb.hs

@@ -17,7 +17,7 @@ newtype MockRead =
 instance Default MockRead where def = MockRead (\_t _k -> rc Nothing)
 
 newtype MockKeys =
-  MockKeys (TableName -> Method () [RowKey])
+  MockKeys (forall k v . (IsString k,AsString k) => Domain k v -> Method () [k])
 instance Default MockKeys where def = MockKeys (\_t -> rc [])
 
 newtype MockTxIds =

src-ghc/Pact/PersistPactDb/Regression.hs

@@ -33,11 +33,12 @@ loadModule = do
   let mn = ModuleName "simple" Nothing
   case r of
     Left a -> throwFail $ "module load failed: " ++ show a
-    Right _ -> case preview (rEvalState . evalRefs . rsNewModules . ix mn) s of
-      Just md -> case traverse (traverse toPersistDirect) md of
+    Right _ -> case preview (rEvalState . evalRefs . rsLoadedModules . ix mn) s of
+      Just (md,_) -> case traverse (traverse toPersistDirect) md of
         Right md' -> return (mn,md,md')
         Left e -> throwFail $ "toPersistDirect failed: " ++ show e
-      Nothing -> throwFail $ "Failed to find module 'simple': " ++ show (view (rEvalState . evalRefs . rsNewModules) s)
+      Nothing -> throwFail $ "Failed to find module 'simple': " ++
+        show (view (rEvalState . evalRefs . rsLoadedModules) s)
 
 nativeLookup :: NativeDefName -> Maybe (Term Name)
 nativeLookup (NativeDefName n) = case HM.lookup (Name n def) nativeDefs of
@@ -106,10 +107,10 @@ runRegression p = do
     _getTxLog pactdb usert (head tids) v
   _writeRow pactdb Insert usert "key2" row v
   assertEquals' "user insert key2 pre-rollback" (Just row) (_readRow pactdb usert "key2" v)
-  assertEquals' "keys pre-rollback" ["key1","key2"] $ _keys pactdb user1 v
+  assertEquals' "keys pre-rollback" ["key1","key2"] $ _keys pactdb (UserTables user1) v
   _rollbackTx pactdb v
   assertEquals' "rollback erases key2" Nothing $ _readRow pactdb usert "key2" v
-  assertEquals' "keys" ["key1"] $ _keys pactdb user1 v
+  assertEquals' "keys" ["key1"] $ _keys pactdb (UserTables user1) v
   return v
 
 toTerm' :: ToTerm a => a -> Term Name

src-ghc/Pact/ReplTools.hs

@@ -35,12 +35,12 @@ import Pact.Repl.Types
 interactiveRepl :: IO (Either () (Term Name))
 interactiveRepl = generalRepl Interactive
 
--- Note(emily): revisit whether we want all _module_ names, or all interface names as well.
+-- | Complete function names for _loaded_ modules
 completeFn :: (MonadIO m, MonadState ReplState m) => CompletionFunc m
 completeFn = completeQuotedWord (Just '\\') "\"" listFiles $
   completeWord (Just '\\') ("\"\'" ++ filenameWordBreakChars) $ \str -> do
-    modules <- use (rEnv . eeRefStore . rsModules)
-    let namesInModules = toListOf (traverse . mdRefMap . to HM.keys . each) modules
+    modules <- use (rEvalState . evalRefs . rsLoadedModules)
+    let namesInModules = toListOf (traverse . _1 . mdRefMap . to HM.keys . each) modules
         allNames = concat
           [ namesInModules
           , nameOfModule <$> HM.keys modules