Skip to content

Commit eefd7d1

Browse files
jasagredojasagredo
committed
Convert to sublibraries
1 parent 7bd4853 commit eefd7d1

File tree

24 files changed

+247
-378
lines changed

24 files changed

+247
-378
lines changed

‎cabal.project‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,6 @@ index-state:
2020

2121
packages:
2222
ouroboros-consensus
23-
ouroboros-consensus-lmdb
24-
ouroboros-consensus-lsm
2523
ouroboros-consensus-cardano
2624
ouroboros-consensus-protocol
2725
ouroboros-consensus-diffusion

‎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: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -36,11 +36,11 @@ import Ouroboros.Consensus.Ledger.Abstract
3636
import Ouroboros.Consensus.Ledger.Tables.Utils (emptyLedgerTables)
3737
import Ouroboros.Consensus.Shelley.Ledger
3838
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
39-
import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
39+
import Ouroboros.Consensus.Storage.LedgerDB.API
40+
import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore as V1
4041
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
41-
import Ouroboros.Consensus.Storage.LedgerDB.V2.Args
42+
import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as V2
4243
import Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
43-
import Ouroboros.Consensus.Util.StreamingLedgerTables
4444
import System.Directory
4545
import System.FS.API
4646
import System.FS.IO
@@ -50,7 +50,7 @@ import System.Random
5050

5151
type L = LedgerState (CardanoBlock StandardCrypto)
5252

53-
fromInMemory :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs L IO)
53+
fromInMemory :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO V2.Mem L)
5454
fromInMemory fp (HardForkLedgerState (HardForkState idx)) _ =
5555
let
5656
np ::
@@ -94,7 +94,8 @@ fromInMemory fp (HardForkLedgerState (HardForkState idx)) _ =
9494
(eraDecoder @era decodeMemPack)
9595
(eraDecoder @era $ toCardanoTxOut <$> decShareCBOR certInterns)
9696

97-
fromLMDB :: FilePath -> LMDB.LMDBLimits -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs L IO)
97+
fromLMDB ::
98+
FilePath -> LMDB.LMDBLimits -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO LMDB.LMDB L)
9899
fromLMDB fp limits hint reg = do
99100
let (dbPath, snapName) = splitFileName fp
100101
tempDir <- getCanonicalTemporaryDirectory
@@ -118,14 +119,14 @@ fromLMDB fp limits hint reg = do
118119
)
119120
bsClose
120121
(_, bsvh) <- allocate reg (\_ -> bsValueHandle bs) bsvhClose
121-
pure (YieldLMDB 1000 bsvh)
122+
pure (LMDB.YieldLMDB 1000 bsvh)
122123

123124
fromLSM ::
124125
FilePath ->
125126
String ->
126127
L EmptyMK ->
127128
ResourceRegistry IO ->
128-
IO (YieldArgs L IO)
129+
IO (YieldArgs IO LSM L)
129130
fromLSM fp snapName _ reg = do
130131
(_, SomeHasFSAndBlockIO hasFS blockIO) <- stdMkBlockIOFS fp reg
131132
salt <- fst . genWord64 <$> newStdGen
@@ -148,7 +149,7 @@ toLMDB ::
148149
LMDB.LMDBLimits ->
149150
L EmptyMK ->
150151
ResourceRegistry IO ->
151-
IO (SinkArgs L IO)
152+
IO (SinkArgs IO LMDB.LMDB L)
152153
toLMDB fp limits hint reg = do
153154
let (snapDir, snapName) = splitFileName fp
154155
tempDir <- getCanonicalTemporaryDirectory
@@ -168,13 +169,13 @@ toLMDB fp limits hint reg = do
168169
(InitFromValues (At 0) hint emptyLedgerTables)
169170
)
170171
bsClose
171-
pure $ SinkLMDB 1000 (bsWrite bs) (\h -> bsCopy bs h (mkFsPath [snapName, "tables"]))
172+
pure $ LMDB.SinkLMDB 1000 (bsWrite bs) (\h -> bsCopy bs h (mkFsPath [snapName, "tables"]))
172173

173174
toInMemory ::
174175
FilePath ->
175176
L EmptyMK ->
176177
ResourceRegistry IO ->
177-
IO (SinkArgs L IO)
178+
IO (SinkArgs IO V2.Mem L)
178179
toInMemory fp (HardForkLedgerState (HardForkState idx)) _ = do
179180
currDir <- getCurrentDirectory
180181
let
@@ -208,7 +209,7 @@ toLSM ::
208209
String ->
209210
L EmptyMK ->
210211
ResourceRegistry IO ->
211-
IO (SinkArgs L IO)
212+
IO (SinkArgs IO LSM L)
212213
toLSM fp snapName _ reg = do
213214
removePathForcibly fp
214215
System.Directory.createDirectory fp

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

Lines changed: 37 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,11 @@ 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
3538
import Ouroboros.Consensus.Util.CRC
36-
import Ouroboros.Consensus.Util.IOLike
37-
import Ouroboros.Consensus.Util.StreamingLedgerTables
39+
import Ouroboros.Consensus.Util.IOLike hiding (yield)
3840
import System.Console.ANSI
3941
import qualified System.Directory as D
4042
import System.Exit
@@ -215,24 +217,29 @@ instance StandardHash blk => Show (Error blk) where
215217
["Error when reading entries in the UTxO tables: ", show df]
216218
show Cancelled = "Cancelled"
217219

