Blockfrost chain integration

.github/workflows/ci-nix.yaml

@@ -47,6 +47,7 @@ jobs:
     - name: ❓ Test
       if: ${{ matrix.package != 'hydra-tui' }}
       run: |
+        echo "${{secrets.blockfrost_token}}" > blockfrost-project.txt
         cd ${{ matrix.package }}
         nix build .#${{ matrix.package }}-tests
         nix develop .#${{ matrix.package }}-tests --command tests

CHANGELOG.md

@@ -30,6 +30,8 @@ changes.
   - Change to the `ReqSn` message in the Hydra network protocol
   - Added `DepositExpired` for when a deposit was deemed expired.
 
+- Enable blockfrost integration for hydra-node.
+
 ## [0.21.0] - 2025-04-28
 
 - New metric for counting the number of active peers: `hydra_head_peers_connected`

hydra-cluster/hydra-cluster.cabal

@@ -144,6 +144,7 @@ test-suite tests
   other-modules:
     Paths_hydra_cluster
     Spec
+    Test.BlockfrostChainSpec
     Test.CardanoClientSpec
     Test.CardanoNodeSpec
     Test.ChainObserverSpec

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module Hydra.Cluster.Faucet where
 
 import Hydra.Cardano.Api
@@ -13,6 +15,7 @@ import CardanoClient (
   awaitTransactionId,
   buildAddress,
   buildTransaction,
+  buildTransactionWithPParams',
   queryUTxO,
   queryUTxOFor,
   sign,
@@ -21,18 +24,24 @@ import CardanoClient (
 import Control.Exception (IOException)
 import Control.Monad.Class.MonadThrow (Handler (Handler), catches)
 import Control.Tracer (Tracer, traceWith)
+import Data.Set qualified as Set
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import GHC.IO.Exception (IOErrorType (ResourceExhausted), IOException (ioe_type))
+import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
+import Hydra.Chain.Direct (DirectBackend (..))
 import Hydra.Chain.ScriptRegistry (
   publishHydraScripts,
  )
 import Hydra.Cluster.Fixture (Actor (Faucet))
 import Hydra.Cluster.Util (keysFor)
 import Hydra.Ledger.Cardano ()
-import Hydra.Tx (balance)
+import Hydra.Options (DirectOptions (..))
+import Hydra.Tx (balance, txId)
 
 data FaucetException
   = FaucetHasNotEnoughFunds {faucetUTxO :: UTxO}
   | FaucetFailedToBuildTx {reason :: TxBodyErrorAutoBalance Era}
+  | FaucetBlockfrostError {blockFrostError :: Text}
   deriving stock (Show)
 
 instance Exception FaucetException
@@ -88,6 +97,55 @@ findFaucetUTxO RunningNode{networkId, nodeSocket} lovelace = do
       FaucetHasNotEnoughFunds{faucetUTxO}
   pure foundUTxO
 
+seedFromFaucetBlockfrost ::
+  -- | Recipient of the funds
+  VerificationKey PaymentKey ->
+  -- | Amount to get from faucet
+  Coin ->
+  Blockfrost.BlockfrostClientT IO UTxO
+seedFromFaucetBlockfrost receivingVerificationKey lovelace = do
+  (faucetVk, faucetSk) <- liftIO $ keysFor Faucet
+
+  Blockfrost.Genesis
+    { Blockfrost._genesisNetworkMagic = networkMagic
+    , Blockfrost._genesisSystemStart = systemStart'
+    } <-
+    Blockfrost.queryGenesisParameters
+  pparams <- Blockfrost.queryProtocolParameters
+  let networkId = Blockfrost.toCardanoNetworkId networkMagic
+  let changeAddress = buildAddress faucetVk networkId
+  let receivingAddress = buildAddress receivingVerificationKey networkId
+  let theOutput =
+        TxOut
+          (shelleyAddressInEra shelleyBasedEra receivingAddress)
+          (lovelaceToValue lovelace)
+          TxOutDatumNone
+          ReferenceScriptNone
+  stakePools' <- Blockfrost.listPools
+  let stakePools = Set.fromList (Blockfrost.toCardanoPoolId <$> stakePools')
+  let systemStart = SystemStart $ posixSecondsToUTCTime systemStart'
+  eraHistory <- Blockfrost.queryEraHistory
+  foundUTxO <- findUTxO networkId changeAddress lovelace
+  case buildTransactionWithPParams' pparams systemStart eraHistory stakePools (mkVkAddress networkId faucetVk) foundUTxO [] [theOutput] of
+    Left e -> liftIO $ throwIO $ FaucetFailedToBuildTx{reason = e}
+    Right tx -> do
+      let signedTx = signTx faucetSk tx
+      eResult <- Blockfrost.tryError $ Blockfrost.submitTransaction signedTx
+      case eResult of
+        Left err -> liftIO $ throwIO $ FaucetBlockfrostError{blockFrostError = show err}
+        Right _ -> do
+          void $ Blockfrost.awaitUTxO networkId [changeAddress] (txId signedTx) 100
+          Blockfrost.awaitUTxO networkId [receivingAddress] (txId signedTx) 100
+ where
+  findUTxO networkId address lovelace' = do
+    faucetUTxO <- Blockfrost.queryUTxO networkId [address]
+    let foundUTxO = UTxO.find (\o -> (selectLovelace . txOutValue) o >= lovelace') faucetUTxO
+    when (isNothing foundUTxO) $
+      liftIO $
+        throwIO $
+          FaucetHasNotEnoughFunds{faucetUTxO}
+    pure $ maybe mempty (uncurry UTxO.singleton) foundUTxO
+
 -- | Like 'seedFromFaucet', but without returning the seeded 'UTxO'.
 seedFromFaucet_ ::
   RunningNode ->
@@ -201,6 +259,6 @@ retryOnExceptions tracer action =
 publishHydraScriptsAs :: RunningNode -> Actor -> IO [TxId]
 publishHydraScriptsAs RunningNode{networkId, nodeSocket} actor = do
   (_, sk) <- keysFor actor
-  txIds <- publishHydraScripts networkId nodeSocket sk
+  txIds <- publishHydraScripts (DirectBackend $ DirectOptions{networkId, nodeSocket}) sk
   mapM_ (awaitTransactionId networkId nodeSocket) txIds
   pure txIds

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

@@ -27,7 +27,10 @@ bobVk = getVerificationKey bobSk
 carolVk = getVerificationKey carolSk
 
 cperiod :: ContestationPeriod
-cperiod = 10
+cperiod = UnsafeContestationPeriod 10
+
+blockfrostcperiod :: ContestationPeriod
+blockfrostcperiod = UnsafeContestationPeriod 200
 
 -- NOTE: This is hard-coded and needs to correspond to the initial funds set in
 -- the genesis-shelley.json file.

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

@@ -107,7 +107,7 @@ import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
 import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Node.DepositPeriod (DepositPeriod (..))
-import Hydra.Options (DirectChainConfig (..), startChainFrom)
+import Hydra.Options (CardanoChainConfig (..), startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
 import Hydra.Tx.ContestationPeriod qualified as CP
 import Hydra.Tx.Utils (dummyValidatorScript, verificationKeyToOnChainId)
@@ -287,7 +287,7 @@ restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do
     chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] 2
       -- we delibelately do not start from a chain point here to highlight the
       -- need for persistence
-      <&> modifyConfig (\config -> config{networkId, startChainFrom = Nothing})
+      <&> modifyConfig (\config -> config{startChainFrom = Nothing})
 
   let hydraTracer = contramap FromHydraNode tracer
   headId1 <- withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
@@ -303,7 +303,7 @@ restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do
     waitFor hydraTracer 20 [n1] $
       output "HeadIsAborted" ["utxo" .= object mempty, "headId" .= headId2]
  where
-  RunningNode{nodeSocket, networkId} = cardanoNode
+  RunningNode{nodeSocket} = cardanoNode
 
 nodeReObservesOnChainTxs :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> [TxId] -> IO ()
 nodeReObservesOnChainTxs tracer workDir cardanoNode hydraScriptsTxId = do
@@ -314,11 +314,11 @@ nodeReObservesOnChainTxs tracer workDir cardanoNode hydraScriptsTxId = do
   let contestationPeriod = 2
   aliceChainConfig <-
     chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [Bob] contestationPeriod
-      <&> modifyConfig (\config -> config{networkId, startChainFrom = Nothing})
+      <&> modifyConfig (\config -> config{startChainFrom = Nothing})
 
   bobChainConfig <-
     chainConfigFor Bob workDir nodeSocket hydraScriptsTxId [Alice] contestationPeriod
-      <&> modifyConfig (\config -> config{networkId, startChainFrom = Nothing})
+      <&> modifyConfig (\config -> config{startChainFrom = Nothing})
 
   (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice
   commitUTxO <- seedFromFaucet cardanoNode aliceCardanoVk 5_000_000 (contramap FromFaucet tracer)
@@ -391,7 +391,7 @@ nodeReObservesOnChainTxs tracer workDir cardanoNode hydraScriptsTxId = do
 
     bobChainConfigFromTip <-
       chainConfigFor Bob workDir nodeSocket hydraScriptsTxId [Alice] contestationPeriod
-        <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
+        <&> modifyConfig (\config -> config{startChainFrom = Just tip})
 
     withTempDir "blank-state" $ \tmpDir -> do
       void $ readCreateProcessWithExitCode (proc "cp" ["-r", workDir </> "state-2", tmpDir]) ""
@@ -450,7 +450,7 @@ singlePartyHeadFullLifeCycle tracer workDir node hydraScriptsTxId =
       contestationPeriod <- CP.fromNominalDiffTime $ 10 * blockTime
       aliceChainConfig <-
         chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod
-          <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
+          <&> modifyConfig (\config -> config{startChainFrom = Just tip})
       withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
         -- Initialize & open head
         send n1 $ input "Init" []
@@ -506,7 +506,7 @@ singlePartyOpenAHead tracer workDir node hydraScriptsTxId callback =
     let contestationPeriod = 100
     aliceChainConfig <-
       chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod
-        <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
+        <&> modifyConfig (\config -> config{startChainFrom = Just tip})
 
     (walletVk, walletSk) <- generate genKeyPair
     let keyPath = workDir <> "/wallet.sk"
@@ -961,7 +961,7 @@ canCloseWithLongContestationPeriod tracer workDir node hydraScriptsTxId = do
   let oneWeek = 60 * 60 * 24 * 7
   aliceChainConfig <-
     chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] oneWeek
-      <&> modifyConfig (\config -> config{networkId, startChainFrom = Just tip})
+      <&> modifyConfig (\config -> config{startChainFrom = Just tip})
   let hydraTracer = contramap FromHydraNode tracer
   withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [] [1] $ \n1 -> do
     -- Initialize & open head

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

@@ -17,7 +17,8 @@ import Hydra.Cardano.Api (
   textEnvelopeToJSON,
  )
 import Hydra.Cluster.Fixture (Actor, actorName, fundsOf)
-import Hydra.Options (ChainConfig (..), DirectChainConfig (..), defaultDirectChainConfig)
+import Hydra.Node.DepositPeriod (DepositPeriod)
+import Hydra.Options (BlockfrostOptions (..), CardanoChainConfig (..), ChainBackendOptions (..), ChainConfig (..), DirectOptions (..), defaultCardanoChainConfig, defaultDepositPeriod, defaultDirectOptions)
 import Hydra.Tx.ContestationPeriod (ContestationPeriod)
 import Paths_hydra_cluster qualified as Pkg
 import System.FilePath ((<.>), (</>))
@@ -66,7 +67,20 @@ chainConfigFor ::
   [Actor] ->
   ContestationPeriod ->
   IO ChainConfig
-chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod = do
+chainConfigFor me targetDir nodeSocket txids actors cp = chainConfigFor' me targetDir (Right nodeSocket) txids actors cp defaultDepositPeriod
+
+chainConfigFor' ::
+  HasCallStack =>
+  Actor ->
+  FilePath ->
+  Either FilePath SocketPath ->
+  -- | Transaction ids at which Hydra scripts should have been published.
+  [TxId] ->
+  [Actor] ->
+  ContestationPeriod ->
+  DepositPeriod ->
+  IO ChainConfig
+chainConfigFor' me targetDir socketOrProjectPath hydraScriptsTxId them contestationPeriod depositPeriod = do
   when (me `elem` them) $
     failure $
       show me <> " must not be in " <> show them
@@ -79,13 +93,17 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod
   forM_ them $ \actor ->
     copyFile actor "vk"
   pure $
-    Direct
-      defaultDirectChainConfig
-        { nodeSocket
-        , hydraScriptsTxId
+    Cardano
+      defaultCardanoChainConfig
+        { hydraScriptsTxId
         , cardanoSigningKey = actorFilePath me "sk"
         , cardanoVerificationKeys = [actorFilePath himOrHer "vk" | himOrHer <- them]
         , contestationPeriod
+        , depositPeriod
+        , chainBackendOptions =
+            case socketOrProjectPath of
+              Left projectPath -> Blockfrost BlockfrostOptions{projectPath}
+              Right nodeSocket -> Direct defaultDirectOptions{nodeSocket = nodeSocket}
         }
  where
   actorFilePath actor fileType = targetDir </> actorFileName actor fileType
@@ -96,12 +114,15 @@ chainConfigFor me targetDir nodeSocket hydraScriptsTxId them contestationPeriod
         filePath = actorFilePath actor fileType
     readConfigFile ("credentials" </> fileName) >>= writeFileBS filePath
 
-modifyConfig :: (DirectChainConfig -> DirectChainConfig) -> ChainConfig -> ChainConfig
+modifyConfig :: (CardanoChainConfig -> CardanoChainConfig) -> ChainConfig -> ChainConfig
 modifyConfig fn = \case
-  Direct config -> Direct $ fn config
+  Cardano config -> Cardano $ fn config
   x -> x
 
 setNetworkId :: NetworkId -> ChainConfig -> ChainConfig
 setNetworkId networkId = \case
-  Direct config -> Direct config{networkId}
+  Cardano config@CardanoChainConfig{chainBackendOptions} ->
+    case chainBackendOptions of
+      Direct direct@DirectOptions{} -> Cardano config{chainBackendOptions = Direct direct{networkId = networkId}}
+      _ -> Cardano config
   x -> x

hydra-cluster/src/HydraNode.hs

@@ -20,12 +20,13 @@ import Data.ByteString (hGetContents)
 import Data.List qualified as List
 import Data.Text qualified as T
 import Hydra.API.HTTPServer (DraftCommitTxRequest (..), DraftCommitTxResponse (..))
+import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
 import Hydra.Cluster.Util (readConfigFile)
 import Hydra.HeadLogic.State (SeenSnapshot)
 import Hydra.Logging (Tracer, Verbosity (..), traceWith)
 import Hydra.Network (Host (Host), NodeId (NodeId), WhichEtcd (EmbeddedEtcd))
 import Hydra.Network qualified as Network
-import Hydra.Options (ChainConfig (..), DirectChainConfig (..), LedgerConfig (..), RunOptions (..), defaultDirectChainConfig, toArgs)
+import Hydra.Options (BlockfrostOptions (..), CardanoChainConfig (..), ChainBackendOptions (..), ChainConfig (..), DirectOptions (..), LedgerConfig (..), RunOptions (..), defaultCardanoChainConfig, defaultDirectOptions, nodeSocket, toArgs)
 import Hydra.Tx (ConfirmedSnapshot)
 import Hydra.Tx.ContestationPeriod (ContestationPeriod)
 import Hydra.Tx.Crypto (HydraKey)
@@ -310,13 +311,17 @@ withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraSc
           cardanoSigningKey = workDir </> show nodeId <.> "sk"
           cardanoVerificationKeys = [workDir </> show i <.> "vk" | i <- allNodeIds, i /= nodeId]
           chainConfig =
-            Direct
-              defaultDirectChainConfig
-                { nodeSocket
-                , hydraScriptsTxId
+            Cardano
+              defaultCardanoChainConfig
+                { hydraScriptsTxId
                 , cardanoSigningKey
                 , cardanoVerificationKeys
                 , contestationPeriod
+                , chainBackendOptions =
+                    Direct
+                      defaultDirectOptions
+                        { nodeSocket = nodeSocket
+                        }
                 }
       withHydraNode
         tracer
@@ -343,9 +348,14 @@ preparePParams chainConfig stateDir paramsDecorator = do
     Offline _ ->
       readConfigFile "protocol-parameters.json"
         >>= writeFileBS cardanoLedgerProtocolParametersFile
-    Direct DirectChainConfig{nodeSocket, networkId} -> do
-      -- NOTE: This implicitly tests of cardano-cli with hydra-node
-      protocolParameters <- cliQueryProtocolParameters nodeSocket networkId
+    Cardano CardanoChainConfig{chainBackendOptions} -> do
+      protocolParameters <- case chainBackendOptions of
+        Direct DirectOptions{networkId, nodeSocket} ->
+          -- NOTE: This implicitly tests of cardano-cli with hydra-node
+          cliQueryProtocolParameters nodeSocket networkId
+        Blockfrost BlockfrostOptions{projectPath} -> do
+          prj <- Blockfrost.projectFromFile projectPath
+          toJSON <$> Blockfrost.runBlockfrostM prj Blockfrost.queryProtocolParameters
       Aeson.encodeFile cardanoLedgerProtocolParametersFile $
         paramsDecorator protocolParameters
           & atKey "txFeeFixed" ?~ toJSON (Number 0)
@@ -477,9 +487,15 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod
       Offline _ ->
         readConfigFile "protocol-parameters.json"
           >>= writeFileBS cardanoLedgerProtocolParametersFile
-      Direct DirectChainConfig{nodeSocket, networkId} -> do
-        -- NOTE: This implicitly tests of cardano-cli with hydra-node
-        protocolParameters <- cliQueryProtocolParameters nodeSocket networkId
+      Cardano CardanoChainConfig{chainBackendOptions} -> do
+        protocolParameters <- case chainBackendOptions of
+          Direct DirectOptions{networkId, nodeSocket} ->
+            -- NOTE: This implicitly tests of cardano-cli with hydra-node
+            cliQueryProtocolParameters nodeSocket networkId
+          Blockfrost BlockfrostOptions{projectPath} -> do
+            prj <- Blockfrost.projectFromFile projectPath
+            toJSON <$> Blockfrost.runBlockfrostM prj Blockfrost.queryProtocolParameters
+
         Aeson.encodeFile cardanoLedgerProtocolParametersFile $
           protocolParameters
             & atKey "txFeeFixed" ?~ toJSON (Number 0)