Skip to content

Commit a3773cf

Browse files
tbagrel1amesgen
tbagrel1
authored and
amesgen
committed
Cheap generalization of ObjectDiffusion to support initialization by either the inbound or outbound peer
1 parent 02f6ff7 commit a3773cf

File tree

4 files changed

+121
-82
lines changed

4 files changed

+121
-82
lines changed

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ObjectDiffusion/Codec.hs

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -27,16 +27,17 @@ import Network.TypedProtocol.Codec.CBOR
2727
import Ouroboros.Network.Protocol.Limits
2828
import Ouroboros.Network.Protocol.ObjectDiffusion.Type
2929
import Text.Printf
30+
import Network.TypedProtocol (Agency)
3031

3132
-- | Byte Limits.
3233
byteLimitsObjectDiffusion ::
33-
forall bytes objectId object.
34+
forall bytes (initAgency :: Agency) objectId object.
3435
(bytes -> Word) ->
35-
ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
36+
ProtocolSizeLimits (ObjectDiffusion initAgency objectId object) bytes
3637
byteLimitsObjectDiffusion = ProtocolSizeLimits stateToLimit
3738
where
3839
stateToLimit ::
39-
forall (st :: ObjectDiffusion objectId object).
40+
forall (st :: ObjectDiffusion initAgency objectId object).
4041
(ActiveState st) =>
4142
StateToken st ->
4243
Word
@@ -62,11 +63,11 @@ byteLimitsObjectDiffusion = ProtocolSizeLimits stateToLimit
6263
-- +---------------------------------+---------------+
6364
-- | `StObjects` | `shortWait` |
6465
-- +---------------------------------+---------------+
65-
timeLimitsObjectDiffusion :: forall (objectId :: Type) (object :: Type). ProtocolTimeLimits (ObjectDiffusion objectId object)
66+
timeLimitsObjectDiffusion :: forall (initAgency :: Agency) (objectId :: Type) (object :: Type). ProtocolTimeLimits (ObjectDiffusion initAgency objectId object)
6667
timeLimitsObjectDiffusion = ProtocolTimeLimits stateToLimit
6768
where
6869
stateToLimit ::
69-
forall (st :: ObjectDiffusion objectId object).
70+
forall (st :: ObjectDiffusion initAgency objectId object).
7071
(ActiveState st) =>
7172
StateToken st ->
7273
Maybe DiffTime
@@ -78,7 +79,7 @@ timeLimitsObjectDiffusion = ProtocolTimeLimits stateToLimit
7879
stateToLimit a@SingDone = notActiveState a
7980

8081
codecObjectDiffusion ::
81-
forall (objectId :: Type) (object :: Type) m.
82+
forall (initAgency :: Agency) (objectId :: Type) (object :: Type) m.
8283
(MonadST m) =>
8384
-- | encode 'objectId'
8485
(objectId -> CBOR.Encoding) ->
@@ -88,14 +89,14 @@ codecObjectDiffusion ::
8889
(object -> CBOR.Encoding) ->
8990
-- | decode object
9091
(forall s. CBOR.Decoder s object) ->
91-
Codec (ObjectDiffusion objectId object) CBOR.DeserialiseFailure m ByteString
92+
Codec (ObjectDiffusion initAgency objectId object) CBOR.DeserialiseFailure m ByteString
9293
codecObjectDiffusion encodeObjectId decodeObjectId encodeObject decodeObject =
9394
mkCodecCborLazyBS
9495
(encodeObjectDiffusion encodeObjectId encodeObject)
9596
decode
9697
where
9798
decode ::
98-
forall (st :: ObjectDiffusion objectId object).
99+
forall (st :: ObjectDiffusion initAgency objectId object).
99100
(ActiveState st) =>
100101
StateToken st ->
101102
forall s. CBOR.Decoder s (SomeMessage st)
@@ -105,18 +106,18 @@ codecObjectDiffusion encodeObjectId decodeObjectId encodeObject decodeObject =
105106
decodeObjectDiffusion decodeObjectId decodeObject stok len key
106107

