diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs index 7593c29e5b5..bd8fcfd02d9 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs @@ -44,6 +44,7 @@ import Cardano.Wallet.UI.Deposit.API.Deposits.Deposits ) import Cardano.Wallet.UI.Deposit.API.Payments ( NewReceiver + , NewReceiverValidation , WithReceivers ) import Control.Lens @@ -213,6 +214,18 @@ type Data = :> "balance" :> "available" :> SessionedHtml Get + :<|> "payments" + :> "receiver" + :> "address" + :> "validation" + :> ReqBody '[FormUrlEncoded] NewReceiverValidation + :> SessionedHtml Post + :<|> "payments" + :> "receiver" + :> "amount" + :> "validation" + :> ReqBody '[FormUrlEncoded] NewReceiverValidation + :> SessionedHtml Post :<|> "modal" :> "info" :> QueryParam "title" Text :> QueryParam "text" Text @@ -267,6 +280,8 @@ paymentsLink :: Link paymentsNewReceiverLink :: Link paymentsDeleteReceiverLink :: Maybe Int -> Link paymentsBalanceAvailableLink :: Link +paymentsReceiverAddressValidationLink :: Link +paymentsReceiverAmountValidationLink :: Link modalLink :: Maybe Text -> Maybe Text -> Link homePageLink :<|> aboutPageLink @@ -302,5 +317,7 @@ homePageLink :<|> paymentsNewReceiverLink :<|> paymentsDeleteReceiverLink :<|> paymentsBalanceAvailableLink + :<|> paymentsReceiverAddressValidationLink + :<|> paymentsReceiverAmountValidationLink :<|> modalLink = 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 0448c40055a..b73a3638232 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} @@ -8,6 +9,7 @@ module Cardano.Wallet.UI.Deposit.API.Payments ( NewReceiver (..) , WithReceivers (..) + , NewReceiverValidation (..) ) where @@ -16,9 +18,13 @@ import Prelude import Cardano.Wallet.UI.Deposit.Types.Payments ( Receiver (..) ) +import Data.Text + ( Text + ) import Web.FormUrlEncoded ( FromForm (..) , parseAll + , parseMaybe , parseUnique ) @@ -45,3 +51,15 @@ instance FromForm NewReceiver where pure $ NewReceiver $ WithReceivers{receivers, what = Receiver{address, amount}} + +data NewReceiverValidation + = NewReceiverValidation + { addressValidation :: Maybe Text + , amountValidation :: Maybe Text + } + +instance FromForm NewReceiverValidation where + fromForm form = do + addressValidation <- parseMaybe "new-receiver-address" form + amountValidation <- parseMaybe "new-receiver-amount" form + pure $ NewReceiverValidation{addressValidation, amountValidation} 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 9d2ef252b2d..50d1d418ecb 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} module Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction @@ -13,6 +14,9 @@ import Cardano.Wallet.Deposit.Pure , ErrCreatePayment , InspectTx (..) ) +import Cardano.Wallet.Deposit.Read + ( Address + ) import Cardano.Wallet.Deposit.REST ( WalletResource , WalletResourceM @@ -30,6 +34,9 @@ import Cardano.Wallet.Read import Cardano.Wallet.UI.Common.Layer ( SessionLayer ) +import Cardano.Wallet.UI.Deposit.API.Payments + ( NewReceiverValidation (..) + ) import Cardano.Wallet.UI.Deposit.Handlers.Lib ( catchRunWalletResourceHtml ) @@ -43,7 +50,8 @@ import Data.Text ( Text ) import Servant - ( Handler + ( FromHttpApiData (..) + , Handler ) import qualified Data.ByteString.Base58 as Base58 @@ -98,3 +106,37 @@ respondCreatePayment render' r = do $ serializeTx $ resolvedTx tx pure $ render' $ ResponseSuccess mt itx + +data AddressValidationResponse + = ValidAddress Address Bool + | InvalidAddress Text + +data AmountValidationResponse + = ValidAmount Double Bool + | InvalidAmount Text + +receiverAddressValidation + :: NewReceiverValidation -> AddressValidationResponse +receiverAddressValidation + nrv@NewReceiverValidation{addressValidation} = + case parseUrlPiece <$> addressValidation of + Nothing -> InvalidAddress "Address cannot be empty" + Just (Left e) -> InvalidAddress $ "Invalid address: " <> e + Just (Right addr) -> + ValidAddress addr + $ case receiverAmountValidation nrv of + ValidAmount _ _ -> True + _ -> False + +receiverAmountValidation + :: NewReceiverValidation -> AmountValidationResponse +receiverAmountValidation nrv@NewReceiverValidation{amountValidation} = + case parseUrlPiece <$> amountValidation of + Nothing -> InvalidAmount "Amount cannot be empty" + Just (Left e) -> InvalidAmount $ "Invalid amount: " <> e + Just (Right amount) + | amount <= 0 -> InvalidAmount "Amount must be positive" + | otherwise -> ValidAmount amount + $ case receiverAddressValidation nrv of + ValidAddress _ _ -> True + _ -> False 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 98d6922eca6..5f42162adfa 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 @@ -8,6 +8,8 @@ module Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page , receiversH , updateReceiversH , availableBalanceElementH + , receiverAddressValidationH + , receiverAmountValidationH ) where @@ -37,6 +39,9 @@ import Cardano.Wallet.UI.Common.Html.Lib , thEnd , truncatableText ) +import Cardano.Wallet.UI.Common.Html.Modal + ( mkModalButton + ) import Cardano.Wallet.UI.Common.Html.Pages.Lib ( Striped (..) , Width (..) @@ -49,12 +54,17 @@ import Cardano.Wallet.UI.Common.Html.Pages.Lib , sseH ) import Cardano.Wallet.UI.Deposit.API - ( paymentsBalanceAvailableLink + ( modalLink + , paymentsBalanceAvailableLink , paymentsDeleteReceiverLink , paymentsNewReceiverLink + , paymentsReceiverAddressValidationLink + , paymentsReceiverAmountValidationLink ) import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction - ( PaymentHandlerResponse (..) + ( AddressValidationResponse (..) + , AmountValidationResponse (..) + , PaymentHandlerResponse (..) ) import Cardano.Wallet.UI.Deposit.Html.Common ( lovelaceH @@ -68,12 +78,13 @@ import Cardano.Wallet.UI.Type ) import Control.Monad ( forM_ + , when ) import Data.Text ( Text ) import Data.Text.Class - ( toText + ( ToText (..) ) import Lucid ( Html @@ -86,6 +97,8 @@ import Lucid , id_ , input_ , name_ + , placeholder_ + , span_ , table_ , tbody_ , thead_ @@ -108,25 +121,47 @@ newReceiverH = do $ tr_ $ do tdEnd - $ input_ - [ class_ "form-control" - , type_ "text" - , name_ "new-receiver-address" - ] + $ span_ [class_ "d-flex"] + $ do + div_ [id_ "receiver-address-validation"] mempty + input_ + [ class_ "form-control" + , type_ "text" + , name_ "new-receiver-address" + , hxPost_ + $ linkText + paymentsReceiverAddressValidationLink + , hxTarget_ "#receiver-address-validation" + , hxInclude_ "#new-receiver-form" + , hxTrigger_ "input" + , placeholder_ "payment address" + ] tdEnd - $ input_ - [ class_ "form-control" - , type_ "text" - , name_ "new-receiver-amount" - ] + $ span_ [class_ "d-flex"] + $ do + div_ [id_ "receiver-amount-validation"] mempty + input_ + [ class_ "form-control" + , type_ "text" + , name_ "new-receiver-amount" + , hxPost_ + $ linkText + paymentsReceiverAmountValidationLink + , hxTarget_ "#receiver-amount-validation" + , hxInclude_ "#new-receiver-form" + , hxTrigger_ "input" + , placeholder_ "amount" + ] + tdEnd $ button_ [ class_ "btn w-100" , hxPost_ $ linkText paymentsNewReceiverLink , hxTarget_ "#receivers" , hxInclude_ "#receivers-state , #new-receiver-form" + , id_ "new-receiver-button" ] - $ i_ [class_ "bi bi-plus-lg"] mempty + mempty receiversH :: [Receiver] -> Html () receiversH rs = do @@ -134,7 +169,7 @@ receiversH rs = do thead_ $ do tr_ $ do thEnd Nothing "Address" - thEnd (Just 7) "Amount" + thEnd (Just 9) "Amount" thEnd (Just 5) "Actions" tbody_ [id_ "receivers-state"] $ forM_ (zip [0 ..] rs) @@ -318,4 +353,27 @@ paymentsElementH = $ div_ [class_ "", id_ "unsigned-transaction"] $ unsignedTransactionH ResponseNoReceivers --- box "Payments History" mempty "To be done" +receiverAddressValidationH :: AddressValidationResponse -> Html () +receiverAddressValidationH (ValidAddress _ m) = + div_ [id_ "new-receiver-button", hxSwapOob_ "innerHTML"] + $ when m + $ i_ [class_ "bi bi-plus-lg"] mempty +receiverAddressValidationH (InvalidAddress e) = do + validationFailedButton "Invalid Address" $ toText e + div_ [id_ "new-receiver-button"] mempty + +receiverAmountValidationH :: AmountValidationResponse -> Html () +receiverAmountValidationH (ValidAmount _ m) = do + div_ [id_ "new-receiver-button", hxSwapOob_ "innerHTML"] + $ when m + $ i_ [class_ "bi bi-plus-lg"] mempty +receiverAmountValidationH (InvalidAmount e) = do + validationFailedButton "Invalid Amount" $ toText e + div_ [id_ "new-receiver-button"] mempty + +validationFailedButton :: Text -> Text -> Html () +validationFailedButton t e = + mkModalButton + (modalLink (Just t) $ Just e) + [class_ "btn px-1"] + $ i_ [class_ "bi bi-exclamation-triangle text-danger-emphasis"] mempty diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index 20a3edd4c64..19825080d9a 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs @@ -113,6 +113,8 @@ import Cardano.Wallet.UI.Deposit.Server.Payments.Page , servePaymentsDeleteReceiver , servePaymentsNewReceiver , servePaymentsPage + , servePaymentsReceiverAddressValidation + , servePaymentsReceiverAmountValidation ) import Cardano.Wallet.UI.Deposit.Server.Wallet ( serveDeleteWallet @@ -196,6 +198,8 @@ serveUI tr ul env dbDir config nid nl bs = :<|> servePaymentsNewReceiver ul :<|> servePaymentsDeleteReceiver ul :<|> servePaymentsBalanceAvailable ul + :<|> servePaymentsReceiverAddressValidation ul + :<|> servePaymentsReceiverAmountValidation ul :<|> serveModal ul serveModal 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 f57581222f7..9b2773ca04f 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 @@ -5,6 +5,8 @@ module Cardano.Wallet.UI.Deposit.Server.Payments.Page , servePaymentsNewReceiver , servePaymentsDeleteReceiver , servePaymentsBalanceAvailable + , servePaymentsReceiverAddressValidation + , servePaymentsReceiverAmountValidation ) where @@ -32,6 +34,7 @@ import Cardano.Wallet.UI.Cookies ) import Cardano.Wallet.UI.Deposit.API.Payments ( NewReceiver (..) + , NewReceiverValidation , WithReceivers (..) ) import Cardano.Wallet.UI.Deposit.Handlers.Lib @@ -42,10 +45,14 @@ import Cardano.Wallet.UI.Deposit.Handlers.Payments.Balance ) import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction ( createPaymentHandler + , receiverAddressValidation + , receiverAmountValidation ) import Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page ( availableBalanceElementH , paymentsElementH + , receiverAddressValidationH + , receiverAmountValidationH , updateReceiversH ) import Cardano.Wallet.UI.Deposit.Server.Lib @@ -71,9 +78,7 @@ servePaymentsNewReceiver ul (NewReceiver WithReceivers{receivers, what = newReceiver}) = withSessionLayer ul $ \layer -> do - _wp <- walletPresence layer let newReceivers = receivers ++ [newReceiver] - renderHtml <$> createPaymentHandler layer alertH updateReceiversH newReceivers @@ -108,3 +113,23 @@ servePaymentsBalanceAvailable ul = withSessionLayer ul $ \layer -> do layer (`availableBalanceElementH` Nothing) alertH + +servePaymentsReceiverAddressValidation + :: UILayer WalletResource + -> NewReceiverValidation + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +servePaymentsReceiverAddressValidation ul receiver = withSessionLayer ul + $ \_ -> do + let response = receiverAddressValidation receiver + pure $ renderHtml $ receiverAddressValidationH response + +servePaymentsReceiverAmountValidation + :: UILayer WalletResource + -> NewReceiverValidation + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +servePaymentsReceiverAmountValidation ul amount = withSessionLayer ul + $ \_ -> do + let response = receiverAmountValidation amount + pure $ renderHtml $ receiverAmountValidationH response