Draft a cliQueryProtocolParameters in withHydraNode'

This deliberately uses the cardano-cli to query protocol parameters as JSON.
cardano-scaling · Jan 3, 2024 · 5ac2048 · 5ac2048
1 parent 3def981
commit 5ac2048
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 25 deletions.
diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs
@@ -12,7 +12,17 @@ import Data.Aeson qualified as Aeson
 import Data.Aeson.Lens (atKey, key, _Number)
 import Data.Text qualified as Text
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
-import Hydra.Cardano.Api (AsType (AsPaymentKey), File (..), NetworkId, PaymentKey, SigningKey, SocketPath, VerificationKey, generateSigningKey, getVerificationKey)
+import Hydra.Cardano.Api (
+  AsType (AsPaymentKey),
+  File (..),
+  NetworkId,
+  PaymentKey,
+  SigningKey,
+  SocketPath,
+  VerificationKey,
+  generateSigningKey,
+  getVerificationKey,
+ )
 import Hydra.Cardano.Api qualified as Api
 import Hydra.Chain.CardanoClient (QueryPoint (QueryTip), queryProtocolParameters)
 import Hydra.Cluster.Fixture (
@@ -29,6 +39,7 @@ import System.Process (
   CreateProcess (..),
   StdStream (UseHandle),
   proc,
+  readCreateProcess,
   readProcess,
   withCreateProcess,
  )
@@ -414,6 +425,29 @@ data ProcessHasExited = ProcessHasExited Text ExitCode
 
 instance Exception ProcessHasExited
 
+-- | Cardano-cli wrapper to query protocol parameters. While we have also client
+-- functions in Hydra.Chain.CardanoClient and Hydra.Cluster.CardanoClient,
+-- sometimes we deliberately want to use the cardano-cli to ensure
+-- compatibility.
+cliQueryProtocolParameters :: RunningNode -> IO Value
+cliQueryProtocolParameters RunningNode{nodeSocket, networkId} = do
+  out <- readCreateProcess cmd ""
+  unsafeDecodeJson $ fromString out
+ where
+  cmd =
+    proc "cardano-cli" $
+      [ "query"
+      , "protocol-parameters"
+      , "--socket-path"
+      , unFile nodeSocket
+      ]
+        <> case networkId of
+          Api.Mainnet -> ["--mainnet"]
+          Api.Testnet magic -> ["--testnet-magic", show magic]
+        <> [ "--out-file"
+           , "/dev/stdout"
+           ]
+
 --
 -- Helpers
 --

diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs
@@ -6,8 +6,8 @@ import Hydra.Cardano.Api
 import Hydra.Prelude hiding (delete)
 
 import Cardano.BM.Tracing (ToObject)
-import Cardano.Ledger.Babbage.PParams (BabbagePParams (..))
 import Cardano.Ledger.Core (PParams (..))
+import CardanoNode (cliQueryProtocolParameters)
 import Control.Concurrent.Async (forConcurrently_)
 import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO)
 import Control.Exception (IOException)
@@ -305,17 +305,21 @@ withHydraNode' ::
   IO a
 withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds pparams mGivenStdOut action = do
   withSystemTempDirectory "hydra-node" $ \dir -> do
-    let cardanoLedgerProtocolParametersFile = dir </> "pparams.json"
-    writeFileBS cardanoLedgerProtocolParametersFile (writeZeroedPParams pparams)
+    -- NOTE: This implicitly tests of cardano-cli with hydra-node
+    let cardanoLedgerProtocolParametersFile = dir </> "protocol-parameters.json"
+    protocolParameters <- cliQueryProtocolParameters
+    Aeson.encodeFile cardanoLedgerProtocolParametersFile $
+      protocolParameters
+        & atKey "txFeeFixed" ?~ toJSON (Number 0)
+        & atKey "txFeePerByte" ?~ toJSON (Number 0)
+        & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
+        & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
+
     let hydraSigningKey = dir </> (show hydraNodeId <> ".sk")
     void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey
     hydraVerificationKeys <- forM (zip [1 ..] hydraVKeys) $ \(i :: Int, vKey) -> do
       let filepath = dir </> (show i <> ".vk")
       filepath <$ writeFileTextEnvelope (File filepath) Nothing vKey
-    let ledgerConfig =
-          CardanoLedgerConfig
-            { cardanoLedgerProtocolParametersFile
-            }
     let p =
           ( hydraNodeProcess $
               RunOptions
@@ -331,7 +335,10 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds p
                 , hydraVerificationKeys
                 , persistenceDir = workDir </> "state-" <> show hydraNodeId
                 , chainConfig
-                , ledgerConfig
+                , ledgerConfig =
+                    CardanoLedgerConfig
+                      { cardanoLedgerProtocolParametersFile
+                      }
                 }
           )
             { std_out = maybe CreatePipe UseHandle mGivenStdOut
@@ -344,22 +351,6 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds p
         (Nothing, _) -> error "Should not happen™"
         (_, Nothing) -> error "Should not happen™"
  where
-  -- NOTE: We want to have zeroed fees in the Head.
-  writeZeroedPParams (PParams BabbagePParams{bppProtocolVersion}) =
-    toStrict $
-      ( Aeson.encode (toJSON pparams)
-          -- FIXME: this is a hack because cardano-ledger has a bug
-          -- (https://github.com/IntersectMBO/cardano-ledger/issues/3943) in the
-          -- BabbagePParams ToJSON instance where 'protocolVersion' is missing.
-          & atKey "protocolVersion" ?~ toJSON bppProtocolVersion
-          & atKey "minFeeA" ?~ toJSON (Number 0)
-          & atKey "minFeeB" ?~ toJSON (Number 0)
-          & atKey "txFeeFixed" ?~ toJSON (Number 0)
-          & atKey "txFeePerByte" ?~ toJSON (Number 0)
-          & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
-          & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
-      )
-
   peers =
     [ Host
       { Network.hostname = "127.0.0.1"