Permalink
Browse files

[fix] stdlib/network: no @publish, and refactoring about channel order

no reason to @publish in stdlib: e.g. for an authentified chat, better to expose
only add or broadcast functions with access control

provide a dummy client implementation of on_remove (e.g. to allow client networks)
  • Loading branch information...
1 parent 36d9675 commit 1597fedc676078b931a7db741f8bdb3b1b5d3a37 François-Régis Sinot committed Sep 13, 2011
Showing with 24 additions and 17 deletions.
  1. +7 −0 opabsl/jsbsl/bslSession.js
  2. +10 −14 stdlib/core/rpc/core/network.opa
  3. +7 −3 stdlib/core/rpc/core/session.opa
@@ -995,6 +995,13 @@ var LowLevelPingLoop = {};
}
}
+##register on_remove : Session.private.native('msg, 'ctx), (-> void) -> void
+##args(chan, callback)
+{
+ %%bslsyslog_warning%%("[Session.on_remove]", "client-side version not implemented");
+ return;
+}
+
##register is_remote : Session.private.native('msg, 'ctx) -> bool
##args(chan)
{
@@ -56,27 +56,24 @@ type Network.instruction('a) = {add: channel('a)} / {remove: channel('a)} / {bro
* {1 Interface}
*/
-//Note: For the moment, [Network] is meaningful only on the server, as the client-side implementation of channels cannot provide a stable ordering of channels
Network = {{
/**
* Create an empty network.
*/
- @publish empty(): Network.network('a) =
- Set = Set_make(channel_order)
- me: Network.network('a) = Session.NonBlocking.make(Set.empty,
+ empty(): Network.network('a) =
+ Session.NonBlocking.make(ChannelSet.empty,
(msg, o ->
match msg with
| ~{add} ->
- do Session.on_remove(add, (-> o.update(Set.remove(add, _))))
- o.update(Set.add(add, _))
+ do Session.on_remove(add, (-> o.update(ChannelSet.remove(add, _))))
+ o.update(ChannelSet.add(add, _))
| ~{remove} ->
- o.update(Set.remove(remove, _))
+ o.update(ChannelSet.remove(remove, _))
| ~{broadcast} ->
chans = o.get()
- Set.iter(chan -> send(chan, broadcast), chans)
+ ChannelSet.iter(chan -> Session.send(chan, broadcast), chans)
)
)
- me
/**
@@ -124,18 +121,17 @@ Network = {{
*/
@private make_generic(maker:('state, ('state, Network.instruction('message) -> Session.instruction('state)) -> channel(Network.instruction('message)))):Network.network('message) =
(
- Set = Set_make(channel_order)
rec val me =
- maker(Set.empty,
+ maker(ChannelSet.empty,
chans, msg ->
match msg with
| {~add} ->
do Session.on_remove(add, (-> remove(add, me)))
- {set = Set.add(add, chans)}
+ {set = ChannelSet.add(add, chans)}
| {~remove} ->
- {set = Set.remove(remove, chans)}
+ {set = ChannelSet.remove(remove, chans)}
| {~broadcast} ->
- do sleep(0, -> Set.iter(chan -> send(chan, broadcast), chans))//Note: sending asynchronously
+ do sleep(0, -> ChannelSet.iter(chan -> send(chan, broadcast), chans))//Note: sending asynchronously
{unchanged} //to minimize critical section
)
me
@@ -160,7 +160,11 @@ type Session.entity = external
compare_channel(a:channel('msg), b:channel('msg)) : Order.ordering =
Order.of_int(%%BslSession.compare_channels%%(a, b))
-channel_order = @nonexpansive(Order.make(compare_channel)) : order(channel('message),Channel.order)
+Channel = {{
+ order = @nonexpansive(Order.make(compare_channel)) : order(channel('message), Channel.order)
+}}
+
+ChannelSet = @nonexpansive(Set_make(Channel.order))
/** The Hlnet definitions for the protocol for "make_at" queries */
type make_at_query = (OpaType.ty, OpaType.ty, RPC.Json.json, RPC.Json.json)
@@ -644,9 +648,9 @@ Session = {{
/**
* [on_remove channel f] Execute f when the [channel] is removed
- * of this server.
+ * of this server (no effect on the client).
*/
- @server on_remove(chan:channel('msg), f:-> void): void =
+ on_remove(chan:channel('msg), f:-> void): void =
bp = @may_cps(%%BslSession.on_remove%%)
: Session.private.native('a, _), (-> void) -> void
bp(chan, f)

0 comments on commit 1597fed

Please sign in to comment.