more work

src/Chainweb/Pact/Backend/Compaction.hs

@@ -23,6 +23,7 @@
 
 module Chainweb.Pact.Backend.Compaction
   ( CompactFlag(..)
+  , TargetBlockHeight(..)
   , CompactM
   , compact
   , compactAll
@@ -71,6 +72,7 @@ import Pact.Types.SQLite (SType(..), RType(..))
 import Pact.Types.SQLite qualified as Pact
 
 newtype ITxId = ITxId Int64
+  deriving newtype (Show)
 
 newtype TableName = TableName { getTableName :: Utf8 }
   deriving stock (Show)
@@ -341,7 +343,7 @@ ensureBlockHeightExists bh = do
 getLatestBlockHeight :: CompactM BlockHeight
 getLatestBlockHeight = do
   r <- qryNoTemplateM
-    "locateTarget.1"
+    "getLatestBlockHeight.0"
     "SELECT blockheight FROM BlockHistory ORDER BY blockheight DESC LIMIT 1"
     []
     [RInt]
@@ -531,12 +533,12 @@ dropCompactTables = do
     \ DROP TABLE CompactActiveRow; "
 
 compact :: ()
-  => BlockHeight
+  => TargetBlockHeight
   -> Logger SomeLogMessage
   -> Database
   -> [CompactFlag]
   -> IO (Maybe ByteString)
-compact blockHeight logger db flags = runCompactM (mkCompactEnv logger db flags) $ do
+compact tbh logger db flags = runCompactM (mkCompactEnv logger db flags) $ do
   logg Info "Beginning compaction"
 
   doGrandHash <- not <$> isFlagSet Flag_NoGrandHash
@@ -545,8 +547,12 @@ compact blockHeight logger db flags = runCompactM (mkCompactEnv logger db flags)
     createCompactGrandHash
     createCompactActiveRow
 
+  blockHeight <- locateTarget tbh
   txId <- getEndingTxId blockHeight
 
+  logg Info $ "Target blockheight: " <> sshow blockHeight
+  logg Info $ "Ending TxId: " <> sshow txId
+
   versionedTables <- getVersionedTables blockHeight
 
   gh <- withTx $ do
@@ -566,7 +572,7 @@ compact blockHeight logger db flags = runCompactM (mkCompactEnv logger db flags)
 
   whenFlagUnset Flag_KeepCompactTables $ do
     logg Info "Dropping compact-specific tables"
-    withTx $ dropCompactTables
+    withTx dropCompactTables
 
   whenFlagUnset Flag_NoVacuum $ do
     logg Info "Vacuum"
@@ -576,7 +582,7 @@ compact blockHeight logger db flags = runCompactM (mkCompactEnv logger db flags)
     Just h -> do
       logg Info $ "Compaction complete, hash=" <> encodeB64Text h
     Nothing -> do
-      logg Info $ "Compaction complete"
+      logg Info "Compaction complete"
 
   pure gh
 
@@ -618,8 +624,7 @@ compactAll CompactConfig{..} = do
           Just ccid | ccid /= cid -> do
             pure ()
           _ -> do
-            blockHeight <- runCompactM (mkCompactEnv logger db []) $ locateTarget ccBlockHeight
-            void $ compact blockHeight logger db ccFlags
+            void $ compact ccBlockHeight logger db ccFlags
 
 compactMain :: IO ()
 compactMain = do

src/Chainweb/Utils.hs

@@ -522,6 +522,18 @@ instance HasTextRepresentation Integer where
     fromText = treadM
     {-# INLINE fromText #-}
 
+instance HasTextRepresentation Word where
+    toText = sshow
+    {-# INLINE toText #-}
+    fromText = treadM
+    {-# INLINE fromText #-}
+
+instance HasTextRepresentation Word64 where
+    toText = sshow
+    {-# INLINE toText #-}
+    fromText = treadM
+    {-# INLINE fromText #-}
+
 instance HasTextRepresentation UTCTime where
     toText = T.pack . formatTime defaultTimeLocale iso8601DateTimeFormat
     {-# INLINE toText #-}

test/Chainweb/Test/Pact/Compaction.hs

@@ -49,7 +49,7 @@ import Chainweb.BlockHeader(genesisHeight)
 import Chainweb.Graph
 import Chainweb.Logger
 import Chainweb.Pact.Types (defaultModuleCacheLimit)
-import Chainweb.Pact.Backend.Compaction (CompactFlag(..), compact, withDefaultLogger)
+import Chainweb.Pact.Backend.Compaction (CompactFlag(..), TargetBlockHeight(..), compact, withDefaultLogger)
 import Chainweb.Pact.Backend.RelationalCheckpointer (initRelationalCheckpointer)
 import Chainweb.Pact.Backend.Types (SQLiteEnv(..), PactDbEnv'(..), Checkpointer(..), BlockEnv, ParentHash, initBlockState, bsModuleNameFix)
 import Chainweb.Test.Pact.Utils (dummyLogger)
@@ -143,7 +143,7 @@ testCompactCheckpointer =
     let compactToHeight :: BlockHeight -> [CompactFlag] -> IO (Maybe ByteString)
         compactToHeight h flags = withDefaultLogger Debug $ \logger -> do
           -- compact and capture global grand hash
-          compact h logger _sConn flags
+          compact (Target h) logger _sConn flags
 
     tables <- getTestTables _sConn
 

test/Chainweb/Test/Pact/PactSingleChainTest.hs

@@ -266,7 +266,7 @@ rosettaFailsWithoutFullHistory rdb =
             let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
             let db = _sConn sqlEnv
             let bh = BlockHeight 5
-            void $ C.compact bh logger db flags
+            void $ C.compact (C.Target bh) logger db flags
 
         -- This needs to run after the previous test
         -- Annoyingly, we must inline the PactService util starts here.
@@ -325,7 +325,7 @@ rewindPastMinBlockHeightFails rdb =
         let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
         let db = _sConn sqlEnv
         let height = BlockHeight 5
-        void $ C.compact height cLogger db flags
+        void $ C.compact (C.Target height) cLogger db flags
 
       -- Genesis block header; compacted away by now
       let bh = genesisBlockHeader ver cid
@@ -403,7 +403,7 @@ pactStateSamePreAndPostCompaction rdb =
       C.withDefaultLogger System.Logger.Types.Error $ \cLogger -> do
         let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
         let height = BlockHeight numBlocks
-        void $ C.compact height cLogger db flags
+        void $ C.compact (C.Target height) cLogger db flags
 
       statePostCompaction <- getLatestPactState db
 
@@ -499,7 +499,7 @@ compactionIsIdempotent rdb =
             let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
             void $ C.compact h cLogger db flags
 
-      let compactionHeight = BlockHeight numBlocks
+      let compactionHeight = C.Target (BlockHeight numBlocks)
       compact compactionHeight
       statePostCompaction1 <- getPactUserTables db
       compact compactionHeight
@@ -627,7 +627,7 @@ compactionUserTablesDropped rdb =
 
       let compact h = C.withDefaultLogger System.Logger.Types.Error $ \cLogger -> do
             let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
-            void $ C.compact h cLogger db flags
+            void $ C.compact (C.Target h) cLogger db flags
 
       let freeBeforeTbl = "free.m0_" <> beforeTable
       let freeAfterTbl = "free.m1_" <> afterTable

test/Chainweb/Test/Pact/RemotePactTest.hs

@@ -43,6 +43,7 @@ import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Short as SB
 import Data.Word (Word64)
 import Data.Default (def)
+import Data.Either (isRight)
 import Data.Foldable (toList)
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List as L
@@ -53,8 +54,6 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import System.Logger.Types (LogLevel(..))
 
-import Numeric.Natural
-
 import Servant.Client
 
 import Test.Tasty
@@ -101,7 +100,7 @@ import Chainweb.Storage.Table.RocksDB
 -- -------------------------------------------------------------------------- --
 -- Global Settings
 
-nNodes :: Natural
+nNodes :: Word
 nNodes = 1
 
 v :: ChainwebVersion
@@ -140,9 +139,9 @@ tests rdb = testGroup "Chainweb.Test.Pact.RemotePactTest"
             let cenv = _getServiceClientEnv <$> net
                 iot = toTxCreationTime <$> iotm
                 pactDir = do
-                  m <- _getPactDbDirs <$> net
+                  m <- _getNodeDbDirs <$> net
                   case M.lookup 0 m of
-                    Just dir -> pure dir
+                    Just (pactDbDir, _) -> pure pactDbDir
                     Nothing -> error "impossible"
 
             in testGroup "remote pact tests"
@@ -215,7 +214,6 @@ txlogsTest t cenv pactDbDir = do
           let tx = T.unlines
                 [ "(namespace 'free)"
                 , "(module m" <> sshow n <> " G"
-                , "  \"Hullabaloo\""
                 , "  (defcap G () true)"
                 , "  (defschema person"
                 , "    name:string"
@@ -229,7 +227,7 @@ txlogsTest t cenv pactDbDir = do
                 , mkInsert "A" "Lindsey Lohan" "42"
                 , mkInsert "B" "Nico Robin" "30"
                 , mkInsert "C" "chessai" "69"
-                , "(map (txlog m0.persons) (txids m0.persons 0))"
+                , "(map (txlog m" <> sshow n <> ".persons) (txids m" <> sshow n <> ".persons 0))"
                 ]
           buildTextCmd
             $ set cbSigners [mkSigner' sender00 []]
@@ -242,21 +240,24 @@ txlogsTest t cenv pactDbDir = do
             $ mkExec tx
             $ mkKeySetData "sender00" [sender00]
 
+    let sendTxs txs = flip runClientM cenv $
+          pactSendApiClient v cid $ SubmitBatch $ NEL.fromList txs
     do
       tx <- getTxLogs 0 "persons"
-      cr <- local cid cenv tx --e <- flip runClientM cenv $
-        --pactSendApiClient v cid $ SubmitBatch $ NEL.fromList [tx]
-      print (_crResult cr) --print e
+      print =<< local cid cenv tx
+      e <- sendTxs [tx]
+      assertBool "sending persistent tx succeeded" (isRight e)
 
     C.withDefaultLogger Error $ \logger -> do
       let flags = [C.Flag_NoVacuum, C.Flag_NoGrandHash]
-      let bh = undefined
       let resetDb = False
 
       Backend.withSqliteDb cid logger pactDbDir resetDb $ \(SQLiteEnv db _) -> do
-        void $ C.compact bh logger db flags
+        void $ C.compact C.Latest logger db flags
 
-    pure ()
+    do
+      tx <- getTxLogs 1 "persons"
+      print =<< local cid cenv tx
 
 localTest :: Pact.TxCreationTime -> ClientEnv -> IO ()
 localTest t cenv = do

test/Chainweb/Test/Rosetta/RestAPI.hs

@@ -76,7 +76,7 @@ import System.IO.Unsafe (unsafePerformIO)
 v :: ChainwebVersion
 v = fastForkingCpmTestVersion petersonChainGraph
 
-nodes :: Natural
+nodes :: Word
 nodes = 1
 
 cid :: ChainId