Remove redundant era conversion functions. Handle IO Exceptions in consensus queries. Refactor Cardano.Api.Convenience.Query to work in ExceptT e IO.

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -634,7 +634,7 @@ genTxMintValue =
 
 genTxBodyContent :: ShelleyBasedEra era -> Gen (TxBodyContent BuildTx era)
 genTxBodyContent sbe = do
-  let era = shelleyBasedToCardanoEra sbe
+  let era = toCardanoEra sbe
   txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
   txInsCollateral <- genTxInsCollateral era
   txInsReference <- genTxInsReference era
@@ -1111,4 +1111,4 @@ genCurrentTreasuryValue :: ConwayEraOnwards era -> Gen L.Coin
 genCurrentTreasuryValue _era = Q.arbitrary
 
 genTreasuryDonation :: ConwayEraOnwards era -> Gen L.Coin
-genTreasuryDonation _era = Q.arbitrary
+genTreasuryDonation _era = Q.arbitrary

cardano-api/internal/Cardano/Api/Convenience/Query.hs

@@ -29,6 +29,7 @@ import           Cardano.Api.Feature (Featured (..))
 import           Cardano.Api.IO
 import           Cardano.Api.IPC
 import           Cardano.Api.IPC.Monad
+import           Cardano.Api.Monad.Error
 import           Cardano.Api.NetworkId
 import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.Query
@@ -45,22 +46,24 @@ import qualified Cardano.Ledger.Shelley.LedgerState as L
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..))
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
 
-import           Control.Monad.Trans (MonadTrans (..))
-import           Control.Monad.Trans.Except (ExceptT (..), runExceptT)
-import           Control.Monad.Trans.Except.Extra (left, onLeft, onNothing)
+import           Control.Exception.Safe (SomeException, displayException)
+import           Control.Monad
+import           Data.Bifunctor (first)
 import           Data.Function ((&))
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Maybe (mapMaybe)
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import           GHC.Exts (IsString (..))
 
 data QueryConvenienceError
   = AcqFailure AcquiringFailure
   | QueryEraMismatch EraMismatch
   | ByronEraNotSupported
   | QceUnsupportedNtcVersion !UnsupportedNtcVersionError
+  | QceUnexpectedException !SomeException
   deriving Show
 
 renderQueryConvenienceError :: QueryConvenienceError -> Text
