Add a restoration form to recover the receivers from a transaction in…

… deposit UI

lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs

@@ -45,6 +45,7 @@ import Cardano.Wallet.UI.Deposit.API.Deposits.Deposits
 import Cardano.Wallet.UI.Deposit.API.Payments
     ( NewReceiver
     , NewReceiverValidation
+    , TransactionExport
     , WithReceivers
     )
 import Control.Lens
@@ -230,6 +231,10 @@ type Data =
             :> QueryParam "title" Text
             :> QueryParam "text" Text
             :> SessionedHtml Get
+        :<|> "payments"
+            :> "restore"
+            :> ReqBody '[FormUrlEncoded] TransactionExport
+            :> SessionedHtml Post
 
 type Home = SessionedHtml Get
 
@@ -283,6 +288,7 @@ paymentsBalanceAvailableLink :: Link
 paymentsReceiverAddressValidationLink :: Link
 paymentsReceiverAmountValidationLink :: Link
 modalLink :: Maybe Text -> Maybe Text -> Link
+paymentsRestoreLink :: Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
@@ -319,5 +325,6 @@ homePageLink
     :<|> paymentsBalanceAvailableLink
     :<|> paymentsReceiverAddressValidationLink
     :<|> paymentsReceiverAmountValidationLink
-    :<|> modalLink =
+    :<|> modalLink
+    :<|> paymentsRestoreLink =
         allLinks (Proxy @UI)

lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs

@@ -10,6 +10,7 @@ module Cardano.Wallet.UI.Deposit.API.Payments
     ( NewReceiver (..)
     , WithReceivers (..)
     , NewReceiverValidation (..)
+    , TransactionExport (..)
     )
 where
 
@@ -18,11 +19,24 @@ import Prelude
 import Cardano.Wallet.UI.Deposit.Types.Payments
     ( Receiver (..)
     )
+import Data.Aeson
+    ( FromJSON (parseJSON)
+    , KeyValue ((.=))
+    , ToJSON (toJSON)
+    , object
+    , withObject
+    , (.:)
+    )
 import Data.Text
     ( Text
     )
