Support for multiple transactions

src/base/lib/Convex/ResolvedTx.hs

@@ -31,11 +31,11 @@ import           Data.Aeson                          (FromJSON (..),
                                                       (.:))
 import           Data.Aeson.Types                    (object, (.=))
 import qualified Data.ByteString.Base16              as Base16
-import           Data.Foldable                       (traverse_)
+import           Data.Foldable                       (forM_, traverse_)
 import           Data.GraphViz.Attributes            (bgColor, filled, style)
 import qualified Data.GraphViz.Attributes.Colors.X11 as Colors
 import qualified Data.GraphViz.Attributes.Complete   as A
-import           Data.GraphViz.Printing              (PrintDot (..))
+import           Data.GraphViz.Printing              (DotCode, PrintDot (..))
 import qualified Data.GraphViz.Types                 as GVT
 import           Data.GraphViz.Types.Generalised     (DotGraph (..))
 import qualified Data.GraphViz.Types.Monadic         as GV
@@ -86,12 +86,12 @@ instance FromJSON ResolvedTx where
 
 {-| A .dot (graphviz) representation of the transaction
 -}
-dot :: ResolvedTx -> Text
-dot tx@ResolvedTx{rtxTransaction} = TL.toStrict $ GVT.printDotGraph $ dot' (C.textShow $ C.getTxId $ C.getTxBody rtxTransaction) tx
+dot :: [ResolvedTx] -> Text
+dot = TL.toStrict . GVT.printDotGraph . dot' "resolved-transactions"
 
 {-| Write the transaction graph to a .dot (graphviz) file
 -}
-dotFile :: FilePath -> ResolvedTx -> IO ()
+dotFile :: FilePath -> [ResolvedTx] -> IO ()
 dotFile fp = TIO.writeFile fp . dot
 
 data FullTxInput =
@@ -176,39 +176,44 @@ shortenHash56 t = Text.take 4 t <> "..." <> Text.drop 52 t
 
 instance GVT.PrintDot FullTxInput where
   unqtDot = \case
-    RefInput txI -> unqtDot ("ref" <> replaceHash (C.renderTxIn txI))
-    SpendInput txI -> unqtDot ("spend" <> replaceHash (C.renderTxIn txI))
-    CollateralInput txI -> unqtDot ("collateral" <> replaceHash (C.renderTxIn txI))
+    RefInput txI -> mkTxInLabel txI
+    SpendInput txI -> mkTxInLabel txI
+    CollateralInput txI -> mkTxInLabel txI
+
+mkTxInLabel :: C.TxIn -> DotCode
+mkTxInLabel txI = unqtDot ("txin_" <> replaceHash (C.renderTxIn txI))
+
+mkTxLabel :: C.TxId -> DotCode
+mkTxLabel txid = unqtDot ("tx_" <> filter (/= '"') (show txid))
 
 {-| Object that we display in the graph
 -}
 data FullTxObject =
-  FtxInput FullTxInput
-  | FullTxBody
-  | FullTxOutput C.TxIn
+  FullTxBody C.TxId -- ^ Body of the transaction
+  | FullTxOutput C.TxIn -- ^ Transaction output
   deriving stock (Eq, Ord, Show)
 
 instance GVT.PrintDot FullTxObject where
   unqtDot = \case
-    FtxInput it      -> unqtDot it
-    FullTxBody       -> unqtDot @String "txbody"
-    FullTxOutput txI -> unqtDot ("output" <> replaceHash (C.renderTxIn txI))
+    FullTxBody txi   -> mkTxLabel txi
+    FullTxOutput txI -> mkTxInLabel txI
 
-dot' :: Text -> ResolvedTx -> DotGraph FullTxObject
-dot' (TL.fromStrict -> nm) ftx = GV.digraph (GV.Str nm) $ do
+dot' :: Text -> [ResolvedTx] -> DotGraph FullTxObject
+dot' (TL.fromStrict -> nm) transactions = GV.digraph (GV.Str nm) $ do
   GV.graphAttrs [ A.RankDir A.FromLeft ]
   GV.nodeAttrs
     [ A.Shape A.Record
     , style filled
     , bgColor Colors.Gray93
     , A.Height 0.1
     ]
-  flip runReaderT ftx $ do
-    addTxBody
-    asks (Utils.spendInputs . txBodyContent) >>= traverse_ (addInput . SpendInput)
-    asks (Utils.referenceInputs . txBodyContent) >>= traverse_ (addInput . RefInput)
-    asks (Utils.collateralInputs . txBodyContent) >>= traverse_ (addInput . CollateralInput)
-    asks (Utils.txnUtxos . rtxTransaction) >>= traverse_ (uncurry addTxOut)
+  forM_ transactions $ \ftx ->
+    flip runReaderT ftx $ do
+      addTxBody
+      asks (Utils.spendInputs . txBodyContent) >>= traverse_ (addInput . SpendInput)
+      asks (Utils.referenceInputs . txBodyContent) >>= traverse_ (addInput . RefInput)
+      asks (Utils.collateralInputs . txBodyContent) >>= traverse_ (addInput . CollateralInput)
+      asks (Utils.txnUtxos . rtxTransaction) >>= traverse_ (uncurry addTxOut)
 
 type GraphBuilder a = ReaderT ResolvedTx (GV.DotM FullTxObject) a
 
@@ -220,13 +225,14 @@ lookupTxIn txI =
 
 addInput :: FullTxInput -> GraphBuilder ()
 addInput txI = do
