Add hashing for versioned scripts

plutus-chain-index-core/src/Plutus/ChainIndex/Tx.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE ViewPatterns        #-}
 {-| The chain index' version of a transaction
 -}
 module Plutus.ChainIndex.Tx(
@@ -43,15 +44,14 @@ import Data.List (sort)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Tuple (swap)
-import Ledger (OnChainTx (..), SomeCardanoApiTx (SomeTx), Tx (..), TxIn (..), TxInType (..), TxOutRef (..),
-               Versioned (unversioned), onCardanoTx, txId)
+import Ledger (OnChainTx (..), SomeCardanoApiTx (SomeTx), Tx (..), TxIn (..), TxInType (..), TxOutRef (..), onCardanoTx,
+               txId)
 import Ledger.Tx.CardanoAPI (toCardanoTxOut, toCardanoTxOutDatumHash)
 import Plutus.ChainIndex.Types
 import Plutus.Contract.CardanoAPI (fromCardanoTx, fromCardanoTxOut, setValidity)
-import Plutus.Script.Utils.Scripts (datumHash, redeemerHash)
-import Plutus.Script.Utils.V1.Scripts (validatorHash)
+import Plutus.Script.Utils.Scripts (Versioned, datumHash, redeemerHash, scriptHash)
 import Plutus.V1.Ledger.Api (Datum, DatumHash, MintingPolicy (getMintingPolicy), MintingPolicyHash (MintingPolicyHash),
-                             Redeemer, RedeemerHash, Script, Validator (getValidator), ValidatorHash (ValidatorHash))
+                             Redeemer, RedeemerHash, Script, Validator (getValidator))
 import Plutus.V1.Ledger.Scripts (ScriptHash (ScriptHash))
 import Plutus.V1.Ledger.Tx (RedeemerPtr (RedeemerPtr), Redeemers, ScriptTag (Spend))
 import Plutus.V2.Ledger.Api (Address (..), OutputDatum (..), Value (..))
@@ -135,12 +135,11 @@ validators = foldMap (\(ix, txIn) -> maybe mempty (withHash ix) $ txInType txIn)
     -- TODO: the index of the txin is probably incorrect as we take it from the set.
     -- To determine the proper index we have to convert the plutus's `TxIn` to cardano-api `TxIn` and
     -- sort them by using the standard `Ord` instance.
-    withHash ix (ConsumeScriptAddress val red dat) =
-      let (ValidatorHash vh) = validatorHash (unversioned val)
-       in ( Map.singleton (ScriptHash vh) (fmap getValidator val)
-          , Map.singleton (datumHash dat) dat
-          , Map.singleton (RedeemerPtr Spend ix) red
-          )
+    withHash ix (ConsumeScriptAddress (fmap getValidator -> val) red dat) =
+        ( Map.singleton (scriptHash val) val
+        , Map.singleton (datumHash dat) dat
+        , Map.singleton (RedeemerPtr Spend ix) red
+        )
     withHash _ _ = mempty
 
 txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer

plutus-contract/src/Plutus/Contract/Test/ContractModel/DoubleSatisfaction.hs

@@ -314,8 +314,8 @@ isVulnerable (DoubleSatisfactionCounterexample orig pre post _ _ _) =
 -- a specific datum attached. Even though this doesn't technically matter.
 --
 -- This is not super important, but we want to leave no room for misunderstanding...
-alwaysOkValidator :: Validator
-alwaysOkValidator = mkValidatorScript $$(PlutusTx.compile [|| (\_ _ _ -> ()) ||])
+alwaysOkValidator :: Versioned Validator
+alwaysOkValidator = Versioned (mkValidatorScript $$(PlutusTx.compile [|| (\_ _ _ -> ()) ||])) PlutusV1
 
 doubleSatisfactionCounterexamples :: WrappedTx -> [DoubleSatisfactionCounterexample]
 doubleSatisfactionCounterexamples dsc =
