From 883bdb7834102e0964f8150fc99f7851c99a0277 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Mon, 25 Mar 2024 12:37:49 +0100 Subject: [PATCH] Add `ConvertRawTxId`, use it for comparing `OneEraGenTxId`s --- ...lexander.esgen_compare_txid_on_raw_hash.md | 3 +++ .../Consensus/Byron/Ledger/Mempool.hs | 7 +++++ .../Consensus/Shelley/Ledger/Mempool.hs | 6 +++++ ...lexander.esgen_compare_txid_on_raw_hash.md | 3 +++ .../Test/Consensus/HardFork/Combinator/A.hs | 5 ++++ .../Test/Consensus/HardFork/Combinator/B.hs | 3 +++ ...lexander.esgen_compare_txid_on_raw_hash.md | 3 +++ .../Combinator/Abstract/SingleEraBlock.hs | 2 +- .../HardFork/Combinator/AcrossEras.hs | 27 ++++++++++++++++--- .../Consensus/Ledger/SupportsMempool.hs | 9 +++++++ 10 files changed, 64 insertions(+), 4 deletions(-) create mode 100644 ouroboros-consensus-cardano/changelog.d/20240325_124120_alexander.esgen_compare_txid_on_raw_hash.md create mode 100644 ouroboros-consensus-diffusion/changelog.d/20240325_124036_alexander.esgen_compare_txid_on_raw_hash.md create mode 100644 ouroboros-consensus/changelog.d/20240325_123915_alexander.esgen_compare_txid_on_raw_hash.md diff --git a/ouroboros-consensus-cardano/changelog.d/20240325_124120_alexander.esgen_compare_txid_on_raw_hash.md b/ouroboros-consensus-cardano/changelog.d/20240325_124120_alexander.esgen_compare_txid_on_raw_hash.md new file mode 100644 index 0000000000..5832b1271e --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20240325_124120_alexander.esgen_compare_txid_on_raw_hash.md @@ -0,0 +1,3 @@ +### Non-Breaking + +- Add `ConvertRawTxId` instances for Shelley and Byron. diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs index ab1c3c8337..36f113528f 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Mempool.hs @@ -47,6 +47,7 @@ import qualified Cardano.Chain.Update as Update import qualified Cardano.Chain.UTxO as Utxo import qualified Cardano.Chain.ValidationMode as CC import Cardano.Crypto (hashDecoded) +import qualified Cardano.Crypto as CC import Cardano.Ledger.Binary (ByteSpan, DecoderError (..), byronProtVer, fromByronCBOR, serialize, slice, toByronCBOR, unsafeDeserialize) @@ -162,6 +163,12 @@ instance HasTxId (GenTx ByronBlock) where txId (ByronUpdateProposal i _) = ByronUpdateProposalId i txId (ByronUpdateVote i _) = ByronUpdateVoteId i +instance ConvertRawTxId (GenTx ByronBlock) where + toRawTxIdHash (ByronTxId i) = CC.abstractHashToShort i + toRawTxIdHash (ByronDlgId i) = CC.abstractHashToShort i + toRawTxIdHash (ByronUpdateProposalId i) = CC.abstractHashToShort i + toRawTxIdHash (ByronUpdateVoteId i) = CC.abstractHashToShort i + instance HasTxs ByronBlock where extractTxs blk = case byronBlockRaw blk of -- EBBs don't contain transactions diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs index b103555f15..07695d5823 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs @@ -34,6 +34,7 @@ module Ouroboros.Consensus.Shelley.Ledger.Mempool ( , fromExUnits ) where +import qualified Cardano.Crypto.Hash as Hash import Cardano.Ledger.Alonzo.Core (Tx, TxSeq, bodyTxL, eraProtVerLow, fromTxSeq, ppMaxBBSizeL, ppMaxBlockExUnitsL, sizeTxF) import Cardano.Ledger.Alonzo.Scripts (ExUnits, ExUnits', @@ -44,6 +45,7 @@ import Cardano.Ledger.Binary (Annotator (..), DecCBOR (..), ToCBOR (..), toPlainDecoder) import qualified Cardano.Ledger.Core as SL (txIdTxBody) import Cardano.Ledger.Crypto (Crypto) +import qualified Cardano.Ledger.SafeHash as SL import qualified Cardano.Ledger.Shelley.API as SL import Control.Monad.Except (Except) import Control.Monad.Identity (Identity (..)) @@ -171,6 +173,10 @@ instance (Typeable era, Typeable proto) instance ShelleyBasedEra era => HasTxId (GenTx (ShelleyBlock proto era)) where txId (ShelleyTx i _) = ShelleyTxId i +instance ShelleyBasedEra era => ConvertRawTxId (GenTx (ShelleyBlock proto era)) where + toRawTxIdHash (ShelleyTxId i) = + Hash.hashToBytesShort . SL.extractHash . SL.unTxId $ i + instance ShelleyBasedEra era => HasTxs (ShelleyBlock proto era) where extractTxs = map mkShelleyTx diff --git a/ouroboros-consensus-diffusion/changelog.d/20240325_124036_alexander.esgen_compare_txid_on_raw_hash.md b/ouroboros-consensus-diffusion/changelog.d/20240325_124036_alexander.esgen_compare_txid_on_raw_hash.md new file mode 100644 index 0000000000..c8765970e2 --- /dev/null +++ b/ouroboros-consensus-diffusion/changelog.d/20240325_124036_alexander.esgen_compare_txid_on_raw_hash.md @@ -0,0 +1,3 @@ +### Non-Breaking + +- Add `ConvertRawTxId` instances. diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs index 79af6e6633..ee99c77e55 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/A.hs @@ -44,7 +44,9 @@ import Control.Monad (guard) import Control.Monad.Except (runExcept) import qualified Data.Binary as B import Data.ByteString as Strict +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as Lazy +import qualified Data.ByteString.Short as SBS import Data.Functor.Identity (Identity) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -336,6 +338,9 @@ newtype instance TxId (GenTx BlockA) = TxIdA Int instance HasTxId (GenTx BlockA) where txId = txA_id +instance ConvertRawTxId (GenTx BlockA) where + toRawTxIdHash = SBS.toShort . BL.toStrict . serialise + instance ShowQuery (BlockQuery BlockA) where showResult qry = case qry of {} diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs index 3e23481c70..ea489dee29 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator/B.hs @@ -273,6 +273,9 @@ data instance TxId (GenTx BlockB) instance HasTxId (GenTx BlockB) where txId tx = case tx of {} +instance ConvertRawTxId (GenTx BlockB) where + toRawTxIdHash = \case {} + instance ShowQuery (BlockQuery BlockB) where showResult qry = case qry of {} diff --git a/ouroboros-consensus/changelog.d/20240325_123915_alexander.esgen_compare_txid_on_raw_hash.md b/ouroboros-consensus/changelog.d/20240325_123915_alexander.esgen_compare_txid_on_raw_hash.md new file mode 100644 index 0000000000..7cdc7c4ee9 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20240325_123915_alexander.esgen_compare_txid_on_raw_hash.md @@ -0,0 +1,3 @@ +### Breaking + +- Add `ConvertRawTxId` and require it for `SingleEraBlock`. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs index 4bcb69307f..c42840d463 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/SingleEraBlock.hs @@ -56,7 +56,7 @@ import Ouroboros.Consensus.Util.Condense class ( LedgerSupportsProtocol blk , InspectLedger blk , LedgerSupportsMempool blk - , HasTxId (GenTx blk) + , ConvertRawTxId (GenTx blk) , QueryLedger blk , HasPartialConsensusConfig (BlockProtocol blk) , HasPartialLedgerConfig blk diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs index a5f4636e34..35661a4202 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs @@ -66,6 +66,7 @@ import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as BSC import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as Short +import Data.Function (on) import Data.Proxy import Data.SOP.BasicFunctors import Data.SOP.Constraint @@ -156,6 +157,23 @@ instance Show (OneEraHash xs) where instance Condense (OneEraHash xs) where condense = show +{------------------------------------------------------------------------------- + OneEraGenTxId +-------------------------------------------------------------------------------} + +-- | This instance compares the underlying raw hash ('toRawTxIdHash') of the +-- 'TxId'. +-- +-- Note that this means that transactions in different eras can have equal +-- 'TxId's. This should only be the case when the transaction format is +-- backwards compatible from one era to the next. +instance CanHardFork xs => Eq (OneEraGenTxId xs) where + (==) = (==) `on` oneEraGenTxIdRawHash + +-- | See the corresponding 'Eq' instance. +instance CanHardFork xs => Ord (OneEraGenTxId xs) where + compare = compare `on` oneEraGenTxIdRawHash + {------------------------------------------------------------------------------- Value for two /different/ eras -------------------------------------------------------------------------------} @@ -245,6 +263,12 @@ getSameValue values = | otherwise = throwError "differing values across hard fork" +oneEraGenTxIdRawHash :: CanHardFork xs => OneEraGenTxId xs -> ShortByteString +oneEraGenTxIdRawHash = + hcollapse + . hcmap proxySingle (K . toRawTxIdHash . unwrapGenTxId) + . getOneEraGenTxId + {------------------------------------------------------------------------------- NoThunks instances -------------------------------------------------------------------------------} @@ -301,7 +325,6 @@ deriving via LiftNamedMismatch "MismatchEraInfo" SingleEraInfo LedgerEraInfo xs deriving via LiftNS WrapApplyTxErr xs instance CanHardFork xs => Eq (OneEraApplyTxErr xs) deriving via LiftNS WrapEnvelopeErr xs instance CanHardFork xs => Eq (OneEraEnvelopeErr xs) deriving via LiftNS GenTx xs instance CanHardFork xs => Eq (OneEraGenTx xs) -deriving via LiftNS WrapGenTxId xs instance CanHardFork xs => Eq (OneEraGenTxId xs) deriving via LiftNS WrapLedgerErr xs instance CanHardFork xs => Eq (OneEraLedgerError xs) deriving via LiftNS WrapLedgerUpdate xs instance CanHardFork xs => Eq (OneEraLedgerUpdate xs) deriving via LiftNS WrapLedgerWarning xs instance CanHardFork xs => Eq (OneEraLedgerWarning xs) @@ -310,8 +333,6 @@ deriving via LiftNS WrapTipInfo xs instance CanHardFork xs => Eq (OneEraT deriving via LiftNS WrapValidatedGenTx xs instance CanHardFork xs => Eq (OneEraValidatedGenTx xs) deriving via LiftNS WrapValidationErr xs instance CanHardFork xs => Eq (OneEraValidationErr xs) -deriving via LiftNS WrapGenTxId xs instance CanHardFork xs => Ord (OneEraGenTxId xs) - deriving via LiftNS WrapEnvelopeErr xs instance CanHardFork xs => Show (OneEraEnvelopeErr xs) deriving via LiftNS WrapForgeStateInfo xs instance CanHardFork xs => Show (OneEraForgeStateInfo xs) deriving via LiftNS WrapForgeStateUpdateError xs instance CanHardFork xs => Show (OneEraForgeStateUpdateError xs) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs index cfe280f500..3f329952ab 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/SupportsMempool.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeFamilies #-} module Ouroboros.Consensus.Ledger.SupportsMempool ( ApplyTxErr + , ConvertRawTxId (..) , GenTx , GenTxId , HasTxId (..) @@ -13,6 +14,7 @@ module Ouroboros.Consensus.Ledger.SupportsMempool ( ) where import Control.Monad.Except +import Data.ByteString.Short (ShortByteString) import Data.Kind (Type) import Data.Word (Word32) import GHC.Stack (HasCallStack) @@ -146,6 +148,13 @@ class ( Show (TxId tx) -- Should be cheap as this will be called often. txId :: tx -> TxId tx +-- | Extract the raw hash bytes from a 'TxId'. +class HasTxId tx => ConvertRawTxId tx where + + -- | NOTE: The composition @'toRawTxIdHash' . 'txId'@ must satisfy the same + -- properties as defined in the docs of 'txId'. + toRawTxIdHash :: TxId tx -> ShortByteString + -- | Shorthand: ID of a generalized transaction type GenTxId blk = TxId (GenTx blk)