Merge pull request #275 from input-output-hk/newhoggy/replace-TxTotal…

…AndReturnCollateralSupportedInEra

Replace `TxTotalAndReturnCollateralSupportedInEra`

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

@@ -707,17 +707,15 @@ genTxInsReference =
 
 genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era)
 genTxReturnCollateral era =
-  case totalAndReturnCollateralSupportedInEra  era of
-    Nothing -> return TxReturnCollateralNone
-    Just supp ->
-      TxReturnCollateral supp <$>  genTxOutTxContext era
+  forEraInEon era
+    (pure TxReturnCollateralNone)
+    (\w -> TxReturnCollateral w <$>  genTxOutTxContext era)
 
 genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era)
-genTxTotalCollateral era =
-  case totalAndReturnCollateralSupportedInEra  era of
-    Nothing -> return TxTotalCollateralNone
-    Just supp ->
-      TxTotalCollateral supp <$> genPositiveLovelace
+genTxTotalCollateral =
+  inEonForEra
+    (pure TxTotalCollateralNone)
+    (\w -> TxTotalCollateral w <$> genPositiveLovelace)
 
 genTxFee :: CardanoEra era -> Gen (TxFee era)
 genTxFee =

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -71,6 +71,7 @@ type ConwayEraOnwardsConstraints era =
   , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
   , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
   , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.BabbageEraTxBody (ShelleyLedgerEra era)
   , L.ConwayEraGov (ShelleyLedgerEra era)
   , L.ConwayEraPParams (ShelleyLedgerEra era)
   , L.ConwayEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Fees.hs

@@ -46,6 +46,7 @@ module Cardano.Api.Fees (
 
 import           Cardano.Api.Address
 import           Cardano.Api.Certificate
+import           Cardano.Api.Eon.BabbageEraOnwards
 import           Cardano.Api.Eon.ByronToAllegraEra
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
@@ -1000,14 +1001,14 @@ makeTransactionBodyAutoBalance systemstart history lpp@(LedgerProtocolParameters
                           mnkeys
         fee   = evaluateTransactionFee pp txbody1 nkeys 0 --TODO: byron keys
         (retColl, reqCol) =
-           case totalAndReturnCollateralSupportedInEra era' of
-             Just supInEra ->
-               obtainAlonzoEraPParams supInEra $
-                 calcReturnAndTotalCollateral supInEra
-                   fee pp (txInsCollateral txbodycontent)
-                   (txReturnCollateral txbodycontent)
-                   (txTotalCollateral txbodycontent) changeaddr utxo
-             Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone)
+           caseShelleyToAlonzoOrBabbageEraOnwards
+            (const (TxReturnCollateralNone, TxTotalCollateralNone))
+            (\w ->
+              calcReturnAndTotalCollateral w
+                fee pp (txInsCollateral txbodycontent) (txReturnCollateral txbodycontent)
+                (txTotalCollateral txbodycontent) changeaddr utxo
+            )
+            sbe
 
     -- Make a txbody for calculating the balance. For this the size of the tx
     -- does not matter, instead it's just the values of the fee and outputs.
@@ -1059,32 +1060,35 @@ makeTransactionBodyAutoBalance systemstart history lpp@(LedgerProtocolParameters
      case txInsCollateral of
        TxInsCollateralNone -> (TxReturnCollateralNone, TxTotalCollateralNone)
        TxInsCollateral{} ->
-         case totalAndReturnCollateralSupportedInEra era' of
-           Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone)
-           Just retColSup ->
-             let dummyRetCol = TxReturnCollateral
-                                 retColSup
-                                 (TxOut cAddr (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1)
-                                 TxOutDatumNone ReferenceScriptNone)
-                 dummyTotCol = TxTotalCollateral retColSup (Lovelace (2^(32 :: Integer) - 1))
-             in case (txReturnCollateral, txTotalCollateral) of
-                  (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) -> (rc, tc)
-                  (rc@TxReturnCollateral{},TxTotalCollateralNone) -> (rc, dummyTotCol)
-                  (TxReturnCollateralNone,tc@TxTotalCollateral{}) -> (dummyRetCol, tc)
-                  (TxReturnCollateralNone, TxTotalCollateralNone) -> (dummyRetCol, dummyTotCol)
+         forEraInEon era'
+            (TxReturnCollateralNone, TxTotalCollateralNone)
+            (\w ->
+              let dummyRetCol =
+                    TxReturnCollateral w
+                    ( TxOut cAddr
+                        (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1)
+                        TxOutDatumNone ReferenceScriptNone
+                    )
+                  dummyTotCol = TxTotalCollateral w (Lovelace (2^(32 :: Integer) - 1))
+              in case (txReturnCollateral, txTotalCollateral) of
+                (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) -> (rc, tc)
+                (rc@TxReturnCollateral{},TxTotalCollateralNone) -> (rc, dummyTotCol)
+                (TxReturnCollateralNone,tc@TxTotalCollateral{}) -> (dummyRetCol, tc)
+                (TxReturnCollateralNone, TxTotalCollateralNone) -> (dummyRetCol, dummyTotCol)
+            )
    -- Calculation taken from validateInsufficientCollateral: https://github.com/input-output-hk/cardano-ledger/blob/389b266d6226dedf3d2aec7af640b3ca4984c5ea/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs#L335
    -- TODO: Bug Jared to expose a function from the ledger that returns total and return collateral.
-   calcReturnAndTotalCollateral
-     :: Ledger.AlonzoEraPParams (ShelleyLedgerEra era)
-     => TxTotalAndReturnCollateralSupportedInEra era
-     -> Lovelace -- ^ Fee
-     -> Ledger.PParams (ShelleyLedgerEra era)
-     -> TxInsCollateral era -- ^ From the initial TxBodyContent
-     -> TxReturnCollateral CtxTx era -- ^ From the initial TxBodyContent
-     -> TxTotalCollateral era -- ^ From the initial TxBodyContent
-     -> AddressInEra era -- ^ Change address
-     -> UTxO era
-     -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
+   calcReturnAndTotalCollateral :: ()
+      => Ledger.AlonzoEraPParams (ShelleyLedgerEra era)
+      => BabbageEraOnwards era
+      -> Lovelace -- ^ Fee
+      -> Ledger.PParams (ShelleyLedgerEra era)
+      -> TxInsCollateral era -- ^ From the initial TxBodyContent
+      -> TxReturnCollateral CtxTx era -- ^ From the initial TxBodyContent
+      -> TxTotalCollateral era -- ^ From the initial TxBodyContent
+      -> AddressInEra era -- ^ Change address
+      -> UTxO era
+      -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
    calcReturnAndTotalCollateral _ _ _ TxInsCollateralNone _ _ _ _= (TxReturnCollateralNone, TxTotalCollateralNone)
    calcReturnAndTotalCollateral _ _ _ _ rc@TxReturnCollateral{} tc@TxTotalCollateral{} _ _ = (rc,tc)
    calcReturnAndTotalCollateral retColSup fee pp' (TxInsCollateral _ collIns) txReturnCollateral txTotalCollateral cAddr (UTxO utxo') = do
