Revert "Fix Query error in QueryStakeDelegDeposits when executing `…

…transaction build` IntersectMBO/cardano-cli#268"

This reverts commit 0783ea1.

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

@@ -32,34 +32,28 @@ import           Cardano.Api.Utils
 import           Cardano.Api.Value
 
 import qualified Cardano.Ledger.Api as L
-import           Cardano.Ledger.Binary (DecoderError)
 import qualified Cardano.Ledger.Credential as L
 import           Cardano.Ledger.DRepDistr (DRepState (..))
 import qualified Cardano.Ledger.Keys as L
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..))
 
 import           Control.Monad.Trans (MonadTrans (..))
-import           Control.Monad.Trans.Except
-import           Control.Monad.Trans.Except.Extra
-import           Data.Bifunctor (first)
+import           Control.Monad.Trans.Except (ExceptT (..), runExceptT)
+import           Control.Monad.Trans.Except.Extra (left, onLeft, onNothing)
 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 qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TL
-import qualified Formatting.Buildable as B
 
 data QueryConvenienceError
   = AcqFailure AcquiringFailure
   | QueryEraMismatch EraMismatch
   | ByronEraNotSupported
   | EraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra
   | QceUnsupportedNtcVersion !UnsupportedNtcVersionError
-  | QceDecoderError !DecoderError
   deriving Show
 
 renderQueryConvenienceError :: QueryConvenienceError -> Text
@@ -78,8 +72,6 @@ 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 (QceDecoderError decoderError) =
-  "Cannot decode serialized value returned from consensus query: " <> (TL.toStrict . TL.toLazyText . B.build $ decoderError)
 
 -- | A convenience function to query the relevant information, from
 -- the local node, for Cardano.Api.Convenience.Construction.constructBalancedTx
@@ -130,12 +122,9 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
     if null stakeCreds
       then pure mempty
       else do
-        serialisedStakeDelegDeposits <-
-          lift (queryStakeDelegDeposits qeInMode sbe stakeCreds)
-            & onLeft (left . QceUnsupportedNtcVersion)
-            & onLeft (left . QueryEraMismatch)
-        hoistEither $ decodeStakeDelegDeposits serialisedStakeDelegDeposits
-          & first QceDecoderError
+        lift (queryStakeDelegDeposits qeInMode sbe stakeCreds)
+          & onLeft (left . QceUnsupportedNtcVersion)
+          & onLeft (left . QueryEraMismatch)
 
   drepDelegDeposits <-
     Map.map (fromShelleyLovelace . drepDeposit) <$>

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

@@ -11,6 +11,8 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+
 -- | Fee calculation
 --
 module Cardano.Api.Fees (

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

@@ -134,7 +134,6 @@ import           Data.Aeson (ToJSON, object, toJSON, (.=))
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Map.Strict as Map
 import           Data.Void (Void)
-import           GHC.Stack
 
 -- ----------------------------------------------------------------------------
 -- The types for the client side of the node-to-client IPC protocols
@@ -215,8 +214,7 @@ connectToLocalNode localNodeConnectInfo handlers
 -- protocol handlers parameterized on the negotiated node-to-client protocol
 -- version.
 --
-connectToLocalNodeWithVersion :: HasCallStack
-                              => LocalNodeConnectInfo mode
+connectToLocalNodeWithVersion :: LocalNodeConnectInfo mode
                               -> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
                               -> IO ()
 connectToLocalNodeWithVersion LocalNodeConnectInfo {
@@ -402,8 +400,7 @@ data LocalNodeClientProtocolsForBlock block =
 -- | Convert from the mode-parametrised style to the block-parametrised style.
 --
 mkLocalNodeClientParams :: forall mode block.
-                           HasCallStack
-                        => ConsensusBlockForMode mode ~ block
+                           ConsensusBlockForMode mode ~ block
                         => ConsensusModeParams mode
                         -> (NodeToClientVersion -> LocalNodeClientProtocolsInMode mode)
                         -> LocalNodeClientParams
@@ -437,8 +434,7 @@ mkLocalNodeClientParams modeparams clients =
 
 
 convLocalNodeClientProtocols :: forall mode block.
-                                HasCallStack
-                             => ConsensusBlockForMode mode ~ block
+                                ConsensusBlockForMode mode ~ block
                              => ConsensusMode mode
                              -> LocalNodeClientProtocolsInMode mode
                              -> LocalNodeClientProtocolsForBlock block
@@ -519,7 +515,7 @@ convLocalTxSubmissionClient mode =
 
 convLocalStateQueryClient
   :: forall mode block m a.
-     (HasCallStack, ConsensusBlockForMode mode ~ block, Functor m)
+     (ConsensusBlockForMode mode ~ block, Functor m)
   => ConsensusMode mode
   -> LocalStateQueryClient (BlockInMode mode) ChainPoint (QueryInMode mode) m a
   -> LocalStateQueryClient block (Consensus.Point block)

cardano-api/internal/Cardano/Api/IPC/Monad.hs

@@ -20,7 +20,6 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Cont
-import           GHC.Stack
 
 {- HLINT ignore "Use const" -}
 {- HLINT ignore "Use let" -}
@@ -42,8 +41,7 @@ newtype LocalStateQueryExpr block point query r m a = LocalStateQueryExpr
 
 -- | Execute a local state query expression.
 executeLocalStateQueryExpr
-  :: HasCallStack
-  => LocalNodeConnectInfo mode
+  :: LocalNodeConnectInfo mode
   -> Maybe ChainPoint
   -> LocalStateQueryExpr (BlockInMode mode) ChainPoint (QueryInMode mode) () IO a
   -> IO (Either AcquiringFailure a)

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

@@ -57,9 +57,6 @@ module Cardano.Api.Query (
     StakeSnapshot(..),
     decodeStakeSnapshot,
 
-    SerialisedStakeDelegDeposits(..),
-    decodeStakeDelegDeposits,
-
     EraHistory(..),
     SystemStart(..),
 
@@ -147,7 +144,6 @@ import           Data.SOP.Constraint (SListI)
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Word (Word64)
-import           GHC.Stack
 
 
 -- ----------------------------------------------------------------------------
@@ -299,7 +295,7 @@ data QueryInShelleyBasedEra era result where
 
   QueryStakeDelegDeposits
     :: Set StakeCredential
-    -> QueryInShelleyBasedEra era (SerialisedStakeDelegDeposits era)
+    -> QueryInShelleyBasedEra era (Map StakeCredential Lovelace)
 
   QueryConstitution
     :: QueryInShelleyBasedEra era (Maybe (L.Constitution (ShelleyLedgerEra era)))
@@ -477,16 +473,6 @@ decodeStakeSnapshot
   -> Either DecoderError (StakeSnapshot era)
 decodeStakeSnapshot (SerialisedStakeSnapshots (Serialised ls)) = StakeSnapshot <$> Plain.decodeFull ls
 
-newtype SerialisedStakeDelegDeposits era
-  = SerialisedStakeDelegDeposits (Serialised (Map (Shelley.StakeCredential (Core.EraCrypto (ShelleyLedgerEra era))) Shelley.Coin))
-
-decodeStakeDelegDeposits
-  :: forall era. ()
-  => SerialisedStakeDelegDeposits era
-  -> Either DecoderError (Map StakeCredential Lovelace)
-decodeStakeDelegDeposits (SerialisedStakeDelegDeposits (Serialised sdd)) =
-  Map.map fromShelleyLovelace . Map.mapKeysMonotonic fromShelleyStakeCredential <$> Plain.decodeFull sdd
-
 toShelleyAddrSet :: CardanoEra era
                  -> Set AddressAny
                  -> Set (Shelley.Addr Consensus.StandardCrypto)
@@ -726,9 +712,7 @@ consensusQueryInEraInMode erainmode =
 -- Conversions of query results from the consensus types.
 --
 
-fromConsensusQueryResult :: forall mode block result result'.
-                            HasCallStack
-                         => ConsensusBlockForMode mode ~ block
+fromConsensusQueryResult :: forall mode block result result'. ConsensusBlockForMode mode ~ block
                          => QueryInMode mode result
                          -> Consensus.Query block result'
                          -> result'
@@ -858,8 +842,7 @@ fromConsensusQueryResult (QueryInEra ConwayEraInCardanoMode
 
 fromConsensusQueryResultShelleyBased
   :: forall era ledgerera protocol result result'.
-     HasCallStack
-  => ShelleyLedgerEra era ~ ledgerera
+     ShelleyLedgerEra era ~ ledgerera
   => Core.EraCrypto ledgerera ~ Consensus.StandardCrypto
   => ConsensusProtocol era ~ protocol
   => ShelleyBasedEra era
@@ -964,10 +947,12 @@ fromConsensusQueryResultShelleyBased _ QueryStakeSnapshot{} q' r' =
     Consensus.GetCBOR Consensus.GetStakeSnapshots {} -> SerialisedStakeSnapshots r'
     _                                                -> fromConsensusQueryResultMismatch
 
-fromConsensusQueryResultShelleyBased _ QueryStakeDelegDeposits{} q' r' =
-  case q' of
-    Consensus.GetCBOR Consensus.GetStakeDelegDeposits{} -> SerialisedStakeDelegDeposits r'
-    _                                                   -> fromConsensusQueryResultMismatch
+fromConsensusQueryResultShelleyBased _ QueryStakeDelegDeposits{} q' stakeCreds' =
+    case q' of
+      Consensus.GetStakeDelegDeposits{} -> Map.map fromShelleyLovelace
+                                         . Map.mapKeysMonotonic fromShelleyStakeCredential
+                                         $ stakeCreds'
+      _                                 -> fromConsensusQueryResultMismatch
 
 fromConsensusQueryResultShelleyBased _ QueryGovState{} q' govState' =
   case q' of
@@ -1003,9 +988,8 @@ fromConsensusQueryResultShelleyBased _ QueryCommitteeState{} q' committeeState'
 --
 -- Such mismatches should be preventable with an appropriate property test.
 --
-fromConsensusQueryResultMismatch :: HasCallStack => a
+fromConsensusQueryResultMismatch :: a
 fromConsensusQueryResultMismatch =
-  withFrozenCallStack $
     error "fromConsensusQueryResult: internal query mismatch"
 
 

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

@@ -167,7 +167,7 @@ queryStakeDelegDeposits :: ()
   => EraInMode era mode
   -> ShelleyBasedEra era
   -> Set StakeCredential
-  -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either Consensus.EraMismatch (SerialisedStakeDelegDeposits era)))
+  -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either Consensus.EraMismatch (Map StakeCredential Lovelace)))
 queryStakeDelegDeposits eraInMode sbe stakeCreds =
   queryExpr $ QueryInEra eraInMode . QueryInShelleyBasedEra sbe $ QueryStakeDelegDeposits stakeCreds