From bf0423cec0909add9b310c80ff0464654b6f3d62 Mon Sep 17 00:00:00 2001 From: paolino Date: Thu, 14 Nov 2024 17:16:57 +0000 Subject: [PATCH] Add a restoration form to recover the receivers from a transaction in deposit UI --- lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs | 9 ++- .../Cardano/Wallet/UI/Deposit/API/Payments.hs | 44 +++++++++++ .../Deposit/Handlers/Payments/Transaction.hs | 78 ++++++++++--------- .../UI/Deposit/Html/Pages/Payments/Page.hs | 31 +++++++- .../src/Cardano/Wallet/UI/Deposit/Server.hs | 2 + .../Wallet/UI/Deposit/Server/Payments/Page.hs | 26 ++++++- 6 files changed, 147 insertions(+), 43 deletions(-) diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs index bd8fcfd02d9..79fa83ff797 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs +++ b/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) diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs index b73a3638232..c091e736230 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs +++ b/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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs index 3a9d3186099..871f889e5f2 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs +++ b/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 + ] diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs index 4c6aa5eeb90..1e5ed73afea 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs +++ b/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 [] diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index 19825080d9a..6a74844fb35 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs index 9b2773ca04f..18d7408b9c3 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs @@ -7,6 +7,7 @@ module Cardano.Wallet.UI.Deposit.Server.Payments.Page , servePaymentsBalanceAvailable , servePaymentsReceiverAddressValidation , servePaymentsReceiverAmountValidation + , servePaymentsRestore ) where @@ -35,6 +36,7 @@ import Cardano.Wallet.UI.Cookies import Cardano.Wallet.UI.Deposit.API.Payments ( NewReceiver (..) , NewReceiverValidation + , TransactionExport (..) , WithReceivers (..) ) import Cardano.Wallet.UI.Deposit.Handlers.Lib @@ -47,6 +49,7 @@ import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction ( createPaymentHandler , receiverAddressValidation , receiverAmountValidation + , restoreTransaction ) import Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page ( availableBalanceElementH @@ -80,7 +83,11 @@ servePaymentsNewReceiver withSessionLayer ul $ \layer -> do let newReceivers = receivers ++ [newReceiver] renderHtml - <$> createPaymentHandler layer alertH updateReceiversH newReceivers + <$> createPaymentHandler + layer + alertH + updateReceiversH + (Right newReceivers) servePaymentsDeleteReceiver :: UILayer WalletResource @@ -99,7 +106,11 @@ servePaymentsDeleteReceiver $ filter ((/= receiverN) . fst) $ zip [0 ..] receivers renderHtml - <$> createPaymentHandler layer alertH updateReceiversH newReceivers + <$> createPaymentHandler + layer + alertH + updateReceiversH + (Right newReceivers) servePaymentsDeleteReceiver _ _ _ = error "servePaymentsDeleteReceiver: receiver-number is required" @@ -133,3 +144,14 @@ servePaymentsReceiverAmountValidation ul amount = withSessionLayer ul $ \_ -> do let response = receiverAmountValidation amount pure $ renderHtml $ receiverAmountValidationH response + +servePaymentsRestore + :: UILayer WalletResource + -> TransactionExport + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +servePaymentsRestore ul txe = + withSessionLayer ul $ \layer -> do + renderHtml + <$> restoreTransaction layer alertH + updateReceiversH txe