pull txScripts into toBabbageTx fix suggestions

mlabs-haskell · Feb 13, 2023 · b617e44 · b617e44
1 parent 0f7311d
commit b617e44
Show file tree

Hide file tree

Showing 3 changed files with 7 additions and 10 deletions.
diff --git a/cardano-simple/cardano-simple.cabal b/cardano-simple/cardano-simple.cabal
@@ -45,6 +45,7 @@ common lang
     LambdaCase
     MultiParamTypeClasses
     NumericUnderscores
+    OverloadedRecordDot
     OverloadedStrings
     RecordWildCards
     ScopedTypeVariables

diff --git a/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs b/cardano-simple/src/Cardano/Simple/Cardano/Babbage.hs
@@ -57,23 +57,23 @@ type Era = BabbageEra StandardCrypto
 
 instance IsCardanoTx Era where
   getTxBody = C.body
-  toCardanoTx n p e tx = toBabbageTx (Plutus.txScripts tx) n p e tx
+  toCardanoTx = toBabbageTx
   toTxOut = toBabbageTxOut
 
 toBabbageTx ::
-  Map P.ScriptHash (C.Versioned P.Script) ->
   Network ->
   C.BabbagePParams Era ->
   P.Extra ->
   Plutus.Tx ->
   Either ToCardanoError (C.AlonzoTx Era)
-toBabbageTx scriptMap network params extra tx = do
+toBabbageTx network params extra tx = do
   body <- getBody
   wits <- toWits (hashAnnotated body) extra tx
   let isValid = C.IsValid True -- TODO or maybe False
       auxData = C.SNothing
   pure $ C.AlonzoTx body wits isValid auxData
   where
+    scriptMap = Plutus.txScripts tx
     getBody = do
       spendInputs <- getInputsBy Plutus.txInputs tx
       collateralInputs <- getInputsBy Plutus.txCollateral tx

diff --git a/psm/src/Plutus/Model/Mock.hs b/psm/src/Plutus/Model/Mock.hs
@@ -587,16 +587,12 @@ checkSingleTx params extra tx = do
     checkBalance = do
       utxos <- gets mockUtxos
       network <- gets $ mockConfigNetworkId . mockConfig
-      balance <- case txBalance @era utxos params network tx extra of
+      case txBalance @era utxos params network tx extra of
         Left err -> throwError $ FailToCardano err
-        case txBalance @era utxos params network tx extra of
-          Left err -> throwError $ FailToCardano err
-          Right bal -> when
+        Right bal ->
+          when
             (bal /= mempty)
             (throwError $ NotBalancedTx $ fromCardanoValue bal)
-      when
-        (balance /= mempty)
-        (throwError $ NotBalancedTx $ fromCardanoValue balance)
 
     evalScripts :: Validate Alonzo.ExUnits
     evalScripts = do