Merge branch 'master' into lc/cardano-api-8.40

Author: locallycompact

hydra-cluster/src/CardanoClient.hs

@@ -79,23 +79,29 @@ submitTx :: RunningNode -> Tx -> IO ()
 submitTx RunningNode{networkId, nodeSocket} =
   submitTransaction networkId nodeSocket
 
-waitForPayment ::
+-- | Wait until the specified Address has received payments, visible on-chain,
+-- for the specified Lovelace amount. Returns the UTxO set containing all payments
+-- with the same Lovelace amount at the given Address.
+--
+-- Note that this function loops indefinitely; therefore, it's recommended to use
+-- it with a surrounding timeout mechanism.
+waitForPayments ::
   NetworkId ->
   SocketPath ->
   Coin ->
   Address ShelleyAddr ->
   IO UTxO
-waitForPayment networkId socket amount addr =
+waitForPayments networkId socket amount addr =
   go
  where
   go = do
     utxo <- queryUTxO networkId socket QueryTip [addr]
-    let expectedPayment = selectPayment utxo
-    if expectedPayment /= mempty
-      then pure $ UTxO expectedPayment
+    let expectedPayments = selectPayments utxo
+    if expectedPayments /= mempty
+      then pure $ UTxO expectedPayments
       else threadDelay 1 >> go
 
-  selectPayment (UTxO utxo) =
+  selectPayments (UTxO utxo) =
     Map.filter ((== amount) . selectLovelace . txOutValue) utxo
 
 waitForUTxO ::
@@ -110,7 +116,7 @@ waitForUTxO networkId nodeSocket utxo =
   forEachUTxO = \case
     TxOut (ShelleyAddressInEra addr@ShelleyAddress{}) value _ _ -> do
       void $
-        waitForPayment
+        waitForPayments
           networkId
           nodeSocket
           (selectLovelace value)

hydra-cluster/src/Hydra/Cluster/Faucet.hs

@@ -16,7 +16,6 @@ import CardanoClient (
   queryUTxOFor,
   sign,
   submitTransaction,
-  waitForPayment,
  )
 import Control.Exception (IOException)
 import Control.Monad.Class.MonadThrow (Handler (Handler), catches)
@@ -56,16 +55,19 @@ seedFromFaucet ::
   IO UTxO
 seedFromFaucet node@RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace tracer = do
   (faucetVk, faucetSk) <- keysFor Faucet
-  retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk
-  waitForPayment networkId nodeSocket lovelace receivingAddress
+  seedTx <- retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk
+  producedUTxO <- awaitTransaction networkId nodeSocket seedTx
+  pure $ UTxO.filter (== toUTxOContext theOutput) producedUTxO
  where
   submitSeedTx faucetVk faucetSk = do
     faucetUTxO <- findFaucetUTxO node lovelace
     let changeAddress = ShelleyAddressInEra (buildAddress faucetVk networkId)
     buildTransaction networkId nodeSocket changeAddress faucetUTxO [] [theOutput] >>= \case
       Left e -> throwIO $ FaucetFailedToBuildTx{reason = e}
       Right body -> do
+        let signedTx = sign faucetSk body
         submitTransaction networkId nodeSocket (sign faucetSk body)
+        pure signedTx
 
   receivingAddress = buildAddress receivingVerificationKey networkId
 
@@ -190,7 +192,7 @@ calculateTxFee RunningNode{networkId, nodeSocket} secretKey utxo addr lovelace =
         Right body -> pure $ txFee' (sign secretKey body)
 
 -- | Try to submit tx and retry when some caught exception/s take place.
-retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m () -> m ()
+retryOnExceptions :: (MonadCatch m, MonadDelay m) => Tracer m FaucetLog -> m a -> m a
 retryOnExceptions tracer action =
   action
     `catches` [ Handler $ \(_ :: SubmitTransactionException) -> do

hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs

@@ -5,10 +5,10 @@ import Test.Hydra.Prelude
 
 import CardanoClient (RunningNode (..))
 import CardanoNode (withCardanoNodeDevnet)
-import Control.Concurrent.Async (replicateConcurrently_)
+import Control.Concurrent.Async (replicateConcurrently)
 import Hydra.Cardano.Api (AssetId (AdaAssetId), selectAsset, txOutValue)
 import Hydra.Chain.CardanoClient (QueryPoint (..), queryUTxOFor)
-import Hydra.Cluster.Faucet (returnFundsToFaucet, seedFromFaucet, seedFromFaucet_)
+import Hydra.Cluster.Faucet (returnFundsToFaucet, seedFromFaucet)
 import Hydra.Cluster.Fixture (Actor (..))
 import Hydra.Cluster.Scenarios (EndToEndLog (..))
 import Hydra.Cluster.Util (keysFor)
@@ -19,17 +19,18 @@ import Test.QuickCheck (elements, generate)
 spec :: Spec
 spec = do
   describe "seedFromFaucet" $
-    it "should work concurrently" $
+    it "should work concurrently when called multiple times with the same amount of lovelace" $
       showLogsOnFailure "FaucetSpec" $ \tracer ->
         failAfter 30 $
           withTempDir "hydra-cluster" $ \tmpDir ->
-            withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
-              replicateConcurrently_ 10 $ do
+            withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> do
+              utxos <- replicateConcurrently 10 $ do
                 vk <- generate genVerificationKey
-                seedFromFaucet_ node vk 1_000_000 (contramap FromFaucet tracer)
-
+                seedFromFaucet node vk 1_000_000 (contramap FromFaucet tracer)
+              -- 10 unique outputs
+              length (fold utxos) `shouldBe` 10
   describe "returnFundsToFaucet" $
-    it "seedFromFaucet and returnFundsToFaucet work together" $ do
+    it "seedFromFaucet and returnFundsToFaucet should work together" $ do
       showLogsOnFailure "FaucetSpec" $ \tracer ->
         withTempDir "hydra-cluster" $ \tmpDir ->
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node@RunningNode{networkId, nodeSocket} -> do

hydra-tui/src/Hydra/TUI/Handlers.hs

@@ -43,7 +43,6 @@ handleEvent ::
   BrickEvent Name (HydraEvent Tx) ->
   EventM Name RootState ()
 handleEvent cardanoClient client e = do
-  handleVtyEventVia (handleExtraHotkeys (handleEvent cardanoClient client)) () e
   zoom logStateL $ handleVtyEventVia handleVtyEventsLogState () e
   handleAppEventVia handleTick () e
   zoom connectedStateL $ do
@@ -55,12 +54,6 @@ handleEvent cardanoClient client e = do
   -- Any `EventM` that decides to `Continue` would override the `Halt` decision.
   handleGlobalEvents e
 
-handleExtraHotkeys :: (BrickEvent w e -> EventM n s ()) -> Vty.Event -> EventM n s ()
-handleExtraHotkeys f = \case
-  EvKey KDown [] -> f $ VtyEvent $ EvKey (KChar '\t') []
-  EvKey KUp [] -> f $ VtyEvent $ EvKey KBackTab []
-  _ -> pure ()
-
 handleTick :: HydraEvent Tx -> EventM Name RootState ()
 handleTick = \case
   Tick now -> nowL .= now