Skip to content

Commit 14c81d8

Browse files
jasagredojasagredo
committed
Cleanup and move the functions to construct streaming args
1 parent 776c3b6 commit 14c81d8

File tree

10 files changed

+208
-185
lines changed

10 files changed

+208
-185
lines changed

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

Lines changed: 6 additions & 112 deletions
Original file line numberDiff line numberDiff line change
@@ -3,55 +3,41 @@
33
{-# LANGUAGE TypeOperators #-}
44

55
module Ouroboros.Consensus.Cardano.StreamingLedgerTables
6-
( fromInMemory
7-
, fromLSM
8-
, fromLMDB
9-
, toLMDB
10-
, toLSM
11-
, toInMemory
6+
( mkInMemYieldArgs
7+
, mkInMemSinkArgs
128
) where
139

14-
import Cardano.Ledger.BaseTypes (WithOrigin (..))
1510
import Cardano.Ledger.Binary
1611
import Cardano.Ledger.Core (ByronEra, Era, eraDecoder, toEraCBOR)
1712
import qualified Cardano.Ledger.Shelley.API as SL
1813
import qualified Cardano.Ledger.Shelley.LedgerState as SL
1914
import qualified Cardano.Ledger.State as SL
2015
import qualified Codec.CBOR.Encoding
2116
import Control.ResourceRegistry
22-
import Control.Tracer (nullTracer)
2317
import Data.Proxy
2418
import Data.SOP.BasicFunctors
2519
import Data.SOP.Functors
2620
import Data.SOP.Strict
2721
import qualified Data.SOP.Telescope as Telescope
28-
import qualified Data.Text as T
2922
import Lens.Micro
3023
import Ouroboros.Consensus.Byron.Ledger
3124
import Ouroboros.Consensus.Cardano.Block
3225
import Ouroboros.Consensus.Cardano.Ledger
3326
import Ouroboros.Consensus.HardFork.Combinator
3427
import Ouroboros.Consensus.HardFork.Combinator.State
3528
import Ouroboros.Consensus.Ledger.Abstract
36-
import Ouroboros.Consensus.Ledger.Tables.Utils (emptyLedgerTables)
3729
import Ouroboros.Consensus.Shelley.Ledger
3830
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
3931
import Ouroboros.Consensus.Storage.LedgerDB.API
40-
import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore as V1
41-
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
4232
import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as V2
43-
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
4433
import System.Directory
4534
import System.FS.API
4635
import System.FS.IO
47-
import System.FilePath as FilePath
48-
import System.IO.Temp
49-
import System.Random
5036

5137
type L = LedgerState (CardanoBlock StandardCrypto)
5238

53-
fromInMemory :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO V2.Mem L)
54-
fromInMemory fp (HardForkLedgerState (HardForkState idx)) _ =
39+
mkInMemYieldArgs :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO V2.Mem L)
40+
mkInMemYieldArgs fp (HardForkLedgerState (HardForkState idx)) _ =
5541
let
5642
np ::
5743
NP
@@ -94,89 +80,12 @@ fromInMemory fp (HardForkLedgerState (HardForkState idx)) _ =
9480
(eraDecoder @era decodeMemPack)
9581
(eraDecoder @era $ toCardanoTxOut <$> decShareCBOR certInterns)
9682

