Add HasCallStack constraints to functions containing error calls

.changes/20260414_cardano_api_has_callstack.yml

@@ -0,0 +1,8 @@
+project: cardano-api
+pr: 1175
+kind:
+  - compatible
+description: |
+  Add HasCallStack constraints to standalone functions that call error
+  directly or indirectly, improving stack traces. Dijkstra-era placeholder
+  error messages are also improved.

cardano-api/src/Cardano/Api/Certificate/Internal.hs

@@ -826,7 +826,7 @@ getAnchorDataFromCertificate c =
           Ledger.RetirePoolTxCert _ _ -> return Nothing
           Ledger.GenesisDelegTxCert{} -> return Nothing
           Ledger.MirTxCert _ -> return Nothing
-          _ -> error "dijkstra"
+          _ -> error "getAnchorDataFromCertificate: Dijkstra era not supported"
     ConwayCertificate ceo ccert ->
       conwayEraOnwardsConstraints ceo $
         case ccert of
@@ -843,7 +843,7 @@ getAnchorDataFromCertificate c =
           Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
           Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing
           Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
-          _ -> error "dijkstra"
+          _ -> error "getAnchorDataFromCertificate: Dijkstra era not supported"
  where
   anchorDataFromPoolMetadata
     :: MonadError AnchorDataFromCertificateError m

cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs

@@ -37,6 +37,7 @@ import Cardano.Protocol.Crypto (StandardCrypto)
 import Cardano.Protocol.TPraos.OCert qualified as Shelley
 
 import Data.Word
+import GHC.Stack (HasCallStack)
 
 -- ----------------------------------------------------------------------------
 -- Operational certificates
@@ -107,7 +108,8 @@ instance Error OperationalCertIssueError where
 -- TODO: include key ids
 
 issueOperationalCertificate
-  :: VerificationKey KesKey
+  :: HasCallStack
+  => VerificationKey KesKey
   -> Either
        AnyStakePoolSigningKey
        (SigningKey GenesisDelegateExtendedKey)

cardano-api/src/Cardano/Api/Experimental/Tx.hs

@@ -264,7 +264,8 @@ hashTxBody
 hashTxBody = L.extractHash . L.hashAnnotated
 
 makeKeyWitness
-  :: Era era
+  :: HasCallStack
+  => Era era
   -> UnsignedTx (LedgerEra era)
   -> ShelleyWitnessSigningKey
   -> L.WitVKey L.Witness

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs

@@ -125,7 +125,7 @@ getPlutusDatum
 getPlutusDatum L.SPlutusV1 (SpendingScriptDatum d) = Just d
 getPlutusDatum L.SPlutusV2 (SpendingScriptDatum d) = Just d
 getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d
-getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "dijkstra"
+getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "getPlutusDatum: Dijkstra era not supported"
 getPlutusDatum _ InlineDatum = Nothing
 getPlutusDatum _ NoScriptDatum = Nothing
 

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs

@@ -170,6 +170,7 @@ import Data.Set qualified as Set
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (cast)
 import GHC.Exts (IsList (..))
+import GHC.Stack (HasCallStack)
 import Lens.Micro
 
 -- | Error that can occur when constructing an unsigned transaction.
@@ -538,7 +539,8 @@ legacyDatumToDatum OldApi.TxOutDatumNone = Nothing
 
 fromLegacyTxOut
   :: forall era
-   . IsEra era
+   . HasCallStack
+  => IsEra era
   => OldApi.TxOut CtxTx era
   -> Either DatumDecodingError (TxOut (LedgerEra era), Map L.DataHash (L.Data (LedgerEra era)))
 fromLegacyTxOut tOut@(OldApi.TxOut _ _ d _) = do

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Compatible.hs

@@ -71,7 +71,7 @@ makeStakeAddressDelegationCertificate sCred delegatee =
     e@ShelleyBasedEraMary -> cert e delegatee
     e@ShelleyBasedEraAllegra -> cert e delegatee
     e@ShelleyBasedEraShelley -> cert e delegatee
-    ShelleyBasedEraDijkstra -> error "TODO: makeStakeAddressDelegationCertificate DijkstraEra"
+    ShelleyBasedEraDijkstra -> error "makeStakeAddressDelegationCertificate: Dijkstra era not supported"
  where
   cert
     :: Delegatee era ~ Api.Hash Api.StakePoolKey

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs

@@ -751,7 +751,8 @@ instance Error FeeCalculationError where
 -- In practice convergence occurs within 2–3 iterations.
 calcMinFeeRecursive
   :: forall era
-   . IsEra era
+   . HasCallStack
+  => IsEra era
   => L.Addr
   -- ^ Change address. Any surplus value (ADA and/or native tokens) is
   -- sent to a new output at this address, appended at the end of the

cardano-api/src/Cardano/Api/Genesis/Internal/Parameters.hs

@@ -25,6 +25,7 @@ import Cardano.Slotting.Slot (EpochSize (..))
 
 import Data.Time (NominalDiffTime, UTCTime)
 import Data.Word (Word64)
+import GHC.Stack (HasCallStack)
 
 -- ----------------------------------------------------------------------------
 -- Genesis parameters
@@ -74,7 +75,7 @@ data GenesisParameters era
 -- Conversion functions
 --
 
-fromShelleyGenesis :: Shelley.ShelleyGenesis -> GenesisParameters ShelleyEra
+fromShelleyGenesis :: HasCallStack => Shelley.ShelleyGenesis -> GenesisParameters ShelleyEra
 fromShelleyGenesis
   sg@Shelley.ShelleyGenesis
     { Shelley.sgSystemStart

cardano-api/src/Cardano/Api/Key/Internal/Class.hs

@@ -22,6 +22,7 @@ import Cardano.Crypto.Seed qualified as Crypto
 
 import Control.Monad.IO.Class
 import Data.Kind (Type)
+import GHC.Stack (HasCallStack)
 import System.Random (StdGen)
 import System.Random qualified as Random
 
@@ -77,7 +78,8 @@ generateSigningKey keytype = do
   seedSize = deterministicSigningKeySeedSize keytype
 
 generateInsecureSigningKey
-  :: MonadIO m
+  :: HasCallStack
+  => MonadIO m
   => Key keyrole
   => SerialiseAsRawBytes (SigningKey keyrole)
   => StdGen

cardano-api/src/Cardano/Api/LedgerState.hs

@@ -270,6 +270,7 @@ import Data.Word
 import Data.Yaml qualified as Yaml
 import Formatting.Buildable (build)
 import GHC.Exts (IsList (..))
+import GHC.Stack (HasCallStack)
 import Lens.Micro
 import Network.Mux qualified as Mux
 import Network.TypedProtocol.Core (Nat (..))
@@ -458,7 +459,7 @@ data FoldStatus
 -- the node's tip where @k@ is the security parameter.
 foldBlocks
   :: forall a t m
-   . ()
+   . HasCallStack
   => Show a
   => MonadIOTransError FoldBlocksError t m
   => NodeConfigFile 'In
@@ -715,7 +716,8 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = hand
 -- | Wrap a 'ChainSyncClient' with logic that tracks the ledger state.
 chainSyncClientWithLedgerState
   :: forall m a
-   . Monad m
+   . HasCallStack
+  => Monad m
   => Env
   -> LedgerState
   -- ^ Initial ledger state
@@ -859,7 +861,8 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie
 -- | See 'chainSyncClientWithLedgerState'.
 chainSyncClientPipelinedWithLedgerState
   :: forall m a
-   . Monad m
+   . HasCallStack
+  => Monad m
   => Env
   -> LedgerState
   -> ValidationMode
@@ -2308,7 +2311,8 @@ getLedgerTablesUTxOValues sbe tbs =
 -- provide a termination epoch otherwise blocks would be applied indefinitely.
 foldEpochState
   :: forall t m s
-   . MonadIOTransError FoldBlocksError t m
+   . HasCallStack
+  => MonadIOTransError FoldBlocksError t m
   => NodeConfigFile 'In
   -- ^ Path to the cardano-node config file (e.g. <path to cardano-node project>/configuration/cardano/mainnet-config.json)
   -> SocketPath

cardano-api/src/Cardano/Api/Network/Internal/NetworkId.hs

@@ -25,6 +25,8 @@ import Cardano.Crypto.ProtocolMagic qualified as Byron
 import Cardano.Ledger.BaseTypes qualified as Shelley (Network (..))
 import Ouroboros.Network.Magic (NetworkMagic (..))
 
+import GHC.Stack (HasCallStack)
+
 -- ----------------------------------------------------------------------------
 -- NetworkId type
 --
@@ -74,7 +76,7 @@ toShelleyNetwork :: NetworkId -> Shelley.Network
 toShelleyNetwork Mainnet = Shelley.Mainnet
 toShelleyNetwork (Testnet _) = Shelley.Testnet
 
-fromShelleyNetwork :: Shelley.Network -> NetworkMagic -> NetworkId
+fromShelleyNetwork :: HasCallStack => Shelley.Network -> NetworkMagic -> NetworkId
 fromShelleyNetwork Shelley.Testnet nm = Testnet nm
 fromShelleyNetwork Shelley.Mainnet nm
   | nm == mainnetNetworkMagic = Mainnet

cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs

@@ -1416,7 +1416,8 @@ toShelleyMultiSig = go
   go _ = Left MultiSigErrorTimelockNotsupported
 
 -- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
-fromShelleyMultiSig :: Shelley.MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
+fromShelleyMultiSig
+  :: Shelley.MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
 fromShelleyMultiSig = go
  where
   go (Shelley.RequireSignature kh) =
@@ -1425,7 +1426,7 @@ fromShelleyMultiSig = go
   go (Shelley.RequireAllOf s) = RequireAllOf (map go $ toList s)
   go (Shelley.RequireAnyOf s) = RequireAnyOf (map go $ toList s)
   go (Shelley.RequireMOf m s) = RequireMOf m (map go $ toList s)
-  go _ = error ""
+  go _ = error "fromShelleyMultiSig: Dijkstra era not supported"
 
 -- | Conversion for the 'Timelock.Timelock' language that is shared between the
 -- Allegra and Mary eras.
@@ -1459,7 +1460,7 @@ fromAllegraTimelock = go
   go (Shelley.RequireAllOf s) = RequireAllOf (map go (toList s))
   go (Shelley.RequireAnyOf s) = RequireAnyOf (map go (toList s))
   go (Shelley.RequireMOf i s) = RequireMOf i (map go (toList s))
-  go _ = error "dijkstra"
+  go _ = error "fromAllegraTimelock: Dijkstra era not supported"
 
 type family ToLedgerPlutusLanguage lang where
   ToLedgerPlutusLanguage PlutusScriptV1 = Plutus.PlutusV1

cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs

@@ -545,6 +545,7 @@ fromShelleyRewardAccounts =
 toConsensusQuery
   :: forall block result
    . ()
+  => HasCallStack
   => Consensus.CardanoBlock StandardCrypto ~ block
   => QueryInMode result
   -> Some (Consensus.Query block)
@@ -572,7 +573,7 @@ toConsensusQuery QueryLedgerConfig = Some Consensus.DebugLedgerConfig
 
 toConsensusQueryShelleyBased
   :: forall era protocol block result
-   . ()
+   . HasCallStack
   => ConsensusBlockForEra era ~ Consensus.ShelleyBlock protocol (ShelleyLedgerEra era)
   => Consensus.CardanoBlock StandardCrypto ~ block
   => L.EraGov (ShelleyLedgerEra era)

cardano-api/src/Cardano/Api/Tx/Internal/Body.hs

@@ -1185,7 +1185,7 @@ setTxTreasuryDonation
   :: Maybe (Featured ConwayEraOnwards era L.Coin) -> TxBodyContent build era -> TxBodyContent build era
 setTxTreasuryDonation v txBodyContent = txBodyContent{txTreasuryDonation = v}
 
-getTxIdByron :: Byron.ATxAux ByteString -> TxId
+getTxIdByron :: HasCallStack => Byron.ATxAux ByteString -> TxId
 getTxIdByron (Byron.ATxAux{Byron.aTaTx = txbody}) =
   TxId
     . fromMaybe impossible
@@ -1518,6 +1518,7 @@ maxShelleyTxInIx = fromIntegral $ maxBound @Word16
 {-# DEPRECATED createAndValidateTransactionBody "Use createTransactionBody instead" #-}
 createAndValidateTransactionBody
   :: ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> TxBodyContent BuildTx era
   -> Either TxBodyError (TxBody era)
@@ -2104,6 +2105,7 @@ mkCommonTxBody sbe txIns txOuts txFee txWithdrawals txAuxData =
 makeShelleyTransactionBody
   :: forall era
    . ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> TxBodyContent BuildTx era
   -> Either TxBodyError (TxBody era)
@@ -2660,7 +2662,7 @@ makeShelleyTransactionBody
 
     txAuxData :: Maybe (L.TxAuxData E.ConwayEra)
     txAuxData = toAuxiliaryData sbe txMetadata txAuxScripts
-makeShelleyTransactionBody ShelleyBasedEraDijkstra _ = error "makeShelleyTransactionBody: Dijkstra is not  supported"
+makeShelleyTransactionBody ShelleyBasedEraDijkstra _ = error "makeShelleyTransactionBody: Dijkstra era not supported"
 
 -- ----------------------------------------------------------------------------
 -- Script witnesses within the tx body

cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs

@@ -34,13 +34,15 @@ import Data.Map.Strict qualified as Map
 import Data.Set (Set)
 import Data.Text qualified as Text
 import GHC.Exts (IsList (..))
+import GHC.Stack (HasCallStack)
 
 -- | Construct a balanced transaction.
 -- See Cardano.Api.Query.Internal.Convenience.queryStateForBalancedTx for a
 -- convenient way of querying the node to get the required arguements
 -- for constructBalancedTx.
 constructBalancedTx
   :: ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> TxBodyContent BuildTx era
   -> AddressInEra era

cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs

@@ -124,7 +124,8 @@ instance Error (AutoBalanceError era) where
     AutoBalanceCalculationError e -> prettyError e
 
 estimateOrCalculateBalancedTxBody
-  :: ShelleyBasedEra era
+  :: HasCallStack
+  => ShelleyBasedEra era
   -> FeeEstimationMode era
   -> L.PParams (ShelleyLedgerEra era)
   -> TxBodyContent BuildTx era

cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs

@@ -115,6 +115,7 @@ import Data.Text qualified as Text
 import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 import Data.Validation qualified as Valid
 import GHC.Exts (IsList (..))
+import GHC.Stack (HasCallStack)
 import Lens.Micro
 
 -- ----------------------------------------------------------------------------
@@ -868,7 +869,8 @@ data ShelleySigningKey
     ShelleyExtendedSigningKey Crypto.HD.XPrv
 
 makeShelleySignature
-  :: Crypto.SignableRepresentation tosign
+  :: HasCallStack
+  => Crypto.SignableRepresentation tosign
   => tosign
   -> ShelleySigningKey
   -> (Crypto.SignedDSIGN Shelley.DSIGN) tosign
@@ -1086,6 +1088,7 @@ data WitnessNetworkIdOrByronAddress
 makeShelleyBootstrapWitness
   :: forall era
    . ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> WitnessNetworkIdOrByronAddress
   -> TxBody era
@@ -1098,6 +1101,7 @@ makeShelleyBootstrapWitness sbe nwOrAddr txBody sk =
 makeShelleyBasedBootstrapWitness
   :: forall era
    . ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> WitnessNetworkIdOrByronAddress
   -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era)
@@ -1181,6 +1185,7 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) =
 makeShelleyKeyWitness
   :: forall era
    . ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> TxBody era
   -> ShelleyWitnessSigningKey
