From c215b7ee4c17da8de1337242f63fc7b4cbed38f7 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 18:28:55 +0100 Subject: [PATCH 1/7] Add a Hydra.Contract.Hash script to test different hashing algorithms The inspect-script binary reports a serialized size of 5KB for this script validator! --- hydra-plutus/exe/inspect-script/Main.hs | 4 ++ hydra-plutus/hydra-plutus.cabal | 1 + hydra-plutus/src/Hydra/Contract/Hash.hs | 67 +++++++++++++++++++++++++ 3 files changed, 72 insertions(+) create mode 100644 hydra-plutus/src/Hydra/Contract/Hash.hs diff --git a/hydra-plutus/exe/inspect-script/Main.hs b/hydra-plutus/exe/inspect-script/Main.hs index c3847b4e05f..aba4f4406c3 100644 --- a/hydra-plutus/exe/inspect-script/Main.hs +++ b/hydra-plutus/exe/inspect-script/Main.hs @@ -8,6 +8,7 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BL import Data.Text (pack) import Hydra.Contract.Commit as Commit +import qualified Hydra.Contract.Hash as Hash import Hydra.Contract.Initial as Initial import Hydra.Contract.MockHead as MockHead import Ledger (Datum (..), datumHash) @@ -64,6 +65,7 @@ main = do [ (headScript policyId, "headScript") , (initialScript, "initialScript") , (commitScript, "commitScript") + , (hashScript, "hashScript") ] headScript policyId = MockHead.validatorScript policyId @@ -72,6 +74,8 @@ main = do initialScript = Initial.validatorScript + hashScript = Hash.validatorScript + datums = [ (headDatum, "headDatum") , (abortDatum, "abortDatum") diff --git a/hydra-plutus/hydra-plutus.cabal b/hydra-plutus/hydra-plutus.cabal index 05487f3ba2a..c2f04771653 100644 --- a/hydra-plutus/hydra-plutus.cabal +++ b/hydra-plutus/hydra-plutus.cabal @@ -72,6 +72,7 @@ library import: project-config exposed-modules: Hydra.Contract.Commit + Hydra.Contract.Hash Hydra.Contract.Initial Hydra.Contract.MockCommit Hydra.Contract.MockHead diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs new file mode 100644 index 00000000000..1d0820ae9a0 --- /dev/null +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-specialize #-} + +-- | An experimental validator which simply hashes a bytestring stored in the +-- datum using one of three supported algorithms. +module Hydra.Contract.Hash where + +import Ledger hiding (validatorHash) +import PlutusTx.Prelude + +import Ledger.Typed.Scripts (TypedValidator, ValidatorType, ValidatorTypes (..)) +import qualified Ledger.Typed.Scripts as Scripts +import PlutusTx (CompiledCode) +import qualified PlutusTx +import PlutusTx.Builtins (blake2b_256) +import PlutusTx.IsData.Class (ToData (..)) + +data Hash + +data HashAlgorithm + = SHA2 + | SHA3 + | Blake2b + +PlutusTx.unstableMakeIsData ''HashAlgorithm + +instance Scripts.ValidatorTypes Hash where + type DatumType Hash = BuiltinByteString + type RedeemerType Hash = HashAlgorithm + +-- NOTE: Plutus is strict, thus this still occurs cost for hashing +validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool +validator bytes algorithm _ctx = + case algorithm of + SHA2 -> let _x = sha2_256 bytes in True + SHA3 -> let _x = sha3_256 bytes in True + Blake2b -> let _x = blake2b_256 bytes in True + +compiledValidator :: CompiledCode (ValidatorType Hash) +compiledValidator = $$(PlutusTx.compile [||validator||]) + +{- ORMOLU_DISABLE -} +typedValidator :: TypedValidator Hash +typedValidator = Scripts.mkTypedValidator @Hash + compiledValidator + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @(DatumType Hash) @(RedeemerType Hash) +{- ORMOLU_ENABLE -} + +-- | Get the actual plutus script. Mainly used to serialize and use in +-- transactions. +validatorScript :: Script +validatorScript = unValidatorScript $ Scripts.validatorScript typedValidator + +validatorHash :: ValidatorHash +validatorHash = Scripts.validatorHash typedValidator + +datum :: DatumType Hash -> Datum +datum a = Datum (toBuiltinData a) + +redeemer :: RedeemerType Hash -> Redeemer +redeemer a = Redeemer (toBuiltinData a) + +address :: Address +address = scriptHashAddress validatorHash From 4f13d15bebff9afe06b156eeab2d543e4760dd65 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 19:14:39 +0100 Subject: [PATCH 2/7] Add a property to ContractSpec for Hash validator --- .../test/Hydra/Chain/Direct/ContractSpec.hs | 49 ++++++++++++++++++- hydra-plutus/src/Hydra/Contract/Hash.hs | 21 +++++--- 2 files changed, 62 insertions(+), 8 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index e99048d7c26..4ca7679ca89 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-} module Hydra.Chain.Direct.ContractSpec where @@ -24,30 +24,47 @@ import qualified Cardano.Ledger.Shelley.API as Ledger import qualified Data.ByteString as BS import qualified Data.Map as Map import Data.Maybe.Strict (StrictMaybe (..)) +import Hydra.Chain.Direct.Fixture (testNetworkId) import qualified Hydra.Chain.Direct.Fixture as Fixture import Hydra.Chain.Direct.Tx (closeRedeemer, closeTx, policyId) import Hydra.Chain.Direct.TxSpec (mkHeadOutput) +import qualified Hydra.Contract.Hash as Hash import Hydra.Contract.MockHead (naturalToCBOR, verifyPartySignature, verifySnapshotSignature) import qualified Hydra.Contract.MockHead as MockHead import Hydra.Data.Party (partyFromVerKey) import Hydra.Ledger.Cardano ( AlonzoEra, + BuildTxWith (BuildTxWith), CardanoTx, CtxUTxO, Era, LedgerCrypto, LedgerEra, + PlutusScriptV1, Tx (Tx), TxBody (ShelleyTxBody), TxBodyScriptData (TxBodyNoScriptData, TxBodyScriptData), TxOut (..), Utxo, + Utxo' (Utxo), + addInputs, describeCardanoTx, + emptyTxBody, + fromAlonzoExUnits, fromLedgerTx, fromLedgerUtxo, + fromPlutusScript, + lovelaceToTxOutValue, + mkDatumForTxIn, + mkRedeemerForTxIn, + mkScriptAddress, + mkScriptWitness, + mkTxOutDatum, mkTxOutDatumHash, + toCtxUTxOTxOut, toLedgerTx, toLedgerUtxo, + unsafeBuildTransaction, ) import qualified Hydra.Ledger.Cardano as Api import Hydra.Ledger.Simple (SimpleTx) @@ -78,10 +95,11 @@ import Test.QuickCheck ( property, suchThat, ) +import qualified Test.QuickCheck as QC import Test.QuickCheck.Instances () spec :: Spec -spec = describe "On-chain contracts" $ do +spec = do prop "correctly encode 'small' integer to CBOR" prop_encode16BitsNaturalToCBOROnChain describe "Signature validator" $ do prop @@ -100,6 +118,33 @@ spec = describe "On-chain contracts" $ do prop "does not survive random adversarial mutations" $ propMutation healthyCloseTx genCloseMutation + describe "Hash" $ + prop "execution units" $ \input algorithm -> + let output = toCtxUTxOTxOut $ TxOut address value (mkTxOutDatum datum) + value = lovelaceToTxOutValue 1_000_000 + address = mkScriptAddress @PlutusScriptV1 testNetworkId script + tx = unsafeBuildTransaction $ emptyTxBody & addInputs [(input, witness)] + utxo = Utxo $ Map.singleton input output + witness = BuildTxWith $ mkScriptWitness script (mkDatumForTxIn datum) redeemer + script = fromPlutusScript Hash.validatorScript + bytes = fold $ replicate 10000 ("a" :: ByteString) + datum = Hash.datum $ toBuiltin bytes + redeemer = mkRedeemerForTxIn $ Hash.redeemer algorithm + in case evaluateTx tx utxo of + Left basicFailure -> + property False + & counterexample ("Basic failure: " <> show basicFailure) + Right report -> + case Map.elems report of + [Right units] -> + property True + & counterexample ("Redeemer report: " <> show report) + & counterexample ("Tx: " <> show tx) + & QC.label (show algorithm <> ":" <> show (fromAlonzoExUnits units)) + _ -> + property False + & counterexample ("Too many redeemers in report: " <> show report) + -- -- Properties -- diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index 1d0820ae9a0..3f0019a626b 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -9,22 +9,29 @@ module Hydra.Contract.Hash where import Ledger hiding (validatorHash) import PlutusTx.Prelude +import Hydra.Prelude (Arbitrary (arbitrary), Generic, Show, genericArbitrary) + import Ledger.Typed.Scripts (TypedValidator, ValidatorType, ValidatorTypes (..)) import qualified Ledger.Typed.Scripts as Scripts import PlutusTx (CompiledCode) import qualified PlutusTx -import PlutusTx.Builtins (blake2b_256) +import PlutusTx.Builtins (equalsByteString) import PlutusTx.IsData.Class (ToData (..)) data Hash data HashAlgorithm - = SHA2 + = Baseline + | SHA2 | SHA3 - | Blake2b + -- Blake2b + deriving (Show, Generic) PlutusTx.unstableMakeIsData ''HashAlgorithm +instance Arbitrary HashAlgorithm where + arbitrary = genericArbitrary + instance Scripts.ValidatorTypes Hash where type DatumType Hash = BuiltinByteString type RedeemerType Hash = HashAlgorithm @@ -33,9 +40,11 @@ instance Scripts.ValidatorTypes Hash where validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool validator bytes algorithm _ctx = case algorithm of - SHA2 -> let _x = sha2_256 bytes in True - SHA3 -> let _x = sha3_256 bytes in True - Blake2b -> let _x = blake2b_256 bytes in True + Baseline -> not $ equalsByteString "" "1" + SHA2 -> not . equalsByteString "" $ sha2_256 bytes + SHA3 -> not . equalsByteString "" $ sha3_256 bytes + +-- Blake2b -> not . equalsByteString "" $ blake2b_256 bytes compiledValidator :: CompiledCode (ValidatorType Hash) compiledValidator = $$(PlutusTx.compile [||validator||]) From 9dd40f1d9706063ca9e46f5db9249a4ddebdcf38 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 19:33:04 +0100 Subject: [PATCH 3/7] Refactor into a pure function and print results in an hspec 'it' Ideally we would have a standalone executable for things like this, but the 'evaluateTx' and included 'Fixture's are not available outside of hydra-node tests. --- .../test/Hydra/Chain/Direct/ContractSpec.hs | 57 ++++++++++--------- hydra-plutus/src/Hydra/Contract/Hash.hs | 10 ++-- 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index 4ca7679ca89..a3fbc109edc 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -38,6 +38,7 @@ import Hydra.Ledger.Cardano ( CardanoTx, CtxUTxO, Era, + ExecutionUnits, LedgerCrypto, LedgerEra, PlutusScriptV1, @@ -95,7 +96,6 @@ import Test.QuickCheck ( property, suchThat, ) -import qualified Test.QuickCheck as QC import Test.QuickCheck.Instances () spec :: Spec @@ -119,31 +119,36 @@ spec = do propMutation healthyCloseTx genCloseMutation describe "Hash" $ - prop "execution units" $ \input algorithm -> - let output = toCtxUTxOTxOut $ TxOut address value (mkTxOutDatum datum) - value = lovelaceToTxOutValue 1_000_000 - address = mkScriptAddress @PlutusScriptV1 testNetworkId script - tx = unsafeBuildTransaction $ emptyTxBody & addInputs [(input, witness)] - utxo = Utxo $ Map.singleton input output - witness = BuildTxWith $ mkScriptWitness script (mkDatumForTxIn datum) redeemer - script = fromPlutusScript Hash.validatorScript - bytes = fold $ replicate 10000 ("a" :: ByteString) - datum = Hash.datum $ toBuiltin bytes - redeemer = mkRedeemerForTxIn $ Hash.redeemer algorithm - in case evaluateTx tx utxo of - Left basicFailure -> - property False - & counterexample ("Basic failure: " <> show basicFailure) - Right report -> - case Map.elems report of - [Right units] -> - property True - & counterexample ("Redeemer report: " <> show report) - & counterexample ("Tx: " <> show tx) - & QC.label (show algorithm <> ":" <> show (fromAlonzoExUnits units)) - _ -> - property False - & counterexample ("Too many redeemers in report: " <> show report) + it "measure execution units" $ do + for_ [1, 10, 100, 1000, 10000] $ \n -> do + putTextLn @IO $ "n = " <> show n + for_ [minBound .. maxBound] $ \algorithm -> do + let units = calculateHashExUnits n algorithm + putTextLn $ " " <> show algorithm <> ":" <> show units + +calculateHashExUnits :: Int -> Hash.HashAlgorithm -> ExecutionUnits +calculateHashExUnits n algorithm = + case evaluateTx tx utxo of + Left basicFailure -> + error ("Basic failure: " <> show basicFailure) + Right report -> + case Map.elems report of + [Right units] -> + fromAlonzoExUnits units + _ -> + error $ "Too many redeemers in report: " <> show report + where + tx = unsafeBuildTransaction $ emptyTxBody & addInputs [(input, witness)] + utxo = Utxo $ Map.singleton input output + input = generateWith arbitrary 42 + output = toCtxUTxOTxOut $ TxOut address value (mkTxOutDatum datum) + value = lovelaceToTxOutValue 1_000_000 + address = mkScriptAddress @PlutusScriptV1 testNetworkId script + witness = BuildTxWith $ mkScriptWitness script (mkDatumForTxIn datum) redeemer + script = fromPlutusScript Hash.validatorScript + datum = Hash.datum $ toBuiltin bytes + redeemer = mkRedeemerForTxIn $ Hash.redeemer algorithm + bytes = fold $ replicate n ("0" :: ByteString) -- -- Properties diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index 3f0019a626b..3a9f29567b6 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -9,7 +9,7 @@ module Hydra.Contract.Hash where import Ledger hiding (validatorHash) import PlutusTx.Prelude -import Hydra.Prelude (Arbitrary (arbitrary), Generic, Show, genericArbitrary) +import qualified Hydra.Prelude as Haskell import Ledger.Typed.Scripts (TypedValidator, ValidatorType, ValidatorTypes (..)) import qualified Ledger.Typed.Scripts as Scripts @@ -25,12 +25,12 @@ data HashAlgorithm | SHA2 | SHA3 -- Blake2b - deriving (Show, Generic) + deriving (Haskell.Show, Haskell.Generic, Haskell.Enum, Haskell.Bounded) PlutusTx.unstableMakeIsData ''HashAlgorithm -instance Arbitrary HashAlgorithm where - arbitrary = genericArbitrary +instance Haskell.Arbitrary HashAlgorithm where + arbitrary = Haskell.genericArbitrary instance Scripts.ValidatorTypes Hash where type DatumType Hash = BuiltinByteString @@ -40,7 +40,7 @@ instance Scripts.ValidatorTypes Hash where validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool validator bytes algorithm _ctx = case algorithm of - Baseline -> not $ equalsByteString "" "1" + Baseline -> not $ equalsByteString "" bytes SHA2 -> not . equalsByteString "" $ sha2_256 bytes SHA3 -> not . equalsByteString "" $ sha3_256 bytes From fba191b365748b9877fe5d06bd2b3313d94735cc Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 19:51:18 +0100 Subject: [PATCH 4/7] Test powers of 8 and print number of words (s) --- hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index a3fbc109edc..65868713cb5 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -119,12 +119,14 @@ spec = do propMutation healthyCloseTx genCloseMutation describe "Hash" $ - it "measure execution units" $ do - for_ [1, 10, 100, 1000, 10000] $ \n -> do - putTextLn @IO $ "n = " <> show n + it "runs with these ^ execution units" $ do + for_ [0 .. 5] $ \(power :: Integer) -> do + let n = 8 ^ power + s = n `quot` 8 + putTextLn @IO $ " n = " <> show n <> ", s = " <> show s for_ [minBound .. maxBound] $ \algorithm -> do let units = calculateHashExUnits n algorithm - putTextLn $ " " <> show algorithm <> ":" <> show units + putTextLn $ " " <> show algorithm <> ":" <> show units calculateHashExUnits :: Int -> Hash.HashAlgorithm -> ExecutionUnits calculateHashExUnits n algorithm = From 4bcd5bd98d7e037f9476ce1471f171e3100b25a5 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 20:37:55 +0100 Subject: [PATCH 5/7] Make Hash results relative to Baseline --- .../test/Hydra/Chain/Direct/ContractSpec.hs | 20 +++++++++++++++---- hydra-plutus/src/Hydra/Contract/Hash.hs | 2 +- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index 65868713cb5..12b1b5b1a24 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -38,7 +38,7 @@ import Hydra.Ledger.Cardano ( CardanoTx, CtxUTxO, Era, - ExecutionUnits, + ExecutionUnits (ExecutionUnits), LedgerCrypto, LedgerEra, PlutusScriptV1, @@ -119,14 +119,26 @@ spec = do propMutation healthyCloseTx genCloseMutation describe "Hash" $ - it "runs with these ^ execution units" $ do + it "runs with these ^ execution units over Baseline" $ do for_ [0 .. 5] $ \(power :: Integer) -> do let n = 8 ^ power s = n `quot` 8 putTextLn @IO $ " n = " <> show n <> ", s = " <> show s for_ [minBound .. maxBound] $ \algorithm -> do - let units = calculateHashExUnits n algorithm - putTextLn $ " " <> show algorithm <> ":" <> show units + let ExecutionUnits + { executionSteps = baselineCpu + , executionMemory = baselineMem + } = calculateHashExUnits n Hash.Baseline + ExecutionUnits + { executionSteps = cpu + , executionMemory = mem + } = calculateHashExUnits n algorithm + putTextLn $ + " " <> show algorithm + <> ": cpu=" + <> show (toInteger cpu - toInteger baselineCpu) + <> ", mem=" + <> show (toInteger mem - toInteger baselineMem) calculateHashExUnits :: Int -> Hash.HashAlgorithm -> ExecutionUnits calculateHashExUnits n algorithm = diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index 3a9f29567b6..b9459dd0d8d 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -40,7 +40,7 @@ instance Scripts.ValidatorTypes Hash where validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool validator bytes algorithm _ctx = case algorithm of - Baseline -> not $ equalsByteString "" bytes + Baseline -> True SHA2 -> not . equalsByteString "" $ sha2_256 bytes SHA3 -> not . equalsByteString "" $ sha3_256 bytes From 47ebf0413109883846de991f4a998e0977d6b1e9 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 20:47:40 +0100 Subject: [PATCH 6/7] Add a bit more computation to baseline --- hydra-plutus/src/Hydra/Contract/Hash.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index b9459dd0d8d..7e054af4024 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -40,9 +40,9 @@ instance Scripts.ValidatorTypes Hash where validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool validator bytes algorithm _ctx = case algorithm of - Baseline -> True - SHA2 -> not . equalsByteString "" $ sha2_256 bytes - SHA3 -> not . equalsByteString "" $ sha3_256 bytes + Baseline -> equalsByteString bytes bytes + SHA2 -> not . equalsByteString bytes $ sha2_256 bytes + SHA3 -> not . equalsByteString bytes $ sha3_256 bytes -- Blake2b -> not . equalsByteString "" $ blake2b_256 bytes From 917127f0000cec14f3e3e1832777867a8da9b288 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Tue, 4 Jan 2022 20:52:23 +0100 Subject: [PATCH 7/7] Improve printed output --- .../test/Hydra/Chain/Direct/ContractSpec.hs | 18 ++++++++++-------- hydra-plutus/src/Hydra/Contract/Hash.hs | 4 ++-- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs index 12b1b5b1a24..730050ed4a2 100644 --- a/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/ContractSpec.hs @@ -126,19 +126,21 @@ spec = do putTextLn @IO $ " n = " <> show n <> ", s = " <> show s for_ [minBound .. maxBound] $ \algorithm -> do let ExecutionUnits - { executionSteps = baselineCpu - , executionMemory = baselineMem - } = calculateHashExUnits n Hash.Baseline - ExecutionUnits + { executionSteps = baseCpu + , executionMemory = baseMem + } = calculateHashExUnits n Hash.Base + units@ExecutionUnits { executionSteps = cpu , executionMemory = mem } = calculateHashExUnits n algorithm putTextLn $ " " <> show algorithm - <> ": cpu=" - <> show (toInteger cpu - toInteger baselineCpu) - <> ", mem=" - <> show (toInteger mem - toInteger baselineMem) + <> ": " + <> show units + <> " Δcpu=" + <> show (toInteger cpu - toInteger baseCpu) + <> " Δmem=" + <> show (toInteger mem - toInteger baseMem) calculateHashExUnits :: Int -> Hash.HashAlgorithm -> ExecutionUnits calculateHashExUnits n algorithm = diff --git a/hydra-plutus/src/Hydra/Contract/Hash.hs b/hydra-plutus/src/Hydra/Contract/Hash.hs index 7e054af4024..4ec90d8a70c 100644 --- a/hydra-plutus/src/Hydra/Contract/Hash.hs +++ b/hydra-plutus/src/Hydra/Contract/Hash.hs @@ -21,7 +21,7 @@ import PlutusTx.IsData.Class (ToData (..)) data Hash data HashAlgorithm - = Baseline + = Base | SHA2 | SHA3 -- Blake2b @@ -40,7 +40,7 @@ instance Scripts.ValidatorTypes Hash where validator :: DatumType Hash -> RedeemerType Hash -> ScriptContext -> Bool validator bytes algorithm _ctx = case algorithm of - Baseline -> equalsByteString bytes bytes + Base -> equalsByteString bytes bytes SHA2 -> not . equalsByteString bytes $ sha2_256 bytes SHA3 -> not . equalsByteString bytes $ sha3_256 bytes