Re-used publish scripts tx building and awaiting

Signed-off-by: Sasha Bogicevic <[email protected]>

Author: ch1bo

docs/docs/configuration.md

@@ -130,8 +130,8 @@ You can also use blockfrost for script publishing. On top of providing cardano s
 
 ```shell
 hydra-node publish-scripts \
-  --blockfrost-project-path /path/to/node.socket \
-  --blockfrost-cardano-signing-key cardano.sk
+  --blockfrost /path/to/node.socket \
+  --cardano-signing-key cardano.sk
 ```
 
 ### Ledger parameters

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

@@ -22,7 +22,7 @@ import Control.Monad.Class.MonadThrow (Handler (Handler), catches)
 import Control.Tracer (Tracer, traceWith)
 import GHC.IO.Exception (IOErrorType (ResourceExhausted), IOException (ioe_type))
 import Hydra.Chain.ScriptRegistry (
-  publishHydraScripts,
+  publishHydraScripts',
  )
 import Hydra.Cluster.Fixture (Actor (Faucet))
 import Hydra.Cluster.Util (keysFor)
@@ -200,6 +200,6 @@ retryOnExceptions tracer action =
 publishHydraScriptsAs :: RunningNode -> Actor -> IO [TxId]
 publishHydraScriptsAs RunningNode{networkId, nodeSocket} actor = do
   (_, sk) <- keysFor actor
-  publishHydraScripts networkId nodeSocket sk
--- FIXME: need to figure out how to await for txs here
--- >>= mapM (awaitTransaction networkId nodeSocket)
+  txs <- publishHydraScripts' networkId nodeSocket sk
+  mapM_ (awaitTransaction networkId nodeSocket) txs
+  pure $ getTxId . getTxBody <$> txs

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

@@ -96,7 +96,7 @@ import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId)
 import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
 import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits)
 import Hydra.Logging (Tracer, traceWith)
-import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom)
+import Hydra.Options (DirectChainConfig (..), startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
 import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime)
 import Hydra.Tx.DepositDeadline (DepositDeadline (..))

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -429,6 +429,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
             )
             ""
         let hydraScriptsTxId = fromString <$> splitWhen (== ',') (filter (/= '\n') hydraScriptsTxIdStr)
+        threadDelay 1
         failAfter 5 $ void $ queryScriptRegistry networkId nodeSocket hydraScriptsTxId
 
   it "can only contest once" $ \tracer -> do

hydra-node/src/Hydra/Chain/Blockfrost/Client.hs

@@ -39,10 +39,8 @@ import Data.Default (def)
 import Data.SOP.NonEmpty (NonEmpty (..))
 import Data.Set qualified as Set
 import Hydra.Cardano.Api.Prelude (StakePoolKey, fromNetworkMagic)
-import Hydra.Chain.ScriptRegistry (buildScriptPublishingTx)
-import Hydra.Contract.Head qualified as Head
-import Hydra.Ledger.Cardano (adjustUTxO)
-import Hydra.Plutus (commitValidatorScript, initialValidatorScript)
+import Hydra.Chain.ScriptRegistry (buildScriptPublishingTxs)
+import Hydra.Tx (txId)
 import Money qualified
 import Ouroboros.Consensus.Block (GenesisWindow (..))
 import Ouroboros.Consensus.Cardano.Block (CardanoEras)
@@ -88,18 +86,12 @@ publishHydraScripts projectPath sk = do
     let eraHistory = mkEraHistory genesis
     utxo <- Blockfrost.getAddressUtxos address
     let cardanoUTxO = toCardanoUTxO utxo changeAddress
-    flip evalStateT cardanoUTxO $
-      forM scripts $ \script -> do
-        nextUTxO <- get
-        (tx, body, spentUTxO) <- liftIO $ buildScriptPublishingTx pparams systemStart networkId eraHistory stakePools changeAddress sk script nextUTxO
-        _ <- lift $ Blockfrost.submitTx $ Blockfrost.CBORString $ fromStrict $ serialiseToCBOR tx
-        put $ pickKeyAddressUTxO $ adjustUTxO tx spentUTxO
-        pure $ getTxId body
- where
-  pickKeyAddressUTxO utxo = maybe mempty UTxO.singleton $ UTxO.findBy (\(_, txOut) -> isKeyAddress (txOutAddress txOut)) utxo
-
-  scripts = [initialValidatorScript, commitValidatorScript, Head.validatorScript]
 
