Example refactored

IntersectMBO · Dec 13, 2023 · aa3ec2c · aa3ec2c
1 parent 5259d54
commit aa3ec2c
Showing 1 changed file with 10 additions and 30 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Protocol/Version.hs b/cardano-api/internal/Cardano/Api/Protocol/Version.hs
@@ -60,58 +60,38 @@ protocolVersionToSbe ExperimentalProtocolVersion = ShelleyBasedEraConway
 
 -- An Example
 validateTxBodyContent'
-  :: ShelleyBasedEra era
+  :: VersionToEra version ~ era
+  => SomeProtocolVersion version
   -> TxBodyContent BuildTx era
   -> Either TxBodyError ()
-validateTxBodyContent' sbe txBodContent@TxBodyContent {
+validateTxBodyContent' p txBodContent@TxBodyContent {
                              txIns,
                              txInsCollateral,
                              txOuts,
                              txProtocolParams,
                              txMintValue,
                              txMetadata} =
-  let witnesses = collectTxBodyScriptWitnesses sbe txBodContent
+
+  let sbe = protocolVersionToSbe p
+      witnesses = collectTxBodyScriptWitnesses sbe txBodContent
       languages = Set.fromList
                     [ toAlonzoLanguage (AnyPlutusScriptVersion v)
                     | (_, AnyScriptWitness (PlutusScriptWitness _ v _ _ _ _)) <- witnesses
                     ]
-  in case sbe of
-       ShelleyBasedEraShelley -> do
-         validateTxIns txIns
-         guardShelleyTxInsOverflow (map fst txIns)
-         validateTxOuts sbe txOuts
-         validateMetadata txMetadata
-       ShelleyBasedEraAllegra -> do
-         validateTxIns txIns
-         guardShelleyTxInsOverflow (map fst txIns)
-         validateTxOuts sbe txOuts
-         validateMetadata txMetadata
-       ShelleyBasedEraMary -> do
-         validateTxIns txIns
-         guardShelleyTxInsOverflow (map fst txIns)
-         validateTxOuts sbe txOuts
-         validateMetadata txMetadata
-         validateMintValue txMintValue
-       ShelleyBasedEraAlonzo -> do
-         validateTxIns txIns
-         guardShelleyTxInsOverflow (map fst txIns)
-         validateTxOuts sbe txOuts
-         validateMetadata txMetadata
-         validateMintValue txMintValue
-         validateTxInsCollateral txInsCollateral languages
-         validateProtocolParameters txProtocolParams languages
-       ShelleyBasedEraBabbage -> do
+  in case p of
+       CurrentProtocolVersion -> do
          validateTxIns txIns
          guardShelleyTxInsOverflow (map fst txIns)
          validateTxOuts sbe txOuts
          validateMetadata txMetadata
          validateMintValue txMintValue
          validateTxInsCollateral txInsCollateral languages
          validateProtocolParameters txProtocolParams languages
-       ShelleyBasedEraConway -> do
+       ExperimentalProtocolVersion -> do
          validateTxIns txIns
          validateTxOuts sbe txOuts
          validateMetadata txMetadata
          validateMintValue txMintValue
          validateTxInsCollateral txInsCollateral languages
          validateProtocolParameters txProtocolParams languages
+