@@ -1191,6 +1196,7 @@ makeShelleyKeyWitness sbe (ShelleyTxBody _ txBody _ _ _ _) =
 makeShelleyKeyWitness'
   :: forall era
    . ()
+  => HasCallStack
   => ShelleyBasedEra era
   -> L.TxBody L.TopTx (ShelleyLedgerEra era)
   -> ShelleyWitnessSigningKey

cardano-api/src/Cardano/Api/UTxO.hs

@@ -122,6 +122,7 @@ import Data.Set (Set)
 import Data.Text (Text)
 import Data.Tuple (uncurry)
 import GHC.Exts qualified as GHC
+import GHC.Stack (HasCallStack)
 import Text.Show
 
 newtype UTxO era = UTxO {unUTxO :: Map TxIn (TxOut CtxUTxO era)}
@@ -354,7 +355,8 @@ fromMap = UTxO
 --------------------------------------------------------------------}
 
 -- | Convert from a `cardano-api` `UTxO` to a `cardano-ledger` UTxO.
-toShelleyUTxO :: ShelleyBasedEra era -> UTxO era -> Ledger.UTxO (ShelleyLedgerEra era)
+toShelleyUTxO
+  :: HasCallStack => ShelleyBasedEra era -> UTxO era -> Ledger.UTxO (ShelleyLedgerEra era)
 toShelleyUTxO sbe =
   Ledger.UTxO . Map.foldMapWithKey f . unUTxO
  where