1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2016-2018, VU University Amsterdam
    7			      CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(swish_chat,
   37	  [ chat_broadcast/1,		% +Message
   38	    chat_broadcast/2,		% +Message, +Channel
   39	    chat_to_profile/2,		% +ProfileID, :HTML
   40	    chat_about/2,		% +DocID, +Message
   41
   42	    notifications//1,		% +Options
   43	    broadcast_bell//1		% +Options
   44	  ]).   45:- use_module(library(http/hub)).   46:- use_module(library(http/http_dispatch)).   47:- use_module(library(http/http_session)).   48:- use_module(library(http/http_parameters)).   49:- use_module(library(http/websocket)).   50:- use_module(library(http/json)).   51:- use_module(library(error)).   52:- use_module(library(lists)).   53:- use_module(library(option)).   54:- use_module(library(debug)).   55:- use_module(library(uuid)).   56:- use_module(library(random)).   57:- use_module(library(base64)).   58:- use_module(library(apply)).   59:- use_module(library(broadcast)).   60:- use_module(library(ordsets)).   61:- use_module(library(http/html_write)).   62:- use_module(library(http/http_path)).   63:- if(exists_source(library(user_profile))).   64:- use_module(library(user_profile)).   65:- endif.   66:- use_module(library(aggregate)).   67
   68:- use_module(storage).   69:- use_module(gitty).   70:- use_module(config).   71:- use_module(avatar).   72:- use_module(noble_avatar).   73:- use_module(chatstore).   74:- use_module(authenticate).   75:- use_module(pep).   76:- use_module(content_filter).   77
   78:- html_meta(chat_to_profile(+, html)).   79
   80/** <module> The SWISH collaboration backbone
   81
   82We have three levels of identity as   enumerated  below. Note that these
   83form a hierarchy: a particular user  may   be  logged  on using multiple
   84browsers which in turn may have multiple SWISH windows opened.
   85
   86  1. Any open SWISH window has an associated websocket, represented
   87     by the identifier returned by hub_add/3.
   88  2. Any browser, possibly having multiple open SWISH windows, is
   89     identified by a session cookie.
   90  3. The user may be logged in, either based on the cookie or on
   91     HTTP authentication.
   92*/
   93
   94:- multifile swish_config:config/2.   95
   96swish_config:config(hangout, 'Hangout.swinb').
   97swish_config:config(avatars, svg).		% or 'noble'
   98
   99
  100		 /*******************************
  101		 *	ESTABLISH WEBSOCKET	*
  102		 *******************************/
  103
  104:- http_handler(swish(chat), start_chat, [ id(swish_chat) ]).  105
  106:- meta_predicate must_succeed(0).  107
  108%!	start_chat(+Request)
  109%
  110%	HTTP handler that establishes  a   websocket  connection where a
  111%	user gets an avatar and optionally a name.
  112
  113start_chat(Request) :-
  114	authenticate(Request, Identity),
  115	start_chat(Request, [identity(Identity)]).
  116
  117start_chat(Request, Options) :-
  118	authorized(chat(open), Options),
  119	(   http_in_session(Session)
  120	->  CheckLogin = false
  121	;   http_open_session(Session, []),
  122	    CheckLogin = true
  123	),
  124	check_flooding(Session),
  125	http_parameters(Request,
  126			[ avatar(Avatar, [optional(true)]),
  127			  nickname(NickName, [optional(true)]),
  128			  reconnect(Token, [optional(true)])
  129			]),
  130	extend_options([ avatar(Avatar),
  131			 nick_name(NickName),
  132			 reconnect(Token),
  133			 check_login(CheckLogin)
  134		       ], Options, ChatOptions),
  135	debug(chat(websocket), 'Accepting (session ~p)', [Session]),
  136	http_upgrade_to_websocket(
  137	    accept_chat(Session, ChatOptions),
  138	    [ guarded(false),
  139	      subprotocols(['v1.chat.swish.swi-prolog.org', chat])
  140	    ],
  141	    Request).
  142
  143extend_options([], Options, Options).
  144extend_options([H|T0], Options, [H|T]) :-
  145	ground(H), !,
  146	extend_options(T0, Options, T).
  147extend_options([_|T0], Options, T) :-
  148	extend_options(T0, Options, T).
  149
  150
  151%!	check_flooding(+Session)
  152%
  153%	See whether the client associated with  a session is flooding us
  154%	and if so, return a resource error.
  155
  156check_flooding(Session) :-
  157	get_time(Now),
  158	(   http_session_retract(websocket(Score, Last))
  159	->  Passed is Now-Last,
  160	    NewScore is Score*(2**(-Passed/60)) + 10
  161	;   NewScore = 10,
  162	    Passed = 0
  163	),
  164	debug(chat(flooding), 'Flooding score: ~2f (session ~p)',
  165	      [NewScore, Session]),
  166	http_session_assert(websocket(NewScore, Now)),
  167	(   NewScore > 50
  168	->  throw(http_reply(resource_error(
  169				 error(permission_error(reconnect, websocket,
  170							Session),
  171				       websocket(reconnect(Passed, NewScore))))))
  172	;   true
  173	).
  174
  175%!	accept_chat(+Session, +Options, +WebSocket)
  176
  177accept_chat(Session, Options, WebSocket) :-
  178	must_succeed(accept_chat_(Session, Options, WebSocket)).
  179
  180accept_chat_(Session, Options, WebSocket) :-
  181	create_chat_room,
  182	(   reconnect_token(WSID, Token, Options),
  183	    retractall(visitor_status(WSID, lost(_))),
  184	    existing_visitor(WSID, Session, Token, TmpUser, UserData),
  185	    hub_add(swish_chat, WebSocket, WSID)
  186	->  Reason = rejoined
  187	;   hub_add(swish_chat, WebSocket, WSID),
  188	    must_succeed(create_visitor(WSID, Session, Token,
  189					TmpUser, UserData, Options)),
  190	    Reason = joined
  191	),
  192	visitor_count(Visitors),
  193	option(check_login(CheckLogin), Options, true),
  194	Msg = _{ type:welcome,
  195		 uid:TmpUser,
  196		 wsid:WSID,
  197		 reconnect:Token,
  198		 visitors:Visitors,
  199		 check_login:CheckLogin
  200	       },
  201	hub_send(WSID, json(UserData.put(Msg))),
  202	must_succeed(chat_broadcast(UserData.put(_{type:Reason,
  203						   visitors:Visitors,
  204						   wsid:WSID}))),
  205	gc_visitors,
  206	debug(chat(websocket), '~w (session ~p, wsid ~p)',
  207	      [Reason, Session, WSID]).
  208
  209
  210reconnect_token(WSID, Token, Options) :-
  211	option(reconnect(Token), Options),
  212	visitor_session(WSID, _, Token), !.
  213
  214must_succeed(Goal) :-
  215	catch(Goal, E, print_message(warning, E)), !.
  216must_succeed(Goal) :-
  217	print_message(warning, goal_failed(Goal)).
  218
  219
  220		 /*******************************
  221		 *	        DATA		*
  222		 *******************************/
  223
  224%%	visitor_session(?WSId, ?Session, ?Token).
  225%%	session_user(?Session, ?TmpUser).
  226%%	visitor_data(?TmpUser, ?UserData:dict).
  227%%	subscription(?Session, ?Channel, ?SubChannel).
  228%
  229%	These predicates represent our notion of visitors.
  230%
  231%	@arg WSID is the identifier of the web socket. As we may have to
  232%	reconnect lost connections, this is may be replaced.
  233%	@arg Session is the session identifier.  This is used to connect
  234%	SWISH actions to WSIDs.
  235%	@arg TmpUser is the ID with which we identify the user for this
  236%	run. The value is a UUID and thus doesn't reveal the real
  237%	identity of the user.
  238%	@arg UserDict is a dict that holds information about the real
  239%	user identity.  This can be empty if no information is known
  240%	about this user.
  241
  242:- dynamic
  243	visitor_status/2,		% WSID, Status
  244	visitor_session/3,		% WSID, Session, Token
  245	session_user/2,			% Session, TmpUser
  246	visitor_data/2,			% TmpUser, Data
  247	subscription/3.			% WSID, Channel, SubChannel
  248
  249%!	visitor(?WSID) is nondet
  250%
  251%	True when WSID should be considered an active visitor.
  252
  253visitor(WSID) :-
  254	visitor_session(WSID, _Session, _Token),
  255	\+ inactive(WSID, 30).
  256
  257visitor_count(Count) :-
  258	aggregate_all(count, visitor(_), Count).
  259
  260%!	inactive(+WSID, +Timeout) is semidet.
  261%
  262%	True if WSID is inactive. This means   we lost the connection at
  263%	least Timeout seconds ago.
  264
  265inactive(WSID, Timeout) :-
  266	visitor_status(WSID, lost(Lost)),
  267	get_time(Now),
  268	Now - Lost > Timeout.
  269
  270%!	visitor_session(?WSID, ?Session) is nondet.
  271%
  272%	True if websocket WSID is associated with Session.
  273
  274visitor_session(WSID, Session) :-
  275	visitor_session(WSID, Session, _Token).
  276
  277%!	wsid_visitor(?WSID, ?Visitor)
  278%
  279%	True when WSID is associated with Visitor
  280
  281wsid_visitor(WSID, Visitor) :-
  282	nonvar(WSID), !,
  283	visitor_session(WSID, Session),
  284	session_user(Session, Visitor).
  285wsid_visitor(WSID, Visitor) :-
  286	session_user(Session, Visitor),
  287	visitor_session(WSID, Session).
  288
  289%!	existing_visitor(+WSID, +Session, +Token, -TmpUser, -UserData) is semidet.
  290%
  291%	True if we are dealing with  an   existing  visitor for which we
  292%	lost the connection.
  293
  294existing_visitor(WSID, Session, Token, TmpUser, UserData) :-
  295	visitor_session(WSID, Session, Token),
  296	session_user(Session, TmpUser),
  297	visitor_data(TmpUser, UserData), !.
  298existing_visitor(WSID, Session, Token, _, _) :-
  299	retractall(visitor_session(WSID, Session, Token)),
  300	fail.
  301
  302%%	create_visitor(+WSID, +Session, ?Token, -TmpUser, -UserData, +Options)
  303%
  304%	Create a new visitor  when  a   new  websocket  is  established.
  305%	Options provides information we have about the user:
  306%
  307%	  - current_user_info(+Info)
  308%	  Already logged in user with given information
  309%	  - avatar(Avatar)
  310%	  Avatar remembered in the browser for this user.
  311%	  - nick_name(NickName)
  312%	  Nick name remembered in the browser for this user.
  313
  314create_visitor(WSID, Session, Token, TmpUser, UserData, Options) :-
  315	generate_key(Token),
  316	assertz(visitor_session(WSID, Session, Token)),
  317	create_session_user(Session, TmpUser, UserData, Options).
  318
  319%!  generate_key(-Key) is det.
  320%
  321%   Generate a random confirmation key
  322
  323generate_key(Key) :-
  324	length(Codes, 16),
  325	maplist(random_between(0,255), Codes),
  326	phrase(base64url(Codes), Encoded),
  327	atom_codes(Key, Encoded).
  328
  329%%	destroy_visitor(+WSID)
  330%
  331%	The web socket WSID has been   closed. We should not immediately
  332%	destroy the temporary user as the browser may soon reconnect due
  333%	to a page reload  or  re-establishing   the  web  socket after a
  334%	temporary network failure. We leave   the destruction thereof to
  335%	the session, but set the session timeout to a fairly short time.
  336%
  337%	@tbd	We should only inform clients that we have informed
  338%		about this user.
  339
  340destroy_visitor(WSID) :-
  341	must_be(atom, WSID),
  342	destroy_reason(WSID, Reason),
  343	(   Reason == unload
  344	->  reclaim_visitor(WSID)
  345	;   get_time(Now),
  346	    assertz(visitor_status(WSID, lost(Now)))
  347	),
  348	visitor_count(Count),
  349	chat_broadcast(_{ type:removeUser,
  350			  wsid:WSID,
  351			  reason:Reason,
  352			  visitors:Count
  353			}).
  354
  355destroy_reason(WSID, Reason) :-
  356	retract(visitor_status(WSID, unload)), !,
  357	Reason = unload.
  358destroy_reason(_, close).
  359
  360%!	gc_visitors
  361%
  362%	Reclaim all visitors with whom we   have lost the connection and
  363%	the browser did not reclaim the selection within 5 minutes.
  364
  365:- dynamic last_gc/1.  366
  367gc_visitors :-
  368	last_gc(Last),
  369	get_time(Now),
  370	Now-Last < 300, !.
  371gc_visitors :-
  372	with_mutex(gc_visitors, gc_visitors_sync).
  373
  374gc_visitors_sync :-
  375	get_time(Now),
  376	(   last_gc(Last),
  377	    Now-Last < 300
  378	->  true
  379	;   retractall(last_gc(_)),
  380	    asserta(last_gc(Now)),
  381	    do_gc_visitors
  382	).
  383
  384do_gc_visitors :-
  385	forall(( visitor_session(WSID, _Session, _Token),
  386		 inactive(WSID, 5*60)
  387	       ),
  388	       reclaim_visitor(WSID)).
  389
  390reclaim_visitor(WSID) :-
  391	debug(chat(gc), 'Reclaiming idle ~p', [WSID]),
  392	reclaim_visitor_session(WSID),
  393	retractall(visitor_status(WSID, _Status)),
  394	unsubscribe(WSID, _).
  395
  396reclaim_visitor_session(WSID) :-
  397	forall(retract(visitor_session(WSID, Session, _Token)),
  398		       http_session_retractall(websocket(_, _), Session)).
  399
  400:- if(\+current_predicate(http_session_retractall/2)).  401http_session_retractall(Data, Session) :-
  402	retractall(http_session:session_data(Session, Data)).
  403:- endif.  404
  405
  406%%	create_session_user(+Session, -User, -UserData, +Options)
  407%
  408%	Associate a user with the session. The user id is a UUID that is
  409%	not associated with  any  persistent  notion   of  a  user.  The
  410%	destruction is left to the destruction of the session.
  411
  412:- listen(http_session(end(SessionID, _Peer)),
  413	  destroy_session_user(SessionID)).  414
  415create_session_user(Session, TmpUser, UserData, _Options) :-
  416	session_user(Session, TmpUser),
  417	visitor_data(TmpUser, UserData), !.
  418create_session_user(Session, TmpUser, UserData, Options) :-
  419	uuid(TmpUser),
  420	get_visitor_data(UserData, Options),
  421	assertz(session_user(Session, TmpUser)),
  422	assertz(visitor_data(TmpUser, UserData)).
  423
  424destroy_session_user(Session) :-
  425	forall(visitor_session(WSID, Session, _Token),
  426	       inform_session_closed(WSID, Session)),
  427	retractall(visitor_session(_, Session, _)),
  428	forall(retract(session_user(Session, TmpUser)),
  429	       destroy_visitor_data(TmpUser)).
  430
  431destroy_visitor_data(TmpUser) :-
  432	(   retract(visitor_data(TmpUser, Data)),
  433	    release_avatar(Data.get(avatar)),
  434	    fail
  435	;   true
  436	).
  437
  438inform_session_closed(WSID, Session) :-
  439	ignore(hub_send(WSID, json(_{type:session_closed}))),
  440	session_user(Session, TmpUser),
  441	update_visitor_data(TmpUser, _Data, logout).
  442
  443
  444%!	update_visitor_data(+TmpUser, +Data, +Reason) is det.
  445%
  446%	Update the user data for the visitor   TmpUser  to Data. This is
  447%	rather complicates due to all the   defaulting  rules. Reason is
  448%	one of:
  449%
  450%	  - login
  451%	  - logout
  452%	  - 'set-nick-name'
  453%	  - 'profile-edit'
  454%
  455%	@tbd Create a more declarative description  on where the various
  456%	attributes must come from.
  457
  458update_visitor_data(TmpUser, _Data, logout) :- !,
  459	anonymise_user_data(TmpUser, NewData),
  460	set_visitor_data(TmpUser, NewData, logout).
  461update_visitor_data(TmpUser, Data, Reason) :-
  462	profile_reason(Reason), !,
  463	(   visitor_data(TmpUser, Old)
  464	;   Old = v{}
  465	),
  466	copy_profile([name,avatar,email], Data, Old, New),
  467	set_visitor_data(TmpUser, New, Reason).
  468update_visitor_data(TmpUser, _{name:Name}, 'set-nick-name') :- !,
  469	visitor_data(TmpUser, Old),
  470	set_nick_name(Old, Name, New),
  471	set_visitor_data(TmpUser, New, 'set-nick-name').
  472update_visitor_data(TmpUser, Data, Reason) :-
  473	set_visitor_data(TmpUser, Data, Reason).
  474
  475profile_reason('profile-edit').
  476profile_reason('login').
  477
  478copy_profile([], _, Data, Data).
  479copy_profile([H|T], New, Data0, Data) :-
  480	copy_profile_field(H, New, Data0, Data1),
  481	copy_profile(T, New, Data1, Data).
  482
  483copy_profile_field(avatar, New, Data0, Data) :-	!,
  484	(   Data1 = Data0.put(avatar,New.get(avatar))
  485	->  Data  = Data1.put(avatar_source, profile)
  486	;   email_gravatar(New.get(email), Avatar),
  487	    valid_gravatar(Avatar)
  488	->  Data = Data0.put(_{avatar:Avatar,avatar_source:email})
  489	;   Avatar = Data0.get(anonymous_avatar)
  490	->  Data = Data0.put(_{avatar:Avatar,avatar_source:client})
  491	;   noble_avatar_url(Avatar, []),
  492	    Data = Data0.put(_{avatar:Avatar,avatar_source:generated,
  493			       anonymous_avatar:Avatar
  494			      })
  495	).
  496copy_profile_field(email, New, Data0, Data) :- !,
  497	(   NewMail = New.get(email)
  498	->  update_avatar_from_email(NewMail, Data0, Data1),
  499	    Data = Data1.put(email, NewMail)
  500	;   update_avatar_from_email('', Data0, Data1),
  501	    (	del_dict(email, Data1, _, Data)
  502	    ->	true
  503	    ;	Data = Data1
  504	    )
  505	).
  506copy_profile_field(F, New, Data0, Data) :-
  507	(   Data = Data0.put(F, New.get(F))
  508	->  true
  509	;   del_dict(F, Data0, _, Data)
  510	->  true
  511	;   Data = Data0
  512	).
  513
  514set_nick_name(Data0, Name, Data) :-
  515	Data = Data0.put(_{name:Name, anonymous_name:Name}).
  516
  517%!	update_avatar_from_email(+Email, +DataIn, -Data)
  518%
  519%	Update the avatar after a change  of   the  known  email. If the
  520%	avatar comes from the profile, no action is needed. If Email has
  521%	a gravatar, use that. Else  use  the   know  or  a new generated
  522%	avatar.
  523
  524update_avatar_from_email(_, Data, Data) :-
  525	Data.get(avatar_source) == profile, !.
  526update_avatar_from_email('', Data0, Data) :-
  527	Data0.get(avatar_source) == email, !,
  528	noble_avatar_url(Avatar, []),
  529	Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  530			   avatar_source:generated}).
  531update_avatar_from_email(Email, Data0, Data) :-
  532	email_gravatar(Email, Avatar),
  533	valid_gravatar(Avatar), !,
  534	Data = Data0.put(avatar, Avatar).
  535update_avatar_from_email(_, Data0, Data) :-
  536	(   Avatar = Data0.get(anonymous_avatar)
  537	->  Data = Data0.put(_{avatar:Avatar, avatar_source:client})
  538	;   noble_avatar_url(Avatar, []),
  539	    Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  540			       avatar_source:generated})
  541	).
  542
  543%!	anonymise_user_data(TmpUser, Data)
  544%
  545%	Create anonymous user profile.
  546
  547anonymise_user_data(TmpUser, Data) :-
  548	visitor_data(TmpUser, Old),
  549	(   _{anonymous_name:AName, anonymous_avatar:AAvatar} :< Old
  550	->  Data = _{anonymous_name:AName, anonymous_avatar:AAvatar,
  551		     name:AName, avatar:AAvatar, avatar_source:client}
  552	;   _{anonymous_avatar:AAvatar} :< Old
  553	->  Data = _{anonymous_avatar:AAvatar,
  554		     avatar:AAvatar, avatar_source:client}
  555	;   _{anonymous_name:AName} :< Old
  556	->  noble_avatar_url(Avatar, []),
  557	    Data = _{anonymous_name:AName, anonymous_avatar:Avatar,
  558		     name:AName, avatar:Avatar, avatar_source:generated}
  559	), !.
  560anonymise_user_data(_, Data) :-
  561	noble_avatar_url(Avatar, []),
  562	Data = _{anonymous_avatar:Avatar,
  563		 avatar:Avatar, avatar_source:generated}.
  564
  565%!	set_visitor_data(+TmpUser, +Data, +Reason) is det.
  566%
  567%	Update the user data for the   session  user TmpUser and forward
  568%	the changes.
  569
  570set_visitor_data(TmpUser, Data, Reason) :-
  571	retractall(visitor_data(TmpUser, _)),
  572	assertz(visitor_data(TmpUser, Data)),
  573	inform_visitor_change(TmpUser, Reason).
  574
  575%!	inform_visitor_change(+TmpUser, +Reason) is det.
  576%
  577%	Inform browsers showing  TmpUser  that   the  visitor  data  has
  578%	changed. The first  clause  deals   with  forwarding  from  HTTP
  579%	requests,  where  we  have  the  session  and  the  second  from
  580%	websocket requests where we have the WSID.
  581
  582inform_visitor_change(TmpUser, Reason) :-
  583	http_in_session(Session), !,
  584	public_user_data(TmpUser, Data),
  585	forall(visitor_session(WSID, Session),
  586	       inform_friend_change(WSID, Data, Reason)).
  587inform_visitor_change(TmpUser, Reason) :-
  588	b_getval(wsid, WSID),
  589	public_user_data(TmpUser, Data),
  590	inform_friend_change(WSID, Data, Reason).
  591
  592inform_friend_change(WSID, Data, Reason) :-
  593	Message = json(_{ type:"profile",
  594			  wsid:WSID,
  595			  reason:Reason
  596			}.put(Data)),
  597	hub_send(WSID, Message),
  598	forall(viewing_same_file(WSID, Friend),
  599	       ignore(hub_send(Friend, Message))).
  600
  601viewing_same_file(WSID, Friend) :-
  602	subscription(WSID, gitty, File),
  603	subscription(Friend, gitty, File),
  604	Friend \== WSID.
  605
  606%%	subscribe(+WSID, +Channel) is det.
  607
  608subscribe(WSID, Channel) :-
  609	subscribe(WSID, Channel, _SubChannel).
  610subscribe(WSID, Channel, SubChannel) :-
  611	(   subscription(WSID, Channel, SubChannel)
  612	->  true
  613	;   assertz(subscription(WSID, Channel, SubChannel))
  614	).
  615
  616unsubscribe(WSID, Channel) :-
  617	unsubscribe(WSID, Channel, _SubChannel).
  618unsubscribe(WSID, Channel, SubChannel) :-
  619	retractall(subscription(WSID, Channel, SubChannel)).
  620
  621%%	sync_gazers(+WSID, +Files:list(atom)) is det.
  622%
  623%	A browser signals it has Files open.   This happens when a SWISH
  624%	instance is created as well  as   when  a SWISH instance changes
  625%	state, such as closing a tab, adding   a  tab, bringing a tab to
  626%	the foreground, etc.
  627
  628sync_gazers(WSID, Files0) :-
  629	findall(F, subscription(WSID, gitty, F), Viewing0),
  630	sort(Files0, Files),
  631	sort(Viewing0, Viewing),
  632	(   Files == Viewing
  633	->  true
  634	;   ord_subtract(Files, Viewing, New),
  635	    add_gazing(WSID, New),
  636	    ord_subtract(Viewing, Files, Left),
  637	    del_gazing(WSID, Left)
  638	).
  639
  640add_gazing(_, []) :- !.
  641add_gazing(WSID, Files) :-
  642	inform_me_about_existing_gazers(WSID, Files),
  643	inform_existing_gazers_about_newby(WSID, Files).
  644
  645inform_me_about_existing_gazers(WSID, Files) :-
  646	findall(Gazer, files_gazer(Files, Gazer), Gazers),
  647	ignore(hub_send(WSID, json(_{type:"gazers", gazers:Gazers}))).
  648
  649files_gazer(Files, Gazer) :-
  650	member(File, Files),
  651	subscription(WSID, gitty, File),
  652	visitor_session(WSID, Session),
  653	session_user(Session, UID),
  654	public_user_data(UID, Data),
  655	Gazer = _{file:File, uid:UID, wsid:WSID}.put(Data).
  656
  657inform_existing_gazers_about_newby(WSID, Files) :-
  658	forall(member(File, Files),
  659	       signal_gazer(WSID, File)).
  660
  661signal_gazer(WSID, File) :-
  662	subscribe(WSID, gitty, File),
  663	broadcast_event(opened(File), File, WSID).
  664
  665del_gazing(_, []) :- !.
  666del_gazing(WSID, Files) :-
  667	forall(member(File, Files),
  668	       del_gazing1(WSID, File)).
  669
  670del_gazing1(WSID, File) :-
  671	broadcast_event(closed(File), File, WSID),
  672	unsubscribe(WSID, gitty, File).
  673
  674%%	add_user_details(+Message, -Enriched) is det.
  675%
  676%	Add additional information to a message.  Message must
  677%	contain a `uid` field.
  678
  679add_user_details(Message, Enriched) :-
  680	public_user_data(Message.uid, Data),
  681	Enriched = Message.put(Data).
  682
  683%%	public_user_data(+UID, -Public:dict) is det.
  684%
  685%	True when Public provides the   information  we publically share
  686%	about UID. This is currently the name and avatar.
  687
  688public_user_data(UID, Public) :-
  689	visitor_data(UID, Data),
  690	(   _{name:Name, avatar:Avatar} :< Data
  691	->  Public = _{name:Name, avatar:Avatar}
  692	;   _{avatar:Avatar} :< Data
  693	->  Public = _{avatar:Avatar}
  694	;   Public = _{}
  695	).
  696
  697%%	get_visitor_data(-Data:dict, +Options) is det.
  698%
  699%	Optain data for a new visitor.  Options include:
  700%
  701%	  - identity(+Identity)
  702%	  Identity information provided by authenticate/2.  Always
  703%	  present.
  704%	  - avatar(+URL)
  705%	  Avatar provided by the user
  706%	  - nick_name(+Name)
  707%	  Nick name provided by the user.
  708%
  709%	Data always contains an `avatar` key   and optionally contains a
  710%	`name` and `email` key. If the avatar is generated there is also
  711%	a key `avatar_generated` with the value `true`.
  712%
  713%	@bug	This may check for avatar validity, which may take
  714%		long.  Possibly we should do this in a thread.
  715
  716get_visitor_data(Data, Options) :-
  717	option(identity(Identity), Options),
  718	findall(N-V, visitor_property(Identity, Options, N, V), Pairs),
  719	dict_pairs(Data, v, Pairs).
  720
  721visitor_property(Identity, Options, name, Name) :-
  722	(   user_property(Identity, name(Name))
  723	->  true
  724	;   option(nick_name(Name), Options)
  725	).
  726visitor_property(Identity, _, email, Email) :-
  727	user_property(Identity, email(Email)).
  728visitor_property(Identity, Options, Name, Value) :-
  729	(   user_property(Identity, avatar(Avatar))
  730	->  avatar_property(Avatar, profile, Name, Value)
  731	;   user_property(Identity, email(Email)),
  732	    email_gravatar(Email, Avatar),
  733	    valid_gravatar(Avatar)
  734	->  avatar_property(Avatar, email, Name, Value)
  735	;   option(avatar(Avatar), Options)
  736	->  avatar_property(Avatar, client, Name, Value)
  737	;   noble_avatar_url(Avatar, Options),
  738	    avatar_property(Avatar, generated, Name, Value)
  739	).
  740visitor_property(_, Options, anonymous_name, Name) :-
  741	option(nick_name(Name), Options).
  742visitor_property(_, Options, anonymous_avatar, Avatar) :-
  743	option(avatar(Avatar), Options).
  744
  745
  746avatar_property(Avatar, _Source, avatar,        Avatar).
  747avatar_property(_Avatar, Source, avatar_source, Source).
  748
  749
  750		 /*******************************
  751		 *	   NOBLE AVATAR		*
  752		 *******************************/
  753
  754:- http_handler(swish('avatar/'), reply_avatar, [id(avatar), prefix]).  755
  756%%	reply_avatar(+Request)
  757%
  758%	HTTP handler for Noble  Avatar   images.  Using  create_avatar/2
  759%	re-creates avatars from the file name,  so we can safely discard
  760%	the avatar file store.
  761%
  762%	Not really. A new user gets a new   avatar  and this is based on
  763%	whether or not the file exists. Probably we should maintain a db
  764%	of handed out avatars and their last-use   time stamp. How to do
  765%	that? Current swish stats: 400K avatars, 3.2Gb data.
  766
  767reply_avatar(Request) :-
  768	option(path_info(Local), Request),
  769	(   absolute_file_name(noble_avatar(Local), Path,
  770			       [ access(read),
  771				 file_errors(fail)
  772			       ])
  773	->  true
  774	;   create_avatar(Local, Path)
  775	),
  776	http_reply_file(Path, [unsafe(true)], Request).
  777
  778
  779noble_avatar_url(HREF, Options) :-
  780	option(avatar(HREF), Options), !.
  781noble_avatar_url(HREF, _Options) :-
  782	swish_config:config(avatars, noble),
  783	!,
  784	noble_avatar(_Gender, Path, true),
  785	file_base_name(Path, File),
  786	http_absolute_location(swish(avatar/File), HREF, []).
  787noble_avatar_url(HREF, _Options) :-
  788	A is random(0x1FFFFF+1),
  789	http_absolute_location(icons('avatar.svg'), HREF0, []),
  790	format(atom(HREF), '~w#~d', [HREF0, A]).
  791
  792
  793
  794		 /*******************************
  795		 *	   BROADCASTING		*
  796		 *******************************/
  797
  798%%	chat_broadcast(+Message) is det.
  799%%	chat_broadcast(+Message, +Channel) is det.
  800%
  801%	Send Message to all known SWISH clients. Message is a valid JSON
  802%	object, i.e., a dict or option list.
  803%
  804%	@arg Channel is either an atom or a term Channel/SubChannel,
  805%	where both Channel and SubChannel are atoms.
  806
  807chat_broadcast(Message) :-
  808	debug(chat(broadcast), 'Broadcast: ~p', [Message]),
  809	hub_broadcast(swish_chat, json(Message)).
  810
  811chat_broadcast(Message, Channel/SubChannel) :- !,
  812	must_be(atom, Channel),
  813	must_be(atom, SubChannel),
  814	debug(chat(broadcast), 'Broadcast on ~p: ~p',
  815	      [Channel/SubChannel, Message]),
  816	hub_broadcast(swish_chat, json(Message),
  817		      subscribed(Channel, SubChannel)).
  818chat_broadcast(Message, Channel) :-
  819	must_be(atom, Channel),
  820	debug(chat(broadcast), 'Broadcast on ~p: ~p', [Channel, Message]),
  821	hub_broadcast(swish_chat, json(Message),
  822		      subscribed(Channel)).
  823
  824subscribed(Channel, WSID) :-
  825	subscription(WSID, Channel, _).
  826subscribed(Channel, SubChannel, WSID) :-
  827	subscription(WSID, Channel, SubChannel).
  828subscribed(gitty, SubChannel, WSID) :-
  829	swish_config:config(hangout, SubChannel),
  830	\+ subscription(WSID, gitty, SubChannel).
  831
  832
  833		 /*******************************
  834		 *	     CHAT ROOM		*
  835		 *******************************/
  836
  837create_chat_room :-
  838	current_hub(swish_chat, _), !.
  839create_chat_room :-
  840	with_mutex(swish_chat, create_chat_room_sync).
  841
  842create_chat_room_sync :-
  843	current_hub(swish_chat, _), !.
  844create_chat_room_sync :-
  845	hub_create(swish_chat, Room, _{}),
  846	thread_create(swish_chat(Room), _, [alias(swish_chat)]).
  847
  848swish_chat(Room) :-
  849	(   catch(swish_chat_event(Room), E, chat_exception(E))
  850	->  true
  851	;   print_message(warning, goal_failed(swish_chat_event(Room)))
  852	),
  853	swish_chat(Room).
  854
  855chat_exception('$aborted') :- !.
  856chat_exception(E) :-
  857	print_message(warning, E).
  858
  859swish_chat_event(Room) :-
  860	thread_get_message(Room.queues.event, Message),
  861	(   handle_message(Message, Room)
  862	->  true
  863	;   print_message(warning, goal_failed(handle_message(Message, Room)))
  864	).
  865
  866%%	handle_message(+Message, +Room)
  867%
  868%	Handle incoming messages
  869
  870handle_message(Message, _Room) :-
  871	websocket{opcode:text} :< Message, !,
  872	atom_json_dict(Message.data, JSON, []),
  873	debug(chat(received), 'Received from ~p: ~p', [Message.client, JSON]),
  874	WSID = Message.client,
  875	setup_call_cleanup(
  876	    b_setval(wsid, WSID),
  877	    json_message(JSON, WSID),
  878	    nb_delete(wsid)).
  879handle_message(Message, _Room) :-
  880	hub{joined:WSID} :< Message, !,
  881	debug(chat(visitor), 'Joined: ~p', [WSID]).
  882handle_message(Message, _Room) :-
  883	hub{left:WSID, reason:write(Lost)} :< Message, !,
  884	(   destroy_visitor(WSID)
  885	->  debug(chat(visitor), 'Left ~p due to write error for ~p',
  886		  [WSID, Lost])
  887	;   true
  888	).
  889handle_message(Message, _Room) :-
  890	hub{left:WSID} :< Message, !,
  891	(   destroy_visitor(WSID)
  892	->  debug(chat(visitor), 'Left: ~p', [WSID])
  893	;   true
  894	).
  895handle_message(Message, _Room) :-
  896	websocket{opcode:close, client:WSID} :< Message, !,
  897	debug(chat(visitor), 'Left: ~p', [WSID]),
  898	destroy_visitor(WSID).
  899handle_message(Message, _Room) :-
  900	debug(chat(ignored), 'Ignoring chat message ~p', [Message]).
  901
  902
  903%%	json_message(+Message, +WSID) is det.
  904%
  905%	Process a JSON message  translated  to   a  dict.  The following
  906%	messages are understood:
  907%
  908%	  - subscribe channel [subchannel]
  909%	  - unsubscribe channel [subchannel]
  910%	  Actively (un)subscribe for specific message channels.
  911%	  - unload
  912%	  A SWISH instance is cleanly being unloaded.
  913%	  - has-open-files files
  914%	  Executed after initiating the websocket to indicate loaded
  915%	  files.
  916%	  - set-nick-name name
  917%	  User set nick name for anonymous identoty
  918
  919json_message(Dict, WSID) :-
  920	_{ type: "subscribe",
  921	   channel:ChannelS, sub_channel:SubChannelS} :< Dict, !,
  922	atom_string(Channel, ChannelS),
  923	atom_string(SubChannel, SubChannelS),
  924	subscribe(WSID, Channel, SubChannel).
  925json_message(Dict, WSID) :-
  926	_{type: "subscribe", channel:ChannelS} :< Dict, !,
  927	atom_string(Channel, ChannelS),
  928	subscribe(WSID, Channel).
  929json_message(Dict, WSID) :-
  930	_{ type: "unsubscribe",
  931	   channel:ChannelS, sub_channel:SubChannelS} :< Dict, !,
  932	atom_string(Channel, ChannelS),
  933	atom_string(SubChannel, SubChannelS),
  934	unsubscribe(WSID, Channel, SubChannel).
  935json_message(Dict, WSID) :-
  936	_{type: "unsubscribe", channel:ChannelS} :< Dict, !,
  937	atom_string(Channel, ChannelS),
  938	unsubscribe(WSID, Channel).
  939json_message(Dict, WSID) :-
  940	_{type: "unload"} :< Dict, !,	% clean close/reload
  941	sync_gazers(WSID, []),
  942	assertz(visitor_status(WSID, unload)).
  943json_message(Dict, WSID) :-
  944	_{type: "has-open-files", files:FileDicts} :< Dict, !,
  945	maplist(dict_file_name, FileDicts, Files),
  946	sync_gazers(WSID, Files).
  947json_message(Dict, WSID) :-
  948	_{type: "reloaded", file:FileS, commit:Hash} :< Dict, !,
  949	atom_string(File, FileS),
  950	event_html(reloaded(File), HTML),
  951	Message = _{ type:notify,
  952		     wsid:WSID,
  953		     html:HTML,
  954		     event:reloaded,
  955		     argv:[File,Hash]
  956		   },
  957	chat_broadcast(Message, gitty/File).
  958json_message(Dict, WSID) :-
  959	_{type: "set-nick-name", name:Name} :< Dict, !,
  960	wsid_visitor(WSID, Visitor),
  961	update_visitor_data(Visitor, _{name:Name}, 'set-nick-name').
  962json_message(Dict, WSID) :-
  963	_{type: "chat-message", docid:DocID} :< Dict, !,
  964	chat_add_user_id(WSID, Dict, Message),
  965	(   forbidden(Message, DocID, Why)
  966	->  hub_send(WSID, json(json{type:forbidden,
  967				     action:chat_post,
  968				     about:DocID,
  969				     message:Why
  970				    }))
  971	;   chat_relay(Message)
  972	).
  973json_message(Dict, _WSID) :-
  974	debug(chat(ignored), 'Ignoring JSON message ~p', [Dict]).
  975
  976dict_file_name(Dict, File) :-
  977	atom_string(File, Dict.get(file)).
  978
  979%!	forbidden(+Message, +DocID, -Why) is semidet.
  980%
  981%	True if the chat Message about DocID must be forbidden, in which
  982%	case Why is  unified  with  a   string  indicating  the  reason.
  983%	Currently:
  984%
  985%	  - Demands the user to be logged on
  986%	  - Limits the size of the message and its payloads
  987%
  988%	@tbd Call authorized/2 with all proper identity information.
  989
  990forbidden(Message, DocID, Why) :-
  991	\+ swish_config:config(chat_spam_protection, false),
  992	\+ ws_authorized(chat(post(Message, DocID)), Message.user), !,
  993	Why = "Due to frequent spamming we were forced to limit \c
  994	       posting chat messages to users who are logged in.".
  995forbidden(Message, _DocID, Why) :-
  996	Text = Message.get(text),
  997	string_length(Text, Len),
  998	Len > 500,
  999	Why = "Chat messages are limited to 500 characters".
 1000forbidden(Message, _DocID, Why) :-
 1001	Payloads = Message.get(payload),
 1002	member(Payload, Payloads),
 1003	large_payload(Payload, Why), !.
 1004forbidden(Message, _DocID, Why) :-
 1005	\+ swish_config:config(chat_spam_protection, false),
 1006	eval_content(Message.get(text), _WC, Score),
 1007	user_score(Message, Score, Cummulative, _Count),
 1008	Score*2 + Cummulative < 0,
 1009	!,
 1010	Why = "Chat messages must be in English and avoid offensive language".
 1011
 1012large_payload(Payload, Why) :-
 1013	Selections = Payload.get(selection),
 1014	member(Selection, Selections),
 1015	(   string_length(Selection.get(string), SelLen), SelLen > 500
 1016	;   string_length(Selection.get(context), SelLen), SelLen > 500
 1017	), !,
 1018	Why = "Selection too long (max. 500 characters)".
 1019large_payload(Payload, Why) :-
 1020	string_length(Payload.get(query), QLen), QLen > 1000, !,
 1021	Why = "Query too long (max. 1000 characters)".
 1022
 1023user_score(Message, MsgScore, Cummulative, Count) :-
 1024	Profile	= Message.get(user).get(profile_id), !,
 1025	block(Profile, MsgScore, Cummulative, Count).
 1026user_score(_, _, 0, 1).
 1027
 1028%!	block(+User, +Score, -Cummulative, -Count)
 1029%
 1030%	Keep a count and cummulative score for a user.
 1031
 1032:- dynamic
 1033	blocked/4. 1034
 1035block(User, Score, Cummulative, Count) :-
 1036	blocked(User, Score0, Count0, Time), !,
 1037	get_time(Now),
 1038	Cummulative = Score0*(0.5**((Now-Time)/600)) + Score,
 1039	Count is Count0 + 1,
 1040	asserta(blocked(User, Cummulative, Count, Now)),
 1041	retractall(blocked(User, Score0, Count0, Time)).
 1042block(User, Score, Score, 1) :-
 1043	get_time(Now),
 1044	asserta(blocked(User, Score, 1, Now)).
 1045
 1046
 1047		 /*******************************
 1048		 *	   CHAT MESSAGES	*
 1049		 *******************************/
 1050
 1051%!	chat_add_user_id(+WSID, +Message0, -Message) is det.
 1052%
 1053%	Decorate a message with the user credentials.
 1054
 1055chat_add_user_id(WSID, Dict, Message) :-
 1056	visitor_session(WSID, Session, _Token),
 1057	session_user(Session, Visitor),
 1058	visitor_data(Visitor, UserData),
 1059	User0 = u{avatar:UserData.avatar,
 1060		  wsid:WSID
 1061		 },
 1062	(   Name = UserData.get(name)
 1063	->  User1 = User0.put(name, Name)
 1064	;   User1 = User0
 1065	),
 1066	(   http_current_session(Session, profile_id(ProfileID))
 1067	->  User = User1.put(profile_id, ProfileID)
 1068	;   User = User1
 1069	),
 1070	Message = Dict.put(user, User).
 1071
 1072
 1073%!	chat_about(+DocID, +Message) is det.
 1074%
 1075%	Distribute a chat message about DocID.
 1076
 1077chat_about(DocID, Message) :-
 1078	chat_relay(Message.put(docid, DocID)).
 1079
 1080%!	chat_relay(+Message) is det.
 1081%
 1082%	Store and relay a chat message.
 1083
 1084chat_relay(Message) :-
 1085	chat_enrich(Message, Message1),
 1086	chat_send(Message1).
 1087
 1088%!	chat_enrich(+Message0, -Message) is det.
 1089%
 1090%	Add time and identifier to the chat message.
 1091
 1092chat_enrich(Message0, Message) :-
 1093	get_time(Now),
 1094	uuid(ID),
 1095	Message = Message0.put(_{time:Now, id:ID}).
 1096
 1097%!	chat_send(+Message)
 1098%
 1099%	Relay the chat message Message. If  the message has a `volatile`
 1100%	property it is broadcasted, but not stored.
 1101
 1102chat_send(Message) :-
 1103	atom_concat("gitty:", File, Message.docid),
 1104	broadcast(swish(chat(Message))),
 1105	(   Message.get(volatile) == true
 1106	->  true
 1107	;   chat_store(Message)
 1108	),
 1109	chat_broadcast(Message, gitty/File).
 1110
 1111
 1112		 /*******************************
 1113		 *	      EVENTS		*
 1114		 *******************************/
 1115
 1116:- unlisten(swish(_)),
 1117   listen(swish(Event), chat_event(Event)). 1118
 1119%%	chat_event(+Event) is semidet.
 1120%
 1121%	Event happened inside SWISH.  Currently triggered events:
 1122%
 1123%	  - updated(+File, +From, +To)
 1124%	  File was updated from hash From to hash To.
 1125%	  - profile(+ProfileID)
 1126%	  Session was associated with user with profile ProfileID
 1127%	  - logout(+ProfileID)
 1128%	  User logged out. If the login was based on HTTP authentication
 1129%	  ProfileID equals `http`.
 1130
 1131chat_event(Event) :-
 1132	broadcast_event(Event),
 1133	http_session_id(Session),
 1134	debug(event, 'Event: ~p, session ~q', [Event, Session]),
 1135	event_file(Event, File), !,
 1136	(   visitor_session(WSID, Session),
 1137	    subscription(WSID, gitty, File)
 1138	->  true
 1139	;   visitor_session(WSID, Session)
 1140	->  true
 1141	;   WSID = undefined
 1142	),
 1143	session_broadcast_event(Event, File, Session, WSID).
 1144chat_event(logout(_ProfileID)) :- !,
 1145	http_session_id(Session),
 1146	session_user(Session, User),
 1147	update_visitor_data(User, _, logout).
 1148chat_event(visitor_count(Count)) :-		% request
 1149	visitor_count(Count).
 1150
 1151:- if(current_predicate(current_profile/2)). 1152
 1153chat_event(profile(ProfileID)) :- !,
 1154	current_profile(ProfileID, Profile),
 1155	http_session_id(Session),
 1156	session_user(Session, User),
 1157	update_visitor_data(User, Profile, login).
 1158
 1159%!	propagate_profile_change(+ProfileID, +Attribute, +Value)
 1160%
 1161%	Trap external changes to the profile.
 1162
 1163:- listen(user_profile(modified(ProfileID, Name, _Old, New)),
 1164          propagate_profile_change(ProfileID, Name, New)). 1165
 1166propagate_profile_change(ProfileID, _, _) :-
 1167	http_current_session(Session, profile_id(ProfileID)),
 1168	session_user(Session, User),
 1169	current_profile(ProfileID, Profile),
 1170	update_visitor_data(User, Profile, 'profile-edit').
 1171
 1172:- endif. 1173
 1174%%	broadcast_event(+Event) is semidet.
 1175%
 1176%	If true, broadcast this event.
 1177
 1178broadcast_event(updated(_File, _From, _To)).
 1179
 1180
 1181%%	broadcast_event(+Event, +File, +WSID) is det.
 1182%
 1183%	Event happened that is related to File  in WSID. Broadcast it to
 1184%	subscribed users as a notification. Always succeeds, also if the
 1185%	message cannot be delivered.
 1186%
 1187%	@tbd	Extend the structure to allow other browsers to act.
 1188
 1189broadcast_event(Event, File, WSID) :-
 1190	visitor_session(WSID, Session),
 1191	session_broadcast_event(Event, File, Session, WSID), !.
 1192broadcast_event(_, _, _).
 1193
 1194session_broadcast_event(Event, File, Session, WSID) :-
 1195	session_user(Session, UID),
 1196	event_html(Event, HTML),
 1197	Event =.. [EventName|Argv],
 1198	Message0 = _{ type:notify,
 1199		      uid:UID,
 1200		      html:HTML,
 1201		      event:EventName,
 1202		      event_argv:Argv,
 1203		      wsid:WSID
 1204		    },
 1205	add_user_details(Message0, Message),
 1206	chat_broadcast(Message, gitty/File).
 1207
 1208%%	event_html(+Event, -HTML:string) mis det.
 1209%
 1210%	Describe an event as an HTML  message   to  be  displayed in the
 1211%	client's notification area.
 1212
 1213event_html(Event, HTML) :-
 1214	(   phrase(event_message(Event), Tokens)
 1215	->  true
 1216	;   phrase(html('Unknown-event: ~p'-[Event]), Tokens)
 1217	),
 1218	delete(Tokens, nl(_), SingleLine),
 1219	with_output_to(string(HTML), print_html(SingleLine)).
 1220
 1221event_message(created(File)) -->
 1222	html([ 'Created ', \file(File) ]).
 1223event_message(reloaded(File)) -->
 1224	html([ 'Reloaded ', \file(File) ]).
 1225event_message(updated(File, _From, _To)) -->
 1226	html([ 'Saved ', \file(File) ]).
 1227event_message(deleted(File, _From, _To)) -->
 1228	html([ 'Deleted ', \file(File) ]).
 1229event_message(closed(File)) -->
 1230	html([ 'Closed ', \file(File) ]).
 1231event_message(opened(File)) -->
 1232	html([ 'Opened ', \file(File) ]).
 1233event_message(download(File)) -->
 1234	html([ 'Opened ', \file(File) ]).
 1235event_message(download(Store, FileOrHash, _Format)) -->
 1236	{ event_file(download(Store, FileOrHash), File)
 1237	},
 1238	html([ 'Opened ', \file(File) ]).
 1239
 1240file(File) -->
 1241	html(a(href('/p/'+File), File)).
 1242
 1243%%	event_file(+Event, -File) is semidet.
 1244%
 1245%	True when Event is associated with File.
 1246
 1247event_file(created(File, _Commit), File).
 1248event_file(updated(File, _Commit), File).
 1249event_file(deleted(File, _Commit), File).
 1250event_file(download(Store, FileOrHash, _Format), File) :-
 1251	(   is_gitty_hash(FileOrHash)
 1252	->  gitty_commit(Store, FileOrHash, Meta),
 1253	    File = Meta.name
 1254	;   File = FileOrHash
 1255	).
 1256
 1257
 1258		 /*******************************
 1259		 *	   NOTIFICATION		*
 1260		 *******************************/
 1261
 1262%!	chat_to_profile(ProfileID, :HTML) is det.
 1263%
 1264%	Send a HTML notification to users logged in using ProfileID.
 1265
 1266chat_to_profile(ProfileID, HTML) :-
 1267	(   http_current_session(Session, profile_id(ProfileID)),
 1268	    visitor_session(WSID, Session),
 1269	    html_string(HTML, String),
 1270	    hub_send(WSID, json(_{ wsid:WSID,
 1271				   type:notify,
 1272				   html:String
 1273				 })),
 1274	    debug(notify(chat), 'Notify to ~p: ~p', [ProfileID, String]),
 1275	    fail
 1276	;   true
 1277	).
 1278
 1279html_string(HTML, String) :-
 1280	phrase(html(HTML), Tokens),
 1281	delete(Tokens, nl(_), SingleLine),
 1282	with_output_to(string(String), print_html(SingleLine)).
 1283
 1284
 1285
 1286
 1287		 /*******************************
 1288		 *	       UI		*
 1289		 *******************************/
 1290
 1291%%	notifications(+Options)//
 1292%
 1293%	The  chat  element  is  added  to  the  navbar  and  managed  by
 1294%	web/js/chat.js
 1295
 1296notifications(_Options) -->
 1297	{ swish_config:config(chat, true) }, !,
 1298	html(div(class(chat),
 1299		 [ div(class('chat-users'),
 1300		       ul([ class([nav, 'navbar-nav', 'pull-right']),
 1301			    id(chat)
 1302			  ], [])),
 1303		   div(class('user-count'),
 1304		       [ span(id('user-count'), '?'),
 1305			 ' users online'
 1306		       ])
 1307		 ])).
 1308notifications(_Options) -->
 1309	[].
 1310
 1311%!	broadcast_bell(+Options)//
 1312%
 1313%	Adds a bell to indicate central chat messages
 1314
 1315broadcast_bell(_Options) -->
 1316	{ swish_config:config(chat, true),
 1317	  swish_config:config(hangout, Hangout),
 1318	  atom_concat('gitty:', Hangout, HangoutID)
 1319	}, !,
 1320	html([ a([ class(['dropdown-toggle', 'broadcast-bell']),
 1321		   'data-toggle'(dropdown)
 1322		 ],
 1323		 [ span([ id('broadcast-bell'),
 1324			  'data-document'(HangoutID)
 1325			], []),
 1326		   b(class(caret), [])
 1327		 ]),
 1328	       ul([ class(['dropdown-menu', 'pull-right']),
 1329		    id('chat-menu')
 1330		  ],
 1331		  [ li(a('data-action'('chat-shared'),
 1332			 'Open hangout')),
 1333		    li(a('data-action'('chat-about-file'),
 1334			 'Open chat for current file'))
 1335		  ])
 1336	     ]).
 1337broadcast_bell(_Options) -->
 1338	[].
 1339
 1340
 1341		 /*******************************
 1342		 *	      MESSAGES		*
 1343		 *******************************/
 1344
 1345:- multifile
 1346	prolog:message_context//1. 1347
 1348prolog:message_context(websocket(reconnect(Passed, Score))) -->
 1349	[ 'WebSocket: too frequent reconnect requests (~1f sec; score = ~1f)'-
 1350	  [Passed, Score] ]