Pre refactor

IntersectMBO · Dec 13, 2023 · 5259d54 · 5259d54
1 parent 1d8b171
commit 5259d54
Showing 1 changed file with 57 additions and 3 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Protocol/Version.hs b/cardano-api/internal/Cardano/Api/Protocol/Version.hs
@@ -58,6 +58,60 @@ protocolVersionToSbe
 protocolVersionToSbe CurrentProtocolVersion = ShelleyBasedEraBabbage
 protocolVersionToSbe ExperimentalProtocolVersion = ShelleyBasedEraConway
 
-createSingleProtVerProxy
-  :: Proxy version -> SingleProtVer version
-createSingleProtVerProxy _ = SingleProtVer
+-- An Example
+validateTxBodyContent'
+  :: ShelleyBasedEra era
+  -> TxBodyContent BuildTx era
+  -> Either TxBodyError ()
+validateTxBodyContent' sbe txBodContent@TxBodyContent {
+                             txIns,
+                             txInsCollateral,
+                             txOuts,
+                             txProtocolParams,
+                             txMintValue,
+                             txMetadata} =
+  let 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
+         validateTxIns txIns
+         guardShelleyTxInsOverflow (map fst txIns)
+         validateTxOuts sbe txOuts
+         validateMetadata txMetadata
+         validateMintValue txMintValue
+         validateTxInsCollateral txInsCollateral languages
+         validateProtocolParameters txProtocolParams languages
+       ShelleyBasedEraConway -> do
+         validateTxIns txIns
+         validateTxOuts sbe txOuts
+         validateMetadata txMetadata
+         validateMintValue txMintValue
+         validateTxInsCollateral txInsCollateral languages
+         validateProtocolParameters txProtocolParams languages