make tests pass

pact-core-tests/Pact/Core/Test/PersistenceTests.hs

@@ -15,7 +15,7 @@ import Pact.Core.Names (Field(..), FullyQualifiedName, RowKey(..), TableName(..)
 import Pact.Core.Guards (KeySet(KeySet), KeySetName(..), PublicKeyText(..), KSPredicate(KeysAll))
 import Pact.Core.Gen.Serialise (keySetGen, keySetNameGen, moduleNameGen, moduleDataGen, builtinGen
                                ,defPactIdGen, defPactExecGen, namespaceNameGen, namespaceGen)
-import Pact.Core.Serialise (PactSerialise, serialisePact)
+import Pact.Core.Serialise (PactSerialise(..), serialisePact)
 import qualified Pact.Core.PactValue as PactValue
 import Pact.Core.Persistence.SQLite
 import Pact.Core.Persistence (WriteType(Insert), readKeySet, writeKeySet, writeModule, readModule
@@ -26,8 +26,15 @@ import Pact.Core.Persistence (WriteType(Insert), readKeySet, writeKeySet, writeM
                              , RowData(..)
                              , WriteType(Insert, Update, Write)
                              )
-import Data.Foldable (forM_)
 import qualified Data.Text as T
+import Pact.Core.Repl.Compile
+import Pact.Core.Repl.Utils
+import Pact.Core.Environment
+import Pact.Core.Persistence.MockPersistence
+import Data.Default
+import Data.IORef
+import Pact.Core.Builtin
+
 
 testsWithSerial :: (Show b, Show i, Eq b, Eq i) => PactSerialise b i -> Gen b -> Gen i -> [TestTree]
 testsWithSerial serial b i =
@@ -38,8 +45,9 @@ testsWithSerial serial b i =
  ]
 
 tests :: TestTree
-tests = testGroup "Persistence Roundtrip"
-  [ testGroup "CBOR encoding/decoding" $ testsWithSerial serialisePact builtinGen (pure ())
+tests = testGroup "Persistence"
+  [ testGroup "CBOR encoding/decoding roundtrip" $ testsWithSerial serialisePact builtinGen (pure ())
+  , sqliteRegression
   ]
 
 readExistingDb :: FilePath -> IO ()
@@ -115,34 +123,68 @@ namespaceRoundtrip serial = property $ do
 sqliteRegression :: TestTree
 sqliteRegression =
   testCase "sqlite persistence backend produces expected values/txlogs" $
-  withSqlitePactDb serialisePact "tmp.sqlite" $ \pdb -> do
+  withSqlitePactDb serialisePact ":memory:" $ \pdb -> do
     let
       user1 = "user1"
       usert = TableName user1 (ModuleName "someModule" Nothing)
-    txId1 <- _pdbBeginTx pdb Transactional
+    _txId1 <- _pdbBeginTx pdb Transactional
     _pdbCreateUserTable pdb usert
 
     txs1 <- _pdbCommitTx pdb
-    assertEqual "output of commit" txs1 [ TxLog "SYS:usertables" "user1" "TODO" ]
+    -- TODO: https://github.com/kadena-io/chainweb-node/blob/28764eb2dae323608ee2d4f17e984948455f04a1/test/Chainweb/Test/Pact/Checkpointer.hs#L492C13-L497C17
+    assertEqual "output of commit" txs1 [ TxLog "SYS:usertables" "user1" mempty ]
+
 
+    --  Begin tx
     _ <- _pdbBeginTx pdb Transactional
-    let row = RowData $ Map.fromList [(Field "gah", PactValue.PDecimal 123.454345)]
+    let
+      row = RowData $ Map.fromList [(Field "gah", PactValue.PDecimal 123.454345)]
+      rowEnc = _encodeRowData serialisePact row
     _pdbWrite pdb Insert (DUserTables usert) (RowKey "key1") row
     Just row' <- _pdbRead pdb (DUserTables usert) (RowKey "key1")
     assertEqual "row should be identical to its saved/recalled value" row row'
 
-    let row2 = RowData $ Map.fromList
-                 [(Field "gah", PactValue.PBool False)
-                 ,(Field "fh", PactValue.PInteger 1)
-                 ]
+    let
+      row2 = RowData $ Map.fromList
+             [ (Field "gah", PactValue.PBool False)
+             , (Field "fh", PactValue.PInteger 1)
+             ]
+      row2Enc = _encodeRowData serialisePact row2
+
     _pdbWrite pdb Update (DUserTables usert) (RowKey "key1") row2
     Just row2' <- _pdbRead pdb (DUserTables usert) (RowKey "key1")
     assertEqual "user update should overwrite with new value" row2 row2'
 
-    let ks = KeySet (Set.fromList [PublicKeyText "skdjhfskj"]) KeysAll
+    let
+      ks = KeySet (Set.fromList [PublicKeyText "skdjhfskj"]) KeysAll
+      ksEnc = _encodeKeySet serialisePact ks
     _ <- _pdbWrite pdb Write DKeySets (KeySetName "ks1" Nothing) ks
     Just ks' <- _pdbRead pdb DKeySets (KeySetName "ks1" Nothing)
     assertEqual "keyset should be equal after storage/retrieval" ks ks'
 
 
+    -- module
+    _md <- loadModule
+
+
+    txs2 <- _pdbCommitTx pdb
+    assertEqual "output of commit" txs2
+      [ TxLog "SYS:KeySets" "ks1" ksEnc
+      -- TxLog Module
+      , TxLog "user1" "key1" row2Enc
+      , TxLog "user1" "key1" rowEnc
+
+      ]
     return ()
+    where
+      loadModule = do
+        let src = "(module test G (defcap G () true) (defun f (a: integer) 1))"
+        pdb <- mockPactDb serialiseRepl
+        g <- newIORef mempty
+        evalLog <- newIORef Nothing
+        let ee = defaultEvalEnv pdb replRawBuiltinMap
+        ref <- newIORef (ReplState mempty pdb def ee g evalLog (SourceCode "" "") Nothing)
+        Right _ <- runReplT ref (interpretReplProgram (SourceCode "test" src) (const (pure ())))
+        Just md <- readModule pdb (ModuleName "test" Nothing)
+        pure md
+

pact-core/Pact/Core/Persistence/SQLite.hs

@@ -84,18 +84,18 @@ getTxLog serial db currTxId txLog tab txId = do
     then do
     txLog' <- readIORef txLog
     let
-      userTabLogs = filter (\tl -> toUserTable tab == _txDomain tl) txLog'
+      userTabLogs = filter (\tl -> _tableName tab == _txDomain tl) txLog'
       env :: Maybe [TxLog RowData] = traverse (traverse (fmap (view document) . _decodeRowData serial)) userTabLogs
     case env of
       Nothing -> fail "undexpected decoding error"
-      Just xs -> pure $ reverse xs
+      Just xs -> pure xs
     else withStmt db ("SELECT rowkey,rowdata FROM \"" <> toUserTable tab <> "\" WHERE txid = ?") $ \stmt -> do
                          let TxId i = txId
                          SQL.bind stmt [SQL.SQLInteger $ fromIntegral i]
                          txLogBS <- collect stmt []
                          case traverse (traverse (fmap (view document) . _decodeRowData serial)) txLogBS of
                            Nothing -> fail "unexpected decoding error"
-                           Just txl -> pure $ reverse txl
+                           Just txl -> pure txl
   where
     collect stmt acc = SQL.step stmt >>= \case
         SQL.Done -> pure acc
@@ -158,8 +158,16 @@ rollbackTx db txLog = do
   writeIORef txLog []
 
 createUserTable :: SQL.Database -> IORef [TxLog ByteString] -> TableName -> IO ()
-createUserTable db _txLog tbl = SQL.exec db ("CREATE TABLE IF NOT EXISTS " <> tblName <> " (txid UNSIGNED BIG INT, rowkey TEXT, rowdata BLOB, UNIQUE (txid, rowkey))")
+createUserTable db txLog tbl = do
+  SQL.exec db stmt
+  modifyIORef' txLog (TxLog "SYS:usertables" (_tableName tbl) mempty :)
+
   where
+    stmt = "CREATE TABLE IF NOT EXISTS " <> tblName <> " \
+           \ (txid UNSIGNED BIG INT, \
+           \  rowkey TEXT, \
+           \  rowdata BLOB, \
+           \  UNIQUE (txid, rowkey))"
     tblName = "\"" <> toUserTable tbl <> "\""
 
 write'
@@ -183,7 +191,7 @@ write' serial db txId txLog wt domain k v =
         TxId i <- readIORef txId
         SQL.bind stmt [SQL.SQLInteger (fromIntegral i), SQL.SQLText k', SQL.SQLBlob encoded]
         SQL.stepNoCB stmt >>= \case
-          SQL.Done -> modifyIORef' txLog (TxLog (toUserTable tbl) k' encoded:)
+          SQL.Done -> modifyIORef' txLog (TxLog (_tableName tbl) k' encoded:)
           SQL.Row -> fail "invariant viaolation"
 
       Just old -> do
@@ -198,15 +206,15 @@ write' serial db txId txLog wt domain k v =
           TxId i <- readIORef txId
           SQL.bind stmt [SQL.SQLInteger (fromIntegral i), SQL.SQLText k', SQL.SQLBlob encoded]
           SQL.stepNoCB stmt >>= \case
-            SQL.Done -> modifyIORef' txLog (TxLog (toUserTable tbl) k' encoded:)
+            SQL.Done -> modifyIORef' txLog (TxLog (_tableName tbl) k' encoded:)
             SQL.Row -> fail "invariant viaolation"
 
     DKeySets -> withStmt db "INSERT OR REPLACE INTO \"SYS:kEYSETS\" (txid, rowkey, rowdata) VALUES (?,?,?)" $ \stmt -> do
       let encoded = _encodeKeySet serial v
       TxId i <- readIORef txId
       SQL.bind stmt [SQL.SQLInteger (fromIntegral i), SQL.SQLText (renderKeySetName k), SQL.SQLBlob encoded]
       SQL.stepNoCB stmt >>= \case
-        SQL.Done -> modifyIORef' txLog (TxLog "SYS:KEYSETS" (renderKeySetName k) encoded:)
+        SQL.Done -> modifyIORef' txLog (TxLog "SYS:KeySets" (renderKeySetName k) encoded:)
         SQL.Row -> fail "invariant violation"
 
     DModules -> withStmt db "INSERT OR REPLACE INTO \"SYS:MODULES\" (txid, rowkey, rowdata) VALUES (?,?,?)" $ \stmt -> do