Skip to content

Commit

Permalink
Return funds to faucet when it finishes
Browse files Browse the repository at this point in the history
  • Loading branch information
ffakenz committed Aug 13, 2024
1 parent ef18be7 commit ec0c35a
Show file tree
Hide file tree
Showing 3 changed files with 64 additions and 41 deletions.
56 changes: 36 additions & 20 deletions hydra-cluster/bench/Bench/EndToEnd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,9 +28,9 @@ import Data.Scientific (Scientific)
import Data.Set ((\\))
import Data.Set qualified as Set
import Data.Time (UTCTime (UTCTime), utctDayTime)
import Hydra.Cardano.Api (NetworkId, SocketPath, Tx, TxId, UTxO, getVerificationKey, signTx)
import Hydra.Cluster.Faucet (FaucetLog, publishHydraScriptsAs, seedFromFaucet)
import Hydra.Cluster.Fixture (Actor (Faucet))
import Hydra.Cardano.Api (NetworkId, PaymentKey, SocketPath, Tx, TxId, UTxO, VerificationKey, getVerificationKey, signTx)
import Hydra.Cluster.Faucet (FaucetLog (..), publishHydraScriptsAs, returnFundsToFaucet', seedFromFaucet)
import Hydra.Cluster.Fixture (Actor (..))
import Hydra.Cluster.Scenarios (
EndToEndLog (..),
headIsInitializingWith,
Expand All @@ -39,7 +39,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
import Hydra.Crypto (HydraKey, SigningKey, generateSigningKey)
import Hydra.Generator (ClientDataset (..), ClientKeys (..), Dataset (..))
import Hydra.Ledger (txId)
import Hydra.Logging (Tracer, withTracerOutputTo)
import Hydra.Logging (Tracer, traceWith, withTracerOutputTo)
import Hydra.Party (Party, deriveParty)
import HydraNode (
HydraClient,
Expand Down Expand Up @@ -102,31 +102,47 @@ benchDemo ::
NetworkId ->
SocketPath ->
NominalDiffTime ->
VerificationKey PaymentKey ->
[SigningKey HydraKey] ->
FilePath ->
Dataset ->
IO Summary
benchDemo networkId nodeSocket timeoutSeconds hydraKeys workDir dataset@Dataset{clientDatasets, fundingTransaction} = do
benchDemo networkId nodeSocket timeoutSeconds faucetVk hydraKeys workDir dataset@Dataset{clientDatasets, fundingTransaction} = do
putStrLn $ "Test logs available in: " <> (workDir </> "test.log")
withFile (workDir </> "test.log") ReadWriteMode $ \hdl ->
withTracerOutputTo hdl "Test" $ \tracer ->
failAfter timeoutSeconds $ do
putTextLn "Starting benchmark"
findRunningCardanoNode' (contramap FromCardanoNode tracer) networkId nodeSocket >>= \case
let cardanoTracer = contramap FromCardanoNode tracer
findRunningCardanoNode' cardanoTracer networkId nodeSocket >>= \case
Nothing ->
error ("Not found running node at socket: " <> show nodeSocket <> ", and network: " <> show networkId)
Just node -> do
putTextLn "Seeding network"
fundClients networkId nodeSocket fundingTransaction
forM_ clientDatasets (fuelWith100Ada (contramap FromFaucet tracer) node)
putStrLn $ "Connecting to hydra cluster in " <> workDir
let hydraTracer = contramap FromHydraNode tracer
let parties = Set.fromList (deriveParty <$> hydraKeys)
withConnectionToNode hydraTracer 1 $ \leader ->
withConnectionToNode hydraTracer 2 $ \node2 ->
withConnectionToNode hydraTracer 3 $ \node3 -> do
let followers = [node2, node3]
scenario hydraTracer node workDir dataset parties leader followers
let clientSks = clientKeys <$> clientDatasets
(`finally` returnFaucetFunds tracer node clientSks) $ do
putTextLn "Seeding network"
fundClients networkId nodeSocket fundingTransaction
forM_ clientSks (fuelWith100Ada (contramap FromFaucet tracer) node)
putStrLn $ "Connecting to hydra cluster in " <> workDir
let hydraTracer = contramap FromHydraNode tracer
let parties = Set.fromList (deriveParty <$> hydraKeys)
withConnectionToNode hydraTracer 1 $ \leader ->
withConnectionToNode hydraTracer 2 $ \node2 ->
withConnectionToNode hydraTracer 3 $ \node3 -> do
let followers = [node2, node3]
scenario hydraTracer node workDir dataset parties leader followers
where
returnFaucetFunds tracer node cKeys = do
putTextLn "Returning funds to faucet"
let faucetTracer = contramap FromFaucet tracer
let toSenders (ClientKeys sk esk) = [(getVerificationKey sk, sk), (getVerificationKey esk, esk)]
let senders = concatMap @[] toSenders cKeys
mapM_
( \sender -> do
returnAmount <- returnFundsToFaucet' faucetTracer node faucetVk sender
traceWith faucetTracer $ ReturnedFunds{actor = show sender, returnAmount}
)
senders

scenario ::
Tracer IO HydraNodeLog ->
Expand Down Expand Up @@ -283,7 +299,7 @@ movingAverage confirmations =
seedNetwork :: RunningNode -> Dataset -> Tracer IO FaucetLog -> IO TxId
seedNetwork node@RunningNode{nodeSocket, networkId} Dataset{fundingTransaction, clientDatasets} tracer = do
fundClients networkId nodeSocket fundingTransaction
forM_ clientDatasets (fuelWith100Ada tracer node)
forM_ (clientKeys <$> clientDatasets) (fuelWith100Ada tracer node)
putTextLn "Publishing hydra scripts"
publishHydraScriptsAs node Faucet

Expand All @@ -293,8 +309,8 @@ fundClients networkId nodeSocket fundingTransaction = do
submitTransaction networkId nodeSocket fundingTransaction
void $ awaitTransaction networkId nodeSocket fundingTransaction

fuelWith100Ada :: Tracer IO FaucetLog -> RunningNode -> ClientDataset -> IO UTxO
fuelWith100Ada tracer node ClientDataset{clientKeys = ClientKeys{signingKey}} = do
fuelWith100Ada :: Tracer IO FaucetLog -> RunningNode -> ClientKeys -> IO UTxO
fuelWith100Ada tracer node ClientKeys{signingKey} = do
let vk = getVerificationKey signingKey
putTextLn $ "Seed client " <> show vk
seedFromFaucet node vk 100_000_000 tracer
Expand Down
18 changes: 7 additions & 11 deletions hydra-cluster/bench/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,16 +42,12 @@ main =
DemoOptions{outputDirectory, scalingFactor, timeoutSeconds, networkId, nodeSocket, hydraSigningKeys} -> do
workDir <- createSystemTempDirectory "demo-bench"
clientKeys <- do
aliceSk <- snd <$> keysFor Alice
aliceFundsSk <- snd <$> keysFor AliceFunds
bobSk <- snd <$> keysFor Bob
bobFundsSk <- snd <$> keysFor BobFunds
carolSk <- snd <$> keysFor Carol
carolFundsSk <- snd <$> keysFor CarolFunds
let alice = ClientKeys aliceSk aliceFundsSk
bob = ClientKeys bobSk bobFundsSk
carol = ClientKeys carolSk carolFundsSk
pure [alice, bob, carol]
let actors = [(Alice, AliceFunds), (Bob, BobFunds), (Carol, CarolFunds)]
let toClientKeys (actor, actorFunds) = do
sk <- snd <$> keysFor actor
fundsSk <- snd <$> keysFor actorFunds
pure $ ClientKeys sk fundsSk
forM actors toClientKeys
hydraKeys <- mapM (readFileTextEnvelopeThrow (AsSigningKey AsHydraKey)) hydraSigningKeys
playDemo outputDirectory timeoutSeconds scalingFactor clientKeys workDir networkId nodeSocket hydraKeys
where
Expand All @@ -62,7 +58,7 @@ main =
dataset <- genDatasetConstantUTxODemo (faucetVk, faucetSk) clientKeys numberOfTxs networkId nodeSocket
let datasetPath = workDir </> "dataset.json"
saveDataset datasetPath dataset
let action = benchDemo networkId nodeSocket timeoutSeconds hydraKeys
let action = benchDemo networkId nodeSocket timeoutSeconds faucetVk hydraKeys
run outputDirectory [datasetPath] action

play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir = do
Expand Down
31 changes: 21 additions & 10 deletions hydra-cluster/src/Hydra/Cluster/Faucet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -106,19 +106,30 @@ returnFundsToFaucet ::
RunningNode ->
Actor ->
IO ()
returnFundsToFaucet tracer RunningNode{networkId, nodeSocket} sender = do
returnFundsToFaucet tracer node sender = do
(faucetVk, _) <- keysFor Faucet
let faucetAddress = mkVkAddress networkId faucetVk
senderKeys <- keysFor sender
returnAmount <- returnFundsToFaucet' tracer node faucetVk senderKeys
traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount}

(senderVk, senderSk) <- keysFor sender
returnFundsToFaucet' ::
Tracer IO FaucetLog ->
RunningNode ->
VerificationKey PaymentKey ->
(VerificationKey PaymentKey, SigningKey PaymentKey) ->
IO Coin
returnFundsToFaucet' tracer RunningNode{networkId, nodeSocket} faucetVk (senderVk, senderSk) = do
let faucetAddress = mkVkAddress networkId faucetVk
utxo <- queryUTxOFor networkId nodeSocket QueryTip senderVk
unless (null utxo) . retryOnExceptions tracer $ do
let utxoValue = balance @Tx utxo
let allLovelace = selectLovelace utxoValue
tx <- sign senderSk <$> buildTxBody utxo faucetAddress
submitTransaction networkId nodeSocket tx
void $ awaitTransaction networkId nodeSocket tx
traceWith tracer $ ReturnedFunds{actor = actorName sender, returnAmount = allLovelace}
if null utxo
then pure 0
else retryOnExceptions tracer $ do
let utxoValue = balance @Tx utxo
let allLovelace = selectLovelace utxoValue
tx <- sign senderSk <$> buildTxBody utxo faucetAddress
submitTransaction networkId nodeSocket tx
void $ awaitTransaction networkId nodeSocket tx
pure allLovelace
where
buildTxBody utxo faucetAddress =
-- Here we specify no outputs in the transaction so that a change output with the
Expand Down

0 comments on commit ec0c35a

Please sign in to comment.