Skip to content

Commit 04c14d5

Browse files
jasagredojasagredo
authored
Extract backends into separate sublibraries (#1653)
# Description Extract the LSM and LMDB backends into separate sublibraries inside `ouroboros-consensus`. This will allow downstream clients to disable the dependency on such sublibraries which removes dependencies on external C libraries.
2 parents 90a926f + c7b258d commit 04c14d5

File tree

39 files changed

+1467
-1246
lines changed

39 files changed

+1467
-1246
lines changed

‎ouroboros-consensus-cardano/app/DBAnalyser/Parsers.hs‎

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -43,12 +43,7 @@ parseDBAnalyserConfig =
4343
<*> parseAnalysis
4444
<*> parseLimit
4545
<*> Foldable.asum
46-
[ flag' V1InMem $
47-
mconcat
48-
[ long "v1-in-mem"
49-
, help "use v1 in-memory backing store [deprecated]"
50-
]
51-
, flag' V1LMDB $
46+
[ flag' V1LMDB $
5247
mconcat
5348
[ long "lmdb"
5449
, help "use v1 LMDB backing store"

‎ouroboros-consensus-cardano/app/Ouroboros/Consensus/Cardano/StreamingLedgerTables.hs‎

Lines changed: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
1+
{-# LANGUAGE ScopedTypeVariables #-}
2+
{-# LANGUAGE TypeApplications #-}
3+
{-# LANGUAGE TypeOperators #-}
4+
5+
module Ouroboros.Consensus.Cardano.StreamingLedgerTables
6+
( mkInMemYieldArgs
7+
, mkInMemSinkArgs
8+
) where
9+
10+
import Cardano.Ledger.Binary
11+
import Cardano.Ledger.Core (ByronEra, Era, eraDecoder, toEraCBOR)
12+
import qualified Cardano.Ledger.Shelley.API as SL
13+
import qualified Cardano.Ledger.Shelley.LedgerState as SL
14+
import qualified Cardano.Ledger.State as SL
15+
import qualified Codec.CBOR.Encoding
16+
import Control.ResourceRegistry
17+
import Data.Proxy
18+
import Data.SOP.BasicFunctors
19+
import Data.SOP.Functors
20+
import Data.SOP.Strict
21+
import qualified Data.SOP.Telescope as Telescope
22+
import Lens.Micro
23+
import Ouroboros.Consensus.Byron.Ledger
24+
import Ouroboros.Consensus.Cardano.Block
25+
import Ouroboros.Consensus.Cardano.Ledger
26+
import Ouroboros.Consensus.HardFork.Combinator
27+
import Ouroboros.Consensus.HardFork.Combinator.State
28+
import Ouroboros.Consensus.Ledger.Abstract
29+
import Ouroboros.Consensus.Shelley.Ledger
30+
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
31+
import Ouroboros.Consensus.Storage.LedgerDB.API
32+
import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as V2
33+
import System.Directory
34+
import System.FS.API
35+
import System.FS.IO
36+
37+
type L = LedgerState (CardanoBlock StandardCrypto)
38+
39+
mkInMemYieldArgs :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO V2.Mem L)
40+
mkInMemYieldArgs fp (HardForkLedgerState (HardForkState idx)) _ =
41+
let
42+
np ::
43+
NP
44+
(Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
45+
(CardanoEras StandardCrypto)
46+
np =
47+
(Fn $ const $ K $ error "Byron")
48+
:* (Fn $ K . fromEra ShelleyTxOut . unFlip . currentState)
49+
:* (Fn $ K . fromEra AllegraTxOut . unFlip . currentState)
50+
:* (Fn $ K . fromEra MaryTxOut . unFlip . currentState)
51+
:* (Fn $ K . fromEra AlonzoTxOut . unFlip . currentState)
52+
:* (Fn $ K . fromEra BabbageTxOut . unFlip . currentState)
53+
:* (Fn $ K . fromEra ConwayTxOut . unFlip . currentState)
54+
:* (Fn $ K . fromEra DijkstraTxOut . unFlip . currentState)
55+
:* Nil
56+
in
57+
pure $
58+
YieldInMemory
59+
(SomeHasFS . ioHasFS)
60+
fp
61+
(hcollapse $ hap np $ Telescope.tip idx)
62+
where
63+
fromEra ::
64+
forall proto era.
65+
ShelleyCompatible proto era =>
66+
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut StandardCrypto) ->
67+
LedgerState (ShelleyBlock proto era) EmptyMK ->
68+
Decoders L
69+
fromEra toCardanoTxOut st =
70+
let certInterns =
71+
internsFromMap $
72+
shelleyLedgerState st
73+
^. SL.nesEsL
74+
. SL.esLStateL
75+
. SL.lsCertStateL
76+
. SL.certDStateL
77+
. SL.accountsL
78+
. SL.accountsMapL
79+
in Decoders
80+
(eraDecoder @era decodeMemPack)
81+
(eraDecoder @era $ toCardanoTxOut <$> decShareCBOR certInterns)
82+
83+
mkInMemSinkArgs ::
84+
FilePath ->
85+
L EmptyMK ->
86+
ResourceRegistry IO ->
87+
IO (SinkArgs IO V2.Mem L)
88+
mkInMemSinkArgs fp (HardForkLedgerState (HardForkState idx)) _ = do
89+
currDir <- getCurrentDirectory
90+
let
91+
np =
92+
(Fn $ const $ K $ encOne (Proxy @ByronEra))
93+
:* (Fn $ const $ K $ encOne (Proxy @ShelleyEra))
94+
:* (Fn $ const $ K $ encOne (Proxy @AllegraEra))
95+
:* (Fn $ const $ K $ encOne (Proxy @MaryEra))
96+
:* (Fn $ const $ K $ encOne (Proxy @AlonzoEra))
97+
:* (Fn $ const $ K $ encOne (Proxy @BabbageEra))
98+
:* (Fn $ const $ K $ encOne (Proxy @ConwayEra))
99+
:* (Fn $ const $ K $ encOne (Proxy @DijkstraEra))
100+
:* Nil
101+
pure $
102+
uncurry
103+
(SinkInMemory 1000)
104+
(hcollapse $ hap np $ Telescope.tip idx)
105+
(SomeHasFS $ ioHasFS $ MountPoint currDir)
106+
fp
107+
where
108+
encOne ::
109+
forall era.
110+
Era era =>
111+
Proxy era ->
112+
(TxIn L -> Codec.CBOR.Encoding.Encoding, TxOut L -> Codec.CBOR.Encoding.Encoding)
113+
encOne _ =
114+
(toEraCBOR @era . encodeMemPack, toEraCBOR @era . eliminateCardanoTxOut (const encodeMemPack))

‎ouroboros-consensus-cardano/app/snapshot-converter.hs‎

Lines changed: 43 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,10 @@
11
{-# LANGUAGE DeriveAnyClass #-}
22
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE GADTs #-}
34
{-# LANGUAGE LambdaCase #-}
45
{-# LANGUAGE OverloadedStrings #-}
56
{-# LANGUAGE RecordWildCards #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
68
{-# LANGUAGE TupleSections #-}
79
{-# LANGUAGE TypeApplications #-}
810
{-# LANGUAGE ViewPatterns #-}
@@ -30,11 +32,12 @@ import Ouroboros.Consensus.Config
3032
import Ouroboros.Consensus.Ledger.Basics
3133
import Ouroboros.Consensus.Ledger.Extended
3234
import Ouroboros.Consensus.Node.ProtocolInfo
35+
import Ouroboros.Consensus.Storage.LedgerDB.API
3336
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
3437
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as V1
38+
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
3539
import Ouroboros.Consensus.Util.CRC
36-
import Ouroboros.Consensus.Util.IOLike
37-
import Ouroboros.Consensus.Util.StreamingLedgerTables
40+
import Ouroboros.Consensus.Util.IOLike hiding (yield)
3841
import System.Console.ANSI
3942
import qualified System.Directory as D
4043
import System.Exit
@@ -45,6 +48,7 @@ import System.FilePath (splitDirectories)
4548
import qualified System.FilePath as F
4649
import System.IO
4750
import System.ProgressBar
51+
import System.Random
4852

4953
data Format
5054
= Mem FilePath
@@ -215,24 +219,29 @@ instance StandardHash blk => Show (Error blk) where
215219
["Error when reading entries in the UTxO tables: ", show df]
216220
show Cancelled = "Cancelled"
217221

218-
data InEnv = InEnv
222+
data InEnv backend = InEnv
219223
{ inState :: LedgerState (CardanoBlock StandardCrypto) EmptyMK
220224
, inFilePath :: FilePath
221225
, inStream ::
222226
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
223227
ResourceRegistry IO ->
224-
IO (YieldArgs (LedgerState (CardanoBlock StandardCrypto)) IO)
228+
IO (SomeBackend YieldArgs)
225229
, inProgressMsg :: String
226230
, inCRC :: CRC
227231
, inSnapReadCRC :: Maybe CRC
228232
}
229233

230-
data OutEnv = OutEnv
234+
data SomeBackend c where
235+
SomeBackend ::
236+
StreamingBackend IO backend (LedgerState (CardanoBlock StandardCrypto)) =>
237+
c IO backend (LedgerState (CardanoBlock StandardCrypto)) -> SomeBackend c
238+
239+
data OutEnv backend = OutEnv
231240
{ outFilePath :: FilePath
232241
, outStream ::
233242
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
234243
ResourceRegistry IO ->
235-
IO (SinkArgs (LedgerState (CardanoBlock StandardCrypto)) IO)
244+
IO (SomeBackend SinkArgs)
236245
, outCreateExtra :: Maybe FilePath
237246
, outDeleteExtra :: Maybe FilePath
238247
, outProgressMsg :: String
@@ -356,7 +365,7 @@ main = withStdTerminalHandles $ do
356365
InEnv
357366
st
358367
fp
359-
(fromInMemory (fp F.</> "tables"))
368+
(\a b -> SomeBackend <$> mkInMemYieldArgs (fp F.</> "tables") a b)
360369
("InMemory@[" <> fp <> "]")
361370
c
362371
mtd
@@ -375,7 +384,7 @@ main = withStdTerminalHandles $ do
375384
InEnv
376385
st
377386
fp
378-
(fromLMDB (fp F.</> "tables") defaultLMDBLimits)
387+
(\a b -> SomeBackend <$> V1.mkLMDBYieldArgs (fp F.</> "tables") defaultLMDBLimits a b)
379388
("LMDB@[" <> fp <> "]")
380389
c
381390
mtd
@@ -394,7 +403,9 @@ main = withStdTerminalHandles $ do
394403
InEnv
395404
st
396405
fp
397-
(fromLSM lsmDbPath (last $ splitDirectories fp))
406+
( \a b ->
407+
SomeBackend <$> mkLSMYieldArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
408+
)
398409
("LSM@[" <> lsmDbPath <> "]")
399410
c
400411
mtd
@@ -412,7 +423,7 @@ main = withStdTerminalHandles $ do
412423
pure $
413424
OutEnv
414425
fp
415-
(toInMemory (fp F.</> "tables"))
426+
(\a b -> SomeBackend <$> mkInMemSinkArgs (fp F.</> "tables") a b)
416427
(Just "tables")
417428
(Nothing)
418429
("InMemory@[" <> fp <> "]")
@@ -429,7 +440,7 @@ main = withStdTerminalHandles $ do
429440
pure $
430441
OutEnv
431442
fp
432-
(toLMDB fp defaultLMDBLimits)
443+
(\a b -> SomeBackend <$> V1.mkLMDBSinkArgs fp defaultLMDBLimits a b)
433444
Nothing
434445
Nothing
435446
("LMDB@[" <> fp <> "]")
@@ -446,12 +457,32 @@ main = withStdTerminalHandles $ do
446457
pure $
447458
OutEnv
448459
fp
449-
(toLSM lsmDbPath (last $ splitDirectories fp))
460+
( \a b ->
461+
SomeBackend <$> mkLSMSinkArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
462+
)
450463
Nothing
451464
(Just lsmDbPath)
452465
("LSM@[" <> lsmDbPath <> "]")
453466
UTxOHDLSMSnapshot
454467

468+
stream ::
469+
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
470+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
471+
ResourceRegistry IO ->
472+
IO (SomeBackend YieldArgs)
473+
) ->
474+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
475+
ResourceRegistry IO ->
476+
IO (SomeBackend SinkArgs)
477+
) ->
478+
ExceptT DeserialiseFailure IO (Maybe CRC, Maybe CRC)
479+
stream st mYieldArgs mSinkArgs =
480+
ExceptT $
481+
withRegistry $ \reg -> do
482+
(SomeBackend (yArgs :: YieldArgs IO backend1 l)) <- mYieldArgs st reg
483+
(SomeBackend (sArgs :: SinkArgs IO backend2 l)) <- mSinkArgs st reg
484+
runExceptT $ yield (Proxy @backend1) yArgs st $ sink (Proxy @backend2) sArgs st
485+
455486
-- Helpers
456487

457488
-- UI

‎ouroboros-consensus-cardano/changelog.d/20251010_121135_javier.sagredo_extract_2.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
<!--
2+
EMPTY as all changes belong to db-analyser and snapshot-converter
3+
-->

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

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,6 @@ library
101101
Ouroboros.Consensus.Cardano.Ledger
102102
Ouroboros.Consensus.Cardano.Node
103103
Ouroboros.Consensus.Cardano.QueryHF
104-
Ouroboros.Consensus.Cardano.StreamingLedgerTables
105104
Ouroboros.Consensus.Shelley.Crypto
106105
Ouroboros.Consensus.Shelley.Eras
107106
Ouroboros.Consensus.Shelley.HFEras
@@ -160,10 +159,7 @@ library
160159
contra-tracer,
161160
crypton,
162161
deepseq,
163-
directory,
164-
filepath,
165162
formatting >=6.3 && <7.3,
166-
fs-api,
167163
measures,
168164
mempack,
169165
microlens,
@@ -172,15 +168,12 @@ library
172168
ouroboros-consensus ^>=0.28,
173169
ouroboros-consensus-protocol ^>=0.13,
174170
ouroboros-network-api ^>=0.16,
175-
random,
176-
resource-registry,
177171
serialise ^>=0.2,
178172
singletons ^>=3.0,
179173
small-steps,
180174
sop-core ^>=0.5,
181175
sop-extras ^>=0.4,
182176
strict-sop-core ^>=0.1,
183-
temporary,
184177
text,
185178
these ^>=1.2,
186179
validation,
@@ -593,7 +586,7 @@ library unstable-cardano-tools
593586
network,
594587
network-mux,
595588
nothunks,
596-
ouroboros-consensus ^>=0.28,
589+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm} ^>=0.28,
597590
ouroboros-consensus-cardano,
598591
ouroboros-consensus-diffusion ^>=0.24,
599592
ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib} ^>=0.13,
@@ -701,21 +694,33 @@ executable immdb-server
701694
executable snapshot-converter
702695
import: common-exe
703696
hs-source-dirs: app
697+
other-modules:
698+
Ouroboros.Consensus.Cardano.StreamingLedgerTables
699+
704700
main-is: snapshot-converter.hs
705701
build-depends:
706702
ansi-terminal,
707703
base,
708704
cardano-crypto-class,
705+
cardano-ledger-binary,
706+
cardano-ledger-core,
707+
cardano-ledger-shelley,
708+
cborg,
709709
directory,
710710
filepath,
711711
fs-api,
712+
microlens,
712713
mtl,
713714
optparse-applicative,
714-
ouroboros-consensus,
715+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm},
715716
ouroboros-consensus-cardano,
716717
ouroboros-consensus-cardano:unstable-cardano-tools,
718+
random,
717719
resource-registry,
718720
serialise,
721+
sop-core,
722+
sop-extras,
723+
strict-sop-core,
719724
terminal-progress-bar,
720725
text,
721726
with-utf8,

0 commit comments

Comments
 (0)