+
+import qualified Data.Aeson as Aeson
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Encoding as TL
 import Web.FormUrlEncoded
     ( FromForm (..)
+    , lookupUnique
     , parseAll
     , parseMaybe
     , parseUnique
@@ -63,3 +77,33 @@ instance FromForm NewReceiverValidation where
         addressValidation <- parseMaybe "new-receiver-address" form
         amountValidation <- parseMaybe "new-receiver-amount" form
         pure $ NewReceiverValidation{addressValidation, amountValidation}
+
+data TransactionExport
+    = TransactionExport
+    { dataType :: Text
+    , description :: Text
+    , cborHex :: Text
+    }
+    deriving (Eq, Show)
+
+instance ToJSON TransactionExport where
+    toJSON TransactionExport{dataType, description, cborHex} =
+        object
+            [ "type" .= dataType
+            , "description" .= description
+            , "cborHex" .= cborHex
+            ]
+
+instance FromJSON TransactionExport where
+    parseJSON = withObject "TransactionExport" $ \o -> do
+        dataType <- o .: "type"
+        description <- o .: "description"
+        cborHex <- o .: "cborHex"
+        pure TransactionExport{dataType, description, cborHex}
+
+instance FromForm TransactionExport where
+    fromForm form = do
+        dataType <- lookupUnique "restore-transaction" form
+        case Aeson.decode $ TL.encodeUtf8 $ T.fromStrict dataType of
+            Nothing -> Left "Invalid JSON for a TransactionExport"
+            Just tx -> pure tx

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

@@ -7,7 +7,8 @@ where
 import Prelude
 
 import Cardano.Read.Ledger.Tx.CBOR
-    ( serializeTx
+    ( deserializeTx
+    , serializeTx
     )
 import Cardano.Wallet.Deposit.Pure
     ( CurrentEraResolvedTx
@@ -23,9 +24,11 @@ import Cardano.Wallet.Deposit.REST
     , availableBalance
     , createPayment
     , inspectTx
+    , resolveCurrentEraTx
     )
 import Cardano.Wallet.Deposit.Write
-    ( resolvedTx
+    ( Tx
+    , resolvedTx
     )
 import Cardano.Wallet.Read
     ( Coin (..)
@@ -36,6 +39,7 @@ import Cardano.Wallet.UI.Common.Layer
     )
 import Cardano.Wallet.UI.Deposit.API.Payments
     ( NewReceiverValidation (..)
+    , TransactionExport (..)
     )
 import Cardano.Wallet.UI.Deposit.Handlers.Lib
     ( catchRunWalletResourceHtml
@@ -46,14 +50,6 @@ import Cardano.Wallet.UI.Deposit.Types.Payments
 import Control.Monad
     ( (<=<)
     )
-import Data.Aeson
-    ( FromJSON (parseJSON)
-    , KeyValue ((.=))
-    , ToJSON (toJSON)
-    , object
-    , withObject
-    , (.:)
-    )
 import Data.Text
     ( Text
     )
@@ -64,6 +60,7 @@ import Servant
 
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.Text.Encoding as T
 
 data PaymentHandlerResponse
@@ -82,12 +79,18 @@ createPaymentHandler
          -> html
        )
     -- ^ Function to render the transaction cbor
-    -> [Receiver]
+    -> Either Tx [Receiver]
     -- ^ Current receivers
     -> Handler html
-createPaymentHandler layer alert render receivers = do
+createPaymentHandler layer alert render receiversOrTx = do
     catchRunWalletResourceHtml layer alert id $ do
         ValueC available _ <- availableBalance
+        receivers <- case receiversOrTx of
+            Left tx -> do
+                tx' <- resolveCurrentEraTx tx
+                itx <- inspectTx tx'
+                pure $ extractReceivers itx
+            Right rs -> pure rs
         let render' = render receivers available
         case receivers of
             [] -> pure $ render' ResponseNoReceivers
@@ -96,29 +99,6 @@ createPaymentHandler layer alert render receivers = do
                     Receiver{address, amount} <- receivers
                     pure (address, ValueC (CoinC $ fromIntegral amount) mempty)
 
-data TransactionExport
-    = TransactionExport
-    { dataType :: Text
-    , description :: Text
-    , cborHex :: Text
-    }
-    deriving (Eq, Show)
-
-instance ToJSON TransactionExport where
-    toJSON TransactionExport{dataType, description, cborHex} =
-        object
-            [ "type" .= dataType
-            , "description" .= description
-            , "cborHex" .= cborHex
-            ]
-
-instance FromJSON TransactionExport where
-    parseJSON = withObject "TransactionExport" $ \o -> do
-        dataType <- o .: "type"
-        description <- o .: "description"
-        cborHex <- o .: "cborHex"
-        pure TransactionExport{dataType, description, cborHex}
-
 conwayEraTransactionExport :: Text -> TransactionExport
 conwayEraTransactionExport cborHex =
     TransactionExport
@@ -156,7 +136,8 @@ data AmountValidationResponse
     | InvalidAmount Text
 
 receiverAddressValidation
-    :: NewReceiverValidation -> AddressValidationResponse
+    :: NewReceiverValidation
+    -> AddressValidationResponse
 receiverAddressValidation
     nrv@NewReceiverValidation{addressValidation} =
         case parseUrlPiece <$> addressValidation of
@@ -180,3 +161,28 @@ receiverAmountValidation nrv@NewReceiverValidation{amountValidation} =
                 $ case receiverAddressValidation nrv of
                     ValidAddress _ _ -> True
                     _ -> False
+
+restoreTransaction
+    :: SessionLayer WalletResource
+    -> (BL.ByteString -> html)
+    -> ([Receiver] -> Coin -> PaymentHandlerResponse -> html)
+    -> TransactionExport
+    -> Handler html
+restoreTransaction layer alert render' TransactionExport{cborHex} = do
+    let eTx = case B16.decode $ T.encodeUtf8 cborHex of
+            Left e -> Left $ "Hex: " <> e
+            Right cbor -> case deserializeTx $ BL.fromStrict cbor of
+                Right tx -> Right tx
+                Left e -> Left $ "CBOR: " <> show e
+    case eTx of
+        Right tx -> createPaymentHandler layer alert render' $ Left tx
+        Left e -> pure $ alert $ BL8.pack e
+
+extractReceivers :: InspectTx -> [Receiver]
+extractReceivers InspectTx{otherOutputs} =
+    [ Receiver
+        { address = addr
+        , amount = fromIntegral coin
+        }
+    | (addr, coin) <- otherOutputs
+    ]

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

@@ -60,12 +60,15 @@ import Cardano.Wallet.UI.Deposit.API
     , paymentsNewReceiverLink
     , paymentsReceiverAddressValidationLink
     , paymentsReceiverAmountValidationLink
+    , paymentsRestoreLink
+    )
+import Cardano.Wallet.UI.Deposit.API.Payments
+    ( TransactionExport
     )
 import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction
     ( AddressValidationResponse (..)
     , AmountValidationResponse (..)
     , PaymentHandlerResponse (..)
-    , TransactionExport
     )
 import Cardano.Wallet.UI.Deposit.Html.Common
     ( lovelaceH
@@ -164,7 +167,7 @@ newReceiverH = do
                     , hxInclude_ "#receivers-state , #new-receiver-form"
                     , id_ "new-receiver-button"
                     ]
-                mempty
+                    mempty
 
 receiversH :: [Receiver] -> Html ()
 receiversH rs = do
@@ -212,7 +215,7 @@ unsignedTransactionH = \case
         let table = table_ [class_ "table table-sm m-0"]
         div_ [class_ ""] $ do
             record (Just 7) Full NotStriped $ do
-                field [] "cbor"
+                field [] "serialized tx"
                     $ transactionCBORH mt
                 field [] "fee"
                     $ lovelaceH
@@ -295,7 +298,8 @@ unsignedTransactionH = \case
 transactionCBORH :: TransactionExport -> Html ()
 transactionCBORH cbor =
     truncatableText WithCopy "unsigned-transaction-copy"
-        $ toHtml $ Aeson.encode cbor
+        $ toHtml
+        $ Aeson.encode cbor
 
 updateReceiversH
     :: [Receiver] -> Coin -> PaymentHandlerResponse -> Html ()
@@ -311,6 +315,7 @@ updateReceiversH rs balance transaction = do
                     $ fromIntegral
                     $ transactionBalance inspect
             _ -> Nothing
+    div_ [id_ "restoration", hxSwapOob_ "innerHTML"] restoreH
 
 availableBalanceElementH :: Coin -> Maybe Coin -> Html ()
 availableBalanceElementH balance mTxBalance =
@@ -329,6 +334,22 @@ availableBalanceElementH balance mTxBalance =
                     $ fromIntegral
                     $ balance - txBalance
 
+restoreH :: Html ()
+restoreH = div_ [class_ "input-group"] $ do
+    input_
+        [ class_ "form-control"
+        , type_ "text"
+        , name_ "restore-transaction"
+        , placeholder_ "serialized tx"
+        ]
+    button_
+        [ class_ "btn"
+        , hxPost_ $ linkText paymentsRestoreLink
+        , hxTarget_ "#receivers"
+        , hxInclude_ "#restoration"
+        ]
+        $ i_ [class_ "bi bi-upload"] mempty
+
 paymentsElementH
     :: Html ()
 paymentsElementH =
@@ -349,6 +370,8 @@ paymentsElementH =
                             , hxTarget_ "#available-balance"
                             ]
                             ""
+                    box "Restoration" mempty
+                        $ div_ [id_ "restoration"] restoreH
                     box "Payments" mempty
                         $ div_ [class_ "", id_ "receivers"]
                         $ receiversH []

lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs

@@ -115,6 +115,7 @@ import Cardano.Wallet.UI.Deposit.Server.Payments.Page
     , servePaymentsPage
     , servePaymentsReceiverAddressValidation
     , servePaymentsReceiverAmountValidation
+    , servePaymentsRestore
     )
 import Cardano.Wallet.UI.Deposit.Server.Wallet
     ( serveDeleteWallet
@@ -201,6 +202,7 @@ serveUI tr ul env dbDir config nid nl bs =
         :<|> servePaymentsReceiverAddressValidation ul
         :<|> servePaymentsReceiverAmountValidation ul
         :<|> serveModal ul
+        :<|> servePaymentsRestore ul
 
 serveModal
     :: UILayer WalletResource