+    let txs = buildScriptPublishingTxs pparams systemStart networkId eraHistory stakePools cardanoUTxO sk
+    forM txs $ \(tx :: Tx) -> do
+      void $ Blockfrost.submitTx $ Blockfrost.CBORString $ fromStrict $ serialiseToCBOR tx
+      pure $ txId tx
+ where
   vk = getVerificationKey sk
 
   vkAddress networkMagic = textAddrOf (toCardanoNetworkMagic networkMagic) vk
@@ -127,7 +119,7 @@ toCardanoTxIn :: Blockfrost.AddressUtxo -> TxIn
 toCardanoTxIn Blockfrost.AddressUtxo{_addressUtxoTxHash = Blockfrost.TxHash{unTxHash}, _addressUtxoOutputIndex} =
   case deserialiseFromRawBytesHex AsTxId (encodeUtf8 unTxHash) of
     Left err -> error (show err)
-    Right txId -> TxIn txId (TxIx (fromIntegral _addressUtxoOutputIndex))
+    Right txid -> TxIn txid (TxIx (fromIntegral _addressUtxoOutputIndex))
 
 -- REVIEW! TxOutDatumNone and ReferenceScriptNone
 toCardanoTxOut :: Blockfrost.AddressUtxo -> AddressInEra -> TxOut CtxUTxO

hydra-node/src/Hydra/Chain/CardanoClient.hs

@@ -76,22 +76,21 @@ buildTransactionWithBody ::
   TxBodyContent BuildTx ->
   -- | Unspent transaction outputs to spend.
   UTxO ->
-  IO (Either (TxBodyErrorAutoBalance Era) Tx)
+  Either (TxBodyErrorAutoBalance Era) Tx
 buildTransactionWithBody pparams systemStart eraHistory stakePools changeAddress body utxoToSpend = do
-  pure $
-    second (flip Tx [] . balancedTxBody) $
-      makeTransactionBodyAutoBalance
-        shelleyBasedEra
-        systemStart
-        (toLedgerEpochInfo eraHistory)
-        (LedgerProtocolParameters pparams)
-        stakePools
-        mempty
-        mempty
-        (UTxO.toApi utxoToSpend)
-        body
-        changeAddress
-        Nothing
+  second (flip Tx [] . balancedTxBody) $
+    makeTransactionBodyAutoBalance
+      shelleyBasedEra
+      systemStart
+      (toLedgerEpochInfo eraHistory)
+      (LedgerProtocolParameters pparams)
+      stakePools
+      mempty
+      mempty
+      (UTxO.toApi utxoToSpend)
+      body
+      changeAddress
+      Nothing
 
 buildTransaction ::
   -- | Current network identifier
@@ -136,7 +135,7 @@ buildTransactionWithPParams pparams networkId socket changeAddress utxoToSpend c
   systemStart <- querySystemStart networkId socket QueryTip
   eraHistory <- queryEraHistory networkId socket QueryTip
   stakePools <- queryStakePools networkId socket QueryTip
-  buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs
+  pure $ buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs
 
 buildTransactionWithPParams' ::
   -- | Protocol parameters
@@ -152,7 +151,7 @@ buildTransactionWithPParams' ::
   [TxIn] ->
   -- | Outputs to create.
   [TxOut CtxTx] ->
-  IO (Either (TxBodyErrorAutoBalance Era) Tx)
+  Either (TxBodyErrorAutoBalance Era) Tx
 buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs = do
   buildTransactionWithBody pparams systemStart eraHistory stakePools changeAddress bodyContent utxoToSpend
  where

hydra-node/src/Hydra/Chain/ScriptRegistry.hs

