Merge pull request #738 from input-output-hk/plt-8242-chain-insert-pe…

…rformance Improve Chain Indexer Performance
input-output-hk · Nov 7, 2023 · e1c6c1a · e1c6c1a
2 parents 8e1affb + 396a8a2
commit e1c6c1a
Show file tree

Hide file tree

Showing 24 changed files with 1,596 additions and 495 deletions.
diff --git a/marlowe-chain-sync/chain-indexer/Language/Marlowe/Runtime/ChainIndexer.hs b/marlowe-chain-sync/chain-indexer/Language/Marlowe/Runtime/ChainIndexer.hs
@@ -22,8 +22,10 @@ import Control.Concurrent.STM (atomically)
 import Control.Monad (join)
 import Control.Monad.Event.Class (Inject, MonadEvent)
 import Data.ByteString (ByteString)
+import Data.Int (Int64)
 import Data.Maybe (catMaybes)
 import Data.String (fromString)
+import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
 import Data.Time (NominalDiffTime)
 import Language.Marlowe.Runtime.ChainIndexer.Database (DatabaseQueries (..))
@@ -142,14 +144,32 @@ renderDatabaseSelectorOTel dbName dbUser host port = \case
       , renderField = \case
           SqlStatement sql -> [("db.statement", toAttribute $ decodeUtf8 sql)]
           Parameters params -> [("db.parameters", toAttribute params)]
-          Operation operation ->
-            catMaybes
-              [ Just ("db.system", "postgresql")
-              , ("db.user",) . toAttribute . decodeUtf8 <$> dbUser
-              , ("net.peer.name",) . toAttribute . decodeUtf8 <$> host
-              , ("net.peer.port",) . toAttribute . decodeUtf8 <$> port
-              , ("db.name",) . toAttribute . decodeUtf8 <$> dbName
-              , Just ("net.transport", "ip_tcp")
-              , Just ("db.operation", toAttribute operation)
-              ]
+          Operation operation -> ("db.operation", toAttribute operation) : standardAttributes
       }
+  CopyBlocks -> renderCopy "block"
+  CopyTxs -> renderCopy "tx"
+  CopyTxOuts -> renderCopy "txOut"
+  CopyTxIns -> renderCopy "txIn"
+  CopyAssetOuts -> renderCopy "assetOut"
+  CopyAssetMints -> renderCopy "assetMint"
+  where
+    standardAttributes =
+      catMaybes
+        [ Just ("db.system", "postgresql")
+        , ("db.user",) . toAttribute . decodeUtf8 <$> dbUser
+        , ("net.peer.name",) . toAttribute . decodeUtf8 <$> host
+        , ("net.peer.port",) . toAttribute . decodeUtf8 <$> port
+        , ("db.name",) . toAttribute . decodeUtf8 <$> dbName
+        , Just ("net.transport", "ip_tcp")
+        ]
+    renderCopy :: Text -> OTelRendered Int64
+    renderCopy table =
+      OTelRendered
+        { eventName = "COPY chain." <> table
+        , eventKind = Internal
+        , renderField = \rows ->
+            standardAttributes
+              <> [ ("db.statement", toAttribute $ "COPY chain." <> table <> " FROM STDIN WITH (FORMAT 'csv')")
+                 , ("db.rowsAffected", toAttribute rows)
+                 ]
+        }