Change queryUTxO to queryCurrentEra in the same n2c connection

This allows us to keep the same era agnostic interface, while we convert
the arbitrary era UTxO into our canonical (Babbage) UTxO

hydra-cluster/src/CardanoClient.hs

@@ -91,16 +91,14 @@ waitForPayment ::
   Address ShelleyAddr ->
   IO UTxO
 waitForPayment networkId socket amount addr = do
-  AnyCardanoEra era <- queryCurrentEra networkId socket QueryTip
-  go era
+  go
  where
-  go :: CardanoEra era -> IO (UTxO' (TxOut CtxUTxO))
-  go era = do
-    utxo <- queryUTxO networkId socket QueryTip [addr] era
+  go = do
+    utxo <- queryUTxO networkId socket QueryTip [addr]
     let expectedPayment = selectPayment utxo
     if expectedPayment /= mempty
       then pure $ UTxO expectedPayment
-      else threadDelay 1 >> go era
+      else threadDelay 1 >> go
 
   selectPayment (UTxO utxo) =
     Map.filter ((== amount) . selectLovelace . txOutValue) utxo

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

@@ -56,14 +56,12 @@ seedFromFaucet ::
   Tracer IO FaucetLog ->
   IO UTxO
 seedFromFaucet node@RunningNode{networkId, nodeSocket} receivingVerificationKey lovelace tracer = do
-  AnyCardanoEra era <- queryCurrentEra networkId nodeSocket QueryTip
   (faucetVk, faucetSk) <- keysFor Faucet
-  retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk era
+  retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk
   waitForPayment networkId nodeSocket lovelace receivingAddress
  where
-  submitSeedTx :: VerificationKey PaymentKey -> SigningKey PaymentKey -> CardanoEra era -> IO ()
-  submitSeedTx faucetVk faucetSk era = do
-    faucetUTxO <- findFaucetUTxO node era lovelace
+  submitSeedTx faucetVk faucetSk = do
+    faucetUTxO <- findFaucetUTxO node lovelace
     let changeAddress = ShelleyAddressInEra (buildAddress faucetVk networkId)
     buildTransaction networkId nodeSocket changeAddress faucetUTxO [] [theOutput] >>= \case
       Left e -> throwIO $ FaucetFailedToBuildTx{reason = e}
@@ -79,10 +77,10 @@ seedFromFaucet node@RunningNode{networkId, nodeSocket} receivingVerificationKey
       TxOutDatumNone
       ReferenceScriptNone
 
-findFaucetUTxO :: RunningNode -> CardanoEra era -> Lovelace -> IO UTxO
-findFaucetUTxO RunningNode{networkId, nodeSocket} era lovelace = do
+findFaucetUTxO :: RunningNode -> Lovelace -> IO UTxO
+findFaucetUTxO RunningNode{networkId, nodeSocket} lovelace = do
   (faucetVk, _) <- keysFor Faucet
-  faucetUTxO <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId] era
+  faucetUTxO <- queryUTxO networkId nodeSocket QueryTip [buildAddress faucetVk networkId]
   let foundUTxO = UTxO.filter (\o -> txOutLovelace o >= lovelace) faucetUTxO
   when (null foundUTxO) $
     throwIO $
@@ -147,7 +145,7 @@ createOutputAtAddress node@RunningNode{networkId, nodeSocket} pparams atAddress
   (faucetVk, faucetSk) <- keysFor Faucet
   -- we don't care which faucet utxo we use here so just pass lovelace 0 to grab
   -- any present utxo
-  utxo <- findFaucetUTxO node era 0
+  utxo <- findFaucetUTxO node 0
   buildTransaction
     networkId
     nodeSocket

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -161,7 +161,7 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
 
                 -- Expect that Alice got her committed value back to her
                 -- external address
-                utxo <- queryUTxO networkId nodeSocket QueryTip [aliceExternalAddress] era
+                utxo <- queryUTxO networkId nodeSocket QueryTip [aliceExternalAddress]
                 let aliceValues = txOutValue <$> toList utxo
                 aliceValues `shouldContain` [lovelaceToValue aliceCommitment]
 

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

@@ -69,8 +69,7 @@ mkCardanoClient :: NetworkId -> SocketPath -> CardanoClient
 mkCardanoClient networkId nodeSocket =
   CardanoClient
     { queryUTxOByAddress = \addresses -> do
-        AnyCardanoEra era <- queryCurrentEra networkId nodeSocket QueryTip
-        queryUTxO networkId nodeSocket QueryTip addresses era
+        queryUTxO networkId nodeSocket QueryTip addresses
     , networkId
     }
 
@@ -324,13 +323,12 @@ queryGenesisParameters networkId socket queryPoint era = do
 -- | Query UTxO for all given addresses at given point.
 --
 -- Throws at least 'QueryException' if query fails.