107108
encodeObjectDiffusion ::
108-
forall (objectId :: Type) (object :: Type) (st :: ObjectDiffusion objectId object) (st' :: ObjectDiffusion objectId object).
109+
forall (initAgency :: Agency) (objectId :: Type) (object :: Type) (st :: ObjectDiffusion initAgency objectId object) (st' :: ObjectDiffusion initAgency objectId object).
109110
-- | encode 'objectId'
110111
(objectId -> CBOR.Encoding) ->
111112
-- | encode 'object'
112113
(object -> CBOR.Encoding) ->
113-
Message (ObjectDiffusion objectId object) st st' ->
114+
Message (ObjectDiffusion initAgency objectId object) st st' ->
114115
CBOR.Encoding
115116
encodeObjectDiffusion encodeObjectId encodeObject = encode
116117
where
117118
encode ::
118119
forall st0 st1.
119-
Message (ObjectDiffusion objectId object) st0 st1 ->
120+
Message (ObjectDiffusion initAgency objectId object) st0 st1 ->
120121
CBOR.Encoding
121122
encode MsgInit =
122123
CBOR.encodeListLen 1
@@ -164,7 +165,7 @@ encodeObjectDiffusion encodeObjectId encodeObject = encode
164165
<> CBOR.encodeWord 4
165166

166167
decodeObjectDiffusion ::
167-
forall (objectId :: Type) (object :: Type) (st :: ObjectDiffusion objectId object) s.
168+
forall (initAgency :: Agency) (objectId :: Type) (object :: Type) (st :: ObjectDiffusion initAgency objectId object) s.
168169
(ActiveState st) =>
169170
-- | decode 'objectId'
170171
(forall s'. CBOR.Decoder s' objectId) ->
@@ -177,7 +178,7 @@ decodeObjectDiffusion ::
177178
decodeObjectDiffusion decodeObjectId decodeObject = decode
178179
where
179180
decode ::
180-
forall (st' :: ObjectDiffusion objectId object).
181+
forall (st' :: ObjectDiffusion initAgency objectId object).
181182
(ActiveState st') =>
182183
StateToken st' ->
183184
Int ->
@@ -243,26 +244,26 @@ decodeObjectDiffusion decodeObjectId decodeObject = decode
243244
fail (printf "codecObjectDiffusion (%s) unexpected key (%d, %d)" (show stok) key len)
244245

245246
codecObjectDiffusionId ::
246-
forall objectId object m.
247+
forall (initAgency :: Agency) objectId object m.
247248
(Monad m) =>
248-
Codec (ObjectDiffusion objectId object) CodecFailure m (AnyMessage (ObjectDiffusion objectId object))
249+
Codec (ObjectDiffusion initAgency objectId object) CodecFailure m (AnyMessage (ObjectDiffusion initAgency objectId object))
249250
codecObjectDiffusionId = Codec {encode, decode}
250251
where
251252
encode ::
252253
forall st st'.
253254
(ActiveState st) =>
254255
(StateTokenI st) =>
255-
Message (ObjectDiffusion objectId object) st st' ->
256-
AnyMessage (ObjectDiffusion objectId object)
256+
Message (ObjectDiffusion initAgency objectId object) st st' ->
257+
AnyMessage (ObjectDiffusion initAgency objectId object)
257258
encode = AnyMessage
258259

259260
decode ::
260-
forall (st :: ObjectDiffusion objectId object).
261+
forall (st :: ObjectDiffusion initAgency objectId object).
261262
(ActiveState st) =>
262263
StateToken st ->
263264
m
264265
( DecodeStep
265-
(AnyMessage (ObjectDiffusion objectId object))
266+
(AnyMessage (ObjectDiffusion initAgency objectId object))
266267
CodecFailure
267268
m
268269
(SomeMessage st)

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ObjectDiffusion/Inbound.hs

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,8 @@ module Ouroboros.Network.Protocol.ObjectDiffusion.Inbound
2121
Collect (..),
2222

2323
-- * Execution as a typed protocol
24-
objectDiffusionClientInboundPeerPipelined,
25-
objectDiffusionServerInboundPeerPipelined,
24+
objectDiffusionInitInboundPeerPipelined,
25+
objectDiffusionNonInitInboundPeerPipelined,
2626
)
2727
where
2828

@@ -76,51 +76,51 @@ data InboundStIdle (n :: N) objectId object m a where
7676
(Collect objectId object -> m (InboundStIdle n objectId object m a)) ->
7777
InboundStIdle (S n) objectId object m a
7878

79-
inboundRun :: forall (pr :: PeerRole) (n :: N) objectId object m a.
79+
inboundRun :: forall (initAgency :: Agency) (n :: N) objectId object m a.
8080
(Functor m) =>
8181
InboundStIdle n objectId object m a ->
82-
Peer (ObjectDiffusion objectId object) pr (Pipelined n (Collect objectId object)) StIdle m a
82+
Peer (ObjectDiffusion initAgency objectId object) AsInbound (Pipelined n (Collect objectId object)) StIdle m a
8383

8484
inboundRun (SendMsgRequestObjectIdsBlocking ackNo reqNo kDone k) =
85-
Yield undefined
85+
Yield ReflInboundAgency
8686
(MsgRequestObjectIds SingBlocking ackNo reqNo)
87-
$ Await undefined
87+
$ Await ReflOutboundAgency
8888
$ \case
89-
MsgDone -> Effect (Done undefined <$> kDone)
89+
MsgDone -> Effect (Done ReflNobodyAgency <$> kDone)
9090
MsgReplyObjectIds (BlockingReply objectIds) -> Effect (inboundRun <$> k objectIds)
9191
inboundRun (SendMsgRequestObjectIdsPipelined ackNo reqNo k) =
92-
YieldPipelined undefined
92+
YieldPipelined ReflInboundAgency
9393
(MsgRequestObjectIds SingNonBlocking ackNo reqNo)
94-
(ReceiverAwait undefined $ \(MsgReplyObjectIds (NonBlockingReply objectIds)) -> ReceiverDone (CollectObjectIds reqNo objectIds))
94+
(ReceiverAwait ReflOutboundAgency $ \(MsgReplyObjectIds (NonBlockingReply objectIds)) -> ReceiverDone (CollectObjectIds reqNo objectIds))
9595
(Effect (inboundRun <$> k))
9696
inboundRun (SendMsgRequestObjectsPipelined objectIds k) =
97-
YieldPipelined undefined
97+
YieldPipelined ReflInboundAgency
9898
(MsgRequestObjects objectIds)
99-
(ReceiverAwait undefined $ \(MsgReplyObjects objects) -> ReceiverDone (CollectObjects objectIds objects))
99+
(ReceiverAwait ReflOutboundAgency $ \(MsgReplyObjects objects) -> ReceiverDone (CollectObjects objectIds objects))
100100
(Effect (inboundRun <$> k))
101101
inboundRun (CollectPipelined mNone collect) =
102102
Collect
103103
(fmap inboundRun mNone)
104104
(Effect . fmap inboundRun . collect)
105105

106106
-- | Transform a 'ObjectDiffusionInboundPipelined' into a 'PeerPipelined'.
107-
objectDiffusionClientInboundPeerPipelined ::
107+
objectDiffusionInitInboundPeerPipelined ::
108108
forall objectId object m a.
109109
(Functor m) =>
110110
ObjectDiffusionInboundPipelined objectId object m a ->
111-
PeerPipelined (ObjectDiffusion objectId object) 'AsClient StInit m a
112-
objectDiffusionClientInboundPeerPipelined (ObjectDiffusionInboundPipelined inboundSt) =
111+
PeerPipelined (ObjectDiffusion InboundAgency objectId object) AsInbound StInit m a
112+
objectDiffusionInitInboundPeerPipelined (ObjectDiffusionInboundPipelined inboundSt) =
113113
PeerPipelined $
114-
Yield undefined MsgInit $
114+
Yield ReflInboundAgency MsgInit $
115115
Effect $
116116
inboundRun <$> inboundSt
117117

118-
objectDiffusionServerInboundPeerPipelined ::
118+
objectDiffusionNonInitInboundPeerPipelined ::
119119
forall objectId object m a.
120120
(Functor m) =>
121121
ObjectDiffusionInboundPipelined objectId object m a ->
122-
PeerPipelined (ObjectDiffusion objectId object) 'AsServer StInit m a
123-
objectDiffusionServerInboundPeerPipelined (ObjectDiffusionInboundPipelined inboundSt) =
122+
PeerPipelined (ObjectDiffusion OutboundAgency objectId object) AsInbound StInit m a
123+
objectDiffusionNonInitInboundPeerPipelined (ObjectDiffusionInboundPipelined inboundSt) =
124124
PeerPipelined $
125-
Await @_ @_ @(Pipelined Z (Collect objectId object)) undefined
125+
Await @_ @_ @(Pipelined Z (Collect objectId object)) ReflOutboundAgency
126126
(\MsgInit -> Effect (inboundRun <$> inboundSt))

‎ouroboros-network-protocols/src/Ouroboros/Network/Protocol/ObjectDiffusion/Outbound.hs

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,8 @@ module Ouroboros.Network.Protocol.ObjectDiffusion.Outbound
2525
BlockingReplyList (..),
2626

2727
-- * Execution as a typed protocol
28-
objectDiffusionServerOutboundPeer,
29-
objectDiffusionClientOutboundPeer,
28+
objectDiffusionNonInitOutboundPeer,
29+
objectDiffusionInitOutboundPeer,
3030
)
3131
where
3232

@@ -78,12 +78,12 @@ data OutboundStObjects txid tx m a where
7878
OutboundStObjects txid tx m a
7979

8080
outboundRun ::
81-
forall (pr :: PeerRole) txid tx m a.
81+
forall (initAgency :: Agency) txid tx m a.
8282
(Monad m) =>
8383
OutboundStIdle txid tx m a ->
84-
Peer (ObjectDiffusion txid tx) pr NonPipelined StIdle m a
84+
Peer (ObjectDiffusion initAgency txid tx) AsOutbound NonPipelined StIdle m a
8585
outboundRun OutboundStIdle {recvMsgRequestObjectIds, recvMsgRequestObjects} =
86-
Await undefined $ \msg -> case msg of
86+
Await ReflInboundAgency $ \msg -> case msg of
8787
MsgRequestObjectIds blocking ackNo reqNo -> Effect $ do
8888
reply <- recvMsgRequestObjectIds blocking ackNo reqNo
8989
case reply of
@@ -92,42 +92,42 @@ outboundRun OutboundStIdle {recvMsgRequestObjectIds, recvMsgRequestObjects} =
9292
-- `coot/typed-protocols-rewrite` branch
9393
return $ case blocking of
9494
SingBlocking ->
95-
Yield undefined
95+
Yield ReflOutboundAgency
9696
(MsgReplyObjectIds txids)
9797
(outboundRun k)
9898
SingNonBlocking ->
99-
Yield undefined
99+
Yield ReflOutboundAgency
100100
(MsgReplyObjectIds txids)
101101
(outboundRun k)
102102
SendMsgDone result ->
103103
return $
104-
Yield undefined
104+
Yield ReflOutboundAgency
105105
MsgDone
106-
(Done undefined result)
106+
(Done ReflNobodyAgency result)
107107
MsgRequestObjects txids -> Effect $ do
108108
SendMsgReplyObjects txs k <- recvMsgRequestObjects txids
109109
return $
110-
Yield undefined
110+
Yield ReflOutboundAgency
111111
(MsgReplyObjects txs)
112112
(outboundRun k)
113113

114114
-- | A non-pipelined 'Peer' representing the 'ObjectDiffusionOutbound'.
115-
objectDiffusionServerOutboundPeer ::
115+
objectDiffusionNonInitOutboundPeer ::
116116
forall txid tx m a.
117117
(Monad m) =>
118118
ObjectDiffusionOutbound txid tx m a ->
119-
Peer (ObjectDiffusion txid tx) 'AsServer NonPipelined StInit m a
120-
objectDiffusionServerOutboundPeer (ObjectDiffusionOutbound outboundSt) =
119+
Peer (ObjectDiffusion InboundAgency txid tx) AsOutbound NonPipelined StInit m a
120+
objectDiffusionNonInitOutboundPeer (ObjectDiffusionOutbound outboundSt) =
121121
-- We need to assist GHC to infer the existentially quantified `c` as
122122
-- `Collect objectId object`
123-
Await undefined
123+
Await ReflInboundAgency
124124
(\MsgInit -> Effect (outboundRun <$> outboundSt))
125125

126-
objectDiffusionClientOutboundPeer ::
126+
objectDiffusionInitOutboundPeer ::
127127
forall txid tx m a.
128128
(Monad m) =>
129129
ObjectDiffusionOutbound txid tx m a ->
130-
Peer (ObjectDiffusion txid tx) 'AsClient NonPipelined StInit m a
131-
objectDiffusionClientOutboundPeer (ObjectDiffusionOutbound outboundSt) =
132-
Yield undefined MsgInit $
130+
Peer (ObjectDiffusion OutboundAgency txid tx) AsOutbound NonPipelined StInit m a
131+
objectDiffusionInitOutboundPeer (ObjectDiffusionOutbound outboundSt) =
132+
Yield ReflOutboundAgency MsgInit $
133133
Effect $ outboundRun <$> outboundSt

0 commit comments

Comments
 (0)