Merge pull request #261 from input-output-hk/newhoggy/replace-TxScrip…

…tValiditySupportedInEra

Replace `TxScriptValiditySupportedInEra`

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

@@ -747,9 +747,10 @@ genMaybeFeaturedInEra f =
     pure Nothing <|> fmap Just (genFeaturedInEra w (f w))
 
 genTxScriptValidity :: CardanoEra era -> Gen (TxScriptValidity era)
-genTxScriptValidity era = case txScriptValiditySupportedInCardanoEra era of
-  Nothing -> pure TxScriptValidityNone
-  Just witness -> TxScriptValidity witness <$> genScriptValidity
+genTxScriptValidity =
+  inEonForEra
+    (pure TxScriptValidityNone)
+    (\w -> TxScriptValidity w <$> genScriptValidity)
 
 genScriptValidity :: Gen ScriptValidity
 genScriptValidity = Gen.element [ScriptInvalid, ScriptValid]

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

@@ -14,6 +14,8 @@
 -- not export any from this API. We also use them unticked as nature intended.
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
+{- HLINT ignore "Avoid lambda using `infix`" -}
+
 -- | Complete, signed transactions
 --
 module Cardano.Api.Tx (
@@ -50,7 +52,6 @@ module Cardano.Api.Tx (
 
 import           Cardano.Api.Address
 import           Cardano.Api.Certificate
-import           Cardano.Api.Eon.AlonzoEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras
 import           Cardano.Api.Eras.Constraints
@@ -445,49 +446,33 @@ getTxBody :: forall era. Tx era -> TxBody era
 getTxBody (ByronTx Byron.ATxAux { Byron.aTaTx = txbody }) =
     ByronTxBody txbody
 
-getTxBody (ShelleyTx sbe tx') =
-    case sbe of
-      ShelleyBasedEraShelley -> getShelleyTxBody tx'
-      ShelleyBasedEraAllegra -> getShelleyTxBody tx'
-      ShelleyBasedEraMary    -> getShelleyTxBody tx'
-      ShelleyBasedEraAlonzo  -> getAlonzoTxBody AlonzoEraOnwardsAlonzo TxScriptValiditySupportedInAlonzoEra tx'
-      ShelleyBasedEraBabbage -> getAlonzoTxBody AlonzoEraOnwardsBabbage TxScriptValiditySupportedInBabbageEra tx'
-      ShelleyBasedEraConway  -> getAlonzoTxBody AlonzoEraOnwardsConway TxScriptValiditySupportedInConwayEra tx'
-  where
-    getShelleyTxBody :: forall ledgerera.
-                        ShelleyLedgerEra era ~ ledgerera
-                     => Ledger.EraTx ledgerera
-                     => L.Tx ledgerera
-                     -> TxBody era
-    getShelleyTxBody tx =
-      let txBody     = tx ^. L.bodyTxL
-          txAuxData  = tx ^. L.auxDataTxL
-          scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL
-      in ShelleyTxBody sbe txBody
-                    (Map.elems scriptWits)
-                    TxBodyNoScriptData
-                    (strictMaybeToMaybe txAuxData)
-                    TxScriptValidityNone
-
-    getAlonzoTxBody :: forall ledgerera.
-                       ShelleyLedgerEra era ~ ledgerera
-                    => L.AlonzoEraTx ledgerera
-                    => AlonzoEraOnwards era
-                    -> TxScriptValiditySupportedInEra era
-                    -> L.Tx ledgerera
-                    -> TxBody era
-    getAlonzoTxBody w txScriptValidityInEra tx =
+getTxBody (ShelleyTx sbe tx) =
+  caseShelleyToMaryOrAlonzoEraOnwards
+    ( const $
+        let txBody     = tx ^. L.bodyTxL
+            txAuxData  = tx ^. L.auxDataTxL
+            scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL
+        in ShelleyTxBody sbe txBody
+            (Map.elems scriptWits)
+            TxBodyNoScriptData
+            (strictMaybeToMaybe txAuxData)
+            TxScriptValidityNone
+    )
+    (\w ->
       let txBody       = tx ^. L.bodyTxL
           txAuxData    = tx ^. L.auxDataTxL
           scriptWits   = tx ^. L.witsTxL . L.scriptTxWitsL
           datsWits     = tx ^. L.witsTxL . L.datsTxWitsL
           redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL
           isValid      = tx ^. L.isValidTxL
       in ShelleyTxBody sbe txBody
-                    (Map.elems scriptWits)
-                    (TxBodyScriptData w datsWits redeemerWits)
-                    (strictMaybeToMaybe txAuxData)
-                    (TxScriptValidity txScriptValidityInEra (isValidToScriptValidity isValid))
+          (Map.elems scriptWits)
+          (TxBodyScriptData w datsWits redeemerWits)
+          (strictMaybeToMaybe txAuxData)
+          (TxScriptValidity w (isValidToScriptValidity isValid))
+    )
+    sbe
+
 
 getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
 getTxWitnesses (ByronTx Byron.ATxAux { Byron.aTaWitness = witnesses }) =

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

@@ -58,7 +58,6 @@ module Cardano.Api.TxBody (
     TxBodyError(..),
     TxBodyScriptData(..),
     TxScriptValidity(..),
-    TxScriptValiditySupportedInEra(..),
 
     ScriptValidity(..),
     scriptValidityToIsValid,
@@ -120,8 +119,6 @@ module Cardano.Api.TxBody (
     -- ** Feature availability functions
     collateralSupportedInEra,
     auxScriptsSupportedInEra,
-    txScriptValiditySupportedInShelleyBasedEra,
-    txScriptValiditySupportedInCardanoEra,
 
     -- * Inspecting 'ScriptWitness'es
     AnyScriptWitness(..),
@@ -298,50 +295,25 @@ isValidToScriptValidity (L.IsValid True) = ScriptValid
 -- The Alonzo and subsequent eras support script validity.
 --
 data TxScriptValidity era where
-  TxScriptValidityNone :: TxScriptValidity era
+  TxScriptValidityNone
+    :: TxScriptValidity era
 
   -- | Tx script validity is supported in transactions in the 'Alonzo' era onwards.
   TxScriptValidity
-    :: TxScriptValiditySupportedInEra era
+    :: AlonzoEraOnwards era
     -> ScriptValidity
     -> TxScriptValidity era
 
-deriving instance Eq   (TxScriptValiditySupportedInEra era)
-deriving instance Show (TxScriptValiditySupportedInEra era)
-
-data TxScriptValiditySupportedInEra era where
-  TxScriptValiditySupportedInAlonzoEra  :: TxScriptValiditySupportedInEra AlonzoEra
-  TxScriptValiditySupportedInBabbageEra :: TxScriptValiditySupportedInEra BabbageEra
-  TxScriptValiditySupportedInConwayEra  :: TxScriptValiditySupportedInEra ConwayEra
-
 deriving instance Eq   (TxScriptValidity era)
 deriving instance Show (TxScriptValidity era)
 
-txScriptValiditySupportedInCardanoEra :: CardanoEra era -> Maybe (TxScriptValiditySupportedInEra era)
-txScriptValiditySupportedInCardanoEra ByronEra   = Nothing
-txScriptValiditySupportedInCardanoEra ShelleyEra = Nothing
-txScriptValiditySupportedInCardanoEra AllegraEra = Nothing
-txScriptValiditySupportedInCardanoEra MaryEra    = Nothing
-txScriptValiditySupportedInCardanoEra AlonzoEra  = Just TxScriptValiditySupportedInAlonzoEra
-txScriptValiditySupportedInCardanoEra BabbageEra = Just TxScriptValiditySupportedInBabbageEra
-txScriptValiditySupportedInCardanoEra ConwayEra = Just TxScriptValiditySupportedInConwayEra
-
-txScriptValiditySupportedInShelleyBasedEra :: ShelleyBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraShelley = Nothing
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAllegra = Nothing
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraMary    = Nothing
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAlonzo  = Just TxScriptValiditySupportedInAlonzoEra
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraBabbage = Just TxScriptValiditySupportedInBabbageEra
-txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraConway = Just TxScriptValiditySupportedInConwayEra
-
 txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
 txScriptValidityToScriptValidity TxScriptValidityNone = ScriptValid
 txScriptValidityToScriptValidity (TxScriptValidity _ scriptValidity) = scriptValidity
 
 scriptValidityToTxScriptValidity :: ShelleyBasedEra era -> ScriptValidity -> TxScriptValidity era
-scriptValidityToTxScriptValidity sbe scriptValidity = case txScriptValiditySupportedInShelleyBasedEra sbe of
-  Nothing -> TxScriptValidityNone
-  Just witness -> TxScriptValidity witness scriptValidity
+scriptValidityToTxScriptValidity sbe scriptValidity =
+  inShelleyBasedEraEon sbe TxScriptValidityNone $ \w -> TxScriptValidity w scriptValidity
 
 txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid
 txScriptValidityToIsValid = scriptValidityToIsValid . txScriptValidityToScriptValidity
@@ -1807,13 +1779,14 @@ deserialiseShelleyBasedTxBody sbe bs =
               (flip CBOR.runAnnotator fbs (return TxScriptValidityNone))
         4 -> do
           sValiditySupported <-
-            case txScriptValiditySupportedInShelleyBasedEra sbe of
-              Nothing -> fail $ mconcat
-                [ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
-                , "script validity flag but got: "
-                , show sbe
-                ]
-              Just supported -> return supported
+            inShelleyBasedEraEon sbe
+              ( fail $ mconcat
+                  [ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
+                  , "script validity flag but got: "
+                  , show sbe
+                  ]
+              )
+              pure
 
           txbody     <- CBOR.decCBOR
           txscripts  <- CBOR.decCBOR
@@ -1838,13 +1811,14 @@ deserialiseShelleyBasedTxBody sbe bs =
               pure
 
           sValiditySupported <-
-            case txScriptValiditySupportedInShelleyBasedEra sbe of
-              Nothing -> fail $ mconcat
-                [ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
-                , "script validity flag but got: "
-                , show sbe
-                ]
-              Just supported -> return supported
+            inShelleyBasedEraEon sbe
+              ( fail $ mconcat
+                  [ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
+                  , "script validity flag but got: "
+                  , show sbe
+                  ]
+              )
+              pure
 
           txbody    <- CBOR.decCBOR
           txscripts <- CBOR.decCBOR

cardano-api/src/Cardano/Api.hs

@@ -417,10 +417,7 @@ module Cardano.Api (
     TxBodyErrorAutoBalance(..),
     TxScriptValidity(..),
     ScriptValidity(..),
-    TxScriptValiditySupportedInEra(..),
     scriptValidityToTxScriptValidity,
-    txScriptValiditySupportedInShelleyBasedEra,
-    txScriptValiditySupportedInCardanoEra,
     txScriptValidityToScriptValidity,
 
     -- * Signing transactions