@@ -1335,10 +1339,3 @@ calculateMinimumUTxO sbe txout pp =
    calcMinUTxO pp' txOut =
       let txOutWithMinCoin = L.setMinCoinTxOut pp' txOut
       in fromShelleyLovelace (txOutWithMinCoin ^. L.coinTxOutL)
-
-obtainAlonzoEraPParams
-  :: TxTotalAndReturnCollateralSupportedInEra era
-  -> (Ledger.AlonzoEraPParams (ShelleyLedgerEra era) => a )
-  -> a
-obtainAlonzoEraPParams TxTotalAndReturnCollateralInBabbageEra f = f
-obtainAlonzoEraPParams TxTotalAndReturnCollateralInConwayEra f = f

cardano-api/internal/Cardano/Api/TxBody.hs

@@ -120,7 +120,6 @@ module Cardano.Api.TxBody (
     ValidityLowerBoundSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
     TxExtraKeyWitnessesSupportedInEra(..),
-    TxTotalAndReturnCollateralSupportedInEra(..),
 
     -- ** Feature availability functions
     collateralSupportedInEra,
@@ -131,7 +130,6 @@ module Cardano.Api.TxBody (
     extraKeyWitnessesSupportedInEra,
     txScriptValiditySupportedInShelleyBasedEra,
     txScriptValiditySupportedInCardanoEra,
-    totalAndReturnCollateralSupportedInEra,
 
     -- * Inspecting 'ScriptWitness'es
     AnyScriptWitness(..),
@@ -1203,44 +1201,30 @@ prettyRenderTxOut (TxOutInAnyEra _ (TxOut (AddressInEra _ addr) txOutVal _ _)) =
 
 data TxReturnCollateral ctx era where
 
-     TxReturnCollateralNone :: TxReturnCollateral ctx era
+  TxReturnCollateralNone
+    :: TxReturnCollateral ctx era
 
-     TxReturnCollateral     :: TxTotalAndReturnCollateralSupportedInEra era
-                            -> TxOut ctx era
-                            -> TxReturnCollateral ctx era
+  TxReturnCollateral
+    :: BabbageEraOnwards era
+    -> TxOut ctx era
+    -> TxReturnCollateral ctx era
 
 deriving instance Eq   (TxReturnCollateral ctx era)
 deriving instance Show (TxReturnCollateral ctx era)
 
 data TxTotalCollateral era where
 
-     TxTotalCollateralNone :: TxTotalCollateral era
+  TxTotalCollateralNone
+    :: TxTotalCollateral era
 
-     TxTotalCollateral     :: TxTotalAndReturnCollateralSupportedInEra era
-                           -> Lovelace
-                           -> TxTotalCollateral era
+  TxTotalCollateral
+    :: BabbageEraOnwards era
+    -> Lovelace
+    -> TxTotalCollateral era
 
 deriving instance Eq   (TxTotalCollateral era)
 deriving instance Show (TxTotalCollateral era)
 
-data TxTotalAndReturnCollateralSupportedInEra era where
-
-     TxTotalAndReturnCollateralInBabbageEra :: TxTotalAndReturnCollateralSupportedInEra BabbageEra
-     TxTotalAndReturnCollateralInConwayEra :: TxTotalAndReturnCollateralSupportedInEra ConwayEra
-
-deriving instance Eq   (TxTotalAndReturnCollateralSupportedInEra era)
-deriving instance Show (TxTotalAndReturnCollateralSupportedInEra era)
-
-totalAndReturnCollateralSupportedInEra
-  :: CardanoEra era -> Maybe (TxTotalAndReturnCollateralSupportedInEra era)
-totalAndReturnCollateralSupportedInEra ByronEra = Nothing
-totalAndReturnCollateralSupportedInEra ShelleyEra = Nothing
-totalAndReturnCollateralSupportedInEra AllegraEra = Nothing
-totalAndReturnCollateralSupportedInEra MaryEra = Nothing
-totalAndReturnCollateralSupportedInEra AlonzoEra = Nothing
-totalAndReturnCollateralSupportedInEra BabbageEra = Just TxTotalAndReturnCollateralInBabbageEra
-totalAndReturnCollateralSupportedInEra ConwayEra = Just TxTotalAndReturnCollateralInConwayEra
-
 -- ----------------------------------------------------------------------------
 -- Transaction output datum (era-dependent)
 --
@@ -2659,42 +2643,28 @@ fromLedgerTxTotalCollateral
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxTotalCollateral era
 fromLedgerTxTotalCollateral sbe txbody =
-  case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra sbe of
-    Nothing -> TxTotalCollateralNone
-    Just supp ->
-      case obtainTotalCollateralHasFieldConstraint supp $ txbody ^. L.totalCollateralTxBodyL of
+  caseShelleyToAlonzoOrBabbageEraOnwards
+    (const TxTotalCollateralNone)
+    (\w ->
+      case txbody ^. L.totalCollateralTxBodyL of
         SNothing -> TxTotalCollateralNone
-        SJust totColl -> TxTotalCollateral supp $ fromShelleyLovelace totColl
- where
-  obtainTotalCollateralHasFieldConstraint
-    :: TxTotalAndReturnCollateralSupportedInEra era
-    -> (L.BabbageEraTxBody (ShelleyLedgerEra era) => a)
-    -> a
-  obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f
-  obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInConwayEra f = f
+        SJust totColl -> TxTotalCollateral w $ fromShelleyLovelace totColl
+    )
+    sbe
 
 fromLedgerTxReturnCollateral
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxReturnCollateral CtxTx era
 fromLedgerTxReturnCollateral sbe txbody =
-  case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra sbe of
-    Nothing -> TxReturnCollateralNone
-    Just supp ->
-      case obtainBabbageEraTxOutConstraint supp $ txbody ^. L.collateralReturnTxBodyL of
+  caseShelleyToAlonzoOrBabbageEraOnwards
+    (const TxReturnCollateralNone)
+    (\w ->
+      case txbody ^. L.collateralReturnTxBodyL of
         SNothing -> TxReturnCollateralNone
-        SJust collReturnOut ->
-          TxReturnCollateral supp $ fromShelleyTxOut sbe collReturnOut
- where
-  obtainBabbageEraTxOutConstraint
-    :: TxTotalAndReturnCollateralSupportedInEra era
-    -> ((L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-        , L.BabbageEraTxBody (ShelleyLedgerEra era)
-        ) => a)
-    -> a
-  obtainBabbageEraTxOutConstraint TxTotalAndReturnCollateralInBabbageEra f = f
-  obtainBabbageEraTxOutConstraint TxTotalAndReturnCollateralInConwayEra f = f
-
+        SJust collReturnOut -> TxReturnCollateral w $ fromShelleyTxOut sbe collReturnOut
+    )
+    sbe
 
 fromLedgerTxFee
   :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxFee era

cardano-api/src/Cardano/Api.hs

@@ -393,7 +393,6 @@ module Cardano.Api (
     ValidityLowerBoundSupportedInEra(..),
     AuxScriptsSupportedInEra(..),
     TxExtraKeyWitnessesSupportedInEra(..),
-    TxTotalAndReturnCollateralSupportedInEra(..),
 
     -- ** Feature availability functions
     collateralSupportedInEra,
@@ -402,7 +401,6 @@ module Cardano.Api (
     validityLowerBoundSupportedInEra,
     auxScriptsSupportedInEra,
     extraKeyWitnessesSupportedInEra,
-    totalAndReturnCollateralSupportedInEra,
 
     -- ** Era-dependent protocol features
     ProtocolUTxOCostPerByteFeature(..),