Flip TxIx serialization to big endian

Author: jasagredo

ouroboros-consensus-cardano/changelog.d/20250904_155947_javier.sagredo_version_tables.md

@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- Change `TxIn (ShelleyBlock proto era)` to `BigEndianTxIn` which is a newtype wrapper over `TxIn` that *only* modifies the `MemPack` instance to ensure big-endian serialization.

ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Alonzo

@@ -466,6 +466,7 @@ translateLedgerStateShelleyToAllegraWrapper =
                 LedgerTables
                   . DiffMK
                   . Diff.fromMapDeletes
+                  . coerceTxInMapKeys
                   . Map.map SL.upgradeTxOut
                   $ avvms
 
@@ -478,6 +479,7 @@ translateLedgerStateShelleyToAllegraWrapper =
                   . withLedgerTables ls
                   . LedgerTables
                   . ValuesMK
+                  . coerceTxInMapKeys
                   $ avvms
 
               resultingState =

ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Babbage

@@ -28,7 +28,6 @@ import Cardano.Ledger.Binary.Decoding hiding (Decoder)
 import Cardano.Ledger.Binary.Encoding hiding (Encoding)
 import qualified Cardano.Ledger.Conway.State as SL
 import Cardano.Ledger.Core (Era, eraDecoder, eraProtVerLow)
