Merge pull request #1236 from IntersectMBO/jordan/remove-caseByronToAlonzoOrBabbageEraOnwards

Remove caseByronToAlonzoOrBabbageEraOnwards and simplify value ops

Author: Jimbo4350

.changes/20260615_remove_caseByronToAlonzoOrBabbageEraOnwards.yml

@@ -0,0 +1,9 @@
+project: cardano-api
+
+pr: 1236
+
+kind:
+  - maintenance
+
+description: |
+  Remove caseByronToAlonzoOrBabbageEraOnwards, replacing usages with caseShelleyToAlonzoOrBabbageEraOnwards. Simplify adaAssetL, mkAdaValue, and negateLedgerValue using the Val typeclass (coin, modifyCoin, invert), dropping the groups dependency.

cardano-api/cardano-api.cabal

@@ -164,7 +164,6 @@ library
     extra,
     filepath,
     formatting,
-    groups,
     iproute,
     memory,
     mempack,

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -1002,7 +1002,7 @@ genTxBodyContent sbe = do
   txIns <-
     map (,BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
   txInsCollateral <- genTxInsCollateral era
-  txInsReference <- genTxInsReference era
+  txInsReference <- genTxInsReference sbe
   txOuts <- Gen.list (Range.constant 1 10) (genTxOutTxContext sbe)
   txTotalCollateral <- genTxTotalCollateral era
   txReturnCollateral <- genTxReturnCollateral sbe
@@ -1062,10 +1062,10 @@ genTxInsCollateral =
 
 genTxInsReference
   :: Applicative (BuildTxWith build)
-  => CardanoEra era
+  => ShelleyBasedEra era
   -> Gen (TxInsReference build era)
 genTxInsReference =
-  caseByronToAlonzoOrBabbageEraOnwards
+  caseShelleyToAlonzoOrBabbageEraOnwards
     (const (pure TxInsReferenceNone))
     ( \w -> do
         txIns <- Gen.list (Range.linear 0 10) genTxIn

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

@@ -69,7 +69,6 @@ module Cardano.Api.Era
   , caseByronOrShelleyBasedEra
 
     -- ** Case on ShelleyBasedEra
-  , caseByronToAlonzoOrBabbageEraOnwards
   , caseShelleyToAllegraOrMaryEraOnwards
   , caseShelleyToMaryOrAlonzoEraOnwards
   , caseShelleyToAlonzoOrBabbageEraOnwards

cardano-api/src/Cardano/Api/Era/Internal/Case.hs

@@ -6,7 +6,6 @@
 module Cardano.Api.Era.Internal.Case
   ( -- Case on CardanoEra
     caseByronOrShelleyBasedEra
-  , caseByronToAlonzoOrBabbageEraOnwards
   -- Case on ShelleyBasedEra
   , caseShelleyEraOnlyOrAllegraEraOnwards
   , caseShelleyToAllegraOrMaryEraOnwards
@@ -20,7 +19,6 @@ import Cardano.Api.Era.Internal.Core
 import Cardano.Api.Era.Internal.Eon.AllegraEraOnwards
 import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards
 import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards
-import Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra
 import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
 import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
@@ -49,24 +47,6 @@ caseByronOrShelleyBasedEra l r = \case
   ConwayEra -> r ShelleyBasedEraConway
   DijkstraEra -> error "TODO Dijkstra: caseByronOrShelleyBasedEra: era not supported"
 
--- | @caseByronToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to byron, shelley, allegra, mary, and alonzo;
--- and @g@ to babbage and later eras.
-caseByronToAlonzoOrBabbageEraOnwards
-  :: ()
-  => (ByronToAlonzoEraConstraints era => ByronToAlonzoEra era -> a)
-  -> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-  -> CardanoEra era
-  -> a
-caseByronToAlonzoOrBabbageEraOnwards l r = \case
-  ByronEra -> l ByronToAlonzoEraByron
-  ShelleyEra -> l ByronToAlonzoEraShelley
-  AllegraEra -> l ByronToAlonzoEraAllegra
-  MaryEra -> l ByronToAlonzoEraMary
-  AlonzoEra -> l ByronToAlonzoEraAlonzo
-  BabbageEra -> r BabbageEraOnwardsBabbage
-  ConwayEra -> r BabbageEraOnwardsConway
-  DijkstraEra -> error "TODO Dijkstra: caseByronToAlonzoOrBabbageEraOnwards: era not supported"
-
 -- | @caseShelleyEraOnlyOrAllegraEraOnwards f g era@ applies @f@ to shelley;
 -- and applies @g@ to allegra and later eras.
 caseShelleyEraOnlyOrAllegraEraOnwards

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

@@ -1655,16 +1655,20 @@ deriving instance Eq (ReferenceScript era)
 
 deriving instance Show (ReferenceScript era)
 
-instance IsCardanoEra era => ToJSON (ReferenceScript era) where
+-- IsShelleyBasedEra constraint is incorrect. Deprecation and removal of this
+-- entire module in favour of the experimental api is the long term solution to this problem.
+instance IsShelleyBasedEra era => ToJSON (ReferenceScript era) where
   toJSON (ReferenceScript _ s) = object ["referenceScript" .= s]
   toJSON ReferenceScriptNone = Aeson.Null
 
-instance IsCardanoEra era => FromJSON (ReferenceScript era) where
+-- IsShelleyBasedEra constraint is incorrect. Deprecation and removal of this
+-- entire module in favour of the experimental api is the long term solution to this problem.
+instance IsShelleyBasedEra era => FromJSON (ReferenceScript era) where
   parseJSON = Aeson.withObject "ReferenceScript" $ \o ->
-    caseByronToAlonzoOrBabbageEraOnwards
+    caseShelleyToAlonzoOrBabbageEraOnwards
       (const (pure ReferenceScriptNone))
       (\w -> ReferenceScript w <$> o .: "referenceScript")
-      (cardanoEra :: CardanoEra era)
+      (shelleyBasedEra :: ShelleyBasedEra era)
 
 refScriptToShelleyScript
   :: ShelleyBasedEra era

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

@@ -52,7 +52,6 @@ import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
 import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Era.Internal.Eon.ShelleyEraOnly
-import Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra
 import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra
 import Cardano.Api.Internal.Orphans ()
 
@@ -64,6 +63,7 @@ import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Mary.Value qualified as L
 import Cardano.Ledger.Shelley.PParams qualified as L
 import Cardano.Ledger.TxIn qualified as L
+import Cardano.Ledger.Val qualified as L
 
 import Data.OSet.Strict qualified as L
 import Data.Sequence.Strict qualified as L
@@ -219,29 +219,15 @@ mkBasicTxOut sbe addr value =
 
 mkAdaValue :: ShelleyBasedEra era -> L.Coin -> L.Value (ShelleyLedgerEra era)
 mkAdaValue sbe coin =
-  caseShelleyToAllegraOrMaryEraOnwards
-    (const coin)
-    (const (L.MaryValue coin mempty))
-    sbe
+  shelleyBasedEraConstraints sbe $
+    L.modifyCoin (const coin) mempty
 
 adaAssetL :: ShelleyBasedEra era -> Lens' (L.Value (ShelleyLedgerEra era)) L.Coin
 adaAssetL sbe =
-  caseShelleyToAllegraOrMaryEraOnwards
-    adaAssetShelleyToAllegraEraL
-    adaAssetMaryEraOnwardsL
-    sbe
-
-adaAssetShelleyToAllegraEraL
-  :: ShelleyToAllegraEra era -> Lens' (L.Value (ShelleyLedgerEra era)) L.Coin
-adaAssetShelleyToAllegraEraL w =
-  shelleyToAllegraEraConstraints w $ lens id const
-
-adaAssetMaryEraOnwardsL :: MaryEraOnwards era -> Lens' L.MaryValue L.Coin
-adaAssetMaryEraOnwardsL w =
-  maryEraOnwardsConstraints w $
+  shelleyBasedEraConstraints sbe $
     lens
-      (\(L.MaryValue c _) -> c)
-      (\(L.MaryValue _ ma) c -> L.MaryValue c ma)
+      L.coin
+      (\v c -> L.modifyCoin (const c) v)
 
 multiAssetL
   :: MaryEraOnwards era -> Lens' L.MaryValue L.MultiAsset

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

@@ -79,7 +79,6 @@ import Cardano.Api.Parser.Text qualified as P
 import Cardano.Api.Plutus.Internal.Script
 import Cardano.Api.Serialise.Raw
 import Cardano.Api.Serialise.SerialiseUsing
-import Cardano.Api.Tx.Internal.Body.Lens qualified as A
 
 import Cardano.Chain.Common qualified as Byron
 import Cardano.Ledger.Allegra.Core qualified as L
@@ -88,6 +87,7 @@ import Cardano.Ledger.Mary.TxOut as Mary (scaledMinDeposit)
 import Cardano.Ledger.Mary.Value (MaryValue (..))
 import Cardano.Ledger.Mary.Value qualified as L
 import Cardano.Ledger.Mary.Value qualified as Mary
+import Cardano.Ledger.Val qualified as L
 
 import Data.Aeson (FromJSON, FromJSONKey, ToJSON, object, parseJSON, toJSON, withObject)
 import Data.Aeson qualified as Aeson
@@ -99,8 +99,6 @@ import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Short qualified as Short
 import Data.Data (Data)
-import Data.Function ((&))
-import Data.Group (invert)
 import Data.List qualified as List
 import Data.Map.Merge.Strict qualified as Map
 import Data.Map.Strict (Map)
@@ -109,7 +107,6 @@ import Data.MonoTraversable
 import Data.Text (Text)
 import Data.Text qualified as Text
 import GHC.Exts (IsList (..))
-import Lens.Micro ((%~))
 
 toByronLovelace :: Lovelace -> Maybe Byron.Lovelace
 toByronLovelace (L.Coin x) =
@@ -295,11 +292,7 @@ negateValue (Value m) = Value (Map.map negate m)
 
 negateLedgerValue
   :: ShelleyBasedEra era -> L.Value (ShelleyLedgerEra era) -> L.Value (ShelleyLedgerEra era)
-negateLedgerValue sbe v =
-  caseShelleyToAllegraOrMaryEraOnwards
-    (\_ -> v & A.adaAssetL sbe %~ L.Coin . negate . L.unCoin)
-    (\w -> v & A.multiAssetL w %~ invert)
-    sbe
+negateLedgerValue sbe v = shelleyBasedEraConstraints sbe $ L.invert v
 
 filterValue :: (AssetId -> Bool) -> Value -> Value
 filterValue p (Value m) = Value (Map.filterWithKey (\k _v -> p k) m)