Merge pull request #1377 from input-output-hk/smoke-tests-commit-tada

💸  Smoke tests do commit some ADA (for TVL)

hydra-cluster/hydra-cluster.cabal

@@ -13,10 +13,16 @@ license-files:
 
 extra-source-files: README.md
 data-files:
+  config/credentials/alice-funds.sk
+  config/credentials/alice-funds.vk
   config/credentials/alice.sk
   config/credentials/alice.vk
+  config/credentials/bob-funds.sk
+  config/credentials/bob-funds.vk
   config/credentials/bob.sk
   config/credentials/bob.vk
+  config/credentials/carol-funds.sk
+  config/credentials/carol-funds.vk
   config/credentials/carol.sk
   config/credentials/carol.vk
   config/credentials/faucet.sk

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

@@ -45,18 +45,34 @@ availableInitialFunds = 900_000_000_000
 -- | Enumeration of known actors for which we can get the 'keysFor' and 'writeKeysFor'.
 data Actor
   = Alice
+  | AliceFunds
   | Bob
+  | BobFunds
   | Carol
+  | CarolFunds
   | Faucet
   deriving stock (Eq, Show)
 
 actorName :: Actor -> String
 actorName = \case
   Alice -> "alice"
+  AliceFunds -> "alice-funds"
   Bob -> "bob"
+  BobFunds -> "bob-funds"
   Carol -> "carol"
+  CarolFunds -> "carol-funds"
   Faucet -> "faucet"
 
+fundsOf :: Actor -> Actor
+fundsOf = \case
+  Alice -> AliceFunds
+  AliceFunds -> AliceFunds
+  Bob -> BobFunds
+  BobFunds -> BobFunds
+  Carol -> CarolFunds
+  CarolFunds -> CarolFunds
+  Faucet -> Faucet
+
 -- | A network known to the hydra-cluster. That means we have configuration
 -- files to connect to at least these networks.
 data KnownNetwork

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

@@ -78,7 +78,7 @@ import Network.HTTP.Req (
 import PlutusLedgerApi.Test.Examples qualified as Plutus
 import System.Directory (removeDirectoryRecursive)
 import System.FilePath ((</>))
-import Test.QuickCheck (generate)
+import Test.QuickCheck (choose, generate)
 
 data EndToEndLog
   = ClusterOptions {options :: Options}
@@ -210,35 +210,45 @@ singlePartyHeadFullLifeCycle ::
   TxId ->
   IO ()
 singlePartyHeadFullLifeCycle tracer workDir node hydraScriptsTxId =
-  (`finally` returnFundsToFaucet tracer node Alice) $ do
-    refuelIfNeeded tracer node Alice 25_000_000
-    -- Start hydra-node on chain tip
-    tip <- queryTip networkId nodeSocket
-    contestationPeriod <- fromNominalDiffTime $ 10 * blockTime
-    aliceChainConfig <-
-      chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod
-        <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
-    withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
-      -- Initialize & open head
-      send n1 $ input "Init" []
-      headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
-      -- Commit nothing for now
-      requestCommitTx n1 mempty >>= submitTx node
-      waitFor hydraTracer (10 * blockTime) [n1] $
-        output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId]
-      -- Close head
-      send n1 $ input "Close" []
-      deadline <- waitMatch (10 * blockTime) n1 $ \v -> do
-        guard $ v ^? key "tag" == Just "HeadIsClosed"
-        guard $ v ^? key "headId" == Just (toJSON headId)
-        v ^? key "contestationDeadline" . _JSON
-      remainingTime <- diffUTCTime deadline <$> getCurrentTime
-      waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $
-        output "ReadyToFanout" ["headId" .= headId]
-      send n1 $ input "Fanout" []
-      waitFor hydraTracer (10 * blockTime) [n1] $
-        output "HeadIsFinalized" ["utxo" .= object mempty, "headId" .= headId]
-    traceRemainingFunds Alice
+  ( `finally`
+      do
+        returnFundsToFaucet tracer node Alice
+        returnFundsToFaucet tracer node AliceFunds
+  )
+    $ do
+      refuelIfNeeded tracer node Alice 25_000_000
+      -- Start hydra-node on chain tip
+      tip <- queryTip networkId nodeSocket
+      contestationPeriod <- fromNominalDiffTime $ 10 * blockTime
+      aliceChainConfig <-
+        chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod
+          <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
+      withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
+        -- Initialize & open head
+        send n1 $ input "Init" []
+        headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
+
+        -- Commit something from external key
+        (walletVk, walletSk) <- keysFor AliceFunds
+        amount <- Coin <$> generate (choose (10_000_000, 50_000_000))
+        utxoToCommit <- seedFromFaucet node walletVk amount (contramap FromFaucet tracer)
+        requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= submitTx node
+
+        waitFor hydraTracer (10 * blockTime) [n1] $
+          output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId]
+        -- Close head
+        send n1 $ input "Close" []
+        deadline <- waitMatch (10 * blockTime) n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "HeadIsClosed"
+          guard $ v ^? key "headId" == Just (toJSON headId)
+          v ^? key "contestationDeadline" . _JSON
+        remainingTime <- diffUTCTime deadline <$> getCurrentTime
+        waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $
+          output "ReadyToFanout" ["headId" .= headId]
+        send n1 $ input "Fanout" []
+        waitFor hydraTracer (10 * blockTime) [n1] $
+          output "HeadIsFinalized" ["utxo" .= toJSON utxoToCommit, "headId" .= headId]
+      traceRemainingFunds Alice
  where
   hydraTracer = contramap FromHydraNode tracer
 

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

