diff --git a/.changes/20260414_cardano_api_has_callstack.yml b/.changes/20260414_cardano_api_has_callstack.yml new file mode 100644 index 0000000000..a05fdc7ea4 --- /dev/null +++ b/.changes/20260414_cardano_api_has_callstack.yml @@ -0,0 +1,6 @@ +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. diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index c982e6ceb4..2f4c3c5f1d 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs b/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs index bf92db8683..4b45ffd48e 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal/OperationalCertificate.hs +++ b/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) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index a6bfbf4f60..f67964e269 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 655c425ab9..35a26a7999 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs index ccdb6005b5..78c895dbe0 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Compatible.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Compatible.hs index 72c5b93327..4bde59015c 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate/Compatible.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs index 1741f9617f..7610541e90 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal/Parameters.hs b/cardano-api/src/Cardano/Api/Genesis/Internal/Parameters.hs index ad30e7feea..5afbe0e409 100644 --- a/cardano-api/src/Cardano/Api/Genesis/Internal/Parameters.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Key/Internal/Class.hs b/cardano-api/src/Cardano/Api/Key/Internal/Class.hs index 07b22df659..509b555d78 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal/Class.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index a96f55ce9f..6fdacf70fc 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/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. /configuration/cardano/mainnet-config.json) -> SocketPath diff --git a/cardano-api/src/Cardano/Api/Network/Internal/NetworkId.hs b/cardano-api/src/Cardano/Api/Network/Internal/NetworkId.hs index bb4906a651..768b7ac4d6 100644 --- a/cardano-api/src/Cardano/Api/Network/Internal/NetworkId.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index ad36721474..686be600b1 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index 2e91880732..e467998d74 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/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) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index 1d1f057d1c..cf75a8e208 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs index 7dc30913e0..94df1beb8d 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs @@ -34,6 +34,7 @@ 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 @@ -41,6 +42,7 @@ import GHC.Exts (IsList (..)) -- for constructBalancedTx. constructBalancedTx :: () + => HasCallStack => ShelleyBasedEra era -> TxBodyContent BuildTx era -> AddressInEra era diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs index 6318629490..9564a13bbc 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index ee658b4a2e..74dc4f593c 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/UTxO.hs b/cardano-api/src/Cardano/Api/UTxO.hs index 57fecad654..599b140e74 100644 --- a/cardano-api/src/Cardano/Api/UTxO.hs +++ b/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