Merge pull request #2822 from input-output-hk/jc/refactor-hashScriptI…

…ntegrity

refactor hashScriptIntegrity

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -19,7 +19,7 @@ import Cardano.Crypto.Hash.Class (Hash)
 import Cardano.Ledger.Address (Addr (..), bootstrapKeyHash, getRwdCred)
 import Cardano.Ledger.Alonzo.Data (DataHash)
 import Cardano.Ledger.Alonzo.Language (Language (..))
-import Cardano.Ledger.Alonzo.PParams (PParams' (..))
+import Cardano.Ledger.Alonzo.PParams (PParams' (..), getLanguageView)
 import Cardano.Ledger.Alonzo.PlutusScriptApi as Alonzo (language, scriptsNeeded)
 import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUTXO)
 import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo (UtxoEvent, UtxoPredicateFailure)
@@ -328,7 +328,8 @@ ppViewHashesMatch ::
   Test (UtxowPredicateFail era)
 ppViewHashesMatch tx txbody pp utxo = do
   let langs = languages @era tx utxo
-      computedPPhash = hashScriptIntegrity pp langs (txrdmrs . wits $ tx) (txdats . wits $ tx)
+      langViews = Set.map (getLanguageView pp) langs
+      computedPPhash = hashScriptIntegrity langViews (txrdmrs . wits $ tx) (txdats . wits $ tx)
       bodyPPhash = getField @"scriptIntegrityHash" txbody
   failureUnless
     (bodyPPhash == computedPPhash)

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs

@@ -76,15 +76,14 @@ import Cardano.Binary
 import Cardano.Crypto.DSIGN.Class (SigDSIGN, VerKeyDSIGN)
 import Cardano.Ledger.Address (Addr (..), RewardAcnt (..))
 import Cardano.Ledger.Alonzo.Data (Data, DataHash, hashData)
-import Cardano.Ledger.Alonzo.Language (Language (..), nonNativeLanguages)
+import Cardano.Ledger.Alonzo.Language (nonNativeLanguages)
 import Cardano.Ledger.Alonzo.PParams
   ( LangDepView (..),
     encodeLangViews,
     getLanguageView,
   )
 import Cardano.Ledger.Alonzo.Scripts
   ( CostModel,
-    CostModels,
     ExUnits (..),
     Prices,
     Script,
@@ -270,20 +269,15 @@ instance (Era era, c ~ Crypto era) => HashAnnotated (ScriptIntegrity era) EraInd
 
 hashScriptIntegrity ::
   forall era.
-  ( Era era,
-    HasField "_costmdls" (Core.PParams era) CostModels
-  ) =>
-  Core.PParams era ->
-  Set Language ->
+  Era era =>
+  Set LangDepView ->
   Redeemers era ->
   TxDats era ->
   StrictMaybe (ScriptIntegrityHash (Crypto era))
-hashScriptIntegrity pp langs rdmrs dats =
-  if nullRedeemers rdmrs && Set.null langs && nullDats dats
+hashScriptIntegrity langViews rdmrs dats =
+  if nullRedeemers rdmrs && Set.null langViews && nullDats dats
     then SNothing
-    else
-      let newset = Set.map (getLanguageView pp) langs
-       in SJust (hashAnnotated (ScriptIntegrity rdmrs dats newset))
+    else SJust (hashAnnotated (ScriptIntegrity rdmrs dats langViews))
 
 -- ===============================================================
 -- From the specification, Figure 5 "Functions related to fees"

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs

@@ -17,7 +17,7 @@ import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Data as Alonzo (AuxiliaryData (..), Data (..), DataHash)
 import Cardano.Ledger.Alonzo.Language (Language (..))
-import Cardano.Ledger.Alonzo.PParams (PParams' (..))
+import Cardano.Ledger.Alonzo.PParams (PParams' (..), getLanguageView)
 import qualified Cardano.Ledger.Alonzo.PParams as Alonzo (PParams, extendPP, retractPP)
 import Cardano.Ledger.Alonzo.PlutusScriptApi (scriptsNeededFromBody)
 import Cardano.Ledger.Alonzo.Rules.Utxo (utxoEntrySize, vKeyLocked)
@@ -287,7 +287,7 @@ genAlonzoTxBody _genenv utxo pparams currentslot input txOuts certs wdrls fee up
         minted2
         -- scriptIntegrityHash starts out with empty Redeemers,
         -- as Remdeemers are added it is recomputed in updateEraTxBody
-        (hashScriptIntegrity pparams (langsUsed @(AlonzoEra c) Map.empty) (Redeemers Map.empty) (TxDats Map.empty))
+        (hashScriptIntegrity @(AlonzoEra c) Set.empty (Redeemers Map.empty) (TxDats Map.empty))
         auxDHash
         netid,
       (List.map TimelockScript scriptsFromPolicies <> plutusScripts)
@@ -358,6 +358,8 @@ instance Mock c => EraGen (AlonzoEra c) where
   genEraTxBody = genAlonzoTxBody
   updateEraTxBody utxo pp witnesses txb coinx txin txout = new
     where
+      langs = langsUsed @(AlonzoEra c) (getField @"txscripts" witnesses)
+      langViews = Set.map (getLanguageView pp) langs
       new =
         txb
           { inputs = (inputs txb) <> txin,
@@ -367,8 +369,7 @@ instance Mock c => EraGen (AlonzoEra c) where
             -- The witnesses may have changed, recompute the scriptIntegrityHash.
             scriptIntegrityHash =
               hashScriptIntegrity
-                pp
-                (langsUsed @(AlonzoEra c) (getField @"txscripts" witnesses))
+                langViews
                 (getField @"txrdmrs" witnesses)
                 (getField @"txdats" witnesses)
           }

eras/shelley-ma/impl/cardano-ledger-shelley-ma.cabal

@@ -57,7 +57,6 @@ library
     cardano-crypto-class,
     cardano-data,
     cardano-ledger-core,
-    cardano-prelude,
     cardano-slotting,
     cborg,
     containers,

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs

@@ -30,10 +30,8 @@ import Cardano.Ledger.Alonzo.Tx
   ( IsValid (..),
     ScriptPurpose (..),
     ValidatedTx (..),
-    hashScriptIntegrity,
     minfee,
   )
-import Cardano.Ledger.Alonzo.TxBody (ScriptIntegrityHash)
 import Cardano.Ledger.Alonzo.TxInfo (TranslationError, VersionedTxInfo, txInfo, valContext)
 import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (..), Redeemers (..), TxDats (..), unRedeemers)
 import Cardano.Ledger.BHeaderView (BHeaderView (..))
@@ -1857,17 +1855,6 @@ alonzoAPITests =
 -- =====================================================================================
 -- Proof parameterized TestTrees
 
-hashScriptIntegrityByProof ::
-  Proof era ->
-  Core.PParams era ->
-  Set.Set Language ->
-  Redeemers era ->
-  TxDats era ->
-  StrictMaybe (ScriptIntegrityHash (Crypto era))
-hashScriptIntegrityByProof (Alonzo _) = hashScriptIntegrity
-hashScriptIntegrityByProof (Babbage _) = hashScriptIntegrity
-hashScriptIntegrityByProof _ = \_ _ _ _ -> SNothing
-
 -- | This type is what you get when you use runSTS in the UTXOW rule. It is also
 --   the type one uses for expected answers, to compare the 'computed' against 'expected'
 type Result era = Either [(PredicateFailure (Core.EraRule "UTXOW" era))] (State (Core.EraRule "UTXOW" era))
@@ -2157,17 +2144,17 @@ alonzoUTXOWexamplesB pf =
               ( Left
                   [ fromPredFail @era $
                       PPViewHashesDontMatch
-                        ( hashScriptIntegrityByProof
+                        ( newScriptIntegrityHash
                             pf
                             (pp pf)
-                            (Set.singleton PlutusV1)
+                            [PlutusV1]
                             (Redeemers mempty)
                             txDatsExample1
                         )
-                        ( hashScriptIntegrityByProof
+                        ( newScriptIntegrityHash
                             pf
                             (pp pf)
-                            (Set.singleton PlutusV1)
+                            [PlutusV1]
                             validatingRedeemersEx1
                             txDatsExample1
                         )

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs

@@ -18,16 +18,9 @@ import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.PParams (PParams, PParams' (..))
 import Cardano.Ledger.Alonzo.PlutusScriptApi (scriptsNeededFromBody)
 import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Tag (..))
-import Cardano.Ledger.Alonzo.Tx
-  ( IsValid (..),
-    ScriptIntegrityHash,
-    ValidatedTx (..),
-    hashScriptIntegrity,
-    minfee,
-  )
+import Cardano.Ledger.Alonzo.Tx (IsValid (..), ValidatedTx (..), minfee)
 import Cardano.Ledger.Alonzo.TxBody (TxOut (..))
 import Cardano.Ledger.Alonzo.TxInfo (languages)
-import Cardano.Ledger.Alonzo.TxWitness (Redeemers (..), TxDats (..))
 import qualified Cardano.Ledger.Babbage.PParams as Babbage (PParams, PParams' (..))
 import Cardano.Ledger.Babbage.Scripts (refScripts)
 import Cardano.Ledger.Babbage.TxBody as Babbage (referenceInputs', spendInputs')
@@ -178,17 +171,6 @@ txInBalance ::
   Coin
 txInBalance txinSet m = coin (balance (UTxO (restrictKeys m txinSet)))
 
-hashScriptIntegrity' ::
-  Proof era ->
-  Core.PParams era ->
-  Set Language ->
-  Redeemers era ->
-  TxDats era ->
-  StrictMaybe (ScriptIntegrityHash (Crypto era))
-hashScriptIntegrity' (Babbage _) = hashScriptIntegrity
-hashScriptIntegrity' (Alonzo _) = hashScriptIntegrity
-hashScriptIntegrity' _proof = (\_pp _l _r _d -> SNothing)
-
 -- | Break a TxOut into its mandatory and optional parts
 txoutFields :: Proof era -> Core.TxOut era -> (Addr (Crypto era), Core.Value era, [TxOutField era])
 txoutFields (Alonzo _) (TxOut addr val dh) = (addr, val, [DHash dh])

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/TxGen.hs

@@ -845,7 +845,7 @@ genValidatedTxAndInfo proof slot = do
 
   -- 7. Estimate the fee
   let redeemerDatumWits = redeemerWitsList ++ datumWitsList
-      bogusIntegrityHash = hashScriptIntegrity' proof gePParams mempty (Redeemers mempty) mempty
+      bogusIntegrityHash = newScriptIntegrityHash proof gePParams mempty (Redeemers mempty) mempty
       inputSet = Map.keysSet toSpendNoCollateral
       outputList = maybe recipients (: recipients) rewardsWithdrawalTxOut
       txBodyNoFee =
@@ -902,11 +902,12 @@ genValidatedTxAndInfo proof slot = do
 
   -- 10. Construct the correct Tx with valid fee and collaterals
   allPlutusScripts <- gsPlutusScripts <$> get
-  let mIntegrityHash =
-        hashScriptIntegrity'
+  let langs = Set.toList $ languagesUsed proof bogusTxForFeeCalc (UTxO utxoNoCollateral) allPlutusScripts
+      mIntegrityHash =
+        newScriptIntegrityHash
           proof
           gePParams
-          (languagesUsed proof bogusTxForFeeCalc (UTxO utxoNoCollateral) allPlutusScripts)
+          langs
           (mkTxrdmrs redeemerDatumWits)
           (mkTxdats redeemerDatumWits)
       balance =

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Updaters.hs

@@ -392,7 +392,7 @@ newPParams era = List.foldl' (updatePParams era) (initialPParams era)
 
 -- ====================================
 
--- | This only make sense in the Alonzo era, all other Eras return Nothing
+-- | This only make sense in the Alonzo era and forward, all other Eras return Nothing
 newScriptIntegrityHash ::
   Proof era ->
   Core.PParams era ->
@@ -401,11 +401,11 @@ newScriptIntegrityHash ::
   TxDats era ->
   StrictMaybe (Alonzo.ScriptIntegrityHash (Crypto era))
 newScriptIntegrityHash (Babbage _) pp ls rds dats =
-  case (hashScriptIntegrity pp (Set.fromList ls) rds dats) of
+  case (hashScriptIntegrity (Set.map (Alonzo.getLanguageView pp) (Set.fromList ls)) rds dats) of
     SJust x -> SJust x
     SNothing -> SNothing
 newScriptIntegrityHash (Alonzo _) pp ls rds dats =
-  case (hashScriptIntegrity pp (Set.fromList ls) rds dats) of
+  case (hashScriptIntegrity (Set.map (Alonzo.getLanguageView pp) (Set.fromList ls)) rds dats) of
     SJust x -> SJust x
     SNothing -> SNothing
 newScriptIntegrityHash _wit _pp _ls _rds _dats = SNothing

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Elaborators/Alonzo.hs

@@ -130,16 +130,12 @@ instance
         Alonzo.txUpdates = SNothing,
         Alonzo.reqSignerHashes = Set.empty,
         Alonzo.mint = mint,
-        Alonzo.scriptIntegrityHash =
-          redeemers
-            >>= uncurry
-              ( Alonzo.hashScriptIntegrity
-                  (LedgerState.esPp . LedgerState.nesEs $ nes)
-                  (Set.singleton PlutusV1)
-              ),
+        Alonzo.scriptIntegrityHash = redeemers >>= uncurry (Alonzo.hashScriptIntegrity langViews),
         Alonzo.adHash = SNothing,
         Alonzo.txnetworkid = SNothing -- SJust Testnet
       }
+    where
+      langViews = Set.singleton $ Alonzo.getLanguageView (LedgerState.esPp . LedgerState.nesEs $ nes) PlutusV1
 
   makeTx _ realTxBody (TxWitnessArguments wits (SupportsScript ScriptFeatureTag_PlutusV1 scripts) (SupportsPlutus (rdmr, dats)) (SupportsPlutus isValid)) =
     let witSet =