-queryUTxO :: NetworkId -> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> CardanoEra era -> IO UTxO
-queryUTxO networkId socket queryPoint addresses era =
-  UTxO.fromApi
-    <$> ( mkQueryInEra era (QueryUTxO (QueryUTxOByAddress (Set.fromList $ map AddressShelley addresses)))
-            >>= runQuery networkId socket queryPoint
-            >>= throwOnEraMismatch
-        )
+queryUTxO :: NetworkId -> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
+queryUTxO networkId socket queryPoint addresses =
+  runQueryExpr networkId socket queryPoint $ do
+    (AnyCardanoEra era) <- queryCurrentEraExpr
+    eraUTxO <- queryInEraExpr era $ QueryUTxO (QueryUTxOByAddress (Set.fromList $ map AddressShelley addresses))
+    pure $ UTxO.fromApi eraUTxO
 
 -- | Query UTxO for given tx inputs at given point.
 --
@@ -380,8 +378,7 @@ queryUTxOFor :: NetworkId -> SocketPath -> QueryPoint -> VerificationKey Payment
 queryUTxOFor networkId nodeSocket queryPoint vk =
   case mkVkAddress networkId vk of
     ShelleyAddressInEra addr -> do
-      AnyCardanoEra era <- queryCurrentEra networkId nodeSocket QueryTip
-      queryUTxO networkId nodeSocket queryPoint [addr] era
+      queryUTxO networkId nodeSocket queryPoint [addr]
     ByronAddressInEra{} ->
       fail "impossible: mkVkAddress returned Byron address."
 
@@ -405,6 +402,25 @@ queryStakePools networkId socket queryPoint =
           )
    in runQuery networkId socket queryPoint query >>= throwOnEraMismatch
 
+-- * Helpers
+
+-- | Monadic query expression to get current era.
+queryCurrentEraExpr :: LocalStateQueryExpr b p (QueryInMode CardanoMode) r IO AnyCardanoEra
+queryCurrentEraExpr =
+  queryExpr (QueryCurrentEra CardanoModeIsMultiEra) >>= liftIO . throwOnUnsupportedNtcVersion
+
+-- | Monadic query expression for a 'QueryInShelleyBasedEra'.
+queryInEraExpr ::
+  -- | The current running era we can use to query the node
+  CardanoEra era ->
+  QueryInShelleyBasedEra era a ->
+  LocalStateQueryExpr b p (QueryInMode CardanoMode) r IO a
+queryInEraExpr era query =
+  liftIO (mkQueryInEra era query)
+    >>= queryExpr
+    >>= (liftIO . throwOnUnsupportedNtcVersion)
+    >>= (liftIO . throwOnEraMismatch)
+
 -- | Construct a 'QueryInMode' from a 'CardanoEra' which is only known at
 -- run-time.
 --
@@ -440,14 +456,35 @@ runQuery networkId socket point query =
       QueryTip -> Nothing
       QueryAt cp -> Just cp
 
--- * Helpers
+-- | Throws at least 'QueryException' if query fails.
+runQueryExpr ::
+  NetworkId ->
+  SocketPath ->
+  QueryPoint ->
+  LocalStateQueryExpr (BlockInMode CardanoMode) ChainPoint (QueryInMode CardanoMode) () IO a ->
+  IO a
+runQueryExpr networkId socket point query =
+  executeLocalStateQueryExpr (localNodeConnectInfo networkId socket) maybePoint query >>= \case
+    Left err -> throwIO $ QueryAcquireException err
+    Right result -> pure result
+ where
+  maybePoint =
+    case point of
+      QueryTip -> Nothing
+      QueryAt cp -> Just cp
 
 throwOnEraMismatch :: MonadThrow m => Either EraMismatch a -> m a
 throwOnEraMismatch res =
   case res of
     Left eraMismatch -> throwIO $ QueryEraMismatchException eraMismatch
     Right result -> pure result
 
+throwOnUnsupportedNtcVersion :: MonadThrow m => Either UnsupportedNtcVersionError a -> m a
+throwOnUnsupportedNtcVersion res =
+  case res of
+    Left unsupportedNtcVersion -> error $ show unsupportedNtcVersion -- TODO
+    Right result -> pure result
+
 localNodeConnectInfo :: NetworkId -> SocketPath -> LocalNodeConnectInfo CardanoMode
 localNodeConnectInfo = LocalNodeConnectInfo cardanoModeParams
 

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

@@ -150,7 +150,7 @@ mkTinyWallet tracer config era = do
     point <- case queryPoint of
       QueryAt point -> pure point
       QueryTip -> queryTip networkId nodeSocket
-    walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address] era
+    walletUTxO <- Ledger.unUTxO . toLedgerUTxO <$> queryUTxO networkId nodeSocket QueryTip [address]
     pparams <- queryProtocolParameters networkId nodeSocket QueryTip era
     systemStart <- querySystemStart networkId nodeSocket QueryTip
     epochInfo <- queryEpochInfo