Skip to content

Commit 1a593c4

Browse files
jasagredojasagredo
committed
Hide LSM Type-classes
1 parent 057118f commit 1a593c4

File tree

28 files changed

+134
-373
lines changed

28 files changed

+134
-373
lines changed

‎ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,6 @@ library
167167
ouroboros-consensus ^>=0.27,
168168
ouroboros-consensus-protocol ^>=0.12,
169169
ouroboros-network-api ^>=0.16,
170-
primitive,
171170
serialise ^>=0.2,
172171
singletons ^>=3.0,
173172
small-steps,
@@ -177,7 +176,6 @@ library
177176
text,
178177
these ^>=1.2,
179178
validation,
180-
vector,
181179
vector-map,
182180

183181
library unstable-byronspec

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/ByronHFC.hs

Lines changed: 1 addition & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,6 @@ import Ouroboros.Consensus.Ledger.Query
4646
import Ouroboros.Consensus.Node.NetworkProtocolVersion
4747
import Ouroboros.Consensus.Node.Serialisation
4848
import Ouroboros.Consensus.Protocol.PBFT (PBft, PBftCrypto)
49-
import Ouroboros.Consensus.Storage.LedgerDB
50-
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
5149
import Ouroboros.Consensus.Storage.Serialisation
5250
import Ouroboros.Consensus.Util.IndexedMemPack
5351

@@ -295,7 +293,7 @@ instance HasCanonicalTxIn '[ByronBlock] where
295293
{ getByronHFCTxIn :: Void
296294
}
297295
deriving stock (Show, Eq, Ord)
298-
deriving newtype (NoThunks, MemPack, LSM.SerialiseKey)
296+
deriving newtype (NoThunks, MemPack)
299297