@@ -18,7 +18,7 @@ import Hydra.Cardano.Api (
   deserialiseFromTextEnvelope,
   textEnvelopeToJSON,
  )
-import Hydra.Cluster.Fixture (Actor, actorName)
+import Hydra.Cluster.Fixture (Actor, actorName, fundsOf)
 import Hydra.ContestationPeriod (ContestationPeriod)
 import Hydra.Ledger.Cardano (genSigningKey)
 import Hydra.Options (ChainConfig (..), DirectChainConfig (..), defaultDirectChainConfig)
@@ -75,24 +75,31 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod
   when (me `elem` them) $
     failure $
       show me <> " must not be in " <> show them
-  readConfigFile ("credentials" </> skName me) >>= writeFileBS (skTarget me)
-  readConfigFile ("credentials" </> vkName me) >>= writeFileBS (vkTarget me)
+
+  copyFile me "vk"
+  copyFile me "sk"
+  copyFile (fundsOf me) "vk"
+  copyFile (fundsOf me) "sk"
+
   forM_ them $ \actor ->
-    readConfigFile ("credentials" </> vkName actor) >>= writeFileBS (vkTarget actor)
+    copyFile actor "vk"
   pure $
     Direct
       defaultDirectChainConfig
         { nodeSocket
         , hydraScriptsTxId
-        , cardanoSigningKey = skTarget me
-        , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them]
+        , cardanoSigningKey = actorFilePath me "sk"
+        , cardanoVerificationKeys = [actorFilePath himOrHer "vk" | himOrHer <- them]
         , contestationPeriod
         }
  where
-  skTarget x = targetDir </> skName x
-  vkTarget x = targetDir </> vkName x
-  skName x = actorName x <.> ".sk"
-  vkName x = actorName x <.> ".vk"
+  actorFilePath actor fileType = targetDir </> actorFileName actor fileType
+  actorFileName actor fileType = actorName actor <.> fileType
+
+  copyFile actor fileType = do
+    let fileName = actorFileName actor fileType
+        filePath = actorFilePath actor fileType
+    readConfigFile ("credentials" </> fileName) >>= writeFileBS filePath
 
 modifyConfig :: (DirectChainConfig -> DirectChainConfig) -> ChainConfig -> ChainConfig
 modifyConfig fn = \case