+  i <- asks txId
   output <- lookupTxIn (getTxIn txI)
   lift $ do
-    let ref = FtxInput txI
+    let ref = FullTxOutput (getTxIn txI)
     GV.node ref
       [ A.Label $ A.RecordLabel (fullTxInputLabel txI output)
       ]
-    GV.edge ref FullTxBody []
+    GV.edge ref (FullTxBody i) []
 
 addTxBody :: GraphBuilder ()
 addTxBody = do
@@ -237,11 +243,12 @@ addTxBody = do
         , A.FieldLabel $ "Fee: " <> TL.fromStrict (adaLabel n)
         , A.FieldLabel $ TL.fromStrict $ C.serialiseToRawBytesHexText i
         ]
-  lift $ GV.node FullTxBody [A.Label $ A.RecordLabel labels]
+  lift $ GV.node (FullTxBody i) [A.Label $ A.RecordLabel labels]
 
 addTxOut :: (C.IsMaryBasedEra era) => C.TxIn -> C.TxOut C.CtxTx era -> GraphBuilder ()
 addTxOut txI txOut = do
+  i <- asks txId
   lift $ do
     let ref = FullTxOutput txI
     GV.node ref [A.Label $ A.RecordLabel (fullTxOutputLabel txI txOut)]
-    GV.edge FullTxBody ref []
+    GV.edge (FullTxBody i) ref []

src/tx-mod/lib/Convex/TxMod/Cli.hs

@@ -5,11 +5,12 @@ module Convex.TxMod.Cli(
 
 import           Blammo.Logging.Simple      (Message ((:#)), MonadLogger,
                                              MonadLoggerIO, WithLogger (..),
-                                             logError, logInfo,
+                                             logError, logInfo, logWarn,
                                              runLoggerLoggingT)
 import           Blockfrost.Client.Core     (BlockfrostError)
 import           Cardano.Api                (TxId)
 import           Control.Lens               (view)
+import           Control.Monad              (when)
 import           Control.Monad.Except       (ExceptT, MonadError, runExceptT)
 import           Control.Monad.IO.Class     (MonadIO (..))
 import           Control.Monad.Reader       (MonadReader, ReaderT, asks,
@@ -55,8 +56,10 @@ runCommand com = do
 downloadTx :: (MonadLoggerIO m, MonadReader Env m, MonadError AppError m) => TxId -> Maybe FilePath -> m ()
 downloadTx txId filePath = resolveTx txId >>= writeTx filePath
 
-graph :: (MonadLoggerIO m, MonadReader Env m, MonadError AppError m) => ResolvedTxInput -> Maybe FilePath -> m ()
-graph input outFile = getTx input >>= writeGraph outFile
+graph :: (MonadLoggerIO m, MonadReader Env m, MonadError AppError m) => [ResolvedTxInput] -> Maybe FilePath -> m ()
+graph inputs outFile = do
+  when (null inputs) $ logWarn "No resolved transactions provided, graph will be empty"
+  traverse getTx inputs >>= writeGraph outFile
 
 newtype TxModApp a = TxModApp{ unTxModApp :: ReaderT Env (ExceptT AppError IO) a }
   deriving newtype (Monad, Applicative, Functor, MonadIO, MonadReader Env, MonadError AppError)
@@ -95,7 +98,7 @@ loadTx fp = do
 getTx :: (MonadLoggerIO m, MonadReader Env m, MonadError AppError m) => ResolvedTxInput -> m ResolvedTx
 getTx (ResolvedTxInput k) = either loadTx resolveTx k
 
-writeGraph :: (MonadLoggerIO m) => Maybe FilePath -> ResolvedTx -> m ()
+writeGraph :: (MonadLoggerIO m) => Maybe FilePath -> [ResolvedTx] -> m ()
 writeGraph = \case
   Nothing -> \tx -> do
     logInfo "Writing graph to stdout"

src/tx-mod/lib/Convex/TxMod/Command.hs

@@ -8,13 +8,13 @@ module Convex.TxMod.Command(
 
 import           Cardano.Api         (TxId)
 import           Options.Applicative (CommandFields, Mod, Parser, argument,
-                                      command, fullDesc, help, info, long,
+                                      command, fullDesc, help, info, long, many,
                                       metavar, optional, progDesc, short, str,
                                       strOption, subparser, (<|>))
 
 data TxModCommand =
   Download TxId (Maybe FilePath) -- ^ Download the transaction from blockfrost and print it to stdout, or write it to the file if a file is provided
-  | Graph ResolvedTxInput (Maybe FilePath) -- ^ visualise the transaction
+  | Graph [ResolvedTxInput] (Maybe FilePath) -- ^ visualise the transaction
 
 parseCommand :: Parser TxModCommand
 parseCommand = subparser $ mconcat [parseDownload, parseGraph]
@@ -25,7 +25,7 @@ parseDownload = command "download" $
 
 parseGraph :: Mod CommandFields TxModCommand
 parseGraph = command "graph" $
-  info (Graph <$> parseResolvedTxInput <*> optional parseGraphOutFile) (fullDesc <> progDesc "Generate a dot graph (graphviz) from a fully resolved transaction")
+  info (Graph <$> many parseResolvedTxInput <*> optional parseGraphOutFile) (fullDesc <> progDesc "Generate a dot graph (graphviz) from a fully resolved transaction")
 
 parseTxId :: Parser TxId
 parseTxId = argument str