300298
injectCanonicalTxIn IZ key = absurd key
301299
injectCanonicalTxIn (IS idx') _ = case idx' of {}
@@ -314,15 +312,6 @@ deriving via
314312
instance
315313
IndexedMemPack (LedgerState (HardForkBlock '[ByronBlock]) EmptyMK) Void
316314

317-
instance LedgerSupportsLSMLedgerDB (LedgerState (HardForkBlock '[ByronBlock])) where
318-
type
319-
LSMTxOut (LedgerState (HardForkBlock '[ByronBlock])) =
320-
TxOut (LedgerState (HardForkBlock '[ByronBlock]))
321-
toLSMTxOut _ = id
322-
fromLSMTxOut _ = id
323-
lsmIndex _ = LSM.OrdinaryIndex
324-
lsmSnapLabel _ = "ByronHFC"
325-
326315
instance BlockSupportsHFLedgerQuery '[ByronBlock] where
327316
answerBlockQueryHFLookup IZ _cfg (q :: BlockQuery ByronBlock QFLookupTables result) _dlv = case q of {}
328317
answerBlockQueryHFLookup (IS is) _cfg _q _dlv = case is of {}

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs

Lines changed: 1 addition & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,6 @@ import Ouroboros.Consensus.Ledger.SupportsPeerSelection
9393
import Ouroboros.Consensus.Ledger.SupportsProtocol
9494
import Ouroboros.Consensus.Ledger.Tables.Utils
9595
import Ouroboros.Consensus.Storage.LedgerDB
96-
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
9796
import Ouroboros.Consensus.Util (ShowProxy (..))
9897
import Ouroboros.Consensus.Util.IndexedMemPack
9998

@@ -189,6 +188,7 @@ data instance Ticked (LedgerState ByronBlock) mk = TickedByronLedgerState
189188
instance IsLedger (LedgerState ByronBlock) where
190189
type LedgerErr (LedgerState ByronBlock) = CC.ChainValidationError
191190

191+
type LedgerBlock (LedgerState ByronBlock) = ByronBlock
192192
type
193193
AuxLedgerEvent (LedgerState ByronBlock) =
194194
VoidLedgerEvent (LedgerState ByronBlock)
@@ -205,14 +205,6 @@ instance IsLedger (LedgerState ByronBlock) where
205205
type instance TxIn (LedgerState ByronBlock) = Void
206206
type instance TxOut (LedgerState ByronBlock) = Void
207207

208-
-- Byron has no ledger tables, therefore we don't need to convert to and from LSMTxOut
209-
instance LedgerSupportsLSMLedgerDB (LedgerState ByronBlock) where
210-
type LSMTxOut (LedgerState ByronBlock) = TxOut (LedgerState ByronBlock)
211-
toLSMTxOut _ = id
212-
fromLSMTxOut _ = id
213-
lsmIndex _ = LSM.OrdinaryIndex
214-
lsmSnapLabel _ = "Byron"
215-
216208
instance LedgerTablesAreTrivial (LedgerState ByronBlock) where
217209
convertMapKind (ByronLedgerState x y z) = ByronLedgerState x y z
218210
instance LedgerTablesAreTrivial (Ticked (LedgerState ByronBlock)) where

‎ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs

Lines changed: 1 addition & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -39,15 +39,13 @@ import Codec.CBOR.Decoding
3939
import Codec.CBOR.Encoding
4040
import qualified Data.Map as Map
4141
import Data.MemPack
42-
import qualified Data.Primitive.ByteArray as PBA
4342
import Data.Proxy
4443
import Data.SOP.BasicFunctors
4544
import Data.SOP.Functors
4645
import Data.SOP.Index
4746
import Data.SOP.Strict
4847
import qualified Data.SOP.Tails as Tails
4948
import qualified Data.SOP.Telescope as Telescope
50-
import Data.Vector.Primitive (Vector (..))
5149
import Data.Void
5250
import GHC.Generics (Generic)
5351
import Lens.Micro
@@ -65,7 +63,6 @@ import Ouroboros.Consensus.Shelley.Ledger
6563
, ShelleyCompatible
6664
, shelleyLedgerState
6765
)
68-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
6966
import Ouroboros.Consensus.TypeFamilyWrappers
7067
import Ouroboros.Consensus.Util.IndexedMemPack
7168

@@ -77,7 +74,7 @@ instance
7774
{ getCardanoTxIn :: SL.TxIn
7875
}
7976
deriving stock (Show, Eq, Ord)
80-
deriving newtype (NoThunks, SerialiseKey)
77+
deriving newtype NoThunks
8178

8279
injectCanonicalTxIn IZ byronTxIn = absurd byronTxIn
8380
injectCanonicalTxIn (IS idx) shelleyTxIn = case idx of
@@ -118,22 +115,6 @@ data CardanoTxOut c
118115
deriving stock (Show, Eq, Generic)
119116
deriving anyclass NoThunks
120117

121-
instance SerialiseValue RawBytes where
122-
serialiseValue = id
123-
deserialiseValue = id
124-
125-
deriving via ResolveAsFirst RawBytes instance ResolveValue RawBytes
126-
127-
instance CardanoHardForkConstraints c => LedgerSupportsLSMLedgerDB (LedgerState (CardanoBlock c)) where
128-
type LSMTxOut (LedgerState (CardanoBlock c)) = RawBytes
129-
toLSMTxOut _ txout =
130-
let barr = eliminateCardanoTxOut (const pack) txout
131-
in RawBytes (Vector 0 (PBA.sizeofByteArray barr) barr)
132-
fromLSMTxOut st (RawBytes (Vector _ _ barr)) =
133-
indexedUnpackError st barr
134-
lsmSnapLabel _ = "Cardano"
135-
lsmIndex _ = CompactIndex
136-
137118
-- | Eliminate the wrapping of CardanoTxOut with the provided function. Similar
138119
-- to 'hcimap' on an 'NS'.
139120
eliminateCardanoTxOut ::

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Eras.hs

Lines changed: 1 addition & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@
77
{-# LANGUAGE LambdaCase #-}
88
{-# LANGUAGE MultiParamTypeClasses #-}
99
{-# LANGUAGE ScopedTypeVariables #-}
10-
{-# LANGUAGE StandaloneDeriving #-}
1110
{-# LANGUAGE TypeApplications #-}
1211
{-# LANGUAGE TypeFamilies #-}
1312
{-# LANGUAGE UndecidableInstances #-}
@@ -38,7 +37,7 @@ module Ouroboros.Consensus.Shelley.Eras
3837
import Cardano.Binary
3938
import Cardano.Ledger.Allegra (AllegraEra)
4039
import Cardano.Ledger.Allegra.Translation ()
41-
import Cardano.Ledger.Alonzo (AlonzoEra, AlonzoTxOut)
40+
import Cardano.Ledger.Alonzo (AlonzoEra)
4241
import Cardano.Ledger.Alonzo.Core as Core
4342
import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
4443
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
@@ -72,7 +71,6 @@ import Ouroboros.Consensus.Ledger.SupportsMempool
7271
( WhetherToIntervene (..)
7372
)
7473
import Ouroboros.Consensus.Protocol.TPraos (StandardCrypto)
75-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
7674

7775
{-------------------------------------------------------------------------------
7876
Era polymorphism
@@ -331,46 +329,3 @@ instance SupportsTwoPhaseValidation DijkstraEra where
331329
)
332330
) -> True
333331
_ -> False
334-
335-
{-------------------------------------------------------------------------------
336-
SerialiseValue
337-
338-
These instances are necessary only to support threadnet shelley tests and the
339-
unstable-cardano-tools library.
340-
-------------------------------------------------------------------------------}
341-
342-
instance SerialiseValue (SL.ShelleyTxOut ShelleyEra) where
343-
serialiseValue = serialiseLSMViaMemPack
344-
deserialiseValue = deserialiseLSMViaMemPack
345-
346-
deriving via
347-
ResolveAsFirst (SL.ShelleyTxOut ShelleyEra)
348-
instance
349-
ResolveValue (SL.ShelleyTxOut ShelleyEra)
350-
351-
instance SerialiseValue (SL.ShelleyTxOut AllegraEra) where
352-
serialiseValue = serialiseLSMViaMemPack
353-
deserialiseValue = deserialiseLSMViaMemPack
354-
355-
deriving via
356-
ResolveAsFirst (SL.ShelleyTxOut AllegraEra)
357-
instance
358-
ResolveValue (SL.ShelleyTxOut AllegraEra)
359-
360-
instance SerialiseValue (SL.ShelleyTxOut MaryEra) where
361-
serialiseValue = serialiseLSMViaMemPack
362-
deserialiseValue = deserialiseLSMViaMemPack
363-
364-
deriving via
365-
ResolveAsFirst (SL.ShelleyTxOut MaryEra)
366-
instance
367-
ResolveValue (SL.ShelleyTxOut MaryEra)
368-
369-
instance SerialiseValue (AlonzoTxOut AlonzoEra) where
370-
serialiseValue = serialiseLSMViaMemPack
371-
deserialiseValue = deserialiseLSMViaMemPack
372-
373-
deriving via
374-
ResolveAsFirst (AlonzoTxOut AlonzoEra)
375-
instance
376-
ResolveValue (AlonzoTxOut AlonzoEra)

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs

Lines changed: 2 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -130,8 +130,6 @@ import Ouroboros.Consensus.Shelley.Protocol.Abstract
130130
, mkHeaderView
131131
)
132132
import Ouroboros.Consensus.Storage.LedgerDB
133-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
134-
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
135133
import Ouroboros.Consensus.Util.CBOR
136134
( decodeWithOrigin
137135
, encodeWithOrigin
@@ -322,36 +320,6 @@ instance ShelleyCompatible proto era => UpdateLedger (ShelleyBlock proto era)
322320
type instance TxIn (LedgerState (ShelleyBlock proto era)) = SL.TxIn
323321
type instance TxOut (LedgerState (ShelleyBlock proto era)) = Core.TxOut era
324322

325-
-- | We use this newtype only to alter MemPack serialization. LSM trees use an
326-
-- index that looks at the first 8 bytes, so it is important to put the index
327-
-- first to avoid all TxIns from the same tx to cause a collision in
328-
-- the LSM index.
329-
newtype LSMTxIn = LSMTxIn {lsmTxIn :: SL.TxIn}
330-
331-
instance MemPack LSMTxIn where
332-
packedByteCount = packedByteCount . lsmTxIn
333-
packM (LSMTxIn (SL.TxIn txid txix)) = packM txix >> packM txid
334-
unpackM = LSMTxIn <$> (flip SL.TxIn <$> unpackM <*> unpackM)
335-
336-
instance SerialiseKey SL.TxIn where
337-
serialiseKey = serialiseLSMViaMemPack . LSMTxIn
338-
deserialiseKey = lsmTxIn . deserialiseLSMViaMemPack
339-
340-
instance
341-
( SerialiseValue (TxOut (LedgerState (ShelleyBlock proto era)))
342-
, ResolveValue (TxOut (LedgerState (ShelleyBlock proto era)))
343-
) =>
344-
LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto era))
345-
where
346-
type
347-
LSMTxOut (LedgerState (ShelleyBlock proto era)) =
348-
TxOut (LedgerState (ShelleyBlock proto era))
349-
350-
toLSMTxOut _ = id
351-
fromLSMTxOut _ = id
352-
lsmSnapLabel _ = "Shelley"
353-
lsmIndex _ = LSM.CompactIndex
354-
355323
instance
356324
(txout ~ Core.TxOut era, MemPack txout) =>
357325
IndexedMemPack (LedgerState (ShelleyBlock proto era) EmptyMK) txout
@@ -533,6 +501,8 @@ untickedShelleyLedgerTipPoint = shelleyTipToPoint . untickedShelleyLedgerTip
533501
instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era)) where
534502
type LedgerErr (LedgerState (ShelleyBlock proto era)) = SL.BlockTransitionError era
535503

504+
type LedgerBlock (LedgerState (ShelleyBlock proto era)) = ShelleyBlock proto era
505+
536506
type AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerEvent era
537507

538508
applyChainTickLedgerResult

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Ouroboros.Consensus.Shelley.Protocol.Abstract
5050
( ProtoCrypto
5151
, pHeaderIssuer
5252
)
53-
import Ouroboros.Consensus.Storage.LedgerDB.API
5453

5554
{-------------------------------------------------------------------------------
5655
ProtocolInfo
@@ -122,6 +121,5 @@ instance
122121
, TxLimits (ShelleyBlock proto era)
123122
, SerialiseNodeToClientConstraints (ShelleyBlock proto era)
124123
, Crypto (ProtoCrypto proto)
125-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto era))
126124
) =>
127125
RunNode (ShelleyBlock proto era)

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs

Lines changed: 1 addition & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -91,8 +91,6 @@ import Ouroboros.Consensus.Shelley.Ledger
9191
import Ouroboros.Consensus.Shelley.Ledger.Inspect as Shelley.Inspect
9292
import Ouroboros.Consensus.Shelley.Node ()
9393
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
94-
import Ouroboros.Consensus.Storage.LedgerDB.API
95-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
9694
import Ouroboros.Consensus.TypeFamilyWrappers
9795
import Ouroboros.Consensus.Util.IndexedMemPack
9896

@@ -169,7 +167,6 @@ instance
169167
, LedgerSupportsProtocol (ShelleyBlock proto era)
170168
, TxLimits (ShelleyBlock proto era)
171169
, Crypto (ProtoCrypto proto)
172-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto era))
173170
) =>
174171
SerialiseHFC '[ShelleyBlock proto era]
175172

@@ -431,27 +428,14 @@ instance
431428
{ getShelleyBlockHFCTxIn :: SL.TxIn
432429
}
433430
deriving stock (Show, Eq, Ord)
434-
deriving newtype (NoThunks, MemPack, SerialiseKey)
431+
deriving newtype (NoThunks, MemPack)
435432

436433
injectCanonicalTxIn IZ txIn = ShelleyBlockHFCTxIn txIn
437434
injectCanonicalTxIn (IS idx') _ = case idx' of {}
438435

439436
ejectCanonicalTxIn IZ txIn = getShelleyBlockHFCTxIn txIn
440437
ejectCanonicalTxIn (IS idx') _ = case idx' of {}
441438

442-
instance
443-
(SerialiseValue (SL.TxOut era), ResolveValue (SL.TxOut era)) =>
444-
LedgerSupportsLSMLedgerDB (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
445-
where
446-
type
447-
LSMTxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era])) =
448-
TxOut (LedgerState (HardForkBlock '[ShelleyBlock proto era]))
449-
450-
toLSMTxOut _ = id
451-
fromLSMTxOut _ = id
452-
lsmIndex _ = CompactIndex
453-
lsmSnapLabel _ = "ShelleyHFC"
454-
455439
{-------------------------------------------------------------------------------
456440
HardForkTxOut
457441
-------------------------------------------------------------------------------}

‎ouroboros-consensus-cardano/src/unstable-byronspec/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,8 @@ data instance Ticked (LedgerState ByronSpecBlock) mk = TickedByronSpecLedgerStat
109109
instance IsLedger (LedgerState ByronSpecBlock) where
110110
type LedgerErr (LedgerState ByronSpecBlock) = ByronSpecLedgerError
111111

112+
type LedgerBlock (LedgerState ByronSpecBlock) = ByronSpecBlock
113+
112114
type
113115
AuxLedgerEvent (LedgerState ByronSpecBlock) =
114116
VoidLedgerEvent (LedgerState ByronSpecBlock)

‎ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs

Lines changed: 1 addition & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,6 @@ import Ouroboros.Consensus.Shelley.Ledger
9494
import Ouroboros.Consensus.Shelley.Node
9595
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
9696
import Ouroboros.Consensus.Storage.LedgerDB
97-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
9897
import Ouroboros.Consensus.TypeFamilyWrappers
9998
import Ouroboros.Consensus.Util (eitherToMaybe)
10099
import Ouroboros.Consensus.Util.IOLike (IOLike)
@@ -195,8 +194,6 @@ type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =
195194
, proto1 ~ proto2
196195
, MemPack (TxOut (LedgerState (ShelleyBlock proto1 era1)))
197196
, MemPack (TxOut (LedgerState (ShelleyBlock proto2 era2)))
198-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto1 era1))
199-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto2 era2))
200197
)
201198

202199
class TranslateTxMeasure a b where
@@ -501,7 +498,7 @@ instance
501498
{ getShelleyHFCTxIn :: SL.TxIn
502499
}
503500
deriving stock (Show, Eq, Ord)
504-
deriving newtype NoThunks
501+
deriving newtype (NoThunks, MemPack)
505502

506503
injectCanonicalTxIn IZ txIn = ShelleyHFCTxIn txIn
507504
injectCanonicalTxIn (IS IZ) txIn = ShelleyHFCTxIn (coerce txIn)
@@ -511,34 +508,6 @@ instance
511508
ejectCanonicalTxIn (IS IZ) txIn = coerce (getShelleyHFCTxIn txIn)
512509
ejectCanonicalTxIn (IS (IS idx')) _ = case idx' of {}
513510

514-
deriving newtype instance
515-
ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =>
516-
MemPack (CanonicalTxIn (ShelleyBasedHardForkEras proto1 era1 proto2 era2))
517-
518-
instance
519-
ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =>
520-
LedgerSupportsLSMLedgerDB
521-
(LedgerState (HardForkBlock (ShelleyBasedHardForkEras proto1 era1 proto2 era2)))
522-
where
523-
type
524-
LSMTxOut (LedgerState (HardForkBlock (ShelleyBasedHardForkEras proto1 era1 proto2 era2))) =
525-
TxOut (LedgerState (HardForkBlock (ShelleyBasedHardForkEras proto1 era1 proto2 era2)))
526-
toLSMTxOut _ = id
527-
fromLSMTxOut _ = id
528-
lsmIndex _ = CompactIndex
529-
lsmSnapLabel _ =
530-
"ShelleyBasedHardFork_"
531-
++ lsmSnapLabel (Proxy @(LedgerState (ShelleyBlock proto1 era1)))
532-
++ "_"
533-
++ lsmSnapLabel (Proxy @(LedgerState (ShelleyBlock proto2 era2)))
534-
535-
instance
536-
ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =>
537-
SerialiseKey (CanonicalTxIn (ShelleyBasedHardForkEras proto1 era1 proto2 era2))
538-
where
539-
serialiseKey = serialiseLSMViaMemPack
540-
deserialiseKey = deserialiseLSMViaMemPack
541-
542511
instance
543512
ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =>
544513
HasHardForkTxOut (ShelleyBasedHardForkEras proto1 era1 proto2 era2)

0 commit comments

Comments
 (0)