97-
fromLMDB ::
98-
FilePath -> LMDB.LMDBLimits -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO LMDB.LMDB L)
99-
fromLMDB fp limits hint reg = do
100-
let (dbPath, snapName) = splitFileName fp
101-
tempDir <- getCanonicalTemporaryDirectory
102-
let lmdbTemp = tempDir FilePath.</> "lmdb_streaming_in"
103-
removePathForcibly lmdbTemp
104-
_ <-
105-
allocate
106-
reg
107-
(\_ -> System.Directory.createDirectory lmdbTemp)
108-
(\_ -> removePathForcibly lmdbTemp)
109-
(_, bs) <-
110-
allocate
111-
reg
112-
( \_ -> do
113-
LMDB.newLMDBBackingStore
114-
nullTracer
115-
limits
116-
(LiveLMDBFS $ SomeHasFS $ ioHasFS $ MountPoint lmdbTemp)
117-
(SnapshotsFS $ SomeHasFS $ ioHasFS $ MountPoint dbPath)
118-
(InitFromCopy hint (mkFsPath [snapName]))
119-
)
120-
bsClose
121-
(_, bsvh) <- allocate reg (\_ -> bsValueHandle bs) bsvhClose
122-
pure (LMDB.YieldLMDB 1000 bsvh)
123-
124-
fromLSM ::
125-
FilePath ->
126-
String ->
127-
L EmptyMK ->
128-
ResourceRegistry IO ->
129-
IO (YieldArgs IO LSM L)
130-
fromLSM fp snapName _ reg = do
131-
(_, SomeHasFSAndBlockIO hasFS blockIO) <- stdMkBlockIOFS fp reg
132-
salt <- fst . genWord64 <$> newStdGen
133-
(_, session) <-
134-
allocate reg (\_ -> openSession nullTracer hasFS blockIO salt (mkFsPath [])) closeSession
135-
tb <-
136-
allocate
137-
reg
138-
( \_ ->
139-
openTableFromSnapshot
140-
session
141-
(toSnapshotName snapName)
142-
(SnapshotLabel $ T.pack "UTxO table")
143-
)
144-
closeTable
145-
YieldLSM 1000 <$> newLSMLedgerTablesHandle nullTracer reg tb
146-
147-
toLMDB ::
148-
FilePath ->
149-
LMDB.LMDBLimits ->
150-
L EmptyMK ->
151-
ResourceRegistry IO ->
152-
IO (SinkArgs IO LMDB.LMDB L)
153-
toLMDB fp limits hint reg = do
154-
let (snapDir, snapName) = splitFileName fp
155-
tempDir <- getCanonicalTemporaryDirectory
156-
let lmdbTemp = tempDir FilePath.</> "lmdb_streaming_out"
157-
removePathForcibly lmdbTemp
158-
_ <-
159-
allocate reg (\_ -> System.Directory.createDirectory lmdbTemp) (\_ -> removePathForcibly lmdbTemp)
160-
(_, bs) <-
161-
allocate
162-
reg
163-
( \_ ->
164-
LMDB.newLMDBBackingStore
165-
nullTracer
166-
limits
167-
(LiveLMDBFS $ SomeHasFS $ ioHasFS $ MountPoint lmdbTemp)
168-
(SnapshotsFS $ SomeHasFS $ ioHasFS $ MountPoint snapDir)
169-
(InitFromValues (At 0) hint emptyLedgerTables)
170-
)
171-
bsClose
172-
pure $ LMDB.SinkLMDB 1000 (bsWrite bs) (\h -> bsCopy bs h (mkFsPath [snapName, "tables"]))
173-
174-
toInMemory ::
83+
mkInMemSinkArgs ::
17584
FilePath ->
17685
L EmptyMK ->
17786
ResourceRegistry IO ->
17887
IO (SinkArgs IO V2.Mem L)
179-
toInMemory fp (HardForkLedgerState (HardForkState idx)) _ = do
88+
mkInMemSinkArgs fp (HardForkLedgerState (HardForkState idx)) _ = do
18089
currDir <- getCurrentDirectory
18190
let
18291
np =
@@ -203,18 +112,3 @@ toInMemory fp (HardForkLedgerState (HardForkState idx)) _ = do
203112
(TxIn L -> Codec.CBOR.Encoding.Encoding, TxOut L -> Codec.CBOR.Encoding.Encoding)
204113
encOne _ =
205114
(toEraCBOR @era . encodeMemPack, toEraCBOR @era . eliminateCardanoTxOut (const encodeMemPack))
206-
207-
toLSM ::
208-
FilePath ->
209-
String ->
210-
L EmptyMK ->
211-
ResourceRegistry IO ->
212-
IO (SinkArgs IO LSM L)
213-
toLSM fp snapName _ reg = do
214-
removePathForcibly fp
215-
System.Directory.createDirectory fp
216-
(_, SomeHasFSAndBlockIO hasFS blockIO) <- stdMkBlockIOFS fp reg
217-
salt <- fst . genWord64 <$> newStdGen
218-
(_, session) <-
219-
allocate reg (\_ -> newSession nullTracer hasFS blockIO salt (mkFsPath [])) closeSession
220-
pure (SinkLSM 1000 snapName session)

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

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ import Ouroboros.Consensus.Node.ProtocolInfo
3535
import Ouroboros.Consensus.Storage.LedgerDB.API
3636
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
3737
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as V1
38+
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
3839
import Ouroboros.Consensus.Util.CRC
3940
import Ouroboros.Consensus.Util.IOLike hiding (yield)
4041
import System.Console.ANSI
@@ -47,6 +48,7 @@ import System.FilePath (splitDirectories)
4748
import qualified System.FilePath as F
4849
import System.IO
4950
import System.ProgressBar
51+
import System.Random
5052