@@ -24,6 +24,7 @@ import Hydra.Cardano.Api (
   TxId,
   TxIn (..),
   TxIx (..),
+  UTxO,
   WitCtx (..),
   examplePlutusScriptAlwaysFails,
   getTxBody,
@@ -36,7 +37,6 @@ import Hydra.Cardano.Api (
   mkTxOutAutoBalance,
   mkVkAddress,
   selectLovelace,
-  throwErrorAsException,
   txOutAddress,
   txOutValue,
   pattern TxOutDatumNone,
@@ -63,29 +63,23 @@ import Hydra.Tx.ScriptRegistry (ScriptRegistry (..), newScriptRegistry)
 -- This is implemented by repeated querying until we have all necessary
 -- reference scripts as we do only know the transaction id, not the indices.
 --
--- NOTE: This is limited to an upper bound of 10 to not query too much before
--- providing an error.
---
--- NOTE: If this should change, make sure to update the command line help.
---
 -- Can throw at least 'NewScriptRegistryException' on failure.
 queryScriptRegistry ::
-  (MonadIO m, MonadThrow m, MonadDelay m) =>
+  (MonadIO m, MonadThrow m) =>
   -- | cardano-node's network identifier.
   -- A combination of network discriminant + magic number.
   NetworkId ->
   -- | Filepath to the cardano-node's domain socket
   SocketPath ->
   [TxId] ->
   m ScriptRegistry
-queryScriptRegistry networkId socketPath txIds = go 10
+queryScriptRegistry networkId socketPath txIds = do
+  utxo <- liftIO $ queryUTxOByTxIn networkId socketPath QueryTip candidates
+  case newScriptRegistry utxo of
+    Left e -> throwIO e
+    Right sr -> pure sr
  where
-  go n = do
-    utxo <- liftIO $ queryUTxOByTxIn networkId socketPath QueryTip candidates
-    case newScriptRegistry utxo of
-      Left e -> if n == (0 :: Integer) then throwIO e else threadDelay 1 >> go (n - 1)
-      Right sr -> pure sr
-  candidates = concatMap (\txId -> [TxIn txId ix | ix <- [TxIx 0 .. TxIx 10]]) txIds -- Arbitrary but, high-enough.
+  candidates = map (\txid -> TxIn txid (TxIx 0)) txIds
 
 publishHydraScripts ::
   -- | Expected network discriminant.
@@ -96,22 +90,51 @@ publishHydraScripts ::
   SigningKey PaymentKey ->
   IO [TxId]
 publishHydraScripts networkId socketPath sk = do
+  txs <- publishHydraScripts' networkId socketPath sk
+  pure $ getTxId . getTxBody <$> txs
+
+publishHydraScripts' ::
+  -- | Expected network discriminant.
+  NetworkId ->
+  -- | Path to the cardano-node's domain socket
+  SocketPath ->
+  -- | Keys assumed to hold funds to pay for the publishing transaction.
+  SigningKey PaymentKey ->
+  IO [Tx]
+publishHydraScripts' networkId socketPath sk = do
   pparams <- queryProtocolParameters networkId socketPath QueryTip
   systemStart <- querySystemStart networkId socketPath QueryTip
   eraHistory <- queryEraHistory networkId socketPath QueryTip
   stakePools <- queryStakePools networkId socketPath QueryTip
   utxo <- queryUTxOFor networkId socketPath QueryTip vk
-  flip evalStateT utxo $
+  let txs = buildScriptPublishingTxs pparams systemStart networkId eraHistory stakePools utxo sk
+  forM txs $ \tx -> do
+    submitTransaction networkId socketPath tx
+    pure tx
+ where
+  vk = getVerificationKey sk
+
+buildScriptPublishingTxs ::
+  PParams LedgerEra ->
+  SystemStart ->
+  NetworkId ->
+  EraHistory ->
+  Set PoolId ->
+  UTxO ->
+  SigningKey PaymentKey ->
+  [Tx]
+buildScriptPublishingTxs pparams systemStart networkId eraHistory stakePools startUTxO sk =
+  flip evalState (startUTxO, mempty) $
     forM scripts $ \script -> do
-      nextUTxO <- get
-      (tx, body, spentUTxO) <- liftIO $ buildScriptPublishingTx pparams systemStart networkId eraHistory stakePools changeAddress sk script nextUTxO
-      _ <- lift $ submitTransaction networkId socketPath tx
-      put $ pickKeyAddressUTxO $ adjustUTxO tx spentUTxO
-      pure $ getTxId body
+      (nextUTxO, _) <- get
+      let (tx, _, spentUTxO) = buildScriptPublishingTx pparams systemStart networkId eraHistory stakePools changeAddress sk script nextUTxO
+      modify' (\(_, existingTxs) -> (pickKeyAddressUTxO $ adjustUTxO tx spentUTxO, tx : existingTxs))
+      pure tx
  where
   pickKeyAddressUTxO utxo = maybe mempty UTxO.singleton $ UTxO.findBy (\(_, txOut) -> isKeyAddress (txOutAddress txOut)) utxo
 
   scripts = [initialValidatorScript, commitValidatorScript, Head.validatorScript]
+
   vk = getVerificationKey sk
 
   changeAddress = mkVkAddress networkId vk
@@ -126,19 +149,18 @@ buildScriptPublishingTx ::
   SigningKey PaymentKey ->
   PlutusScript ->
   UTxO.UTxO ->
-  IO (Tx, TxBody, UTxO.UTxO)
-buildScriptPublishingTx pparams systemStart networkId eraHistory stakePools changeAddress sk script utxo = do
+  (Tx, TxBody, UTxO.UTxO)
+buildScriptPublishingTx pparams systemStart networkId eraHistory stakePools changeAddress sk script utxo =
   let output = mkScriptTxOut <$> [mkScriptRef script]
       totalDeposit = sum (selectLovelace . txOutValue <$> output)
       utxoToSpend =
         maybe mempty UTxO.singleton $
           UTxO.find (\o -> selectLovelace (txOutValue o) > totalDeposit) utxo
-  buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend [] output
-    >>= \case
-      Left e -> throwErrorAsException e
-      Right rawTx -> do
-        let body = getTxBody rawTx
-        pure (makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey sk)] body, body, utxoToSpend)
+   in case buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend [] output of
+        Left e -> error $ show e
+        Right rawTx -> do
+          let body = getTxBody rawTx
+          (makeSignedTransaction [makeShelleyKeyWitness body (WitnessPaymentKey sk)] body, body, utxoToSpend)
  where
   mkScriptTxOut =
     mkTxOutAutoBalance

