Allow user to select the amount (lovelace only at this stage) when se…

…nding through the TUI.

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -36,6 +36,7 @@ import qualified Cardano.Ledger.SafeHash as SafeHash
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as Cardano
 import qualified Cardano.Ledger.ShelleyMA.TxBody as Cardano
 import Cardano.Ledger.Slot (EpochSize (EpochSize), SlotNo (SlotNo))
+import Cardano.Ledger.Val (invert)
 import Cardano.Slotting.EpochInfo (fixedEpochInfo)
 import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength)
 import qualified Codec.Binary.Bech32 as Bech32
@@ -72,7 +73,7 @@ import qualified Shelley.Spec.Ledger.API as Cardano hiding (TxBody)
 import Shelley.Spec.Ledger.Tx (WitnessSetHKD (WitnessSet))
 import Shelley.Spec.Ledger.TxBody (TxId (..))
 import Test.Cardano.Ledger.MaryEraGen ()
-import Test.QuickCheck (Gen, choose, getSize, suchThat, vectorOf)
+import Test.QuickCheck (Gen, choose, getSize, scale, suchThat, vectorOf)
 import qualified Test.Shelley.Spec.Ledger.Generator.Constants as Constants
 import Test.Shelley.Spec.Ledger.Generator.Core (geConstants)
 import Test.Shelley.Spec.Ledger.Generator.EraGen (genUtxo0)
@@ -170,7 +171,9 @@ genUtxoFor vk = do
  where
   genOutput :: Gen TxOut
   genOutput =
-    Cardano.TxOut (mkVkAddress vk) <$> arbitrary
+    -- NOTE: Scaling a bit the generator to get non-trivial outputs with some
+    -- funds, and not just a few lovelaces.
+    Cardano.TxOut (mkVkAddress vk) <$> scale (* 8) arbitrary
 
 genUtxo :: Gen (Utxo CardanoTx)
 genUtxo = do
@@ -193,18 +196,23 @@ mkVkAddress vk =
 -- signed by the given key.
 mkSimpleCardanoTx ::
   (TxIn, TxOut) ->
-  Cardano.Addr StandardCrypto ->
+  (Cardano.Addr StandardCrypto, Cardano.Value StandardCrypto) ->
   Cardano.KeyPair 'Cardano.Payment StandardCrypto ->
   CardanoTx
-mkSimpleCardanoTx (i, Cardano.TxOut _owner value) recipient credentials =
+mkSimpleCardanoTx (i, Cardano.TxOut owner valueIn) (recipient, valueOut) credentials =
   CardanoTx{id, body, witnesses, auxiliaryData}
  where
   id = Cardano.TxId $ SafeHash.hashAnnotated body
 
   body =
     Cardano.TxBody
       (Set.singleton i)
-      (StrictSeq.fromList [Cardano.TxOut recipient value])
+      ( StrictSeq.fromList $
+          Cardano.TxOut recipient valueOut :
+            [ Cardano.TxOut owner (valueIn <> invert valueOut)
+            | valueOut /= valueIn
+            ]
+      )
       mempty
       (Cardano.Wdrl mempty)
       fees
@@ -300,8 +308,9 @@ signWith (_unTxId -> safeHash) credentials =
 prettyBalance :: Balance tx -> Text
 prettyBalance Balance{lovelace, assets} =
   let (ada, decimal) = lovelace `quotRem` 1000000
+      padLeft c n str = T.takeEnd n (T.replicate n c <> str)
    in unwords $
