Add HasCallStack constraints to functions containing error calls

Add HasCallStack to functions that call error directly or indirectly
(via fromMaybe impossible), so that call stacks are captured in error
messages. For class methods (castVerificationKey, deterministicSigningKey),
the constraint is placed on individual instance methods that actually
call error, rather than on the class method itself. Also improve
Dijkstra-era placeholder error messages to be more descriptive.

Author: Jimbo4350

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

@@ -55,6 +55,7 @@ import Data.ByteString.Lazy qualified as LB
 import Data.Either.Combinators
 import Data.Text qualified as Text
 import Formatting (build, formatToString)
+import GHC.Stack (HasCallStack)
 
 -- | Byron-era payment keys. Used for Byron addresses and witnessing
 -- transactions that spend from these addresses.
@@ -195,7 +196,8 @@ instance Key ByronKeyLegacy where
     deriving newtype (ToCBOR, FromCBOR)
     deriving anyclass SerialiseAsCBOR
 
-  deterministicSigningKey :: AsType ByronKeyLegacy -> Crypto.Seed -> SigningKey ByronKeyLegacy
+  deterministicSigningKey
+    :: HasCallStack => AsType ByronKeyLegacy -> Crypto.Seed -> SigningKey ByronKeyLegacy
   deterministicSigningKey _ _ = error "Please generate a non legacy Byron key instead"
 
   deterministicSigningKeySeedSize :: AsType ByronKeyLegacy -> Word

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/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/Key/Internal.hs

@@ -81,6 +81,7 @@ import Data.ByteString qualified as BS
 import Data.Either.Combinators (maybeToRight)
 import Data.Maybe
 import Data.String (IsString (..))
+import GHC.Stack (HasCallStack)
 
 --
 -- Shelley payment keys
@@ -330,6 +331,8 @@ instance HasTextEnvelope (SigningKey PaymentExtendedKey) where
   textEnvelopeType _ = "PaymentExtendedSigningKeyShelley_ed25519_bip32"
 
 instance CastVerificationKeyRole PaymentExtendedKey PaymentKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
   castVerificationKey (PaymentExtendedVerificationKey vk) =
     PaymentVerificationKey
       . Shelley.VKey
@@ -580,6 +583,7 @@ instance HasTextEnvelope (SigningKey StakeExtendedKey) where
   textEnvelopeType _ = "StakeExtendedSigningKeyShelley_ed25519_bip32"
 
 instance CastVerificationKeyRole StakeExtendedKey StakeKey where
+  castVerificationKey :: HasCallStack => VerificationKey StakeExtendedKey -> VerificationKey StakeKey
   castVerificationKey (StakeExtendedVerificationKey vk) =
     StakeVerificationKey
       . Shelley.VKey
@@ -1033,6 +1037,8 @@ instance SerialiseAsBech32 (SigningKey CommitteeColdExtendedKey) where
   bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_cold_xsk"]
 
 instance CastVerificationKeyRole CommitteeColdExtendedKey CommitteeColdKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey CommitteeColdExtendedKey -> VerificationKey CommitteeColdKey
   castVerificationKey (CommitteeColdExtendedVerificationKey vk) =
     CommitteeColdVerificationKey
       . Shelley.VKey
@@ -1168,6 +1174,8 @@ instance SerialiseAsBech32 (SigningKey CommitteeHotExtendedKey) where
   bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["cc_hot_xsk"]
 
 instance CastVerificationKeyRole CommitteeHotExtendedKey CommitteeHotKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey CommitteeHotExtendedKey -> VerificationKey CommitteeHotKey
   castVerificationKey (CommitteeHotExtendedVerificationKey vk) =
     CommitteeHotVerificationKey
       . Shelley.VKey
@@ -1307,6 +1315,8 @@ instance HasTextEnvelope (SigningKey GenesisExtendedKey) where
   textEnvelopeType _ = "GenesisExtendedSigningKey_ed25519_bip32"
 
 instance CastVerificationKeyRole GenesisExtendedKey GenesisKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey GenesisExtendedKey -> VerificationKey GenesisKey
   castVerificationKey (GenesisExtendedVerificationKey vk) =
     GenesisVerificationKey
       . Shelley.VKey
@@ -1556,6 +1566,8 @@ instance HasTextEnvelope (SigningKey GenesisDelegateExtendedKey) where
   textEnvelopeType _ = "GenesisDelegateExtendedSigningKey_ed25519_bip32"
 
 instance CastVerificationKeyRole GenesisDelegateExtendedKey GenesisDelegateKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey GenesisDelegateExtendedKey -> VerificationKey GenesisDelegateKey
   castVerificationKey (GenesisDelegateExtendedVerificationKey vk) =
     GenesisDelegateVerificationKey
       . Shelley.VKey
@@ -1966,6 +1978,8 @@ instance FromJSON (Hash StakePoolExtendedKey) where
       Right h -> pure h
 
 instance CastVerificationKeyRole StakePoolExtendedKey StakePoolKey where
+  castVerificationKey
+    :: HasCallStack => VerificationKey StakePoolExtendedKey -> VerificationKey StakePoolKey
   castVerificationKey (StakePoolExtendedVerificationKey vk) =
     StakePoolVerificationKey
       . Shelley.VKey
@@ -2225,6 +2239,7 @@ instance SerialiseAsBech32 (SigningKey DRepExtendedKey) where
   bech32PrefixesPermitted _ = unsafeHumanReadablePartFromText <$> ["drep_xsk"]
 
 instance CastVerificationKeyRole DRepExtendedKey DRepKey where
+  castVerificationKey :: HasCallStack => VerificationKey DRepExtendedKey -> VerificationKey DRepKey
   castVerificationKey (DRepExtendedVerificationKey vk) =
     DRepVerificationKey
       . Shelley.VKey

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

@@ -572,7 +572,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