-import qualified Cardano.Ledger.Shelley.API as SL
 import Cardano.Ledger.Shelley.LedgerState as SL
   ( esLStateL
   , lsCertStateL
@@ -57,7 +56,8 @@ import Ouroboros.Consensus.Ledger.Tables
 import Ouroboros.Consensus.Protocol.Praos (Praos)
 import Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import Ouroboros.Consensus.Shelley.Ledger
-  ( IsShelleyBlock
+  ( BigEndianTxIn
+  , IsShelleyBlock
   , ShelleyBlock
   , ShelleyCompatible
   , shelleyLedgerState
@@ -70,7 +70,7 @@ instance
   HasCanonicalTxIn (CardanoEras c)
   where
   newtype CanonicalTxIn (CardanoEras c) = CardanoTxIn
-    { getCardanoTxIn :: SL.TxIn
+    { getCardanoTxIn :: BigEndianTxIn
     }
     deriving stock (Show, Eq, Ord)
     deriving newtype NoThunks

ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Conway

@@ -19,6 +19,7 @@
 
 module Ouroboros.Consensus.Cardano.QueryHF () where
 
+import Data.Coerce
 import Data.Functor.Product
 import Data.SOP.BasicFunctors
 import Data.SOP.Constraint
@@ -98,14 +99,14 @@ instance CardanoHardForkConstraints c => BlockSupportsHFLedgerQuery (CardanoEras
           answerShelleyLookupQueries
             (injectLedgerTables idx)
             (ejectHardForkTxOut idx)
-            (ejectCanonicalTxIn idx)
+            (coerce . ejectCanonicalTxIn idx)
       )
   answerBlockQueryHFTraverse =
     answerCardanoQueryHF
       ( \idx ->
           answerShelleyTraversingQueries
             (ejectHardForkTxOut idx)
-            (ejectCanonicalTxIn idx)
+            (coerce . ejectCanonicalTxIn idx)
             (queryLedgerGetTraversingFilter idx)
       )
 

ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Dijkstra

@@ -54,10 +54,13 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger
 
     -- * Low-level UTxO manipulations
   , slUtxoL
+  , BigEndianTxIn (..)
+  , coerceTxInSet
+  , coerceTxInMapKeys
   ) where
 
 import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView)
-import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure)
+import qualified Cardano.Ledger.BaseTypes as SL (TxIx (..), epochInfoPure)
 import Cardano.Ledger.BaseTypes.NonZero (unNonZero)
 import Cardano.Ledger.Binary.Decoding
   ( decShareCBOR
@@ -97,9 +100,11 @@ import Control.Arrow (left, second)
 import qualified Control.Exception as Exception
 import Control.Monad.Except
 import qualified Control.State.Transition.Extended as STS
-import Data.Coerce (coerce)
+import Data.Coerce
 import Data.Functor.Identity
+import Data.Map.Strict (Map)
 import Data.MemPack
+import Data.Set (Set)
 import qualified Data.Text as T
 import qualified Data.Text as Text
 import Data.Word
@@ -135,7 +140,9 @@ import Ouroboros.Consensus.Util.CBOR
   , encodeWithOrigin
   )
 import Ouroboros.Consensus.Util.IndexedMemPack
+import Ouroboros.Consensus.Util.RedundantConstraints (keepRedundantConstraint)
 import Ouroboros.Consensus.Util.Versioned
+import Unsafe.Coerce
 
 {-------------------------------------------------------------------------------
   Config
@@ -317,7 +324,32 @@ shelleyLedgerTipPoint = shelleyTipToPoint . shelleyLedgerTip
 
 instance ShelleyCompatible proto era => UpdateLedger (ShelleyBlock proto era)
 
-type instance TxIn (LedgerState (ShelleyBlock proto era)) = SL.TxIn
+-- | The only purpose of this type is to modify the MemPack instance to use big
+-- endian serialization. This is necessary to ensure streaming functions of the
+-- UTxO set preserve the order of the entries, as otherwise we would get
+-- different sortings if sorting via the Serialized form and the Haskell Ord
+-- instance.
+newtype BigEndianTxIn = BigEndianTxIn {getOriginalTxIn :: SL.TxIn}
+  deriving newtype (Eq, Show, Ord, NoThunks)
+
+newtype BigEndianTxIx = BigEndianTxIx {getOriginalTxIx :: SL.TxIx}
+
+instance MemPack BigEndianTxIx where
+  typeName = "BigEndianTxIx"
+  packedByteCount = packedByteCount . getOriginalTxIx
+  packM (BigEndianTxIx (SL.TxIx w)) = packM (byteSwap16 w)
+  unpackM = BigEndianTxIx . SL.TxIx . byteSwap16 <$> unpackM
+
+instance MemPack BigEndianTxIn where
+  typeName = "BigEndianTxIn"
+  packedByteCount = packedByteCount . getOriginalTxIn
+  packM (BigEndianTxIn (SL.TxIn txid txix)) = do
+    packM txid
+    packM (BigEndianTxIx txix)
+  unpackM = do
+    BigEndianTxIn <$> (SL.TxIn <$> unpackM <*> (getOriginalTxIx <$> unpackM))
+
+type instance TxIn (LedgerState (ShelleyBlock proto era)) = BigEndianTxIn
 type instance TxOut (LedgerState (ShelleyBlock proto era)) = Core.TxOut era
 
 instance
@@ -397,7 +429,7 @@ instance
       , shelleyLedgerTables = emptyLedgerTables
       }
    where
-    (_, shelleyLedgerState') = shelleyLedgerState `slUtxoL` SL.UTxO m
+    (_, shelleyLedgerState') = shelleyLedgerState `slUtxoL` SL.UTxO (coerceTxInMapKeys m)
     ShelleyLedgerState
       { shelleyLedgerTip
       , shelleyLedgerState
@@ -409,7 +441,7 @@ instance
       { shelleyLedgerTip = shelleyLedgerTip
       , shelleyLedgerState = shelleyLedgerState'
       , shelleyLedgerTransition = shelleyLedgerTransition
-      , shelleyLedgerTables = LedgerTables (ValuesMK (SL.unUTxO tbs))
+      , shelleyLedgerTables = LedgerTables (ValuesMK (coerceTxInMapKeys $ SL.unUTxO tbs))
       }
    where
     (tbs, shelleyLedgerState') = shelleyLedgerState `slUtxoL` mempty
@@ -419,6 +451,26 @@ instance
       , shelleyLedgerTransition
       } = st
 
+-- | UNSAFE: use this function to coerce a @'Map' 'TxIn' ('TxOut' l)@ into and from
+-- a @'Map' 'BigEndianTxIn' ('TxOut' l)@.
+--
+-- This is only safe in such case because the keys are coercible and the 'Ord'
+-- instance is exactly the same.
+coerceTxInMapKeys :: forall k1 k2 v. Coercible k1 k2 => Map k1 v -> Map k2 v
+coerceTxInMapKeys = unsafeCoerce
+ where
+  _ = keepRedundantConstraint (Proxy @(Coercible k1 k2))
+
+-- | UNSAFE: use this function to coerce a @'Set' 'TxIn'@ into and from
+-- a @'Set' 'BigEndianTxIn'@.
+--
+-- This is only safe in such case because the keys are coercible and the 'Ord'
+-- instance is exactly the same.
+coerceTxInSet :: forall k1 k2. Coercible k1 k2 => Set k1 -> Set k2
+coerceTxInSet = unsafeCoerce
+ where
+  _ = keepRedundantConstraint (Proxy @(Coercible k1 k2))
+
 instance
   ShelleyBasedEra era =>
   CanStowLedgerTables (Ticked (LedgerState (ShelleyBlock proto era)))
@@ -432,7 +484,7 @@ instance
       }
    where
     (_, tickedShelleyLedgerState') =
-      tickedShelleyLedgerState `slUtxoL` SL.UTxO tbs
+      tickedShelleyLedgerState `slUtxoL` SL.UTxO (coerceTxInMapKeys tbs)
     TickedShelleyLedgerState
       { untickedShelleyLedgerTip
       , tickedShelleyLedgerTransition
@@ -445,7 +497,7 @@ instance
       { untickedShelleyLedgerTip = untickedShelleyLedgerTip
       , tickedShelleyLedgerTransition = tickedShelleyLedgerTransition
       , tickedShelleyLedgerState = tickedShelleyLedgerState'
-      , tickedShelleyLedgerTables = LedgerTables (ValuesMK (SL.unUTxO tbs))
+      , tickedShelleyLedgerTables = LedgerTables (ValuesMK (coerceTxInMapKeys (SL.unUTxO tbs)))
       }
    where
     (tbs, tickedShelleyLedgerState') = tickedShelleyLedgerState `slUtxoL` mempty
@@ -583,6 +635,7 @@ instance
   getBlockKeySets =
     LedgerTables
       . KeysMK
+      . coerceTxInSet
       . Core.neededTxInsForBlock
       . shelleyBlockRaw
 

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -98,8 +98,10 @@ import Ouroboros.Consensus.Ledger.Tables.Utils
 import Ouroboros.Consensus.Shelley.Eras
 import Ouroboros.Consensus.Shelley.Ledger.Block
 import Ouroboros.Consensus.Shelley.Ledger.Ledger
-  ( ShelleyLedgerConfig (shelleyLedgerGlobals)
+  ( BigEndianTxIn (..)
+  , ShelleyLedgerConfig (shelleyLedgerGlobals)
   , Ticked (TickedShelleyLedgerState, tickedShelleyLedgerState)
+  , coerceTxInSet
   , getPParams
   )
 import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
@@ -177,8 +179,9 @@ instance
 
   getTransactionKeySets (ShelleyTx _ tx) =
     LedgerTables $
-      KeysMK
-        (tx ^. bodyTxL . allInputsTxBodyF)
+      KeysMK $
+        coerceTxInSet
+          (tx ^. bodyTxL . allInputsTxBodyF)
 
 mkShelleyTx :: forall era proto. ShelleyBasedEra era => Tx era -> GenTx (ShelleyBlock proto era)
 mkShelleyTx tx = ShelleyTx (txIdTx tx) tx