@@ -357,7 +357,7 @@ doubleSatisfactionCounterexamples dsc =
                                    , txOutRefIdx = 1
                                    }
         newFakeTxIn = TxIn { txInRef = newFakeTxOutRef
-                           , txInType = Just $ ConsumeScriptAddress (Versioned alwaysOkValidator PlutusV1)
+                           , txInType = Just $ ConsumeScriptAddress alwaysOkValidator
                                                                     redeemerEmpty
                                                                     datumEmpty
                            }

plutus-ledger-constraints/src/Ledger/Constraints.hs

@@ -55,6 +55,7 @@ module Ledger.Constraints(
     , OC.ScriptLookups(..)
     , OC.typedValidatorLookups
     , OC.unspentOutputs
+    , OC.mintingPolicy
     , OC.plutusV1MintingPolicy
     , OC.plutusV2MintingPolicy
     , OC.otherScript

plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs

@@ -22,6 +22,7 @@ module Ledger.Constraints.OffChain(
     , typedValidatorLookups
     , generalise
     , unspentOutputs
+    , mintingPolicy
     , plutusV1MintingPolicy
     , plutusV2MintingPolicy
     , otherScript
@@ -109,12 +110,11 @@ import Ledger.Typed.Scripts (Any, ConnectionError (UnknownRef), TypedValidator,
 import Ledger.Typed.Scripts qualified as Typed
 import Ledger.Validation (evaluateMinLovelaceOutput, fromPlutusTxOutUnsafe)
 import Plutus.Script.Utils.Scripts qualified as P
-import Plutus.Script.Utils.V1.Scripts qualified as PV1
 import Plutus.Script.Utils.V1.Tx (scriptAddressTxOut)
-import Plutus.Script.Utils.V2.Scripts qualified as PV2
 import Plutus.V1.Ledger.Api (Datum (Datum), DatumHash, POSIXTimeRange, Redeemer, Value, getMintingPolicy)
 import Plutus.V1.Ledger.Scripts (MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), Script,
-                                 ScriptHash (ScriptHash), Validator (Validator), ValidatorHash (ValidatorHash))
+                                 ScriptHash (ScriptHash), Validator (Validator, getValidator),
+                                 ValidatorHash (ValidatorHash))
 import Plutus.V1.Ledger.Value qualified as Value
 import PlutusTx (FromData, ToData (toBuiltinData))
 import PlutusTx.Lattice (BoundedMeetSemiLattice (top), JoinSemiLattice ((\/)), MeetSemiLattice ((/\)))
@@ -188,34 +188,29 @@ typedValidatorLookups inst =
 unspentOutputs :: Map TxOutRef ChainIndexTxOut -> ScriptLookups a
 unspentOutputs mp = mempty { slTxOutputs = mp }
 
--- | A script lookups value with a minting policy script.
+-- | A script lookups value with a versioned minting policy script.
+mintingPolicy :: Versioned MintingPolicy -> ScriptLookups a
+mintingPolicy (fmap getMintingPolicy -> script) = mempty { slOtherScripts = Map.singleton (P.scriptHash script) script }
+
+-- | A script lookups value with a PlutusV1 minting policy script.
 plutusV1MintingPolicy :: MintingPolicy -> ScriptLookups a
-plutusV1MintingPolicy (MintingPolicy pl) =
-    let MintingPolicyHash hsh = PV1.mintingPolicyHash (MintingPolicy pl) in
-    mempty { slOtherScripts = Map.singleton (ScriptHash hsh) (Versioned pl PlutusV1) }
+plutusV1MintingPolicy pl = mintingPolicy (Versioned pl PlutusV1)
 
--- | A script lookups value with a minting policy script.
+-- | A script lookups value with a PlutusV2 minting policy script.
 plutusV2MintingPolicy :: MintingPolicy -> ScriptLookups a
-plutusV2MintingPolicy (MintingPolicy pl) =
-    let MintingPolicyHash hsh = PV2.mintingPolicyHash (MintingPolicy pl) in
-    mempty { slOtherScripts = Map.singleton (ScriptHash hsh) (Versioned pl PlutusV2) }
+plutusV2MintingPolicy pl = mintingPolicy (Versioned pl PlutusV2)
 
 -- | A script lookups value with a versioned validator script.
 otherScript :: Versioned Validator -> ScriptLookups a
-otherScript (Versioned vl PlutusV1) = plutusV1OtherScript vl
-otherScript (Versioned vl PlutusV2) = plutusV2OtherScript vl
+otherScript (fmap getValidator -> script) = mempty { slOtherScripts = Map.singleton (P.scriptHash script) script }
 
 -- | A script lookups value with a PlutusV1 validator script.
 plutusV1OtherScript :: Validator -> ScriptLookups a
-plutusV1OtherScript (Validator vl) =
-    let vh = PV1.scriptHash vl in
-    mempty { slOtherScripts = Map.singleton vh (Versioned vl PlutusV1) }
+plutusV1OtherScript vl = otherScript (Versioned vl PlutusV1)
 
 -- | A script lookups value with a PlutusV2 validator script.
 plutusV2OtherScript :: Validator -> ScriptLookups a
-plutusV2OtherScript (Validator vl) =
-    let vh = PV2.scriptHash vl in
-    mempty { slOtherScripts = Map.singleton vh (Versioned vl PlutusV2) }
+plutusV2OtherScript vl = otherScript (Versioned vl PlutusV2)
 
 -- | A script lookups value with a datum.
 otherData :: Datum -> ScriptLookups a

plutus-ledger/src/Ledger/Scripts.hs

@@ -4,5 +4,4 @@ module Ledger.Scripts (
 
 import Ledger.Scripts.Orphans ()
 import Plutus.Script.Utils.Scripts as Export
-import Plutus.Script.Utils.V1.Scripts as Export
 import Plutus.V1.Ledger.Scripts as Export

plutus-script-utils/src/Plutus/Script/Utils/Scripts.hs

@@ -13,6 +13,13 @@ module Plutus.Script.Utils.Scripts
     ( -- * Plutus language versioning
       Language (..)
     , Versioned (..)
+      -- * Script hashing
+    , scriptHash
+    , validatorHash
+    , mintingPolicyHash
+    , stakeValidatorHash
+      -- * Script utilities
+    , scriptCurrencySymbol
       -- * Script data hashes
     , PV1.Datum
     , PV1.DatumHash
@@ -23,15 +30,18 @@ module Plutus.Script.Utils.Scripts
     , dataHash
     ) where
 
-import Cardano.Api qualified as Script
-import Cardano.Api.Shelley qualified as Script
+import Cardano.Api qualified as C.Api
+import Cardano.Api.Shelley qualified as C.Api
 import Cardano.Ledger.Alonzo.Language (Language (PlutusV1, PlutusV2))
-import Codec.Serialise (Serialise)
+import Codec.Serialise (Serialise, serialise)
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON, ToJSON)
+import Data.ByteString.Lazy qualified as BSL
+import Data.ByteString.Short qualified as SBS
 import Data.OpenApi qualified as OpenApi
 import GHC.Generics (Generic)
 import Plutus.V1.Ledger.Api qualified as PV1
+import Plutus.V1.Ledger.Scripts qualified as PV1
 import PlutusTx.Builtins qualified as Builtins
 import Prettyprinter (Pretty (pretty))
 
@@ -52,6 +62,51 @@ deriving instance OpenApi.ToSchema script => OpenApi.ToSchema (Versioned script)
 instance Pretty script => Pretty (Versioned script) where
     pretty Versioned{unversioned,version} = pretty unversioned <> " (" <> pretty version <> ")"
 
+-- | Hash a 'Versioned' 'Script'
+scriptHash :: Versioned PV1.Script -> PV1.ScriptHash
+scriptHash (Versioned script lang) =
+    PV1.ScriptHash
+    . Builtins.toBuiltin
+    . C.Api.serialiseToRawBytes
+    . hashInner lang
+    . SBS.toShort
+    . BSL.toStrict
+    . serialise
+    $ script
+    where
+      hashInner PlutusV1 = C.Api.hashScript . C.Api.PlutusScript C.Api.PlutusScriptV1 . C.Api.PlutusScriptSerialised
+      hashInner PlutusV2 = C.Api.hashScript . C.Api.PlutusScript C.Api.PlutusScriptV2 . C.Api.PlutusScriptSerialised
+
+-- | Hash a 'Versioned' 'PV1.Validator' script.
+validatorHash :: Versioned PV1.Validator -> PV1.ValidatorHash
+validatorHash =
+    PV1.ValidatorHash
+  . PV1.getScriptHash
+  . scriptHash
+  . fmap PV1.getValidator
+
+-- | Hash a 'Versioned' 'PV1.MintingPolicy' script.
+mintingPolicyHash :: Versioned PV1.MintingPolicy -> PV1.MintingPolicyHash
+mintingPolicyHash =
+    PV1.MintingPolicyHash
+  . PV1.getScriptHash
+  . scriptHash
+  . fmap PV1.getMintingPolicy
+
+-- | Hash a 'Versioned' 'PV1.StakeValidator' script.
+stakeValidatorHash :: Versioned PV1.StakeValidator -> PV1.StakeValidatorHash
+stakeValidatorHash =
+    PV1.StakeValidatorHash
+  . PV1.getScriptHash
+  . scriptHash
+  . fmap PV1.getStakeValidator
+
+{-# INLINABLE scriptCurrencySymbol #-}
+-- | The 'CurrencySymbol' of a 'MintingPolicy'.
+scriptCurrencySymbol :: Versioned PV1.MintingPolicy -> PV1.CurrencySymbol
+scriptCurrencySymbol scrpt =
+    let (PV1.MintingPolicyHash hsh) = mintingPolicyHash scrpt in PV1.CurrencySymbol hsh
+
 -- | Hash a 'PV1.Datum builtin data.
 datumHash :: PV1.Datum -> PV1.DatumHash
 datumHash = PV1.DatumHash . dataHash . PV1.getDatum
@@ -64,17 +119,17 @@ redeemerHash = PV1.RedeemerHash . dataHash . PV1.getRedeemer
 dataHash :: Builtins.BuiltinData -> Builtins.BuiltinByteString
 dataHash =
     Builtins.toBuiltin
-    . Script.serialiseToRawBytes
-    . Script.hashScriptData
+    . C.Api.serialiseToRawBytes
+    . C.Api.hashScriptData
     . toCardanoAPIData
 
 -- | Convert a 'Builtins.BuiltinsData' value to a 'cardano-api' script
 --   data value.
 --
 -- For why we depend on `cardano-api`,
 -- see note [Hash computation of datums, redeemers and scripts]
-toCardanoAPIData :: Builtins.BuiltinData -> Script.ScriptData
-toCardanoAPIData = Script.fromPlutusData . Builtins.builtinDataToData
+toCardanoAPIData :: Builtins.BuiltinData -> C.Api.ScriptData
+toCardanoAPIData = C.Api.fromPlutusData . Builtins.builtinDataToData
 
 {- Note [Hash computation of datums, redeemers and scripts]
 

plutus-tx-constraints/src/Ledger/Tx/Constraints.hs

@@ -55,6 +55,7 @@ module Ledger.Tx.Constraints(
     , OC.ScriptLookups(..)
     , OC.typedValidatorLookups
     , OC.unspentOutputs
+    , OC.mintingPolicy
     , OC.plutusV1MintingPolicy
     , OC.plutusV2MintingPolicy
     , OC.otherScript

plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs

@@ -24,6 +24,7 @@ module Ledger.Tx.Constraints.OffChain(
     , P.typedValidatorLookups
     , P.generalise
     , P.unspentOutputs
+    , P.mintingPolicy
     , P.plutusV1MintingPolicy
     , P.plutusV2MintingPolicy
     , P.otherScript