5153
data Format
5254
= Mem FilePath
@@ -363,7 +365,7 @@ main = withStdTerminalHandles $ do
363365
InEnv
364366
st
365367
fp
366-
(\a b -> SomeBackend <$> fromInMemory (fp F.</> "tables" F.</> "tvar") a b)
368+
(\a b -> SomeBackend <$> mkInMemYieldArgs (fp F.</> "tables" F.</> "tvar") a b)
367369
("InMemory@[" <> fp <> "]")
368370
c
369371
mtd
@@ -382,7 +384,7 @@ main = withStdTerminalHandles $ do
382384
InEnv
383385
st
384386
fp
385-
(\a b -> SomeBackend <$> fromLMDB (fp F.</> "tables") defaultLMDBLimits a b)
387+
(\a b -> SomeBackend <$> V1.mkLMDBYieldArgs (fp F.</> "tables") defaultLMDBLimits a b)
386388
("LMDB@[" <> fp <> "]")
387389
c
388390
mtd
@@ -401,7 +403,9 @@ main = withStdTerminalHandles $ do
401403
InEnv
402404
st
403405
fp
404-
(\a b -> SomeBackend <$> fromLSM lsmDbPath (last $ splitDirectories fp) a b)
406+
( \a b ->
407+
SomeBackend <$> mkLSMYieldArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
408+
)
405409
("LSM@[" <> lsmDbPath <> "]")
406410
c
407411
mtd
@@ -419,7 +423,7 @@ main = withStdTerminalHandles $ do
419423
pure $
420424
OutEnv
421425
fp
422-
(\a b -> SomeBackend <$> toInMemory (fp F.</> "tables" F.</> "tvar") a b)
426+
(\a b -> SomeBackend <$> mkInMemSinkArgs (fp F.</> "tables" F.</> "tvar") a b)
423427
(Just "tables")
424428
(Nothing)
425429
("InMemory@[" <> fp <> "]")
@@ -436,7 +440,7 @@ main = withStdTerminalHandles $ do
436440
pure $
437441
OutEnv
438442
fp
439-
(\a b -> SomeBackend <$> toLMDB fp defaultLMDBLimits a b)
443+
(\a b -> SomeBackend <$> V1.mkLMDBSinkArgs fp defaultLMDBLimits a b)
440444
Nothing
441445
Nothing
442446
("LMDB@[" <> fp <> "]")
@@ -453,7 +457,9 @@ main = withStdTerminalHandles $ do
453457
pure $
454458
OutEnv
455459
fp
456-
(\a b -> SomeBackend <$> toLSM lsmDbPath (last $ splitDirectories fp) a b)
460+
( \a b ->
461+
SomeBackend <$> mkLSMSinkArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
462+
)
457463
Nothing
458464
(Just lsmDbPath)
459465
("LSM@[" <> lsmDbPath <> "]")

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

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -160,7 +160,6 @@ library
160160
crypton,
161161
deepseq,
162162
formatting >=6.3 && <7.3,
163-
fs-api,
164163
measures,
165164
mempack,
166165
microlens,
@@ -169,15 +168,12 @@ library
169168
ouroboros-consensus ^>=0.27,
170169
ouroboros-consensus-protocol ^>=0.12,
171170
ouroboros-network-api ^>=0.16,
172-
random,
173-
resource-registry,
174171
serialise ^>=0.2,
175172
singletons ^>=3.0,
176173
small-steps,
177174
sop-core ^>=0.5,
178175
sop-extras ^>=0.4,
179176
strict-sop-core ^>=0.1,
180-
temporary,
181177
text,
182178
these ^>=1.2,
183179
validation,
@@ -589,7 +585,7 @@ library unstable-cardano-tools
589585
network,
590586
network-mux,
591587
nothunks,
592-
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb} ^>=0.27,
588+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm} ^>=0.27,
593589
ouroboros-consensus-cardano,
594590
ouroboros-consensus-diffusion ^>=0.23,
595591
ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib} ^>=0.12,
@@ -698,25 +694,32 @@ executable snapshot-converter
698694
import: common-exe
699695
hs-source-dirs: app
700696
other-modules:
701-
Ouroboros.Consensus.Cardano.StreamingLedgerTables
697+
Ouroboros.Consensus.Cardano.StreamingLedgerTables
702698

