Skip to content

Commit 86a9dfc

Browse files
bolt12bolt12
authored
Integrate with network and io-sim (#968)
Integrate recent network package releases and io-sim.
2 parents ca23fa5 + 6b6a2d7 commit 86a9dfc

File tree

12 files changed

+136
-79
lines changed

12 files changed

+136
-79
lines changed

‎cabal.project‎

Lines changed: 2 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,9 @@ repository cardano-haskell-packages
1414
-- update either of these.
1515
index-state:
1616
-- Bump this if you need newer packages from Hackage
17-
, hackage.haskell.org 2024-01-28T20:27:47Z
17+
, hackage.haskell.org 2024-02-23T10:26:05Z
1818
-- Bump this if you need newer packages from CHaP
19-
, cardano-haskell-packages 2024-01-28T20:24:54Z
19+
, cardano-haskell-packages 2024-02-23T10:34:09Z
2020

2121
packages:
2222
ouroboros-consensus
@@ -31,23 +31,3 @@ tests: true
3131
benchmarks: true
3232

3333
import: ./asserts.cabal
34-
35-
source-repository-package
36-
type: git
37-
location: https://github.com/input-output-hk/ouroboros-network/
38-
tag: 8ab444850b9d654110cd751a17c21db814bba593
39-
subdir: monoidal-synchronisation
40-
network-mux
41-
ouroboros-network
42-
ouroboros-network-api
43-
ouroboros-network-framework
44-
ouroboros-network-protocols
45-
ouroboros-network-testing
46-
--sha256: 1vw8r8csa6lq4330bwgddxa4nl2m1pw1ps5y6l7lw2zw3xdlr0hf
47-
48-
source-repository-package
49-
type: git
50-
location: https://github.com/input-output-hk/io-sim
51-
tag: 85d633d6f9c76ffb678b36396c8fd39b2ff7219e
52-
subdir: io-sim
53-
--sha256: 10f54xg88wq2w7ylg3n33f1yiswd6w4dam7fvl12raiqj0rk21qm

‎flake.lock‎

Lines changed: 6 additions & 6 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎ouroboros-consensus-cardano/changelog.d/20240223_135546_armandoifsantos_integrate.md‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
-->
6+
7+
<!--
8+
### Patch
9+
10+
- A bullet item for the Patch category.
11+
12+
-->
13+
### Non-Breaking
14+
15+
- Integrate with network-packages and io-sim 1.4.1 packages
16+
- Bump dependencies version bounds
17+
18+
<!--
19+
### Breaking
20+
21+
- A bullet item for the Breaking category.
22+
23+
-->

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -142,7 +142,7 @@ library
142142
, nothunks
143143
, ouroboros-consensus ^>=0.15
144144
, ouroboros-consensus-protocol ^>=0.7
145-
, ouroboros-network-api ^>=0.6.2
145+
, ouroboros-network-api ^>=0.7
146146
, serialise ^>=0.2
147147
, small-steps
148148
, sop-core ^>=0.5

‎ouroboros-consensus-diffusion/changelog.d/20240223_135212_armandoifsantos_integrate.md‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
-->
6+
7+
<!--
8+
### Patch
9+
10+
- A bullet item for the Patch category.
11+
12+
-->
13+
### Non-Breaking
14+
15+
- Integrate with network-packages and io-sim 1.4.1 packages
16+
- Bump dependencies version bounds
17+
18+
<!--
19+
### Breaking
20+
21+
- A bullet item for the Breaking category.
22+
23+
-->

‎ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -68,27 +68,27 @@ library
6868
, Ouroboros.Consensus.Node.NetworkProtocolVersion
6969

7070
build-depends:
71-
, base >=4.14 && <4.20
72-
, bytestring >=0.10 && <0.13
71+
, base >=4.14 && <4.20
72+
, bytestring >=0.10 && <0.13
7373
, cardano-slotting
7474
, cborg ^>=0.2.2
75-
, containers >=0.5 && <0.7
75+
, containers >=0.5 && <0.7
7676
, contra-tracer
7777
, deepseq
7878
, filepath
7979
, fs-api ^>=0.2
8080
, hashable
81-
, io-classes ^>=1.3
81+
, io-classes ^>=1.4.1
8282
, mtl
8383
, ouroboros-consensus ^>=0.15
84-
, ouroboros-network ^>=0.11
85-
, ouroboros-network-api ^>=0.6
86-
, ouroboros-network-framework ^>=0.11
87-
, ouroboros-network-protocols ^>=0.7
84+
, ouroboros-network ^>=0.12
85+
, ouroboros-network-api ^>=0.7
86+
, ouroboros-network-framework ^>=0.11.1
87+
, ouroboros-network-protocols ^>=0.8
8888
, random
8989
, serialise ^>=0.2
90-
, si-timers ^>=1.3
91-
, strict-stm ^>=1.3
90+
, si-timers ^>=1.4
91+
, strict-stm ^>=1.4
9292
, text
9393
, time
9494
, transformers

‎ouroboros-consensus/changelog.d/20240223_133210_armandoifsantos_integrate.md‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
-->
6+
7+
<!--
8+
### Patch
9+
10+
- A bullet item for the Patch category.
11+
12+
-->
13+
### Non-Breaking
14+
15+
- Integrate with network-packages and io-sim 1.4.1 packages
16+
- Bump dependencies version bounds
17+
18+
<!--
19+
### Breaking
20+
21+
- A bullet item for the Breaking category.
22+
23+
-->

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -270,24 +270,25 @@ library
270270
, filelock
271271
, fs-api ^>=0.2
272272
, hashable
273-
, io-classes ^>=1.3
273+
, io-classes ^>=1.4.1
274274
, measures
275275
, mtl
276276
, nothunks ^>=0.1.5
277-
, ouroboros-network-api ^>=0.6.2
277+
, ouroboros-network-api ^>=0.7
278278
, ouroboros-network-mock ^>=0.1
279-
, ouroboros-network-protocols ^>=0.7
279+
, ouroboros-network-protocols ^>=0.8
280+
, primitive
280281
, psqueues ^>=0.2.3
281282
, quiet ^>=0.2
282283
, semialign >=1.1
283284
, serialise ^>=0.2
284-
, si-timers ^>=1.3
285+
, si-timers ^>=1.4
285286
, sop-core ^>=0.5
286287
, sop-extras ^>=0.1
287288
, streaming
288289
, strict-checked-vars ^>=0.2
289290
, strict-sop-core ^>=0.1
290-
, strict-stm ^>=1.3
291+
, strict-stm ^>=1.4
291292
, text
292293
, these ^>=1.2
293294
, time

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/CBOR.hs‎

Lines changed: 21 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ import Data.Sequence.Strict (StrictSeq)
5151
import qualified Data.Sequence.Strict as Seq
5252
import Data.Word (Word64)
5353
import GHC.Stack (HasCallStack)
54-
import Ouroboros.Consensus.Util.IOLike
54+
import Ouroboros.Consensus.Util.IOLike as U
5555
import qualified Streaming as S
5656
import qualified Streaming.Prelude as S
5757
import Streaming.Prelude (Of (..), Stream)
@@ -67,13 +67,13 @@ data IDecodeIO a =
6767
| Fail !ByteString !CBOR.R.ByteOffset CBOR.R.DeserialiseFailure
6868

6969
fromIDecode :: CBOR.R.IDecode RealWorld a -> IDecodeIO a
70-
fromIDecode (CBOR.R.Partial k) = Partial $ fmap fromIDecode . stToIO . k
70+
fromIDecode (CBOR.R.Partial k) = Partial $ fmap fromIDecode . U.stToIO . k
7171
fromIDecode (CBOR.R.Done bs off x) = Done bs off x
7272
fromIDecode (CBOR.R.Fail bs off e) = Fail bs off e
7373

7474
deserialiseIncrementalIO :: (forall s. CBOR.D.Decoder s a) -> IO (IDecodeIO a)
7575
deserialiseIncrementalIO = fmap fromIDecode
76-
. stToIO
76+
. U.stToIO
7777
. CBOR.R.deserialiseIncremental
7878

7979
{-------------------------------------------------------------------------------
@@ -185,27 +185,26 @@ data ReadIncrementalErr =
185185
-- 'withStreamIncrementalOffsets'.
186186
readIncremental :: forall m a. IOLike m
187187
=> SomeHasFS m
188-
-> (forall s . CBOR.D.Decoder s a)
188+
-> CBOR.D.Decoder (U.PrimState m) a
189189
-> FsPath
190190
-> m (Either ReadIncrementalErr a)
191-
readIncremental = \(SomeHasFS hasFS) decoder fp -> withLiftST $ \liftST -> do
191+
readIncremental = \(SomeHasFS hasFS) decoder fp -> do
192192
withFile hasFS fp ReadMode $ \h ->
193-
go hasFS liftST h =<< liftST (CBOR.R.deserialiseIncremental decoder)
193+
go hasFS h =<< U.stToIO (CBOR.R.deserialiseIncremental decoder)
194194
where
195195
go :: HasFS m h
196-
-> (forall x. ST s x -> m x)
197196
-> Handle h
198-
-> CBOR.R.IDecode s a
197+
-> CBOR.R.IDecode (U.PrimState m) a
199198
-> m (Either ReadIncrementalErr a)
200-
go hasFS@HasFS{..} liftST h (CBOR.R.Partial k) = do
199+
go hasFS@HasFS{..} h (CBOR.R.Partial k) = do
201200
bs <- hGetSome h (fromIntegral defaultChunkSize)
202-
dec' <- liftST $ k (checkEmpty bs)
203-
go hasFS liftST h dec'
204-
go _ _ _ (CBOR.R.Done leftover _ a) =
201+
dec' <- U.stToIO $ k (checkEmpty bs)
202+
go hasFS h dec'
203+
go _ _ (CBOR.R.Done leftover _ a) =
205204
return $ if BS.null leftover
206205
then Right a
207206
else Left $ TrailingBytes leftover
208-
go _ _ _ (CBOR.R.Fail _ _ err) =
207+
go _ _ (CBOR.R.Fail _ _ err) =
209208
return $ Left $ ReadFailed err
210209

211210
checkEmpty :: ByteString -> Maybe ByteString
@@ -232,34 +231,32 @@ withStreamIncrementalOffsets ::
232231
-> (Stream (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64)) -> m r)
233232
-> m r
234233
withStreamIncrementalOffsets hasFS@HasFS{..} decoder fp = \k ->
235-
withLiftST $ \liftST ->
236234
withFile hasFS fp ReadMode $ \h -> k $ do
237235
fileSize <- S.lift $ hGetSize h
238236
if fileSize == 0 then
239237
-- If the file is empty, we will immediately get "end of input"
240238
return Nothing
241239
else
242-
S.lift (liftST (CBOR.R.deserialiseIncremental decoder)) >>=
243-
go liftST h 0 Nothing [] fileSize
240+
S.lift (U.stToIO (CBOR.R.deserialiseIncremental decoder)) >>=
241+
go h 0 Nothing [] fileSize
244242
where
245243
-- TODO stream from HasFS?
246-
go :: (forall x. ST s x -> m x)
247-
-> Handle h
244+
go :: Handle h
248245
-> Word64 -- ^ Offset
249246
-> Maybe ByteString -- ^ Unconsumed bytes from last time
250247
-> [ByteString] -- ^ Chunks pushed for this item (rev order)
251248
-> Word64 -- ^ Total file size
252-
-> CBOR.R.IDecode s (LBS.ByteString -> a)
249+
-> CBOR.R.IDecode (U.PrimState m) (LBS.ByteString -> a)
253250
-> Stream (Of (Word64, (Word64, a))) m (Maybe (ReadIncrementalErr, Word64))
254-
go liftST h offset mbUnconsumed bss fileSize dec = case dec of
251+
go h offset mbUnconsumed bss fileSize dec = case dec of
255252
CBOR.R.Partial k -> do
256253
-- First use the unconsumed bytes from a previous read before read
257254
-- some more bytes from the file.
258255
bs <- case mbUnconsumed of
259256
Just unconsumed -> return unconsumed
260257
Nothing -> S.lift $ hGetSome h (fromIntegral defaultChunkSize)
261-
dec' <- S.lift $ liftST $ k (checkEmpty bs)
262-
go liftST h offset Nothing (bs:bss) fileSize dec'
258+
dec' <- S.lift $ U.stToIO $ k (checkEmpty bs)
259+
go h offset Nothing (bs:bss) fileSize dec'
263260

264261
CBOR.R.Done leftover size mkA -> do
265262
let nextOffset = offset + fromIntegral size
@@ -288,8 +285,8 @@ withStreamIncrementalOffsets hasFS@HasFS{..} decoder fp = \k ->
288285
-> return Nothing
289286
-- Some more bytes, so try to read the next @a@.
290287
mbLeftover ->
291-
S.lift (liftST (CBOR.R.deserialiseIncremental decoder)) >>=
292-
go liftST h nextOffset mbLeftover [] fileSize
288+
S.lift (U.stToIO (CBOR.R.deserialiseIncremental decoder)) >>=
289+
go h nextOffset mbLeftover [] fileSize
293290

294291
CBOR.R.Fail _ _ err -> return $ Just (ReadFailed err, offset)
295292

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/EarlyExit.hs‎

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -31,15 +31,14 @@ import Control.Monad.Class.MonadTime
3131
import Control.Monad.Class.MonadTime.SI
3232
import Control.Monad.Class.MonadTimer
3333
import qualified Control.Monad.Class.MonadTimer.SI as TimerSI
34-
import Control.Monad.ST (ST)
3534
import Control.Monad.Trans.Class
3635
import Control.Monad.Trans.Maybe
3736
import Data.Function (on)
3837
import Data.Proxy
3938
import NoThunks.Class (NoThunks (..))
4039
import Ouroboros.Consensus.Util ((.:))
41-
import Ouroboros.Consensus.Util.IOLike (IOLike (..), StrictSVar,
42-
StrictTVar)
40+
import Ouroboros.Consensus.Util.IOLike (IOLike (..), PrimMonad (..),
41+
StrictSVar, StrictTVar)
4342
import Ouroboros.Consensus.Util.NormalForm.StrictMVar (StrictMVar)
4443

4544
{-------------------------------------------------------------------------------
@@ -251,14 +250,16 @@ instance MonadFork m => MonadFork (WithEarlyExit m) where
251250
throwTo = lift .: throwTo
252251
yield = lift yield
253252

253+
254+
instance PrimMonad m => PrimMonad (WithEarlyExit m) where
255+
type PrimState (WithEarlyExit m) = PrimState m
256+
primitive = lift . primitive
257+
{-# INLINE primitive #-}
258+
254259
instance MonadST m => MonadST (WithEarlyExit m) where
255-
withLiftST f = lowerLiftST $ \(_proxy :: Proxy s) liftST ->
256-
let liftST' :: forall a. ST s a -> WithEarlyExit m a
257-
liftST' = lift . liftST
258-
in f liftST'
259-
where
260-
lowerLiftST :: (forall s. Proxy s -> (forall a. ST s a -> m a) -> b) -> b
261-
lowerLiftST g = withLiftST $ g Proxy
260+
stToIO = lift . stToIO
261+
withLiftST k = k stToIO
262+
262263

263264
instance MonadMonotonicTimeNSec m => MonadMonotonicTimeNSec (WithEarlyExit m) where
264265
getMonotonicTimeNSec = lift getMonotonicTimeNSec

0 commit comments

Comments
 (0)