View source with formatted comments or as raw
    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-2020, 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	->  fail
  257	;   reap(WSID)
  258	).
  259
  260:- if(current_predicate(hub_member/2)).  261reap(WSID) :-
  262	hub_member(swish_chat, WSID),
  263	!.
  264:- else.  265reap(_) :-
  266	!.
  267:- endif.  268reap(WSID) :-
  269	reclaim_visitor(WSID),
  270	fail.
  271
  272visitor_count(Count) :-
  273	aggregate_all(count, visitor(_), Count).
  274
  275%!	inactive(+WSID, +Timeout) is semidet.
  276%
  277%	True if WSID is inactive. This means   we lost the connection at
  278%	least Timeout seconds ago.
  279
  280inactive(WSID, Timeout) :-
  281	visitor_status(WSID, lost(Lost)),
  282	get_time(Now),
  283	Now - Lost > Timeout.
  284
  285%!	visitor_session(?WSID, ?Session) is nondet.
  286%
  287%	True if websocket WSID is associated with Session.
  288
  289visitor_session(WSID, Session) :-
  290	visitor_session(WSID, Session, _Token).
  291
  292%!	wsid_visitor(?WSID, ?Visitor)
  293%
  294%	True when WSID is associated with Visitor
  295
  296wsid_visitor(WSID, Visitor) :-
  297	nonvar(WSID), !,
  298	visitor_session(WSID, Session),
  299	session_user(Session, Visitor).
  300wsid_visitor(WSID, Visitor) :-
  301	session_user(Session, Visitor),
  302	visitor_session(WSID, Session).
  303
  304%!	existing_visitor(+WSID, +Session, +Token, -TmpUser, -UserData) is semidet.
  305%
  306%	True if we are dealing with  an   existing  visitor for which we
  307%	lost the connection.
  308
  309existing_visitor(WSID, Session, Token, TmpUser, UserData) :-
  310	visitor_session(WSID, Session, Token),
  311	session_user(Session, TmpUser),
  312	visitor_data(TmpUser, UserData), !.
  313existing_visitor(WSID, Session, Token, _, _) :-
  314	retractall(visitor_session(WSID, Session, Token)),
  315	fail.
  316
  317%%	create_visitor(+WSID, +Session, ?Token, -TmpUser, -UserData, +Options)
  318%
  319%	Create a new visitor  when  a   new  websocket  is  established.
  320%	Options provides information we have about the user:
  321%
  322%	  - current_user_info(+Info)
  323%	  Already logged in user with given information
  324%	  - avatar(Avatar)
  325%	  Avatar remembered in the browser for this user.
  326%	  - nick_name(NickName)
  327%	  Nick name remembered in the browser for this user.
  328
  329create_visitor(WSID, Session, Token, TmpUser, UserData, Options) :-
  330	generate_key(Token),
  331	assertz(visitor_session(WSID, Session, Token)),
  332	create_session_user(Session, TmpUser, UserData, Options).
  333
  334%!  generate_key(-Key) is det.
  335%
  336%   Generate a random confirmation key
  337
  338generate_key(Key) :-
  339	length(Codes, 16),
  340	maplist(random_between(0,255), Codes),
  341	phrase(base64url(Codes), Encoded),
  342	atom_codes(Key, Encoded).
  343
  344%%	destroy_visitor(+WSID)
  345%
  346%	The web socket WSID has been   closed. We should not immediately
  347%	destroy the temporary user as the browser may soon reconnect due
  348%	to a page reload  or  re-establishing   the  web  socket after a
  349%	temporary network failure. We leave   the destruction thereof to
  350%	the session, but set the session timeout to a fairly short time.
  351%
  352%	@tbd	We should only inform clients that we have informed
  353%		about this user.
  354
  355destroy_visitor(WSID) :-
  356	must_be(atom, WSID),
  357	destroy_reason(WSID, Reason),
  358	(   Reason == unload
  359	->  reclaim_visitor(WSID)
  360	;   get_time(Now),
  361	    assertz(visitor_status(WSID, lost(Now)))
  362	),
  363	visitor_count(Count),
  364	chat_broadcast(_{ type:removeUser,
  365			  wsid:WSID,
  366			  reason:Reason,
  367			  visitors:Count
  368			}).
  369
  370destroy_reason(WSID, Reason) :-
  371	retract(visitor_status(WSID, unload)), !,
  372	Reason = unload.
  373destroy_reason(_, close).
  374
  375%!	gc_visitors
  376%
  377%	Reclaim all visitors with whom we   have lost the connection and
  378%	the browser did not reclaim the selection within 5 minutes.
  379
  380:- dynamic last_gc/1.  381
  382gc_visitors :-
  383	last_gc(Last),
  384	get_time(Now),
  385	Now-Last < 300, !.
  386gc_visitors :-
  387	with_mutex(gc_visitors, gc_visitors_sync).
  388
  389gc_visitors_sync :-
  390	get_time(Now),
  391	(   last_gc(Last),
  392	    Now-Last < 300
  393	->  true
  394	;   retractall(last_gc(_)),
  395	    asserta(last_gc(Now)),
  396	    do_gc_visitors
  397	).
  398
  399do_gc_visitors :-
  400	forall(( visitor_session(WSID, _Session, _Token),
  401		 inactive(WSID, 5*60)
  402	       ),
  403	       reclaim_visitor(WSID)).
  404
  405reclaim_visitor(WSID) :-
  406	debug(chat(gc), 'Reclaiming idle ~p', [WSID]),
  407	reclaim_visitor_session(WSID),
  408	retractall(visitor_status(WSID, _Status)),
  409	unsubscribe(WSID, _).
  410
  411reclaim_visitor_session(WSID) :-
  412	forall(retract(visitor_session(WSID, Session, _Token)),
  413		       http_session_retractall(websocket(_, _), Session)).
  414
  415:- if(\+current_predicate(http_session_retractall/2)).  416http_session_retractall(Data, Session) :-
  417	retractall(http_session:session_data(Session, Data)).
  418:- endif.  419
  420
  421%%	create_session_user(+Session, -User, -UserData, +Options)
  422%
  423%	Associate a user with the session. The user id is a UUID that is
  424%	not associated with  any  persistent  notion   of  a  user.  The
  425%	destruction is left to the destruction of the session.
  426
  427:- listen(http_session(end(SessionID, _Peer)),
  428	  destroy_session_user(SessionID)).  429
  430create_session_user(Session, TmpUser, UserData, _Options) :-
  431	session_user(Session, TmpUser),
  432	visitor_data(TmpUser, UserData), !.
  433create_session_user(Session, TmpUser, UserData, Options) :-
  434	uuid(TmpUser),
  435	get_visitor_data(UserData, Options),
  436	assertz(session_user(Session, TmpUser)),
  437	assertz(visitor_data(TmpUser, UserData)).
  438
  439destroy_session_user(Session) :-
  440	forall(visitor_session(WSID, Session, _Token),
  441	       inform_session_closed(WSID, Session)),
  442	retractall(visitor_session(_, Session, _)),
  443	forall(retract(session_user(Session, TmpUser)),
  444	       destroy_visitor_data(TmpUser)).
  445
  446destroy_visitor_data(TmpUser) :-
  447	(   retract(visitor_data(TmpUser, Data)),
  448	    release_avatar(Data.get(avatar)),
  449	    fail
  450	;   true
  451	).
  452
  453inform_session_closed(WSID, Session) :-
  454	ignore(hub_send(WSID, json(_{type:session_closed}))),
  455	session_user(Session, TmpUser),
  456	update_visitor_data(TmpUser, _Data, logout).
  457
  458
  459%!	update_visitor_data(+TmpUser, +Data, +Reason) is det.
  460%
  461%	Update the user data for the visitor   TmpUser  to Data. This is
  462%	rather complicates due to all the   defaulting  rules. Reason is
  463%	one of:
  464%
  465%	  - login
  466%	  - logout
  467%	  - 'set-nick-name'
  468%	  - 'profile-edit'
  469%
  470%	@tbd Create a more declarative description  on where the various
  471%	attributes must come from.
  472
  473update_visitor_data(TmpUser, _Data, logout) :- !,
  474	anonymise_user_data(TmpUser, NewData),
  475	set_visitor_data(TmpUser, NewData, logout).
  476update_visitor_data(TmpUser, Data, Reason) :-
  477	profile_reason(Reason), !,
  478	(   visitor_data(TmpUser, Old)
  479	;   Old = v{}
  480	),
  481	copy_profile([name,avatar,email], Data, Old, New),
  482	set_visitor_data(TmpUser, New, Reason).
  483update_visitor_data(TmpUser, _{name:Name}, 'set-nick-name') :- !,
  484	visitor_data(TmpUser, Old),
  485	set_nick_name(Old, Name, New),
  486	set_visitor_data(TmpUser, New, 'set-nick-name').
  487update_visitor_data(TmpUser, Data, Reason) :-
  488	set_visitor_data(TmpUser, Data, Reason).
  489
  490profile_reason('profile-edit').
  491profile_reason('login').
  492
  493copy_profile([], _, Data, Data).
  494copy_profile([H|T], New, Data0, Data) :-
  495	copy_profile_field(H, New, Data0, Data1),
  496	copy_profile(T, New, Data1, Data).
  497
  498copy_profile_field(avatar, New, Data0, Data) :-	!,
  499	(   Data1 = Data0.put(avatar,New.get(avatar))
  500	->  Data  = Data1.put(avatar_source, profile)
  501	;   email_gravatar(New.get(email), Avatar),
  502	    valid_gravatar(Avatar)
  503	->  Data = Data0.put(_{avatar:Avatar,avatar_source:email})
  504	;   Avatar = Data0.get(anonymous_avatar)
  505	->  Data = Data0.put(_{avatar:Avatar,avatar_source:client})
  506	;   noble_avatar_url(Avatar, []),
  507	    Data = Data0.put(_{avatar:Avatar,avatar_source:generated,
  508			       anonymous_avatar:Avatar
  509			      })
  510	).
  511copy_profile_field(email, New, Data0, Data) :- !,
  512	(   NewMail = New.get(email)
  513	->  update_avatar_from_email(NewMail, Data0, Data1),
  514	    Data = Data1.put(email, NewMail)
  515	;   update_avatar_from_email('', Data0, Data1),
  516	    (	del_dict(email, Data1, _, Data)
  517	    ->	true
  518	    ;	Data = Data1
  519	    )
  520	).
  521copy_profile_field(F, New, Data0, Data) :-
  522	(   Data = Data0.put(F, New.get(F))
  523	->  true
  524	;   del_dict(F, Data0, _, Data)
  525	->  true
  526	;   Data = Data0
  527	).
  528
  529set_nick_name(Data0, Name, Data) :-
  530	Data = Data0.put(_{name:Name, anonymous_name:Name}).
  531
  532%!	update_avatar_from_email(+Email, +DataIn, -Data)
  533%
  534%	Update the avatar after a change  of   the  known  email. If the
  535%	avatar comes from the profile, no action is needed. If Email has
  536%	a gravatar, use that. Else  use  the   know  or  a new generated
  537%	avatar.
  538
  539update_avatar_from_email(_, Data, Data) :-
  540	Data.get(avatar_source) == profile, !.
  541update_avatar_from_email('', Data0, Data) :-
  542	Data0.get(avatar_source) == email, !,
  543	noble_avatar_url(Avatar, []),
  544	Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  545			   avatar_source:generated}).
  546update_avatar_from_email(Email, Data0, Data) :-
  547	email_gravatar(Email, Avatar),
  548	valid_gravatar(Avatar), !,
  549	Data = Data0.put(avatar, Avatar).
  550update_avatar_from_email(_, Data0, Data) :-
  551	(   Avatar = Data0.get(anonymous_avatar)
  552	->  Data = Data0.put(_{avatar:Avatar, avatar_source:client})
  553	;   noble_avatar_url(Avatar, []),
  554	    Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  555			       avatar_source:generated})
  556	).
  557
  558%!	anonymise_user_data(TmpUser, Data)
  559%
  560%	Create anonymous user profile.
  561
  562anonymise_user_data(TmpUser, Data) :-
  563	visitor_data(TmpUser, Old),
  564	(   _{anonymous_name:AName, anonymous_avatar:AAvatar} :< Old
  565	->  Data = _{anonymous_name:AName, anonymous_avatar:AAvatar,
  566		     name:AName, avatar:AAvatar, avatar_source:client}
  567	;   _{anonymous_avatar:AAvatar} :< Old
  568	->  Data = _{anonymous_avatar:AAvatar,
  569		     avatar:AAvatar, avatar_source:client}
  570	;   _{anonymous_name:AName} :< Old
  571	->  noble_avatar_url(Avatar, []),
  572	    Data = _{anonymous_name:AName, anonymous_avatar:Avatar,
  573		     name:AName, avatar:Avatar, avatar_source:generated}
  574	), !.
  575anonymise_user_data(_, Data) :-
  576	noble_avatar_url(Avatar, []),
  577	Data = _{anonymous_avatar:Avatar,
  578		 avatar:Avatar, avatar_source:generated}.
  579
  580%!	set_visitor_data(+TmpUser, +Data, +Reason) is det.
  581%
  582%	Update the user data for the   session  user TmpUser and forward
  583%	the changes.
  584
  585set_visitor_data(TmpUser, Data, Reason) :-
  586	retractall(visitor_data(TmpUser, _)),
  587	assertz(visitor_data(TmpUser, Data)),
  588	inform_visitor_change(TmpUser, Reason).
  589
  590%!	inform_visitor_change(+TmpUser, +Reason) is det.
  591%
  592%	Inform browsers showing  TmpUser  that   the  visitor  data  has
  593%	changed. The first  clause  deals   with  forwarding  from  HTTP
  594%	requests,  where  we  have  the  session  and  the  second  from
  595%	websocket requests where we have the WSID.
  596
  597inform_visitor_change(TmpUser, Reason) :-
  598	http_in_session(Session), !,
  599	public_user_data(TmpUser, Data),
  600	forall(visitor_session(WSID, Session),
  601	       inform_friend_change(WSID, Data, Reason)).
  602inform_visitor_change(TmpUser, Reason) :-
  603	b_getval(wsid, WSID),
  604	public_user_data(TmpUser, Data),
  605	inform_friend_change(WSID, Data, Reason).
  606
  607inform_friend_change(WSID, Data, Reason) :-
  608	Message = json(_{ type:"profile",
  609			  wsid:WSID,
  610			  reason:Reason
  611			}.put(Data)),
  612	hub_send(WSID, Message),
  613	forall(viewing_same_file(WSID, Friend),
  614	       ignore(hub_send(Friend, Message))).
  615
  616viewing_same_file(WSID, Friend) :-
  617	subscription(WSID, gitty, File),
  618	subscription(Friend, gitty, File),
  619	Friend \== WSID.
  620
  621%%	subscribe(+WSID, +Channel) is det.
  622
  623subscribe(WSID, Channel) :-
  624	subscribe(WSID, Channel, _SubChannel).
  625subscribe(WSID, Channel, SubChannel) :-
  626	(   subscription(WSID, Channel, SubChannel)
  627	->  true
  628	;   assertz(subscription(WSID, Channel, SubChannel))
  629	).
  630
  631unsubscribe(WSID, Channel) :-
  632	unsubscribe(WSID, Channel, _SubChannel).
  633unsubscribe(WSID, Channel, SubChannel) :-
  634	retractall(subscription(WSID, Channel, SubChannel)).
  635
  636%%	sync_gazers(+WSID, +Files:list(atom)) is det.
  637%
  638%	A browser signals it has Files open.   This happens when a SWISH
  639%	instance is created as well  as   when  a SWISH instance changes
  640%	state, such as closing a tab, adding   a  tab, bringing a tab to
  641%	the foreground, etc.
  642
  643sync_gazers(WSID, Files0) :-
  644	findall(F, subscription(WSID, gitty, F), Viewing0),
  645	sort(Files0, Files),
  646	sort(Viewing0, Viewing),
  647	(   Files == Viewing
  648	->  true
  649	;   ord_subtract(Files, Viewing, New),
  650	    add_gazing(WSID, New),
  651	    ord_subtract(Viewing, Files, Left),
  652	    del_gazing(WSID, Left)
  653	).
  654
  655add_gazing(_, []) :- !.
  656add_gazing(WSID, Files) :-
  657	inform_me_about_existing_gazers(WSID, Files),
  658	inform_existing_gazers_about_newby(WSID, Files).
  659
  660inform_me_about_existing_gazers(WSID, Files) :-
  661	findall(Gazer, files_gazer(Files, Gazer), Gazers),
  662	ignore(hub_send(WSID, json(_{type:"gazers", gazers:Gazers}))).
  663
  664files_gazer(Files, Gazer) :-
  665	member(File, Files),
  666	subscription(WSID, gitty, File),
  667	visitor_session(WSID, Session),
  668	session_user(Session, UID),
  669	public_user_data(UID, Data),
  670	Gazer = _{file:File, uid:UID, wsid:WSID}.put(Data).
  671
  672inform_existing_gazers_about_newby(WSID, Files) :-
  673	forall(member(File, Files),
  674	       signal_gazer(WSID, File)).
  675
  676signal_gazer(WSID, File) :-
  677	subscribe(WSID, gitty, File),
  678	broadcast_event(opened(File), File, WSID).
  679
  680del_gazing(_, []) :- !.
  681del_gazing(WSID, Files) :-
  682	forall(member(File, Files),
  683	       del_gazing1(WSID, File)).
  684
  685del_gazing1(WSID, File) :-
  686	broadcast_event(closed(File), File, WSID),
  687	unsubscribe(WSID, gitty, File).
  688
  689%%	add_user_details(+Message, -Enriched) is det.
  690%
  691%	Add additional information to a message.  Message must
  692%	contain a `uid` field.
  693
  694add_user_details(Message, Enriched) :-
  695	public_user_data(Message.uid, Data),
  696	Enriched = Message.put(Data).
  697
  698%%	public_user_data(+UID, -Public:dict) is det.
  699%
  700%	True when Public provides the   information  we publically share
  701%	about UID. This is currently the name and avatar.
  702
  703public_user_data(UID, Public) :-
  704	visitor_data(UID, Data),
  705	(   _{name:Name, avatar:Avatar} :< Data
  706	->  Public = _{name:Name, avatar:Avatar}
  707	;   _{avatar:Avatar} :< Data
  708	->  Public = _{avatar:Avatar}
  709	;   Public = _{}
  710	).
  711
  712%%	get_visitor_data(-Data:dict, +Options) is det.
  713%
  714%	Optain data for a new visitor.  Options include:
  715%
  716%	  - identity(+Identity)
  717%	  Identity information provided by authenticate/2.  Always
  718%	  present.
  719%	  - avatar(+URL)
  720%	  Avatar provided by the user
  721%	  - nick_name(+Name)
  722%	  Nick name provided by the user.
  723%
  724%	Data always contains an `avatar` key   and optionally contains a
  725%	`name` and `email` key. If the avatar is generated there is also
  726%	a key `avatar_generated` with the value `true`.
  727%
  728%	@bug	This may check for avatar validity, which may take
  729%		long.  Possibly we should do this in a thread.
  730
  731get_visitor_data(Data, Options) :-
  732	option(identity(Identity), Options),
  733	findall(N-V, visitor_property(Identity, Options, N, V), Pairs),
  734	dict_pairs(Data, v, Pairs).
  735
  736visitor_property(Identity, Options, name, Name) :-
  737	(   user_property(Identity, name(Name))
  738	->  true
  739	;   option(nick_name(Name), Options)
  740	).
  741visitor_property(Identity, _, email, Email) :-
  742	user_property(Identity, email(Email)).
  743visitor_property(Identity, Options, Name, Value) :-
  744	(   user_property(Identity, avatar(Avatar))
  745	->  avatar_property(Avatar, profile, Name, Value)
  746	;   user_property(Identity, email(Email)),
  747	    email_gravatar(Email, Avatar),
  748	    valid_gravatar(Avatar)
  749	->  avatar_property(Avatar, email, Name, Value)
  750	;   option(avatar(Avatar), Options)
  751	->  avatar_property(Avatar, client, Name, Value)
  752	;   noble_avatar_url(Avatar, Options),
  753	    avatar_property(Avatar, generated, Name, Value)
  754	).
  755visitor_property(_, Options, anonymous_name, Name) :-
  756	option(nick_name(Name), Options).
  757visitor_property(_, Options, anonymous_avatar, Avatar) :-
  758	option(avatar(Avatar), Options).
  759
  760
  761avatar_property(Avatar, _Source, avatar,        Avatar).
  762avatar_property(_Avatar, Source, avatar_source, Source).
  763
  764
  765		 /*******************************
  766		 *	   NOBLE AVATAR		*
  767		 *******************************/
  768
  769:- http_handler(swish('avatar/'), reply_avatar, [id(avatar), prefix]).  770
  771%%	reply_avatar(+Request)
  772%
  773%	HTTP handler for Noble  Avatar   images.  Using  create_avatar/2
  774%	re-creates avatars from the file name,  so we can safely discard
  775%	the avatar file store.
  776%
  777%	Not really. A new user gets a new   avatar  and this is based on
  778%	whether or not the file exists. Probably we should maintain a db
  779%	of handed out avatars and their last-use   time stamp. How to do
  780%	that? Current swish stats: 400K avatars, 3.2Gb data.
  781
  782reply_avatar(Request) :-
  783	option(path_info(Local), Request),
  784	(   absolute_file_name(noble_avatar(Local), Path,
  785			       [ access(read),
  786				 file_errors(fail)
  787			       ])
  788	->  true
  789	;   create_avatar(Local, Path)
  790	),
  791	http_reply_file(Path, [unsafe(true)], Request).
  792
  793
  794noble_avatar_url(HREF, Options) :-
  795	option(avatar(HREF), Options), !.
  796noble_avatar_url(HREF, _Options) :-
  797	swish_config:config(avatars, noble),
  798	!,
  799	noble_avatar(_Gender, Path, true),
  800	file_base_name(Path, File),
  801	http_absolute_location(swish(avatar/File), HREF, []).
  802noble_avatar_url(HREF, _Options) :-
  803	A is random(0x1FFFFF+1),
  804	http_absolute_location(icons('avatar.svg'), HREF0, []),
  805	format(atom(HREF), '~w#~d', [HREF0, A]).
  806
  807
  808
  809		 /*******************************
  810		 *	   BROADCASTING		*
  811		 *******************************/
  812
  813%%	chat_broadcast(+Message) is det.
  814%%	chat_broadcast(+Message, +Channel) is det.
  815%
  816%	Send Message to all known SWISH clients. Message is a valid JSON
  817%	object, i.e., a dict or option list.
  818%
  819%	@arg Channel is either an atom or a term Channel/SubChannel,
  820%	where both Channel and SubChannel are atoms.
  821
  822chat_broadcast(Message) :-
  823	debug(chat(broadcast), 'Broadcast: ~p', [Message]),
  824	hub_broadcast(swish_chat, json(Message)).
  825
  826chat_broadcast(Message, Channel/SubChannel) :- !,
  827	must_be(atom, Channel),
  828	must_be(atom, SubChannel),
  829	debug(chat(broadcast), 'Broadcast on ~p: ~p',
  830	      [Channel/SubChannel, Message]),
  831	hub_broadcast(swish_chat, json(Message),
  832		      subscribed(Channel, SubChannel)).
  833chat_broadcast(Message, Channel) :-
  834	must_be(atom, Channel),
  835	debug(chat(broadcast), 'Broadcast on ~p: ~p', [Channel, Message]),
  836	hub_broadcast(swish_chat, json(Message),
  837		      subscribed(Channel)).
  838
  839subscribed(Channel, WSID) :-
  840	subscription(WSID, Channel, _).
  841subscribed(Channel, SubChannel, WSID) :-
  842	subscription(WSID, Channel, SubChannel).
  843subscribed(gitty, SubChannel, WSID) :-
  844	swish_config:config(hangout, SubChannel),
  845	\+ subscription(WSID, gitty, SubChannel).
  846
  847
  848		 /*******************************
  849		 *	     CHAT ROOM		*
  850		 *******************************/
  851
  852create_chat_room :-
  853	current_hub(swish_chat, _), !.
  854create_chat_room :-
  855	with_mutex(swish_chat, create_chat_room_sync).
  856
  857create_chat_room_sync :-
  858	current_hub(swish_chat, _), !.
  859create_chat_room_sync :-
  860	hub_create(swish_chat, Room, _{}),
  861	thread_create(swish_chat(Room), _, [alias(swish_chat)]).
  862
  863swish_chat(Room) :-
  864	(   catch(swish_chat_event(Room), E, chat_exception(E))
  865	->  true
  866	;   print_message(warning, goal_failed(swish_chat_event(Room)))
  867	),
  868	swish_chat(Room).
  869
  870chat_exception('$aborted') :- !.
  871chat_exception(E) :-
  872	print_message(warning, E).
  873
  874swish_chat_event(Room) :-
  875	thread_get_message(Room.queues.event, Message),
  876	(   handle_message(Message, Room)
  877	->  true
  878	;   print_message(warning, goal_failed(handle_message(Message, Room)))
  879	).
  880
  881%%	handle_message(+Message, +Room)
  882%
  883%	Handle incoming messages
  884
  885handle_message(Message, _Room) :-
  886	websocket{opcode:text} :< Message, !,
  887	atom_json_dict(Message.data, JSON, []),
  888	debug(chat(received), 'Received from ~p: ~p', [Message.client, JSON]),
  889	WSID = Message.client,
  890	setup_call_cleanup(
  891	    b_setval(wsid, WSID),
  892	    json_message(JSON, WSID),
  893	    nb_delete(wsid)).
  894handle_message(Message, _Room) :-
  895	hub{joined:WSID} :< Message, !,
  896	debug(chat(visitor), 'Joined: ~p', [WSID]).
  897handle_message(Message, _Room) :-
  898	hub{left:WSID, reason:write(Lost)} :< Message, !,
  899	(   destroy_visitor(WSID)
  900	->  debug(chat(visitor), 'Left ~p due to write error for ~p',
  901		  [WSID, Lost])
  902	;   true
  903	).
  904handle_message(Message, _Room) :-
  905	hub{left:WSID} :< Message, !,
  906	(   destroy_visitor(WSID)
  907	->  debug(chat(visitor), 'Left: ~p', [WSID])
  908	;   true
  909	).
  910handle_message(Message, _Room) :-
  911	websocket{opcode:close, client:WSID} :< Message, !,
  912	debug(chat(visitor), 'Left: ~p', [WSID]),
  913	destroy_visitor(WSID).
  914handle_message(Message, _Room) :-
  915	debug(chat(ignored), 'Ignoring chat message ~p', [Message]).
  916
  917
  918%%	json_message(+Message, +WSID) is det.
  919%
  920%	Process a JSON message  translated  to   a  dict.  The following
  921%	messages are understood:
  922%
  923%	  - subscribe channel [subchannel]
  924%	  - unsubscribe channel [subchannel]
  925%	  Actively (un)subscribe for specific message channels.
  926%	  - unload
  927%	  A SWISH instance is cleanly being unloaded.
  928%	  - has-open-files files
  929%	  Executed after initiating the websocket to indicate loaded
  930%	  files.
  931%	  - set-nick-name name
  932%	  User set nick name for anonymous identoty
  933
  934json_message(Dict, WSID) :-
  935	_{ type: "subscribe",
  936	   channel:ChannelS, sub_channel:SubChannelS} :< Dict, !,
  937	atom_string(Channel, ChannelS),
  938	atom_string(SubChannel, SubChannelS),
  939	subscribe(WSID, Channel, SubChannel).
  940json_message(Dict, WSID) :-
  941	_{type: "subscribe", channel:ChannelS} :< Dict, !,
  942	atom_string(Channel, ChannelS),
  943	subscribe(WSID, Channel).
  944json_message(Dict, WSID) :-
  945	_{ type: "unsubscribe",
  946	   channel:ChannelS, sub_channel:SubChannelS} :< Dict, !,
  947	atom_string(Channel, ChannelS),
  948	atom_string(SubChannel, SubChannelS),
  949	unsubscribe(WSID, Channel, SubChannel).
  950json_message(Dict, WSID) :-
  951	_{type: "unsubscribe", channel:ChannelS} :< Dict, !,
  952	atom_string(Channel, ChannelS),
  953	unsubscribe(WSID, Channel).
  954json_message(Dict, WSID) :-
  955	_{type: "unload"} :< Dict, !,	% clean close/reload
  956	sync_gazers(WSID, []),
  957	assertz(visitor_status(WSID, unload)).
  958json_message(Dict, WSID) :-
  959	_{type: "has-open-files", files:FileDicts} :< Dict, !,
  960	maplist(dict_file_name, FileDicts, Files),
  961	sync_gazers(WSID, Files).
  962json_message(Dict, WSID) :-
  963	_{type: "reloaded", file:FileS, commit:Hash} :< Dict, !,
  964	atom_string(File, FileS),
  965	event_html(reloaded(File), HTML),
  966	Message = _{ type:notify,
  967		     wsid:WSID,
  968		     html:HTML,
  969		     event:reloaded,
  970		     argv:[File,Hash]
  971		   },
  972	chat_broadcast(Message, gitty/File).
  973json_message(Dict, WSID) :-
  974	_{type: "set-nick-name", name:Name} :< Dict, !,
  975	wsid_visitor(WSID, Visitor),
  976	update_visitor_data(Visitor, _{name:Name}, 'set-nick-name').
  977json_message(Dict, WSID) :-
  978	_{type: "chat-message", docid:DocID} :< Dict, !,
  979	chat_add_user_id(WSID, Dict, Message),
  980	(   forbidden(Message, DocID, Why)
  981	->  hub_send(WSID, json(json{type:forbidden,
  982				     action:chat_post,
  983				     about:DocID,
  984				     message:Why
  985				    }))
  986	;   chat_relay(Message)
  987	).
  988json_message(Dict, _WSID) :-
  989	debug(chat(ignored), 'Ignoring JSON message ~p', [Dict]).
  990
  991dict_file_name(Dict, File) :-
  992	atom_string(File, Dict.get(file)).
  993
  994%!	forbidden(+Message, +DocID, -Why) is semidet.
  995%
  996%	True if the chat Message about DocID must be forbidden, in which
  997%	case Why is  unified  with  a   string  indicating  the  reason.
  998%	Currently:
  999%
 1000%	  - Demands the user to be logged on
 1001%	  - Limits the size of the message and its payloads
 1002%
 1003%	@tbd Call authorized/2 with all proper identity information.
 1004
 1005forbidden(Message, DocID, Why) :-
 1006	\+ swish_config:config(chat_spam_protection, false),
 1007	\+ ws_authorized(chat(post(Message, DocID)), Message.user), !,
 1008	Why = "Due to frequent spamming we were forced to limit \c
 1009	       posting chat messages to users who are logged in.".
 1010forbidden(Message, _DocID, Why) :-
 1011	Text = Message.get(text),
 1012	string_length(Text, Len),
 1013	Len > 500,
 1014	Why = "Chat messages are limited to 500 characters".
 1015forbidden(Message, _DocID, Why) :-
 1016	Payloads = Message.get(payload),
 1017	member(Payload, Payloads),
 1018	large_payload(Payload, Why), !.
 1019forbidden(Message, _DocID, Why) :-
 1020	\+ swish_config:config(chat_spam_protection, false),
 1021	eval_content(Message.get(text), _WC, Score),
 1022	user_score(Message, Score, Cummulative, _Count),
 1023	Score*2 + Cummulative < 0,
 1024	!,
 1025	Why = "Chat messages must be in English and avoid offensive language".
 1026
 1027large_payload(Payload, Why) :-
 1028	Selections = Payload.get(selection),
 1029	member(Selection, Selections),
 1030	(   string_length(Selection.get(string), SelLen), SelLen > 500
 1031	;   string_length(Selection.get(context), SelLen), SelLen > 500
 1032	), !,
 1033	Why = "Selection too long (max. 500 characters)".
 1034large_payload(Payload, Why) :-
 1035	string_length(Payload.get(query), QLen), QLen > 1000, !,
 1036	Why = "Query too long (max. 1000 characters)".
 1037
 1038user_score(Message, MsgScore, Cummulative, Count) :-
 1039	Profile	= Message.get(user).get(profile_id), !,
 1040	block(Profile, MsgScore, Cummulative, Count).
 1041user_score(_, _, 0, 1).
 1042
 1043%!	block(+User, +Score, -Cummulative, -Count)
 1044%
 1045%	Keep a count and cummulative score for a user.
 1046
 1047:- dynamic
 1048	blocked/4. 1049
 1050block(User, Score, Cummulative, Count) :-
 1051	blocked(User, Score0, Count0, Time), !,
 1052	get_time(Now),
 1053	Cummulative = Score0*(0.5**((Now-Time)/600)) + Score,
 1054	Count is Count0 + 1,
 1055	asserta(blocked(User, Cummulative, Count, Now)),
 1056	retractall(blocked(User, Score0, Count0, Time)).
 1057block(User, Score, Score, 1) :-
 1058	get_time(Now),
 1059	asserta(blocked(User, Score, 1, Now)).
 1060
 1061
 1062		 /*******************************
 1063		 *	   CHAT MESSAGES	*
 1064		 *******************************/
 1065
 1066%!	chat_add_user_id(+WSID, +Message0, -Message) is det.
 1067%
 1068%	Decorate a message with the user credentials.
 1069
 1070chat_add_user_id(WSID, Dict, Message) :-
 1071	visitor_session(WSID, Session, _Token),
 1072	session_user(Session, Visitor),
 1073	visitor_data(Visitor, UserData),
 1074	User0 = u{avatar:UserData.avatar,
 1075		  wsid:WSID
 1076		 },
 1077	(   Name = UserData.get(name)
 1078	->  User1 = User0.put(name, Name)
 1079	;   User1 = User0
 1080	),
 1081	(   http_current_session(Session, profile_id(ProfileID))
 1082	->  User = User1.put(profile_id, ProfileID)
 1083	;   User = User1
 1084	),
 1085	Message = Dict.put(user, User).
 1086
 1087
 1088%!	chat_about(+DocID, +Message) is det.
 1089%
 1090%	Distribute a chat message about DocID.
 1091
 1092chat_about(DocID, Message) :-
 1093	chat_relay(Message.put(docid, DocID)).
 1094
 1095%!	chat_relay(+Message) is det.
 1096%
 1097%	Store and relay a chat message.
 1098
 1099chat_relay(Message) :-
 1100	chat_enrich(Message, Message1),
 1101	chat_send(Message1).
 1102
 1103%!	chat_enrich(+Message0, -Message) is det.
 1104%
 1105%	Add time and identifier to the chat message.
 1106
 1107chat_enrich(Message0, Message) :-
 1108	get_time(Now),
 1109	uuid(ID),
 1110	Message = Message0.put(_{time:Now, id:ID}).
 1111
 1112%!	chat_send(+Message)
 1113%
 1114%	Relay the chat message Message. If  the message has a `volatile`
 1115%	property it is broadcasted, but not stored.
 1116
 1117chat_send(Message) :-
 1118	atom_concat("gitty:", File, Message.docid),
 1119	broadcast(swish(chat(Message))),
 1120	(   Message.get(volatile) == true
 1121	->  true
 1122	;   chat_store(Message)
 1123	),
 1124	chat_broadcast(Message, gitty/File).
 1125
 1126
 1127		 /*******************************
 1128		 *	      EVENTS		*
 1129		 *******************************/
 1130
 1131:- unlisten(swish(_)),
 1132   listen(swish(Event), chat_event(Event)). 1133
 1134%%	chat_event(+Event) is semidet.
 1135%
 1136%	Event happened inside SWISH.  Currently triggered events:
 1137%
 1138%	  - updated(+File, +From, +To)
 1139%	  File was updated from hash From to hash To.
 1140%	  - profile(+ProfileID)
 1141%	  Session was associated with user with profile ProfileID
 1142%	  - logout(+ProfileID)
 1143%	  User logged out. If the login was based on HTTP authentication
 1144%	  ProfileID equals `http`.
 1145
 1146chat_event(Event) :-
 1147	broadcast_event(Event),
 1148	http_session_id(Session),
 1149	debug(event, 'Event: ~p, session ~q', [Event, Session]),
 1150	event_file(Event, File), !,
 1151	(   visitor_session(WSID, Session),
 1152	    subscription(WSID, gitty, File)
 1153	->  true
 1154	;   visitor_session(WSID, Session)
 1155	->  true
 1156	;   WSID = undefined
 1157	),
 1158	session_broadcast_event(Event, File, Session, WSID).
 1159chat_event(logout(_ProfileID)) :- !,
 1160	http_session_id(Session),
 1161	session_user(Session, User),
 1162	update_visitor_data(User, _, logout).
 1163chat_event(visitor_count(Count)) :-		% request
 1164	visitor_count(Count).
 1165
 1166:- if(current_predicate(current_profile/2)). 1167
 1168chat_event(profile(ProfileID)) :- !,
 1169	current_profile(ProfileID, Profile),
 1170	http_session_id(Session),
 1171	session_user(Session, User),
 1172	update_visitor_data(User, Profile, login).
 1173
 1174%!	propagate_profile_change(+ProfileID, +Attribute, +Value)
 1175%
 1176%	Trap external changes to the profile.
 1177
 1178:- listen(user_profile(modified(ProfileID, Name, _Old, New)),
 1179          propagate_profile_change(ProfileID, Name, New)). 1180
 1181propagate_profile_change(ProfileID, _, _) :-
 1182	http_current_session(Session, profile_id(ProfileID)),
 1183	session_user(Session, User),
 1184	current_profile(ProfileID, Profile),
 1185	update_visitor_data(User, Profile, 'profile-edit').
 1186
 1187:- endif. 1188
 1189%%	broadcast_event(+Event) is semidet.
 1190%
 1191%	If true, broadcast this event.
 1192
 1193broadcast_event(updated(_File, _From, _To)).
 1194
 1195
 1196%%	broadcast_event(+Event, +File, +WSID) is det.
 1197%
 1198%	Event happened that is related to File  in WSID. Broadcast it to
 1199%	subscribed users as a notification. Always succeeds, also if the
 1200%	message cannot be delivered.
 1201%
 1202%	@tbd	Extend the structure to allow other browsers to act.
 1203
 1204broadcast_event(Event, File, WSID) :-
 1205	visitor_session(WSID, Session),
 1206	session_broadcast_event(Event, File, Session, WSID), !.
 1207broadcast_event(_, _, _).
 1208
 1209session_broadcast_event(Event, File, Session, WSID) :-
 1210	session_user(Session, UID),
 1211	event_html(Event, HTML),
 1212	Event =.. [EventName|Argv],
 1213	Message0 = _{ type:notify,
 1214		      uid:UID,
 1215		      html:HTML,
 1216		      event:EventName,
 1217		      event_argv:Argv,
 1218		      wsid:WSID
 1219		    },
 1220	add_user_details(Message0, Message),
 1221	chat_broadcast(Message, gitty/File).
 1222
 1223%%	event_html(+Event, -HTML:string) mis det.
 1224%
 1225%	Describe an event as an HTML  message   to  be  displayed in the
 1226%	client's notification area.
 1227
 1228event_html(Event, HTML) :-
 1229	(   phrase(event_message(Event), Tokens)
 1230	->  true
 1231	;   phrase(html('Unknown-event: ~p'-[Event]), Tokens)
 1232	),
 1233	delete(Tokens, nl(_), SingleLine),
 1234	with_output_to(string(HTML), print_html(SingleLine)).
 1235
 1236event_message(created(File)) -->
 1237	html([ 'Created ', \file(File) ]).
 1238event_message(reloaded(File)) -->
 1239	html([ 'Reloaded ', \file(File) ]).
 1240event_message(updated(File, _From, _To)) -->
 1241	html([ 'Saved ', \file(File) ]).
 1242event_message(deleted(File, _From, _To)) -->
 1243	html([ 'Deleted ', \file(File) ]).
 1244event_message(closed(File)) -->
 1245	html([ 'Closed ', \file(File) ]).
 1246event_message(opened(File)) -->
 1247	html([ 'Opened ', \file(File) ]).
 1248event_message(download(File)) -->
 1249	html([ 'Opened ', \file(File) ]).
 1250event_message(download(Store, FileOrHash, Format)) -->
 1251	{ event_file(download(Store, FileOrHash, Format), File)
 1252	},
 1253	html([ 'Opened ', \file(File) ]).
 1254
 1255file(File) -->
 1256	html(a(href('/p/'+File), File)).
 1257
 1258%%	event_file(+Event, -File) is semidet.
 1259%
 1260%	True when Event is associated with File.
 1261
 1262event_file(created(File, _Commit), File).
 1263event_file(updated(File, _Commit), File).
 1264event_file(deleted(File, _Commit), File).
 1265event_file(download(Store, FileOrHash, _Format), File) :-
 1266	(   is_gitty_hash(FileOrHash)
 1267	->  gitty_commit(Store, FileOrHash, Meta),
 1268	    File = Meta.name
 1269	;   File = FileOrHash
 1270	).
 1271
 1272
 1273		 /*******************************
 1274		 *	   NOTIFICATION		*
 1275		 *******************************/
 1276
 1277%!	chat_to_profile(ProfileID, :HTML) is det.
 1278%
 1279%	Send a HTML notification to users logged in using ProfileID.
 1280
 1281chat_to_profile(ProfileID, HTML) :-
 1282	(   http_current_session(Session, profile_id(ProfileID)),
 1283	    visitor_session(WSID, Session),
 1284	    html_string(HTML, String),
 1285	    hub_send(WSID, json(_{ wsid:WSID,
 1286				   type:notify,
 1287				   html:String
 1288				 })),
 1289	    debug(notify(chat), 'Notify to ~p: ~p', [ProfileID, String]),
 1290	    fail
 1291	;   true
 1292	).
 1293
 1294html_string(HTML, String) :-
 1295	phrase(html(HTML), Tokens),
 1296	delete(Tokens, nl(_), SingleLine),
 1297	with_output_to(string(String), print_html(SingleLine)).
 1298
 1299
 1300
 1301
 1302		 /*******************************
 1303		 *	       UI		*
 1304		 *******************************/
 1305
 1306%%	notifications(+Options)//
 1307%
 1308%	The  chat  element  is  added  to  the  navbar  and  managed  by
 1309%	web/js/chat.js
 1310
 1311notifications(_Options) -->
 1312	{ swish_config:config(chat, true) }, !,
 1313	html(div(class(chat),
 1314		 [ div(class('chat-users'),
 1315		       ul([ class([nav, 'navbar-nav', 'pull-right']),
 1316			    id(chat)
 1317			  ], [])),
 1318		   div(class('user-count'),
 1319		       [ span(id('user-count'), '?'),
 1320			 ' users online'
 1321		       ])
 1322		 ])).
 1323notifications(_Options) -->
 1324	[].
 1325
 1326%!	broadcast_bell(+Options)//
 1327%
 1328%	Adds a bell to indicate central chat messages
 1329
 1330broadcast_bell(_Options) -->
 1331	{ swish_config:config(chat, true),
 1332	  swish_config:config(hangout, Hangout),
 1333	  atom_concat('gitty:', Hangout, HangoutID)
 1334	}, !,
 1335	html([ a([ class(['dropdown-toggle', 'broadcast-bell']),
 1336		   'data-toggle'(dropdown)
 1337		 ],
 1338		 [ span([ id('broadcast-bell'),
 1339			  'data-document'(HangoutID)
 1340			], []),
 1341		   b(class(caret), [])
 1342		 ]),
 1343	       ul([ class(['dropdown-menu', 'pull-right']),
 1344		    id('chat-menu')
 1345		  ],
 1346		  [ li(a('data-action'('chat-shared'),
 1347			 'Open hangout')),
 1348		    li(a('data-action'('chat-about-file'),
 1349			 'Open chat for current file'))
 1350		  ])
 1351	     ]).
 1352broadcast_bell(_Options) -->
 1353	[].
 1354
 1355
 1356		 /*******************************
 1357		 *	      MESSAGES		*
 1358		 *******************************/
 1359
 1360:- multifile
 1361	prolog:message_context//1. 1362
 1363prolog:message_context(websocket(reconnect(Passed, Score))) -->
 1364	[ 'WebSocket: too frequent reconnect requests (~1f sec; score = ~1f)'-
 1365	  [Passed, Score] ]