Skip to content

Commit df2449e

Browse files
jasagredojasagredo
committed
Convert to sublibraries
1 parent 69b1067 commit df2449e

File tree

24 files changed

+247
-376
lines changed

24 files changed

+247
-376
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
, outCreateExtra :: Maybe FilePath
237244
, outDeleteExtra :: Maybe FilePath
238245
, outProgressMsg :: String
@@ -356,7 +363,7 @@ main = withStdTerminalHandles $ do
356363
InEnv
357364
st
358365
fp
359-
(fromInMemory (fp F.</> "tables" F.</> "tvar"))
366+
(\a b -> SomeBackend <$> fromInMemory (fp F.</> "tables" F.</> "tvar") a b)
360367
("InMemory@[" <> fp <> "]")
361368
c
362369
mtd
@@ -375,7 +382,7 @@ main = withStdTerminalHandles $ do
375382
InEnv
376383
st
377384
fp
378-
(fromLMDB (fp F.</> "tables") defaultLMDBLimits)
385+
(\a b -> SomeBackend <$> fromLMDB (fp F.</> "tables") defaultLMDBLimits a b)
379386
("LMDB@[" <> fp <> "]")
380387
c
381388
mtd
@@ -394,7 +401,7 @@ main = withStdTerminalHandles $ do
394401
InEnv
395402
st
396403
fp
397-
(fromLSM lsmDbPath (last $ splitDirectories fp))
404+
(\a b -> SomeBackend <$> fromLSM lsmDbPath (last $ splitDirectories fp) a b)
398405
("LSM@[" <> lsmDbPath <> "]")
399406
c
400407
mtd
@@ -412,7 +419,7 @@ main = withStdTerminalHandles $ do
412419
pure $
413420
OutEnv
414421
fp
415-
(toInMemory (fp F.</> "tables" F.</> "tvar"))
422+
(\a b -> SomeBackend <$> toInMemory (fp F.</> "tables" F.</> "tvar") a b)
416423
(Just "tables")
417424
(Nothing)
418425
("InMemory@[" <> fp <> "]")
@@ -429,7 +436,7 @@ main = withStdTerminalHandles $ do
429436
pure $
430437
OutEnv
431438
fp
432-
(toLMDB fp defaultLMDBLimits)
439+
(\a b -> SomeBackend <$> toLMDB fp defaultLMDBLimits a b)
433440
Nothing
434441
Nothing
435442
("LMDB@[" <> fp <> "]")
@@ -446,12 +453,30 @@ main = withStdTerminalHandles $ do
446453
pure $
447454
OutEnv
448455
fp
449-
(toLSM lsmDbPath (last $ splitDirectories fp))
456+
(\a b -> SomeBackend <$> toLSM lsmDbPath (last $ splitDirectories fp) a b)
450457
Nothing
451458
(Just lsmDbPath)
452459
("LSM@[" <> lsmDbPath <> "]")
453460
UTxOHDLSMSnapshot
454461

462+
stream ::
463+
LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
464+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
465+
ResourceRegistry IO ->
466+
IO (SomeBackend YieldArgs)
467+
) ->
468+
( LedgerState (CardanoBlock StandardCrypto) EmptyMK ->
469+
ResourceRegistry IO ->
470+
IO (SomeBackend SinkArgs)
471+
) ->
472+
ExceptT DeserialiseFailure IO (Maybe CRC, Maybe CRC)
473+
stream st mYieldArgs mSinkArgs =
474+
ExceptT $
475+
withRegistry $ \reg -> do
476+
(SomeBackend (yArgs :: YieldArgs IO backend1 l)) <- mYieldArgs st reg
477+
(SomeBackend (sArgs :: SinkArgs IO backend2 l)) <- mSinkArgs st reg
478+
runExceptT $ yield (Proxy @backend1) yArgs st $ sink (Proxy @backend2) sArgs st
479+
455480
-- Helpers
456481

457482
-- UI

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -580,7 +580,7 @@ library unstable-cardano-tools
580580
network,
581581
network-mux,
582582
nothunks,
583-
ouroboros-consensus ^>=0.27,
583+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb} ^>=0.27,
584584
ouroboros-consensus-cardano,
585585
ouroboros-consensus-diffusion ^>=0.23,
586586
ouroboros-consensus-protocol:{ouroboros-consensus-protocol, unstable-protocol-testlib} ^>=0.12,
@@ -697,16 +697,16 @@ executable snapshot-converter
697697
terminal-progress-bar,
698698
text,
699699
base,
700+
cardano-ledger-core, cardano-ledger-binary, cardano-ledger-shelley, cborg, contra-tracer, sop-core, sop-extras, strict-sop-core,
700701
cardano-crypto-class,
702+
microlens, temporary, random,
701703
directory,
702704
filepath,
703705
fs-api,
704706
mtl,
705707
ansi-terminal,
706708
optparse-applicative,
707-
ouroboros-consensus,
708-
ouroboros-consensus-lsm,
709-
ouroboros-consensus-lmdb,
709+
ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lsm, ouroboros-consensus-lmdb},
710710
ouroboros-consensus-cardano,
711711
ouroboros-consensus-cardano:unstable-cardano-tools,
712712
serialise,

0 commit comments

Comments
 (0)