218-
data InEnv = InEnv
220+
data InEnv backend = InEnv
219221
{ inState :: LedgerState (CardanoBlock StandardCrypto) EmptyMK
220222
, inFilePath :: FilePath
221223
, inStream ::
222224
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
223225
ResourceRegistry IO ->
224-
IO (YieldArgs (LedgerState (CardanoBlock StandardCrypto)) IO)
226+
IO (SomeBackend YieldArgs)
225227
, inProgressMsg :: String
226228
, inCRC :: CRC
227229
, inSnapReadCRC :: Maybe CRC
228230
}
229231

230-
data OutEnv = OutEnv
232+
data SomeBackend c where
233+
SomeBackend ::
234+
StreamingBackend IO backend (LedgerState (CardanoBlock StandardCrypto)) =>
235+
c IO backend (LedgerState (CardanoBlock StandardCrypto)) -> SomeBackend c
236+
237+
data OutEnv backend = OutEnv
231238
{ outFilePath :: FilePath
232239
, outStream ::
233240
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
234241
ResourceRegistry IO ->
235-
IO (SinkArgs (LedgerState (CardanoBlock StandardCrypto)) IO)
242+
IO (SomeBackend SinkArgs)
236243
, outDeleteExtra :: Maybe FilePath
237244
, outProgressMsg :: String
238245
, outBackend :: SnapshotBackend
@@ -354,7 +361,7 @@ main = withStdTerminalHandles $ do
354361
InEnv
355362
st
356363
fp
357-
(fromInMemory (fp F.</> "tables"))
364+
(\a b -> SomeBackend <$> fromInMemory (fp F.</> "tables") a b)
358365
("InMemory@[" <> fp <> "]")
359366
c
360367
mtd
@@ -373,7 +380,7 @@ main = withStdTerminalHandles $ do
373380
InEnv
374381
st
375382
fp
376-
(fromLMDB (fp F.</> "tables") defaultLMDBLimits)
383+
(\a b -> SomeBackend <$> fromLMDB (fp F.</> "tables") defaultLMDBLimits a b)
377384
("LMDB@[" <> fp <> "]")
378385
c
379386
mtd
@@ -392,7 +399,7 @@ main = withStdTerminalHandles $ do
392399
InEnv
393400
st
394401
fp
395-
(fromLSM lsmDbPath (last $ splitDirectories fp))
402+
(\a b -> SomeBackend <$> fromLSM lsmDbPath (last $ splitDirectories fp) a b)
396403
("LSM@[" <> lsmDbPath <> "]")
397404
c
398405
mtd
@@ -410,7 +417,7 @@ main = withStdTerminalHandles $ do
410417
pure $
411418
OutEnv
412419
fp
413-
(toInMemory (fp F.</> "tables"))
420+
(\a b -> SomeBackend <$> toInMemory (fp F.</> "tables") a b)
414421
Nothing
415422
("InMemory@[" <> fp <> "]")
416423
UTxOHDMemSnapshot
@@ -426,7 +433,7 @@ main = withStdTerminalHandles $ do
426433
pure $
427434
OutEnv
428435
fp
429-
(toLMDB fp defaultLMDBLimits)
436+
(\a b -> SomeBackend <$> toLMDB fp defaultLMDBLimits a b)
430437
Nothing
431438
("LMDB@[" <> fp <> "]")
432439
UTxOHDLMDBSnapshot
@@ -442,11 +449,29 @@ main = withStdTerminalHandles $ do
442449
pure $
443450
OutEnv
444451
fp
445-
(toLSM lsmDbPath (last $ splitDirectories fp))
452+
(\a b -> SomeBackend <$> toLSM lsmDbPath (last $ splitDirectories fp) a b)
446453
(Just lsmDbPath)
447454
("LSM@[" <> lsmDbPath <> "]")
448455
UTxOHDLSMSnapshot
449456

457+
stream ::
458+
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
459+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
460+
ResourceRegistry IO ->
461+
IO (SomeBackend YieldArgs)
462+
) ->
463+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
464+
ResourceRegistry IO ->
465+
IO (SomeBackend SinkArgs)
466+
) ->
467+
ExceptT DeserialiseFailure IO (Maybe CRC, Maybe CRC)
468+
stream st mYieldArgs mSinkArgs =
469+
ExceptT $
470+
withRegistry $ \reg -> do
471+
(SomeBackend (yArgs :: YieldArgs IO backend1 l)) <- mYieldArgs st reg
472+
(SomeBackend (sArgs :: SinkArgs IO backend2 l)) <- mSinkArgs st reg
473+
runExceptT $ yield (Proxy @backend1) yArgs st $ sink (Proxy @backend2) sArgs st
474+
450475
-- Helpers
451476

452477
-- UI

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

Lines changed: 4 additions & 5 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
@@ -587,7 +586,7 @@ library unstable-cardano-tools
587586
network,
588587
network-mux,
589588
nothunks,
590-
ouroboros-consensus ^>=0.27,
589+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb} ^>=0.27,
591590
ouroboros-consensus-cardano,
592591
ouroboros-consensus-diffusion ^>=0.23,
593592
ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib} ^>=0.12,
@@ -702,15 +701,15 @@ executable snapshot-converter
702701
build-depends:
703702
ansi-terminal,
704703
base,
704+
cardano-ledger-core, cardano-ledger-binary, cardano-ledger-shelley, cborg, contra-tracer, sop-core, sop-extras, strict-sop-core,
705705
cardano-crypto-class,
706+
microlens, temporary, random,
706707
directory,
707708
filepath,
708709
fs-api,
709710
mtl,
710711
optparse-applicative,
711-
ouroboros-consensus,
712-
ouroboros-consensus-lsm,
713-
ouroboros-consensus-lmdb,
712+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb},
714713
ouroboros-consensus-cardano,
715714
ouroboros-consensus-cardano:unstable-cardano-tools,
716715
resource-registry,

0 commit comments

Comments
 (0)