@@ -76,6 +79,8 @@ renderQueryConvenienceError (QceUnsupportedNtcVersion (UnsupportedNtcVersionErro
   "Unsupported feature for the node-to-client protocol version.\n" <>
   "This query requires at least " <> textShow minNtcVersion <> " but the node negotiated " <> textShow ntcVersion <> ".\n" <>
   "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)."
+renderQueryConvenienceError (QceUnexpectedException e) =
+  "Unexpected exception while processing query:\n" <> fromString (displayException e)
 
 newtype TxCurrentTreasuryValue = TxCurrentTreasuryValue { unTxCurrentTreasuryValue :: L.Coin }
   deriving newtype Show
@@ -153,7 +158,7 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
 -- | Query the node to determine which era it is in.
 determineEra :: ()
   => LocalNodeConnectInfo
-  -> IO (Either AcquiringFailure AnyCardanoEra)
+  -> ExceptT AcquiringFailure IO AnyCardanoEra
 determineEra localNodeConnInfo =
   queryNodeLocalState localNodeConnInfo VolatileTip QueryCurrentEra
 
@@ -163,23 +168,24 @@ executeQueryCardanoMode :: ()
   => SocketPath
   -> NetworkId
   -> QueryInMode (Either EraMismatch result)
-  -> IO (Either QueryConvenienceError result)
-executeQueryCardanoMode socketPath nid q = runExceptT $ do
+  -> ExceptT QueryConvenienceError IO result
+executeQueryCardanoMode socketPath nid q = do
   let localNodeConnInfo =
         LocalNodeConnectInfo
           { localConsensusModeParams = CardanoModeParams (EpochSlots 21600)
           , localNodeNetworkId = nid
           , localNodeSocketPath = socketPath
           }
 
-  ExceptT $ executeQueryAnyMode localNodeConnInfo q
+  executeQueryAnyMode localNodeConnInfo q
 
 -- | Execute a query against the local node in any mode.
 executeQueryAnyMode :: forall result. ()
   => LocalNodeConnectInfo
   -> QueryInMode (Either EraMismatch result)
-  -> IO (Either QueryConvenienceError result)
-executeQueryAnyMode localNodeConnInfo q = runExceptT $ do
-  lift (queryNodeLocalState localNodeConnInfo VolatileTip q)
-    & onLeft (left . AcqFailure)
-    & onLeft (left . QueryEraMismatch)
+  -> ExceptT QueryConvenienceError IO result
+executeQueryAnyMode localNodeConnInfo q =
+  liftEither <=< fmap (first QueryEraMismatch)
+    . handleIOExceptionsWith QceUnexpectedException
+    . modifyError AcqFailure
+    $ queryNodeLocalState localNodeConnInfo VolatileTip q

cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.AllegraEraOnwards
   ( AllegraEraOnwards(..)
   , allegraEraOnwardsConstraints
-  , allegraEraOnwardsToCardanoEra
   , allegraEraOnwardsToShelleyBasedEra
 
   , AllegraEraOnwardsConstraints
@@ -102,9 +101,6 @@ allegraEraOnwardsConstraints = \case
   AllegraEraOnwardsBabbage -> id
   AllegraEraOnwardsConway  -> id
 
-allegraEraOnwardsToCardanoEra :: AllegraEraOnwards era -> CardanoEra era
-allegraEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . allegraEraOnwardsToShelleyBasedEra
-
 allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era
 allegraEraOnwardsToShelleyBasedEra = \case
   AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra

cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.AlonzoEraOnwards
   ( AlonzoEraOnwards(..)
   , alonzoEraOnwardsConstraints
-  , alonzoEraOnwardsToCardanoEra
   , alonzoEraOnwardsToShelleyBasedEra
 
   , AlonzoEraOnwardsConstraints
@@ -113,9 +112,6 @@ alonzoEraOnwardsConstraints = \case
   AlonzoEraOnwardsBabbage -> id
   AlonzoEraOnwardsConway  -> id
 
-alonzoEraOnwardsToCardanoEra :: AlonzoEraOnwards era -> CardanoEra era
-alonzoEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . alonzoEraOnwardsToShelleyBasedEra
-
 alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era
 alonzoEraOnwardsToShelleyBasedEra = \case
   AlonzoEraOnwardsAlonzo  -> ShelleyBasedEraAlonzo

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.BabbageEraOnwards
   ( BabbageEraOnwards(..)
   , babbageEraOnwardsConstraints
-  , babbageEraOnwardsToCardanoEra
   , babbageEraOnwardsToShelleyBasedEra
 
   , BabbageEraOnwardsConstraints
@@ -107,9 +106,6 @@ babbageEraOnwardsConstraints = \case
   BabbageEraOnwardsBabbage -> id
   BabbageEraOnwardsConway  -> id
 
-babbageEraOnwardsToCardanoEra :: BabbageEraOnwards era -> CardanoEra era
-babbageEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . babbageEraOnwardsToShelleyBasedEra
-
 babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era
 babbageEraOnwardsToShelleyBasedEra = \case
   BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage

cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs

@@ -10,7 +10,6 @@
 module Cardano.Api.Eon.ByronToAlonzoEra
   ( ByronToAlonzoEra(..)
   , byronToAlonzoEraConstraints
-  , byronToAlonzoEraToCardanoEra
 
   , ByronToAlonzoEraConstraints
   ) where
@@ -62,11 +61,3 @@ byronToAlonzoEraConstraints = \case
   ByronToAlonzoEraAllegra  -> id
   ByronToAlonzoEraMary     -> id
   ByronToAlonzoEraAlonzo   -> id
-
-byronToAlonzoEraToCardanoEra :: ByronToAlonzoEra era -> CardanoEra era
-byronToAlonzoEraToCardanoEra = \case
-  ByronToAlonzoEraByron    -> ByronEra
-  ByronToAlonzoEraShelley  -> ShelleyEra
-  ByronToAlonzoEraAllegra  -> AllegraEra
-  ByronToAlonzoEraMary     -> MaryEra
-  ByronToAlonzoEraAlonzo   -> AlonzoEra

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ConwayEraOnwards
   ( ConwayEraOnwards(..)
   , conwayEraOnwardsConstraints
-  , conwayEraOnwardsToCardanoEra
   , conwayEraOnwardsToShelleyBasedEra
 
   , ConwayEraOnwardsConstraints
@@ -109,9 +108,6 @@ conwayEraOnwardsConstraints :: ()
 conwayEraOnwardsConstraints = \case
   ConwayEraOnwardsConway -> id
 
-conwayEraOnwardsToCardanoEra :: ConwayEraOnwards era -> CardanoEra era
-conwayEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . conwayEraOnwardsToShelleyBasedEra
-
 conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era
 conwayEraOnwardsToShelleyBasedEra = \case
   ConwayEraOnwardsConway -> ShelleyBasedEraConway

cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.MaryEraOnwards
   ( MaryEraOnwards(..)
   , maryEraOnwardsConstraints
-  , maryEraOnwardsToCardanoEra
   , maryEraOnwardsToShelleyBasedEra
 
   , MaryEraOnwardsConstraints
@@ -103,9 +102,6 @@ maryEraOnwardsConstraints = \case
   MaryEraOnwardsBabbage -> id
   MaryEraOnwardsConway  -> id
 
-maryEraOnwardsToCardanoEra :: MaryEraOnwards era -> CardanoEra era
-maryEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . maryEraOnwardsToShelleyBasedEra
-
 maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era
 maryEraOnwardsToShelleyBasedEra = \case
   MaryEraOnwardsMary    -> ShelleyBasedEraMary

cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs

@@ -17,7 +17,6 @@ module Cardano.Api.Eon.ShelleyBasedEra
   , AnyShelleyBasedEra(..)
   , InAnyShelleyBasedEra(..)
   , inAnyShelleyBasedEra
-  , shelleyBasedToCardanoEra
   , inEonForShelleyBasedEra
   , inEonForShelleyBasedEraMaybe
   , forShelleyBasedEraInEon
@@ -71,7 +70,7 @@ inEonForShelleyBasedEra :: ()
   -> ShelleyBasedEra era
   -> a
 inEonForShelleyBasedEra no yes =
-  inEonForEra no yes . shelleyBasedToCardanoEra
+  inEonForEra no yes . toCardanoEra
 
 inEonForShelleyBasedEraMaybe :: ()
   => Eon eon
@@ -86,7 +85,7 @@ forShelleyBasedEraMaybeEon :: ()
   => ShelleyBasedEra era
   -> Maybe (eon era)
 forShelleyBasedEraMaybeEon =
-  inEonForEra Nothing Just . shelleyBasedToCardanoEra
+  inEonForEra Nothing Just . toCardanoEra
 
 forShelleyBasedEraInEon :: ()
   => Eon eon
@@ -139,10 +138,10 @@ deriving instance Ord  (ShelleyBasedEra era)
 deriving instance Show (ShelleyBasedEra era)
 
 instance Pretty (ShelleyBasedEra era) where
-  pretty = pretty . shelleyBasedToCardanoEra
+  pretty = pretty . toCardanoEra
 
 instance ToJSON (ShelleyBasedEra era) where
-   toJSON = toJSON . shelleyBasedToCardanoEra
+   toJSON = toJSON . toCardanoEra
 
 instance TestEquality ShelleyBasedEra where
     testEquality ShelleyBasedEraShelley ShelleyBasedEraShelley = Just Refl
@@ -306,15 +305,6 @@ inAnyShelleyBasedEra :: ()
 inAnyShelleyBasedEra sbe a =
   shelleyBasedEraConstraints sbe $ InAnyShelleyBasedEra sbe a
 
--- | Converts a 'ShelleyBasedEra' to the broader 'CardanoEra'.
-shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era
-shelleyBasedToCardanoEra ShelleyBasedEraShelley = ShelleyEra
-shelleyBasedToCardanoEra ShelleyBasedEraAllegra = AllegraEra
-shelleyBasedToCardanoEra ShelleyBasedEraMary    = MaryEra
-shelleyBasedToCardanoEra ShelleyBasedEraAlonzo  = AlonzoEra
-shelleyBasedToCardanoEra ShelleyBasedEraBabbage = BabbageEra
-shelleyBasedToCardanoEra ShelleyBasedEraConway  = ConwayEra
-
 -- ----------------------------------------------------------------------------
 -- Conversion to Shelley ledger library types
 --

cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ShelleyEraOnly
   ( ShelleyEraOnly(..)
   , shelleyEraOnlyConstraints
-  , shelleyEraOnlyToCardanoEra
   , shelleyEraOnlyToShelleyBasedEra
 
   , ShelleyEraOnlyConstraints
@@ -99,9 +98,6 @@ shelleyEraOnlyConstraints :: ()
 shelleyEraOnlyConstraints = \case
   ShelleyEraOnlyShelley  -> id
 
-shelleyEraOnlyToCardanoEra :: ShelleyEraOnly era -> CardanoEra era
-shelleyEraOnlyToCardanoEra = shelleyBasedToCardanoEra . shelleyEraOnlyToShelleyBasedEra
-
 shelleyEraOnlyToShelleyBasedEra :: ShelleyEraOnly era -> ShelleyBasedEra era
 shelleyEraOnlyToShelleyBasedEra = \case
   ShelleyEraOnlyShelley  -> ShelleyBasedEraShelley

cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ShelleyToAllegraEra
   ( ShelleyToAllegraEra(..)
   , shelleyToAllegraEraConstraints
-  , shelleyToAllegraEraToCardanoEra
   , shelleyToAllegraEraToShelleyBasedEra
 
   , ShelleyToAllegraEraConstraints
@@ -102,9 +101,6 @@ shelleyToAllegraEraConstraints = \case
   ShelleyToAllegraEraShelley -> id
   ShelleyToAllegraEraAllegra -> id
 
-shelleyToAllegraEraToCardanoEra :: ShelleyToAllegraEra era -> CardanoEra era
-shelleyToAllegraEraToCardanoEra = shelleyBasedToCardanoEra . shelleyToAllegraEraToShelleyBasedEra
-
 shelleyToAllegraEraToShelleyBasedEra :: ShelleyToAllegraEra era -> ShelleyBasedEra era
 shelleyToAllegraEraToShelleyBasedEra = \case
   ShelleyToAllegraEraShelley -> ShelleyBasedEraShelley

cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ShelleyToAlonzoEra
   ( ShelleyToAlonzoEra(..)
   , shelleyToAlonzoEraConstraints
-  , shelleyToAlonzoEraToCardanoEra
   , shelleyToAlonzoEraToShelleyBasedEra
 
   , ShelleyToAlonzoEraConstraints
@@ -103,9 +102,6 @@ shelleyToAlonzoEraConstraints = \case
   ShelleyToAlonzoEraMary    -> id
   ShelleyToAlonzoEraAlonzo  -> id
 
-shelleyToAlonzoEraToCardanoEra :: ShelleyToAlonzoEra era -> CardanoEra era
-shelleyToAlonzoEraToCardanoEra = shelleyBasedToCardanoEra . shelleyToAlonzoEraToShelleyBasedEra
-
 shelleyToAlonzoEraToShelleyBasedEra :: ShelleyToAlonzoEra era -> ShelleyBasedEra era
 shelleyToAlonzoEraToShelleyBasedEra = \case
   ShelleyToAlonzoEraShelley -> ShelleyBasedEraShelley

cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ShelleyToBabbageEra
   ( ShelleyToBabbageEra(..)
   , shelleyToBabbageEraConstraints
-  , shelleyToBabbageEraToCardanoEra
   , shelleyToBabbageEraToShelleyBasedEra
 
   , ShelleyToBabbageEraConstraints
@@ -105,9 +104,6 @@ shelleyToBabbageEraConstraints = \case
   ShelleyToBabbageEraAlonzo  -> id
   ShelleyToBabbageEraBabbage -> id
 
-shelleyToBabbageEraToCardanoEra :: ShelleyToBabbageEra era -> CardanoEra era
-shelleyToBabbageEraToCardanoEra = shelleyBasedToCardanoEra . shelleyToBabbageEraToShelleyBasedEra
-
 shelleyToBabbageEraToShelleyBasedEra :: ShelleyToBabbageEra era -> ShelleyBasedEra era
 shelleyToBabbageEraToShelleyBasedEra = \case
   ShelleyToBabbageEraShelley -> ShelleyBasedEraShelley

cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs

@@ -11,7 +11,6 @@
 module Cardano.Api.Eon.ShelleyToMaryEra
   ( ShelleyToMaryEra(..)
   , shelleyToMaryEraConstraints
-  , shelleyToMaryEraToCardanoEra
   , shelleyToMaryEraToShelleyBasedEra
 
   , ShelleyToMaryEraConstraints
@@ -101,9 +100,6 @@ shelleyToMaryEraConstraints = \case
   ShelleyToMaryEraAllegra -> id
   ShelleyToMaryEraMary    -> id
 
-shelleyToMaryEraToCardanoEra :: ShelleyToMaryEra era -> CardanoEra era
-shelleyToMaryEraToCardanoEra = shelleyBasedToCardanoEra . shelleyToMaryEraToShelleyBasedEra
-
 shelleyToMaryEraToShelleyBasedEra :: ShelleyToMaryEra era -> ShelleyBasedEra era
 shelleyToMaryEraToShelleyBasedEra = \case
   ShelleyToMaryEraShelley -> ShelleyBasedEraShelley

cardano-api/internal/Cardano/Api/Feature.hs

@@ -48,4 +48,4 @@ asFeaturedInShelleyBasedEra :: ()
   => a
   -> ShelleyBasedEra era
   -> Maybe (Featured eon era a)
-asFeaturedInShelleyBasedEra value = asFeaturedInEra value . shelleyBasedToCardanoEra
+asFeaturedInShelleyBasedEra value = asFeaturedInEra value . toCardanoEra

cardano-api/internal/Cardano/Api/Fees.hs

@@ -328,7 +328,7 @@ evaluateTransactionFee :: forall era. ()
   -> L.Coin
 evaluateTransactionFee sbe pp txbody keywitcount byronwitcount refScriptsSize =
   shelleyBasedEraConstraints sbe $
-    case makeSignedTransaction' (shelleyBasedToCardanoEra sbe) [] txbody of
+    case makeSignedTransaction' (toCardanoEra sbe) [] txbody of
       ShelleyTx _ tx ->
           L.estimateMinFeeTx pp tx (fromIntegral keywitcount) (fromIntegral byronwitcount) refScriptsSize
 
@@ -353,7 +353,7 @@ calculateMinTxFee :: forall era. ()
   -> L.Coin
 calculateMinTxFee sbe pp utxo txbody keywitcount =
   shelleyBasedEraConstraints sbe $
-    case makeSignedTransaction' (shelleyBasedToCardanoEra sbe) [] txbody of
+    case makeSignedTransaction' (toCardanoEra sbe) [] txbody of
       ShelleyTx _ tx ->
         L.calcMinFeeTx (toLedgerUTxO sbe utxo) pp tx (fromIntegral keywitcount)
 
@@ -1102,7 +1102,7 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame
     return (BalancedTxBody finalTxBodyContent txbody3 (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee)
  where
    era :: CardanoEra era
-   era = shelleyBasedToCardanoEra sbe
+   era = toCardanoEra sbe
 
 -- | In the event of spending the exact amount of lovelace in
 -- the specified input(s), this function excludes the change