Skip to content

Commit 51a7aef

Browse files
committed
Cleanup and move the functions to construct streaming args
1 parent eefd7d1 commit 51a7aef

File tree

6 files changed

+203
-182
lines changed

6 files changed

+203
-182
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
@@ -361,7 +363,7 @@ main = withStdTerminalHandles $ do
361363
InEnv
362364
st
363365
fp
364-
(\a b -> SomeBackend <$> fromInMemory (fp F.</> "tables") a b)
366+
(\a b -> SomeBackend <$> mkInMemYieldArgs (fp F.</> "tables") a b)
365367
("InMemory@[" <> fp <> "]")
366368
c
367369
mtd
@@ -380,7 +382,7 @@ main = withStdTerminalHandles $ do
380382
InEnv
381383
st
382384
fp
383-
(\a b -> SomeBackend <$> fromLMDB (fp F.</> "tables") defaultLMDBLimits a b)
385+
(\a b -> SomeBackend <$> V1.mkLMDBYieldArgs (fp F.</> "tables") defaultLMDBLimits a b)
384386
("LMDB@[" <> fp <> "]")
385387
c
386388
mtd
@@ -399,7 +401,9 @@ main = withStdTerminalHandles $ do
399401
InEnv
400402
st
401403
fp
402-
(\a b -> SomeBackend <$> fromLSM lsmDbPath (last $ splitDirectories fp) a b)
404+
( \a b ->
405+
SomeBackend <$> mkLSMYieldArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
406+
)
403407
("LSM@[" <> lsmDbPath <> "]")
404408
c
405409
mtd
@@ -417,7 +421,7 @@ main = withStdTerminalHandles $ do
417421
pure $
418422
OutEnv
419423
fp
420-
(\a b -> SomeBackend <$> toInMemory (fp F.</> "tables") a b)
424+
(\a b -> SomeBackend <$> mkInMemSinkArgs (fp F.</> "tables") a b)
421425
Nothing
422426
("InMemory@[" <> fp <> "]")
423427
UTxOHDMemSnapshot
@@ -433,7 +437,7 @@ main = withStdTerminalHandles $ do
433437
pure $
434438
OutEnv
435439
fp
436-
(\a b -> SomeBackend <$> toLMDB fp defaultLMDBLimits a b)
440+
(\a b -> SomeBackend <$> V1.mkLMDBSinkArgs fp defaultLMDBLimits a b)
437441
Nothing
438442
("LMDB@[" <> fp <> "]")
439443
UTxOHDLMDBSnapshot
@@ -449,7 +453,9 @@ main = withStdTerminalHandles $ do
449453
pure $
450454
OutEnv
451455
fp
452-
(\a b -> SomeBackend <$> toLSM lsmDbPath (last $ splitDirectories fp) a b)
456+
( \a b ->
457+
SomeBackend <$> mkLSMSinkArgs lsmDbPath (last $ splitDirectories fp) stdMkBlockIOFS newStdGen a b
458+
)
453459
(Just lsmDbPath)
454460
("LSM@[" <> lsmDbPath <> "]")
455461
UTxOHDLSMSnapshot

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

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -156,11 +156,9 @@ library
156156
cardano-strict-containers,
157157
cborg ^>=0.2.2,
158158
containers >=0.5 && <0.8,
159-
contra-tracer,
160159
crypton,
161160
deepseq,
162161
formatting >=6.3 && <7.3,
163-
fs-api,
164162
measures,
165163
mempack,
166164
microlens,
@@ -169,15 +167,12 @@ library
169167
ouroboros-consensus ^>=0.27,
170168
ouroboros-consensus-protocol ^>=0.12,
171169
ouroboros-network-api ^>=0.16,
172-
random,
173-
resource-registry,
174170
serialise ^>=0.2,
175171
singletons ^>=3.0,
176172
small-steps,
177173
sop-core ^>=0.5,
178174
sop-extras ^>=0.4,
179175
strict-sop-core ^>=0.1,
180-
temporary,
181176
text,
182177
these ^>=1.2,
183178
validation,
@@ -586,7 +581,7 @@ library unstable-cardano-tools
586581
network,
587582
network-mux,
588583
nothunks,
589-
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb} ^>=0.27,
584+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm} ^>=0.27,
590585
ouroboros-consensus-cardano,
591586
ouroboros-consensus-diffusion ^>=0.23,
592587
ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib} ^>=0.12,
@@ -695,25 +690,32 @@ executable snapshot-converter
695690
import: common-exe
696691
hs-source-dirs: app
697692
other-modules:
698-
Ouroboros.Consensus.Cardano.StreamingLedgerTables
693+
Ouroboros.Consensus.Cardano.StreamingLedgerTables
699694

700695
main-is: snapshot-converter.hs
701696
build-depends:
702697
ansi-terminal,
703698
base,
704-
cardano-ledger-core, cardano-ledger-binary, cardano-ledger-shelley, cborg, contra-tracer, sop-core, sop-extras, strict-sop-core,
705699
cardano-crypto-class,
706-
microlens, temporary, random,
700+
cardano-ledger-binary,
701+
cardano-ledger-core,
702+
cardano-ledger-shelley,
703+
cborg,
707704
directory,
708705
filepath,
709706
fs-api,
707+
microlens,
710708
mtl,
711709
optparse-applicative,
712-
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb},
710+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm},
713711
ouroboros-consensus-cardano,
714712
ouroboros-consensus-cardano:unstable-cardano-tools,
713+
random,
715714
resource-registry,
716715
serialise,
716+
sop-core,
717+
sop-extras,
718+
strict-sop-core,
717719
terminal-progress-bar,
718720
text,
719721
with-utf8,

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)