Skip to content

Commit 4c06bb6

Browse files
jasagredojasagredo
committed
Hide LSM Type-classes
1 parent dbe86b7 commit 4c06bb6

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
@@ -38,15 +38,13 @@ import Codec.CBOR.Decoding
3838
import Codec.CBOR.Encoding
3939
import qualified Data.Map as Map
4040
import Data.MemPack
41-
import qualified Data.Primitive.ByteArray as PBA
4241
import Data.Proxy
4342
import Data.SOP.BasicFunctors
4443
import Data.SOP.Functors
4544
import Data.SOP.Index
4645
import Data.SOP.Strict
4746
import qualified Data.SOP.Tails as Tails
4847
import qualified Data.SOP.Telescope as Telescope
49-
import Data.Vector.Primitive (Vector (..))
5048
import Data.Void
5149
import GHC.Generics (Generic)
5250
import Lens.Micro
@@ -64,7 +62,6 @@ import Ouroboros.Consensus.Shelley.Ledger
6462
, ShelleyCompatible
6563
, shelleyLedgerState
6664
)
67-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
6865
import Ouroboros.Consensus.TypeFamilyWrappers
6966
import Ouroboros.Consensus.Util.IndexedMemPack
7067

@@ -76,7 +73,7 @@ instance
7673
{ getCardanoTxIn :: SL.TxIn
7774
}
7875
deriving stock (Show, Eq, Ord)
79-
deriving newtype (NoThunks, SerialiseKey)
76+
deriving newtype NoThunks
8077

8178
injectCanonicalTxIn IZ byronTxIn = absurd byronTxIn
8279
injectCanonicalTxIn (IS idx) shelleyTxIn = case idx of
@@ -117,22 +114,6 @@ data CardanoTxOut c
117114
deriving stock (Show, Eq, Generic)
118115
deriving anyclass NoThunks
119116

120-
instance SerialiseValue RawBytes where
121-
serialiseValue = id
122-
deserialiseValue = id
123-
124-
deriving via ResolveAsFirst RawBytes instance ResolveValue RawBytes
125-
126-
instance CardanoHardForkConstraints c => LedgerSupportsLSMLedgerDB (LedgerState (CardanoBlock c)) where
127-
type LSMTxOut (LedgerState (CardanoBlock c)) = RawBytes
128-
toLSMTxOut _ txout =
129-
let barr = eliminateCardanoTxOut (const pack) txout
130-
in RawBytes (Vector 0 (PBA.sizeofByteArray barr) barr)
131-
fromLSMTxOut st (RawBytes (Vector _ _ barr)) =
132-
indexedUnpackError st barr
133-
lsmSnapLabel _ = "Cardano"
134-
lsmIndex _ = CompactIndex
135-
136117
-- | Eliminate the wrapping of CardanoTxOut with the provided function. Similar
137118
-- to 'hcimap' on an 'NS'.
138119
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
@@ -93,7 +93,6 @@ import Ouroboros.Consensus.Shelley.Ledger
9393
import Ouroboros.Consensus.Shelley.Node
9494
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
9595
import Ouroboros.Consensus.Storage.LedgerDB
96-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
9796
import Ouroboros.Consensus.TypeFamilyWrappers
9897
import Ouroboros.Consensus.Util (eitherToMaybe)
9998
import Ouroboros.Consensus.Util.IOLike (IOLike)
@@ -194,8 +193,6 @@ type ShelleyBasedHardForkConstraints proto1 era1 proto2 era2 =
194193
, proto1 ~ proto2
195194
, MemPack (TxOut (LedgerState (ShelleyBlock proto1 era1)))
196195
, MemPack (TxOut (LedgerState (ShelleyBlock proto2 era2)))
197-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto1 era1))
198-
, LedgerSupportsLSMLedgerDB (LedgerState (ShelleyBlock proto2 era2))
199196
)
200197

201198
class TranslateTxMeasure a b where
@@ -500,7 +497,7 @@ instance
500497
{ getShelleyHFCTxIn :: SL.TxIn
501498
}
502499
deriving stock (Show, Eq, Ord)
503-
deriving newtype NoThunks
500+
deriving newtype (NoThunks, MemPack)
504501

505502
injectCanonicalTxIn IZ txIn = ShelleyHFCTxIn txIn
506503
injectCanonicalTxIn (IS IZ) txIn = ShelleyHFCTxIn (coerce txIn)
@@ -510,34 +507,6 @@ instance
510507
ejectCanonicalTxIn (IS IZ) txIn = coerce (getShelleyHFCTxIn txIn)
511508
ejectCanonicalTxIn (IS (IS idx')) _ = case idx' of {}
512509

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

0 commit comments

Comments
 (0)