Skip to content

Commit d84a1c6

Browse files
revert obtaining ledger peers from cardano-node
1 parent a4dbefd commit d84a1c6

File tree

1 file changed

+41
-36
lines changed

1 file changed

+41
-36
lines changed

dmq-node/src/DMQ/NodeToClient/LocalStateQueryClient.hs

Lines changed: 41 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -108,43 +108,48 @@ cardanoClient _tracer StakePools { stakePoolsVar, ledgerPeersVar, ledgerBigPeers
108108
atomically do
109109
writeTVar stakePoolsVar ssStakeSnapshots
110110
writeTVar nextEpochVar $ Just nextEpoch
111-
pure $
112-
SendMsgQuery (BlockQuery . QueryIfCurrentConway $ GetLedgerPeerSnapshot AllLedgerPeers)
113-
$ wrappingMismatch handleLedgerPeers
114-
where
115-
handleLedgerPeers (SomeLedgerPeerSnapshot (LedgerAllPeerSnapshotV23 pt magic peers)) = do
116-
let bigSrvRelays = force
117-
[(accStake, (stake, NonEmpty.fromList relays'))
118-
| (accStake, (stake, relays)) <- accumulateBigLedgerStake peers
119-
, let relays' = NonEmpty.filter
120-
(\case
121-
LedgerRelayAccessSRVDomain {} -> True
122-
_ -> False
123-
)
124-
relays
125-
, not (null relays')
126-
]
127-
pt' = Point $ getPoint pt <&>
128-
\blk -> blk { blockPointSlot = maxBound }
129-
srvRelays = force
130-
[ (stake, NonEmpty.fromList relays')
131-
| (stake, relays) <- peers
132-
, let relays' = NonEmpty.filter
133-
(\case
134-
LedgerRelayAccessSRVDomain {} -> True
135-
_ -> False
136-
)
137-
relays
138-
, not (null relays')
139-
]
140-
atomically do
141-
writeTMVar ledgerPeersVar $ LedgerAllPeerSnapshotV23 pt magic srvRelays
142-
writeTVar ledgerBigPeersVar . Just $! LedgerBigPeerSnapshotV23 pt' magic bigSrvRelays
143-
pure $ SendMsgRelease do
144-
threadDelay $ min (realToFrac toNextEpoch) 86400 -- TODO fuzz this?
145-
idle $ Just systemStart
111+
pure $ SendMsgRelease do
112+
threadDelay $ min (realToFrac toNextEpoch) 86400 -- TODO fuzz this?
113+
idle $ Just systemStart
114+
115+
-- TODO uncomment once this functionality is integrated into cardano-node
116+
-- pure $
117+
-- SendMsgQuery (BlockQuery . QueryIfCurrentConway $ GetLedgerPeerSnapshot AllLedgerPeers)
118+
-- $ wrappingMismatch handleLedgerPeers
119+
-- where
120+
-- handleLedgerPeers (SomeLedgerPeerSnapshot (LedgerAllPeerSnapshotV23 pt magic peers)) = do
121+
-- let bigSrvRelays = force
122+
-- [(accStake, (stake, NonEmpty.fromList relays'))
123+
-- | (accStake, (stake, relays)) <- accumulateBigLedgerStake peers
124+
-- , let relays' = NonEmpty.filter
125+
-- (\case
126+
-- LedgerRelayAccessSRVDomain {} -> True
127+
-- _ -> False
128+
-- )
129+
-- relays
130+
-- , not (null relays')
131+
-- ]
132+
-- pt' = Point $ getPoint pt <&>
133+
-- \blk -> blk { blockPointSlot = maxBound }
134+
-- srvRelays = force
135+
-- [ (stake, NonEmpty.fromList relays')
136+
-- | (stake, relays) <- peers
137+
-- , let relays' = NonEmpty.filter
138+
-- (\case
139+
-- LedgerRelayAccessSRVDomain {} -> True
140+
-- _ -> False
141+
-- )
142+
-- relays
143+
-- , not (null relays')
144+
-- ]
145+
-- atomically do
146+
-- writeTMVar ledgerPeersVar $ LedgerAllPeerSnapshotV23 pt magic srvRelays
147+
-- writeTVar ledgerBigPeersVar . Just $! LedgerBigPeerSnapshotV23 pt' magic bigSrvRelays
148+
-- pure $ SendMsgRelease do
149+
-- threadDelay $ min (realToFrac toNextEpoch) 86400 -- TODO fuzz this?
150+
-- idle $ Just systemStart
146151

147-
handleLedgerPeers _ = error "handleLedgerPeers: impossible!"
152+
-- handleLedgerPeers _ = error "handleLedgerPeers: impossible!"
148153

149154

150155
connectToCardanoNode :: Tracer IO (WithEventType String)

0 commit comments

Comments
 (0)