WIP: redundant JSON constraint

IntersectMBO · Jan 19, 2024 · ea0835d · ea0835d
1 parent a2c8bef
commit ea0835d
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 6 deletions.
diff --git a/cabal.project b/cabal.project
@@ -20,8 +20,8 @@ packages:
     cardano-api
     cardano-api-gen
 
-package cardano-api
-  ghc-options: -Werror
+-- package cardano-api
+--   ghc-options: -Werror
 
 package cardano-api-gen
   ghc-options: -Werror

diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs
@@ -47,6 +47,7 @@ import qualified Cardano.Ledger.BaseTypes as L
 import           Cardano.Ledger.Binary (FromCBOR)
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.Shelley.API.Mempool as L
 import qualified Cardano.Ledger.Shelley.Rules as L
 import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
@@ -212,9 +213,10 @@ type ShelleyBasedEraConstraints era =
   , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
   , IsCardanoEra era
   , IsShelleyBasedEra era
-  , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
-  , ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era)))
-  , ToJSON (L.PredicateFailure (L.EraRule "UTXOW" (ShelleyLedgerEra era)))
+ -- TODO: GHC complains these constraints are redundant for specific eras
+ -- , ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
+ -- , ToJSON (L.ShelleyLedgerPredFailure (ShelleyLedgerEra era))
+ -- , ToJSON (L.PredicateFailure (L.EraRule "UTXOW" (ShelleyLedgerEra era)))
   , Typeable era
   )
 

diff --git a/cardano-api/internal/Cardano/Api/InMode.hs b/cardano-api/internal/Cardano/Api/InMode.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -36,6 +37,8 @@ import           Cardano.Api.Tx.Sign
 import           Cardano.Api.Utils (textShow)
 
 import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.Shelley.Rules as L
 import qualified Ouroboros.Consensus.Byron.Ledger as Consensus
 import qualified Ouroboros.Consensus.Cardano.Block as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
@@ -262,7 +265,7 @@ appTxErrToJson :: ()
   => ShelleyBasedEra era
   -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
   -> Aeson.Value
-appTxErrToJson w e = shelleyBasedEraConstraints w $ toJSON e
+appTxErrToJson w (Consensus.ApplyTxError e) = shelleyBasedEraConstraints w $ toJSON e
 
 -- | A 'TxValidationError' in one of the eras supported by a given protocol
 -- mode.