Skip to content
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
59 changes: 27 additions & 32 deletions hydra-node/src/Hydra/Chain/CardanoClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -161,9 +161,7 @@ queryEpochNo ::
IO EpochNo
queryEpochNo networkId socket queryPoint = do
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
(sbe :: ShelleyBasedEra e) <- liftIO $ assumeShelleyBasedEraOrThrow era
queryInShelleyBasedEraExpr sbe QueryEpoch
queryForCurrentEraInShelleyBasedEraExpr (`queryInShelleyBasedEraExpr` QueryEpoch)

-- | Query the protocol parameters at given point and convert them to Babbage
-- era protocol parameters.
Expand All @@ -178,10 +176,9 @@ queryProtocolParameters ::
IO (PParams LedgerEra)
queryProtocolParameters networkId socket queryPoint =
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
sbe <- liftIO $ assumeShelleyBasedEraOrThrow era
Copy link
Member

@ch1bo ch1bo Jul 7, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

IMO the continuation passing is less clear than the assumeShelleyBasedEraOrThrow.

Furthermore, the new code does a worse job in saying that it throws if the current era is not a shelley based era.

At the very least we should improve the name and/or add documentation about that to queryForCurrentEraInShelleyBasedEraExpr

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I should have mentioned that I did this to prepare for the loss of UTxO.fromApi when porting to the upstream Cardano.Api.UTxO, where we do not use a new type but only a new ViewPattern, and where we need to unify the ConwayEra witness for UTxO queries.

https://github.com/cardano-scaling/hydra/pull/2061/files#diff-276e1103e4ea3e18432d556cad69781c3436da9f4026132b76cb74ae84c72504R219-R224

I don't know that this could have been done differently but this what I ended up with.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also the name is queryForEraIn${EON}Expr where ShelleyBasedEra and ConwaEraOnwards are the literal Eon names.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually my opinion might be to push this somewhere where we can leave out the Era assumption and just unify it later, if it works.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

push this somewhere where we can leave out the Era assumption and just unify it later,

The reason why we query the current era from the node here (and similar functions in this module) is to make the request work across eras.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Coercing to Era strikes me as a lie then in that case.

eraPParams <- queryInShelleyBasedEraExpr sbe QueryProtocolParameters
liftIO $ coercePParamsToLedgerEra era eraPParams
queryForCurrentEraInShelleyBasedEraExpr $ \sbe -> do
eraPParams <- queryInShelleyBasedEraExpr sbe QueryProtocolParameters
liftIO $ coercePParamsToLedgerEra (convert sbe) eraPParams
where
encodeToEra eraToEncode pparams =
case eitherDecode' (encode pparams) of
Expand Down Expand Up @@ -211,19 +208,16 @@ queryGenesisParameters ::
IO (GenesisParameters ShelleyEra)
queryGenesisParameters networkId socket queryPoint =
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
sbe <- liftIO $ assumeShelleyBasedEraOrThrow era
queryInShelleyBasedEraExpr sbe QueryGenesisParameters
queryForCurrentEraInShelleyBasedEraExpr (`queryInShelleyBasedEraExpr` QueryGenesisParameters)

-- | Query UTxO for all given addresses at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxO :: NetworkId -> SocketPath -> QueryPoint -> [Address ShelleyAddr] -> IO UTxO
queryUTxO networkId socket queryPoint addresses =
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
sbe <- liftIO $ assumeShelleyBasedEraOrThrow era
queryUTxOExpr sbe addresses
queryForCurrentEraInShelleyBasedEraExpr
(`queryUTxOExpr` addresses)

queryUTxOExpr :: ShelleyBasedEra era -> [Address ShelleyAddr] -> LocalStateQueryExpr b p QueryInMode r IO UTxO
queryUTxOExpr sbe addresses = do
Expand All @@ -242,18 +236,23 @@ queryUTxOByTxIn ::
[TxIn] ->
IO UTxO
queryUTxOByTxIn networkId socket queryPoint inputs =
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
(sbe :: ShelleyBasedEra e) <- liftIO $ assumeShelleyBasedEraOrThrow era
eraUTxO <- queryInShelleyBasedEraExpr sbe $ QueryUTxO (QueryUTxOByTxIn (Set.fromList inputs))
pure $ UTxO.fromApi eraUTxO

assumeShelleyBasedEraOrThrow :: MonadThrow m => CardanoEra era -> m (ShelleyBasedEra era)
assumeShelleyBasedEraOrThrow era = do
x <- requireShelleyBasedEra era
case x of
Just sbe -> pure sbe
Nothing -> throwIO $ QueryNotShelleyBasedEraException (anyCardanoEra era)
runQueryExpr networkId socket queryPoint $
queryForCurrentEraInShelleyBasedEraExpr
(fmap UTxO.fromApi . flip queryInShelleyBasedEraExpr (QueryUTxO (QueryUTxOByTxIn (Set.fromList inputs))))

queryForCurrentEraInEonExpr ::
Eon eon =>
(AnyCardanoEra -> IO a) ->
(forall era. eon era -> LocalStateQueryExpr b p QueryInMode r IO a) ->
LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInEonExpr no yes = do
k@(AnyCardanoEra era) <- queryCurrentEraExpr
inEonForEra (liftIO $ no k) yes era

queryForCurrentEraInShelleyBasedEraExpr ::
(forall era. ShelleyBasedEra era -> LocalStateQueryExpr b p QueryInMode r IO a) ->
LocalStateQueryExpr b p QueryInMode r IO a
queryForCurrentEraInShelleyBasedEraExpr = queryForCurrentEraInEonExpr (throwIO . QueryNotShelleyBasedEraException)

-- | Query the whole UTxO from node at given point. Useful for debugging, but
-- should obviously not be used in production code.
Expand All @@ -268,10 +267,8 @@ queryUTxOWhole ::
IO UTxO
queryUTxOWhole networkId socket queryPoint = do
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
(sbe :: ShelleyBasedEra e) <- liftIO $ assumeShelleyBasedEraOrThrow era
eraUTxO <- queryInShelleyBasedEraExpr sbe $ QueryUTxO QueryUTxOWhole
pure $ UTxO.fromApi eraUTxO
queryForCurrentEraInShelleyBasedEraExpr
(fmap UTxO.fromApi . flip queryInShelleyBasedEraExpr (QueryUTxO QueryUTxOWhole))

-- | Query UTxO for the address of given verification key at point.
--
Expand All @@ -296,9 +293,7 @@ queryStakePools ::
IO (Set PoolId)
queryStakePools networkId socket queryPoint =
runQueryExpr networkId socket queryPoint $ do
(AnyCardanoEra era) <- queryCurrentEraExpr
(sbe :: ShelleyBasedEra e) <- liftIO $ assumeShelleyBasedEraOrThrow era
queryInShelleyBasedEraExpr sbe QueryStakePools
queryForCurrentEraInShelleyBasedEraExpr (`queryInShelleyBasedEraExpr` QueryStakePools)

-- * Helpers

Expand Down