Add read-only fields in the unsigned transaction component

lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs

@@ -8,10 +8,14 @@ import Prelude
 import Cardano.Read.Ledger.Tx.CBOR
     ( serializeTx
     )
+import Cardano.Wallet.Deposit.Pure
+    ( InspectTx (..)
+    )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
     , availableBalance
     , createPayment
+    , inspectTx
     )
 import Cardano.Wallet.Deposit.Write
     ( resolvedTx
@@ -45,30 +49,37 @@ createPaymentHandler
     :: SessionLayer WalletResource
     -> (BL.ByteString -> html)
     -- ^ Function to render the exception as HTML
-    -> ([Receiver] -> Coin -> Coin -> Maybe Text -> html)
+    -> ( [Receiver]
+         -> Coin
+         -> Coin
+         -> Maybe (Text, InspectTx)
+         -> html
+       )
     -- ^ Function to render the transaction cbor
     -> [Receiver]
     -- ^ Current receivers
     -> Handler html
 createPaymentHandler layer alert render receivers = do
     catchRunWalletResourceHtml layer alert id $ do
         ValueC available _ <- availableBalance
-        let afterTransaction = available
-                - CoinC (sum $ fmap (fromIntegral . amount) receivers)
+        let afterTransaction =
+                available
+                    - CoinC (sum $ fmap (fromIntegral . amount) receivers)
             render' = render receivers available afterTransaction
         case receivers of
             [] -> pure $ render' Nothing
             _ -> do
                 r <- createPayment $ do
                     Receiver{address, amount} <- receivers
                     pure (address, ValueC (CoinC $ fromIntegral amount) mempty)
-                pure $ case r of
-                    Left e -> alert $ "Error: " <> BL8.pack (show e)
-                    Right tx ->
-                        render'
-                            $ Just
-                            $ T.decodeUtf8
-                            $ Base58.encodeBase58 Base58.bitcoinAlphabet
-                            $ BL.toStrict
-                            $ serializeTx
-                            $ resolvedTx tx
+                case r of
+                    Left e -> pure $ alert $ "Error: " <> BL8.pack (show e)
+                    Right tx -> do
+                        itx <- inspectTx tx
+                        let
+                            mt = T.decodeUtf8
+                                $ Base58.encodeBase58 Base58.bitcoinAlphabet
+                                $ BL.toStrict
+                                $ serializeTx
+                                $ resolvedTx tx
+                        pure $ render' $ Just (mt, itx)

lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page
     ( paymentsH
@@ -15,6 +16,9 @@ import Prelude
 import Cardano.Wallet.Deposit.IO
     ( WalletPublicIdentity (..)
     )
+import Cardano.Wallet.Deposit.Pure
+    ( InspectTx (..)
+    )
 import Cardano.Wallet.Read
     ( Coin (..)
     )
@@ -37,7 +41,9 @@ import Cardano.Wallet.UI.Common.Html.Pages.Lib
     ( Striped (..)
     , Width (..)
     , addressH
+    , alertH
     , box
+    , field
     , record
     , simpleField
     , sseH
@@ -49,6 +55,7 @@ import Cardano.Wallet.UI.Deposit.API
     )
 import Cardano.Wallet.UI.Deposit.Html.Common
     ( lovelaceH
+    , txIdH
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     ( WalletPresent (..)
@@ -152,17 +159,87 @@ receiversH rs = do
                         $ i_ [class_ "bi bi-trash"] mempty
         newReceiverH
 
-transactionCBORH :: Maybe Text -> Html ()
-transactionCBORH (Just cbor) =
+unsignedTransactionH
+    :: Maybe (Text, InspectTx)
+    -> Html ()
+unsignedTransactionH Nothing = alertH ("No transaction defined" :: Text)
+unsignedTransactionH (Just (mt, InspectTx{..})) = do
+    div_ [class_ ""] $ do
+        record (Just 7) Full Striped $ do
+            field [] "cbor" $ do
+                transactionCBORH mt
+            field [] "fee" $ lovelaceH $ fromIntegral fee
+            field [] "our inputs" $ table_ [class_ "table table-striped"] $ do
+                thead_ $ do
+                    tr_ $ do
+                        thEnd Nothing "Transaction"
+                        thEnd (Just 4) "Index"
+                        thEnd (Just 7) "Amount"
+                tbody_
+                    $ forM_ ourInputs
+                    $ \(txId, txIx, CoinC amount) -> do
+                        tr_ $ do
+                            tdEnd $ txIdH txId
+                            tdEnd $ toHtml $ show $ fromEnum txIx
+                            tdEnd $ lovelaceH $ fromIntegral amount
+            field [] "other inputs" $ table_ [class_ "table table-striped"] $ do
+                thead_ $ do
+                    tr_ $ do
+                        thEnd Nothing "Transaction"
+                        thEnd (Just 4) "Index"
+                tbody_
+                    $ forM_ otherInputs
+                    $ \(txId, txIx) -> do
+                        tr_ $ do
+                            tdEnd $ txIdH txId
+                            tdEnd $ toHtml $ show $ fromEnum txIx
+            field [] "change" $ table_ [class_ "table table-striped"] $ do
+                thead_ $ do
+                    tr_ $ do
+                        thEnd Nothing "Change Address"
+                        thEnd (Just 7) "Amount"
+                tbody_
+                    $ forM_ change
+                    $ \(addr, CoinC amount) -> do
+                        tr_ $ do
+                            tdEnd $ addressH WithCopy addr
+                            tdEnd $ lovelaceH $ fromIntegral amount
+            field [] "customer outputs" $ table_ [class_ "table table-striped"] $ do
+                thead_ $ do
+                    tr_ $ do
+                        thEnd Nothing "Address"
+                        thEnd (Just 6) "Customer"
+                        thEnd (Just 7) "Amount"
+                tbody_
+                    $ forM_ ourOutputs
+                    $ \(addr, customer, CoinC amount) -> do
+                        tr_ $ do
+                            tdEnd $ addressH WithCopy addr
+                            tdEnd $ toHtml $ show customer
+                            tdEnd $ lovelaceH $ fromIntegral amount
+            field [] "other outputs" $ table_ [class_ "table table-striped"] $ do
+                thead_ $ do
+                    tr_ $ do
+                        thEnd Nothing "Address"
+                        thEnd (Just 7) "Amount"
+                tbody_
+                    $ forM_ otherOutputs
+                    $ \(addr, CoinC amount) -> do
+                        tr_ $ do
+                            tdEnd $ addressH WithCopy addr
+                            tdEnd $ lovelaceH $ fromIntegral amount
+
+transactionCBORH :: Text -> Html ()
+transactionCBORH cbor =
     truncatableText WithCopy "unsigned-transaction-copy"
         $ toHtml cbor
-transactionCBORH Nothing = ""
 
-updateReceiversH :: [Receiver] -> Coin -> Coin -> Maybe Text -> Html ()
+updateReceiversH
+    :: [Receiver] -> Coin -> Coin -> Maybe (Text, InspectTx) -> Html ()
 updateReceiversH rs balance afterTransaction cbor = do
     receiversH rs
     div_ [id_ "unsigned-transaction", hxSwapOob_ "innerHTML"]
-        $ transactionCBORH cbor
+        $ unsignedTransactionH cbor
     div_ [id_ "available-balance", hxSwapOob_ "innerHTML"]
         $ availableBalanceElementH balance afterTransaction
 
@@ -189,19 +266,19 @@ paymentsElementH = onWalletPresentH $ \case
                     $ do
                         box "Available balance" mempty
                             $ div_
-                                [class_ ""
-                                    , id_ "available-balance"
-                                    , hxTrigger_ "load"
-                                    , hxPost_ $ linkText paymentsBalanceAvailableLink
-                                    , hxInclude_ "#receivers-state"
-                                    , hxTarget_ "#available-balance"
-                                    ]
+                                [ class_ ""
+                                , id_ "available-balance"
+                                , hxTrigger_ "load"
+                                , hxPost_ $ linkText paymentsBalanceAvailableLink
+                                , hxInclude_ "#receivers-state"
+                                , hxTarget_ "#available-balance"
+                                ]
                                 ""
                         box "Transaction payments" mempty
                             $ div_ [class_ "", id_ "receivers"]
                             $ receiversH []
                         box "Unsigned Transaction" mempty
                             $ div_ [class_ "", id_ "unsigned-transaction"]
-                            $ transactionCBORH Nothing
+                            $ unsignedTransactionH Nothing
 
 -- box "Payments History" mempty "To be done"