diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index aaf2c1fa1c5..5438d7b67ee 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -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. @@ -178,10 +176,9 @@ queryProtocolParameters :: IO (PParams LedgerEra) queryProtocolParameters networkId socket queryPoint = runQueryExpr networkId socket queryPoint $ do - (AnyCardanoEra era) <- queryCurrentEraExpr - sbe <- liftIO $ assumeShelleyBasedEraOrThrow era - 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 @@ -211,9 +208,7 @@ 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. -- @@ -221,9 +216,8 @@ queryGenesisParameters networkId socket queryPoint = 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 @@ -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. @@ -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. -- @@ -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