hydra-node/src/Hydra/Options.hs

@@ -387,13 +387,6 @@ defaultDirectChainConfig =
     , depositDeadline = defaultDepositDeadline
     }
 
-defaultDirectChainBackend :: ChainBackend
-defaultDirectChainBackend =
-  DirectBackend
-    { networkId = defaultDirectChainConfig.networkId
-    , nodeSocket = defaultDirectChainConfig.nodeSocket
-    }
-
 instance Arbitrary ChainConfig where
   arbitrary =
     oneof
@@ -736,10 +729,9 @@ hydraScriptsTxIdsParser =
     ( long "hydra-scripts-tx-id"
         <> metavar "TXID"
         <> help
-          "The transaction which is expected to have published Hydra scripts as \
-          \reference scripts in its outputs. Note: All scripts need to be in the \
-          \first 10 outputs. See release notes for pre-published versions. You \
-          \can use the 'publish-scripts' sub-command to publish them yourself."
+          "The transactions which are expected to have published Hydra scripts as \
+          \reference scripts in their outputs. You can use the 'publish-scripts' \
+          \sub-command to publish scripts yourself."
     )
  where
   parseFromHex = mapM (deserialiseFromRawBytesHex AsTxId)

weeder.toml

@@ -12,6 +12,8 @@ roots = [
  , "spy'$"
  , "showFromAction$"
  , "redeemer$"
+ # toCardanoGenesisParameters will be needed for full blockfrost integration
+ , "toCardanoGenesisParameters"
  ]
 root-instances = [
  # Stock instances are treated as roots.