703699
main-is: snapshot-converter.hs
704700
build-depends:
705701
ansi-terminal,
706702
base,
707-
cardano-ledger-core, cardano-ledger-binary, cardano-ledger-shelley, cborg, contra-tracer, sop-core, sop-extras, strict-sop-core,
708703
cardano-crypto-class,
709-
microlens, temporary, random,
704+
cardano-ledger-binary,
705+
cardano-ledger-core,
706+
cardano-ledger-shelley,
707+
cborg,
710708
directory,
711709
filepath,
712710
fs-api,
711+
microlens,
713712
mtl,
714713
optparse-applicative,
715-
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb},
714+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm},
716715
ouroboros-consensus-cardano,
717716
ouroboros-consensus-cardano:unstable-cardano-tools,
717+
random,
718718
resource-registry,
719719
serialise,
720+
sop-core,
721+
sop-extras,
722+
strict-sop-core,
720723
terminal-progress-bar,
721724
text,
722725
with-utf8,

‎ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ openLedgerDB args = do
8282
bss
8383
(\_ -> pure (error "no stream"))
8484
snapManager
85-
(LedgerDB.praosGetVolatileSuffix $ LedgerDB.ledgerDbCfgSecParam $ LedgerDB.lgrConfig lgrDbArgs)
85+
(LedgerDB.praosGetVolatileSuffix $ LedgerDB.ledgerDbCfgSecParam $ LedgerDB.lgrConfig args)
8686
in LedgerDB.openDBInternal args initDb snapManager emptyStream genesisPoint
8787
LedgerDB.LedgerDbBackendArgsV2 (LedgerDB.V2.SomeBackendArgs bArgs) -> do
8888
res <-
@@ -104,7 +104,7 @@ openLedgerDB args = do
104104
args
105105
(\_ -> pure (error "no stream"))
106106
snapManager
107-
(LedgerDB.praosGetVolatileSuffix $ LedgerDB.ledgerDbCfgSecParam $ LedgerDB.lgrConfig lgrDbArgs)
107+
(LedgerDB.praosGetVolatileSuffix $ LedgerDB.ledgerDbCfgSecParam $ LedgerDB.lgrConfig args)
108108
res
109109
LedgerDB.openDBInternal args initDb snapManager emptyStream genesisPoint
110110
pure (ldb, od)

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -375,24 +375,24 @@ library ouroboros-consensus-lsm
375375
build-depends:
376376
base >=4.14 && <4.22,
377377
blockio,
378-
random,
379-
filepath,
380378
cardano-binary,
381379
containers >=0.5 && <0.8,
382380
contra-tracer,
381+
filepath,
383382
fs-api ^>=0.4,
384-
ouroboros-consensus,
385383
lsm-tree,
386384
mempack,
387385
mtl,
388386
nothunks ^>=0.2,
387+
ouroboros-consensus,
389388
primitive,
389+
random,
390390
resource-registry ^>=0.1,
391391
serialise ^>=0.2,
392+
streaming,
392393
text,
393394
transformers,
394395
vector ^>=0.13,
395-
streaming,
396396

397397
build-depends: text >=1.2.5.0 && <2.2
398398

@@ -413,21 +413,24 @@ library ouroboros-consensus-lmdb
413413
cardano-slotting,
414414
containers >=0.5 && <0.8,
415415
contra-tracer,
416+
directory,
417+
filepath,
416418
fs-api ^>=0.4,
417419
io-classes ^>=1.8.0.1,
418420
mempack,
419-
sop-core,
421+
mtl,
420422
nothunks ^>=0.2,
421423
ouroboros-consensus,
422424
rawlock ^>=0.1.1,
425+
resource-registry,
423426
serialise ^>=0.2,
424-
mtl,
427+
sop-core,
425428
streaming,
429+
temporary,
426430
text,
427431

428432
build-depends: text >=1.2.5.0 && <2.2
429433

430-
431434
library unstable-consensus-testlib
432435
import: common-lib
433436
visibility: public
@@ -807,7 +810,7 @@ test-suite storage-test
807810
mempack,
808811
mtl,
809812
nothunks,
810-
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb},
813+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm},
811814
ouroboros-network-api,
812815
ouroboros-network-mock,
813816
ouroboros-network-protocols,

0 commit comments

Comments
 (0)