DRAFT: re-used publisch scripts tx building

Author: ch1bo

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

@@ -39,10 +39,11 @@ 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.Chain.ScriptRegistry (buildScriptPublishingTx, buildScriptPublishingTxs)
 import Hydra.Contract.Head qualified as Head
 import Hydra.Ledger.Cardano (adjustUTxO)
 import Hydra.Plutus (commitValidatorScript, initialValidatorScript)
+import Hydra.Tx (txId)
 import Money qualified
 import Ouroboros.Consensus.Block (GenesisWindow (..))
 import Ouroboros.Consensus.Cardano.Block (CardanoEras)
@@ -88,18 +89,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

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

@@ -24,6 +24,7 @@ import Hydra.Cardano.Api (
   TxId,
   TxIn (..),
   TxIx (..),
+  UTxO,
   WitCtx (..),
   examplePlutusScriptAlwaysFails,
   getTxBody,
@@ -55,6 +56,7 @@ import Hydra.Chain.CardanoClient (
 import Hydra.Contract.Head qualified as Head
 import Hydra.Ledger.Cardano (adjustUTxO)
 import Hydra.Plutus (commitValidatorScript, initialValidatorScript)
+import Hydra.Tx (txId)
 import Hydra.Tx.ScriptRegistry (ScriptRegistry (..), newScriptRegistry)
 
 -- | Query for 'TxIn's in the search for outputs containing all the reference
@@ -78,14 +80,16 @@ queryScriptRegistry ::
   SocketPath ->
   [TxId] ->
   m ScriptRegistry
-queryScriptRegistry networkId socketPath txIds = go 10
+queryScriptRegistry networkId socketPath txIds =
+  -- FIXME: No need to change semantics by looping
+  go 10
  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 = concatMap (\txid -> [TxIn txid ix | ix <- [TxIx 0 .. TxIx 10]]) txIds -- Arbitrary but, high-enough.
 
 publishHydraScripts ::
   -- | Expected network discriminant.
@@ -101,20 +105,23 @@ publishHydraScripts networkId socketPath sk = do
   eraHistory <- queryEraHistory networkId socketPath QueryTip
   stakePools <- queryStakePools networkId socketPath QueryTip
   utxo <- queryUTxOFor networkId socketPath QueryTip vk
-  flip evalStateT utxo $
-    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
+  let txs = buildScriptPublishingTxs pparams systemStart networkId eraHistory stakePools utxo sk
+  forM txs $ \tx -> do
+    submitTransaction networkId socketPath tx
+    pure $ txId 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
+buildScriptPublishingTxs ::
+  PParams LedgerEra ->
+  SystemStart ->
+  NetworkId ->
+  EraHistory ->
+  Set PoolId ->
+  UTxO ->
+  SigningKey PaymentKey ->
+  [Tx]
+buildScriptPublishingTxs = undefined
 
 buildScriptPublishingTx ::
   PParams LedgerEra ->