More friendly format for writes

kadena-io · Feb 5, 2025 · 97a92e4 · 97a92e4
1 parent c065f70
commit 97a92e4
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 16 deletions.
diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs
@@ -145,6 +145,7 @@ import Chainweb.Pact.PactService.Checkpointer (SomeBlockM(..))
 import qualified Pact.Core.StableEncoding as Pact5
 import Control.Monad.Cont (evalContT)
 import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text.IO as T
 
 
 runPactService
@@ -718,7 +719,9 @@ execReadOnlyReplay lowerBound maybeUpperBound = pactLabel "execReadOnlyReplay" $
                         (void $ Pact4.execBlock bh (CheckablePayloadWithOutputs payload))
                         (void $ Pact5.execExistingBlock bh (CheckablePayloadWithOutputs payload))
             pact4DbReads <- Pact4.printPactDbReads
-            writeFile ("pact4_db_reads_block_" <> show (view blockHeight bh) <> ".txt") pact4DbReads
+            T.writeFile
+                ("pact4_db_reads_block_" <> show (view blockHeight bh) <> ".txt")
+                (J.encodeText $ J.array pact4DbReads)
             )
         validationFailed <- readIORef validationFailedRef
         when validationFailed $

diff --git a/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact4/Backend/ChainwebPactDb.hs
@@ -325,7 +325,7 @@ tableExistsInDbAtHeight tableName bh = do
         [] -> return False
         _ -> return True
 
-data SomeDomainKey = forall k v. (Ord k) => SomeDomainKey (Domain k v) k
+data SomeDomainKey = forall k v. SomeDomainKey (Domain k v) J.JsonText
 
 instance Eq SomeDomainKey where
     SomeDomainKey d1 k1 == SomeDomainKey d2 k2 = case (d1, d2) of
@@ -362,19 +362,18 @@ pactDbReads = unsafePerformIO $ do
 clearPactDbReads :: IO ()
 clearPactDbReads = atomicModifyIORef' pactDbReads $ const (PactDbReads M.empty, ())
 
-printPactDbReads :: IO String
+printPactDbReads :: IO [J.Builder]
 printPactDbReads = do
     PactDbReads m <- readIORef pactDbReads
-    fmap unlines $ forM (M.toList m) $ \(SomeDomainKey d k, v) -> do
-        return $ case d of
-            UserTables _ -> "(" <> show d <> ", " <> show k <> ", " <> T.unpack (T.decodeUtf8 v) <> ")"
-            KeySets -> "(" <> show d <> ", " <> show k <> ", " <> T.unpack (T.decodeUtf8 v) <> ")"
-            Modules -> "(" <> show d <> ", " <> show k <> ", " <> T.unpack (T.decodeUtf8 v) <> ")"
-            Namespaces -> "(" <> show d <> ", " <> show k <> ", " <> T.unpack (T.decodeUtf8 v) <> ")"
-            Pacts -> "(" <> show d <> ", " <> show k <> ", " <> T.unpack (T.decodeUtf8 v) <> ")"
+    return $ M.toList m <&> \(SomeDomainKey d k, v) ->
+        J.object
+            [ "domain" J..= domainTableName d
+            , "key" J..= k
+            , "value" J..= T.decodeUtf8 v
+            ]
 
 -- insert a read into the pact db reads, but if the (domain, key) pair already exist, do nothing
-insertPactDbRead :: forall k v. (Ord k) => Domain k v -> k -> ByteString -> IO ()
+insertPactDbRead :: forall k v. (Ord k) => Domain k v -> J.JsonText -> ByteString -> IO ()
 insertPactDbRead d k v = atomicModifyIORef' pactDbReads $ \(PactDbReads m) ->
     let key = SomeDomainKey d k
     in
@@ -446,11 +445,11 @@ doReadRow mlim d k = forModuleNameFix $ \mnFix ->
             [] -> mzero
             [[SBlob a]] -> do
                 () <- liftIO $ case d of
-                    UserTables _ -> insertPactDbRead d k a
-                    KeySets -> insertPactDbRead d k a
-                    Modules -> insertPactDbRead d k a
-                    Namespaces -> insertPactDbRead d k a
-                    Pacts -> insertPactDbRead d k a
+                    UserTables _ -> insertPactDbRead d (J.encodeJsonText (case k of RowKey t -> t)) a
+                    KeySets -> insertPactDbRead d (J.encodeJsonText k) a
+                    Modules -> insertPactDbRead d (J.encodeJsonText k) a
+                    Namespaces -> insertPactDbRead d (J.encodeJsonText k) a
+                    Pacts -> insertPactDbRead d (J.encodeJsonText k) a
                 checkCache rowkey a
             err -> internalError $
                      "doReadRow: Expected (at most) a single result, but got: " <>