-        [ show ada <> "." <> show decimal
+        [ show ada <> "." <> padLeft "0" 6 (show decimal)
         , "₳"
         ]
           ++ if null assets

hydra-tui/src/Hydra/TUI.hs

@@ -9,10 +9,11 @@ import Hydra.Prelude hiding (State)
 
 import Brick
 import Brick.BChan (newBChan, writeBChan)
-import Brick.Forms (Form, FormFieldState, checkboxField, formState, handleFormEvent, newForm, radioField, renderForm)
+import Brick.Forms (Form, FormFieldState, checkboxField, editShowableFieldWithValidate, formState, handleFormEvent, newForm, radioField, renderForm)
 import Brick.Widgets.Border (hBorder, vBorder)
 import Brick.Widgets.Border.Style (ascii)
 import Cardano.Ledger.Keys (KeyPair (..))
+import Cardano.Ledger.Val (coin, inject)
 import Data.List (nub, (!!), (\\))
 import qualified Data.Map.Strict as Map
 import Data.Version (showVersion)
@@ -172,7 +173,7 @@ handleAppEvent s = \case
     s & feedbackL ?~ UserFeedback Error "Invalid command."
   Update ReadyToCommit{parties} ->
     let utxo = mempty
-     in s & headStateL .~ Initializing{parties, utxo}
+     in s & headStateL .~ Initializing{parties = toList parties, utxo}
           & feedbackL ?~ UserFeedback Info "Head initialized, ready for commit(s)."
   Update Committed{party, utxo} ->
     s & headStateL %~ partyCommitted party utxo
@@ -246,11 +247,11 @@ handleCommitEvent ::
   EventM n (Next State)
 handleCommitEvent Client{sendInput} = \case
   s@State{headState = Initializing{}} ->
-    continue $ s & dialogStateL .~ newCommitDialog (myTotalUtxo s)
+    continue $ s & dialogStateL .~ commitDialog (myTotalUtxo s)
   s ->
     continue $ s & feedbackL ?~ UserFeedback Error "Invalid command."
  where
-  newCommitDialog u =
+  commitDialog u =
     Dialog title form submit
    where
     title = "Select UTXO to commit"
@@ -266,20 +267,20 @@ handleNewTxEvent ::
   EventM n (Next State)
 handleNewTxEvent Client{sendInput} = \case
   s@State{headState = Open{}} ->
-    continue $ s & dialogStateL .~ newTransactionBuilderDialog (myAvailableUtxo s)
+    continue $ s & dialogStateL .~ transactionBuilderDialog (myAvailableUtxo s)
   s ->
     continue $ s & feedbackL ?~ UserFeedback Error "Invalid command."
  where
-  newTransactionBuilderDialog u =
+  transactionBuilderDialog u =
     Dialog title form submit
    where
     title = "Select UTXO to spend"
     -- FIXME: This crashes if the utxo is empty
     form = newForm (utxoRadioField u) (Map.toList u !! 0)
     submit s input = do
-      continue $ s & dialogStateL .~ newRecipientsDialog input (s ^. peersL)
+      continue $ s & dialogStateL .~ recipientsDialog input (s ^. peersL)
 
-  newRecipientsDialog input peers =
+  recipientsDialog input peers =
     Dialog title form submit
    where
     title = "Select a recipient"
@@ -288,10 +289,21 @@ handleNewTxEvent Client{sendInput} = \case
       let field = radioField (lens id seq) [(p, show p, show p) | p <- peers]
        in newForm [field] (peers !! 0)
     submit s (getAddress -> recipient) = do
+      continue $ s & dialogStateL .~ amountDialog input recipient
+
+  amountDialog input@(_, Cardano.TxOut _ v) recipient =
+    Dialog title form submit
+   where
+    title = "Choose an amount"
+    form =
+      let limit = Cardano.unCoin $ coin v
+          field = editShowableFieldWithValidate (lens id seq) "amount" (\n -> n > 0 && n <= limit)
+       in newForm [field] limit
+    submit s (inject . Cardano.Coin -> amount) = do
       liftIO (sendInput (NewTx tx))
       continue $ s & dialogStateL .~ NoDialog
      where
-      tx = mkSimpleCardanoTx input recipient (myCredentials s)
+      tx = mkSimpleCardanoTx input (recipient, amount) (myCredentials s)
 
 --
 -- View
@@ -313,7 +325,7 @@ draw s =
           ]
  where
   drawInfo =
-    hLimit 72 $
+    hLimit 71 $
       vBox $
         mconcat
           [