Deprecate witsFromTxWitnesses in favor of keyHashWitnessesTxWits

Author: lehins

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

@@ -67,7 +67,6 @@ import Cardano.Ledger.Shelley.Rules (
   validateNeededWitnesses,
  )
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
-import Cardano.Ledger.Shelley.Tx (witsFromTxWitnesses)
 import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
 import Cardano.Ledger.State (
   EraCertState (..),
@@ -341,7 +340,7 @@ alonzoStyleWitness = do
   {-  witsKeyHashes := { hashKey vk | vk ∈ dom(txwitsVKey txw) }  -}
   let utxo = utxosUtxo u
       txBody = tx ^. bodyTxL
-      witsKeyHashes = witsFromTxWitnesses @era tx
+      witsKeyHashes = keyHashWitnessesTxWits (tx ^. witsTxL)
       scriptsProvided = getScriptsProvided utxo tx
 
   -- check scripts

eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs

@@ -62,7 +62,6 @@ import Cardano.Ledger.Shelley.Rules (
   validateNeededWitnesses,
  )
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
-import Cardano.Ledger.Shelley.Tx (witsFromTxWitnesses)
 import Cardano.Ledger.State (EraCertState (..), EraUTxO (..), ScriptsProvided (..))
 import Control.DeepSeq (NFData)
 import Control.Monad.Trans.Reader (asks)
@@ -301,7 +300,7 @@ babbageUtxowMirTransition = do
   {-  genSig := { hashKey gkey | gkey ∈ dom(genDelegs)} ∩ witsKeyHashes  -}
   {-  { c ∈ txcerts txb ∩ TxCert_mir} ≠ ∅  ⇒ |genSig| ≥ Quorum  -}
   let genDelegs = certState ^. certDStateL . dsGenDelegsL
-      witsKeyHashes = witsFromTxWitnesses tx
+      witsKeyHashes = keyHashWitnessesTxWits (tx ^. witsTxL)
   coreNodeQuorum <- liftSTS $ asks quorum
   runTest $
     Shelley.validateMIRInsufficientGenesisSigs genDelegs coreNodeQuorum witsKeyHashes tx
@@ -335,7 +334,7 @@ babbageUtxowTransition = do
   {-  witsKeyHashes := { hashKey vk | vk ∈ dom(txwitsVKey txw) }  -}
   let utxo = utxosUtxo u
       txBody = tx ^. bodyTxL
-      witsKeyHashes = witsFromTxWitnesses tx
+      witsKeyHashes = keyHashWitnessesTxWits (tx ^. witsTxL)
       inputs = (txBody ^. referenceInputsTxBodyL) `Set.union` (txBody ^. inputsTxBodyL)
 
   -- check scripts

eras/shelley/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.17.0.0
 
+* Deprecate `witsFromTxWitnesses`
 * Expose access to `ShelleyTxRaw`, `ShelleyTxAuxDataRaw`, `ShelleyTxBodyRaw`, `ShelleyTxWitsRaw`, `MkMultiSig`
 * Expose constructors `MkShelleyTx`, `MkShelleyTxAuxData`, `MkShelleyTxBody`, `MkShelleyTxWits`, `MultiSigRaw`
 * Remove re-export of `WitVKey` from `Cardano.Ledger.Shelley.TxWits`

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs

@@ -69,7 +69,6 @@ import Cardano.Ledger.Shelley.Rules.Utxo (
   UtxoEvent,
  )
 import qualified Cardano.Ledger.Shelley.SoftForks as SoftForks
-import Cardano.Ledger.Shelley.Tx (witsFromTxWitnesses)
 import Cardano.Ledger.Shelley.TxCert (isInstantaneousRewards)
 import Cardano.Ledger.Shelley.UTxO (
   EraUTxO (..),
@@ -303,7 +302,7 @@ transitionRulesUTXOW = do
   {-  (utxo,_,_,_ ) := utxoSt  -}
   {-  witsKeyHashes := { hashKey vk | vk ∈ dom(txwitsVKey txw) }  -}
   let utxo = utxosUtxo u
-      witsKeyHashes = witsFromTxWitnesses tx
+      witsKeyHashes = keyHashWitnessesTxWits (tx ^. witsTxL)
       scriptsProvided = getScriptsProvided utxo tx
 
   -- check scripts

eras/shelley/impl/src/Cardano/Ledger/Shelley/Tx/Internal.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -63,8 +62,6 @@ import Cardano.Ledger.Binary.Coders
 import qualified Cardano.Ledger.Binary.Plain as Plain
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Core
-import Cardano.Ledger.Keys.Bootstrap (bootstrapWitKeyHash)
-import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
 import Cardano.Ledger.MemoBytes (
   EqRaw (..),
   Mem,
@@ -91,7 +88,6 @@ import Data.Maybe.Strict (
   strictMaybeToMaybe,
  )
 import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.Typeable (Typeable)
 import Data.Word (Word32)
 import GHC.Generics (Generic)
@@ -431,6 +427,5 @@ witsFromTxWitnesses ::
   EraTx era =>
   Tx era ->
   Set (KeyHash 'Witness)
-witsFromTxWitnesses tx =
-  Set.map witVKeyHash (tx ^. witsTxL . addrTxWitsL)
-    `Set.union` Set.map bootstrapWitKeyHash (tx ^. witsTxL . bootAddrTxWitsL)
+witsFromTxWitnesses tx = keyHashWitnessesTxWits (tx ^. witsTxL)
+{-# DEPRECATED witsFromTxWitnesses "In favor ot `keyHashWitnessesTxWits`" #-}

libs/cardano-ledger-core/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.18.0.0
 
+* Add `keyHashWitnessesTxWits`
 * Remove export of `mkMemoBytes` from `Cardano.Ledger.MemoBytes` as unsafe
 * Add `CanGetChainAccountState` and `CanSetChainAccountState`
 * Add `treasuryL` and `reservesL`

libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs

@@ -38,6 +38,7 @@ module Cardano.Ledger.Core (
   hashScript,
   isNativeScript,
   hashScriptTxWitsL,
+  keyHashWitnessesTxWits,
   Value,
   EraPParams (..),
   mkCoinTxOut,
@@ -92,8 +93,8 @@ import Cardano.Ledger.Core.Translation
 import Cardano.Ledger.Core.TxCert
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Hashes hiding (GenDelegPair (..), GenDelegs (..), unsafeMakeSafeHash)
-import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness)
-import Cardano.Ledger.Keys.WitVKey (WitVKey)
+import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness, bootstrapWitKeyHash)
+import Cardano.Ledger.Keys.WitVKey (WitVKey, witVKeyHash)
 import Cardano.Ledger.MemoBytes
 import Cardano.Ledger.Metadata
 import Cardano.Ledger.Rewards (Reward (..), RewardType (..))
@@ -110,6 +111,7 @@ import Data.Maybe.Strict (StrictMaybe, strictMaybe)
 import Data.MemPack
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.Void (Void)
 import Data.Word (Word32, Word64)
 import GHC.Stack (HasCallStack)
@@ -512,6 +514,16 @@ hashScriptTxWitsL =
     (\wits ss -> wits & scriptTxWitsL .~ Map.fromList [(hashScript s, s) | s <- ss])
 {-# INLINEABLE hashScriptTxWitsL #-}
 
+-- | Extract all of the `KeyHash` witnesses provided in the `TxWits`
+keyHashWitnessesTxWits ::
+  EraTxWits era =>
+  TxWits era ->
+  Set (KeyHash 'Witness)
+keyHashWitnessesTxWits txWits =
+  Set.map witVKeyHash (txWits ^. addrTxWitsL)
+    `Set.union` Set.map bootstrapWitKeyHash (txWits ^. bootAddrTxWitsL)
+{-# INLINEABLE keyHashWitnessesTxWits #-}
+
 -----------------------------------------------------------------------------
 -- Script Validation
 -----------------------------------------------------------------------------