chat.pl

View source with formatted comments or as raw
    1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2016-2023, VU University Amsterdam
    7                              CWI Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(swish_chat,
   38          [ chat_broadcast/1,           % +Message
   39            chat_broadcast/2,           % +Message, +Channel
   40            chat_to_profile/2,          % +ProfileID, :HTML
   41            chat_about/2,               % +DocID, +Message
   42
   43            notifications//1,           % +Options
   44            broadcast_bell//1           % +Options
   45          ]).   46:- use_module(library(http/hub)).   47:- use_module(library(http/http_dispatch)).   48:- use_module(library(http/http_session)).   49:- use_module(library(http/http_parameters)).   50:- use_module(library(http/http_cors)).   51:- use_module(library(http/websocket)).   52:- use_module(library(http/json)).   53:- use_module(library(error)).   54:- use_module(library(lists)).   55:- use_module(library(option)).   56:- use_module(library(debug)).   57:- use_module(library(uuid)).   58:- use_module(library(random)).   59:- use_module(library(base64)).   60:- use_module(library(apply)).   61:- use_module(library(broadcast)).   62:- use_module(library(ordsets)).   63:- use_module(library(http/html_write)).   64:- use_module(library(http/http_path)).   65:- if(exists_source(library(user_profile))).   66:- use_module(library(user_profile)).   67:- endif.   68:- use_module(library(aggregate)).   69:- use_module(library(redis)).   70:- use_module(library(solution_sequences)).   71
   72:- use_module(storage).   73:- use_module(gitty).   74:- use_module(config).   75:- use_module(avatar).   76:- use_module(noble_avatar).   77:- use_module(chatstore).   78:- use_module(authenticate).   79:- use_module(pep).   80:- use_module(content_filter).   81:- use_module(swish_redis).   82
   83:- html_meta(chat_to_profile(+, html)).   84
   85/** <module> The SWISH collaboration backbone
   86
   87We have three levels of identity as   enumerated  below. Note that these
   88form a hierarchy: a particular user  may   be  logged  on using multiple
   89browsers which in turn may have multiple SWISH windows opened.
   90
   91  1. Any open SWISH window has an associated websocket, represented
   92     by the identifier returned by hub_add/3.
   93  2. Any browser, possibly having multiple open SWISH windows, is
   94     identified by a session cookie.
   95  3. The user may be logged in, either based on the cookie or on
   96     HTTP authentication.
   97*/
   98
   99:- multifile swish_config:config/2.  100
  101swish_config:config(hangout, 'Hangout.swinb').
  102swish_config:config(avatars, svg).              % or 'noble'
  103swish_config:config(session_lost_timeout, 60).
  104
  105
  106                 /*******************************
  107                 *      ESTABLISH WEBSOCKET     *
  108                 *******************************/
  109
  110:- http_handler(swish(chat), start_chat, [ id(swish_chat) ]).  111
  112:- meta_predicate must_succeed(0).  113
  114%!  start_chat(+Request)
  115%
  116%   HTTP handler that establishes  a   websocket  connection where a
  117%   user gets an avatar and optionally a name.
  118
  119start_chat(Request) :-
  120    memberchk(method(options), Request),
  121    !,
  122    cors_enable(Request,
  123                [ methods([get])
  124                ]),
  125    format('~n').
  126start_chat(Request) :-
  127    cors_enable,
  128    authenticate(Request, Identity),
  129    start_chat(Request, [identity(Identity)]).
  130
  131start_chat(Request, Options) :-
  132    authorized(chat(open), Options),
  133    (   http_in_session(Session)
  134    ->  CheckLogin = false
  135    ;   http_open_session(Session, []),
  136        CheckLogin = true
  137    ),
  138    check_flooding(Session),
  139    http_parameters(Request,
  140                    [ avatar(Avatar, [optional(true)]),
  141                      nickname(NickName, [optional(true)]),
  142                      reconnect(Token, [optional(true)])
  143                    ]),
  144    extend_options([ avatar(Avatar),
  145                     nick_name(NickName),
  146                     reconnect(Token),
  147                     check_login(CheckLogin)
  148                   ], Options, ChatOptions),
  149    debug(chat(websocket), 'Accepting (session ~p)', [Session]),
  150    http_upgrade_to_websocket(
  151        accept_chat(Session, ChatOptions),
  152        [ guarded(false),
  153          subprotocols(['v1.chat.swish.swi-prolog.org', chat])
  154        ],
  155        Request).
  156
  157extend_options([], Options, Options).
  158extend_options([H|T0], Options, [H|T]) :-
  159    ground(H),
  160    !,
  161    extend_options(T0, Options, T).
  162extend_options([_|T0], Options, T) :-
  163    extend_options(T0, Options, T).
  164
  165
  166%!  check_flooding(+Session)
  167%
  168%   See whether the client associated with  a session is flooding us
  169%   and if so, return a resource error.
  170
  171check_flooding(Session) :-
  172    get_time(Now),
  173    (   http_session_retract(websocket(Score, Last))
  174    ->  Passed is Now-Last,
  175        NewScore is Score*(2**(-Passed/60)) + 10
  176    ;   NewScore = 10,
  177        Passed = 0
  178    ),
  179    debug(chat(flooding), 'Flooding score: ~2f (session ~p)',
  180          [NewScore, Session]),
  181    http_session_assert(websocket(NewScore, Now)),
  182    (   NewScore > 50
  183    ->  throw(http_reply(resource_error(
  184                             error(permission_error(reconnect, websocket,
  185                                                    Session),
  186                                   websocket(reconnect(Passed, NewScore))))))
  187    ;   true
  188    ).
  189
  190%!  accept_chat(+Session, +Options, +WebSocket)
  191
  192accept_chat(Session, Options, WebSocket) :-
  193    must_succeed(accept_chat_(Session, Options, WebSocket)).
  194
  195accept_chat_(Session, Options, WebSocket) :-
  196    must_succeed(create_chat_room),
  197    (   reconnect_token(WSID, Token, Options),
  198        visitor_status_del_lost(WSID),
  199        existing_visitor(WSID, Session, Token, TmpUser, UserData),
  200        hub_add(swish_chat, WebSocket, WSID)
  201    ->  Reason = rejoined
  202    ;   must_succeed(hub_add(swish_chat, WebSocket, WSID)),
  203        must_succeed(create_visitor(WSID, Session, Token,
  204                                    TmpUser, UserData, Options)),
  205        Reason = joined
  206    ),
  207    must_succeed(gc_visitors),
  208    must_succeed(visitor_count(Visitors)),
  209    ignore(Visitors = 0),           % in case visitor_count/1 failed
  210    option(check_login(CheckLogin), Options, true),
  211    Msg0 = _{ type:welcome,
  212	      uid:TmpUser,
  213	      wsid:WSID,
  214	      reconnect:Token,
  215	      visitors:Visitors,
  216	      check_login:CheckLogin
  217	    },
  218    add_redis_consumer(Msg0, Msg),
  219    must_succeed(hub_send(WSID, json(UserData.put(Msg)))),
  220    must_succeed(chat_broadcast(UserData.put(_{type:Reason,
  221                                               visitors:Visitors,
  222                                               wsid:WSID}))),
  223    debug(chat(websocket), '~w (session ~p, wsid ~p)',
  224          [Reason, Session, WSID]).
  225
  226add_redis_consumer(Msg0, Msg) :-
  227    use_redis,
  228    redis_consumer(Consumer),
  229    !,
  230    Msg = Msg0.put(consumer, Consumer).
  231add_redis_consumer(Msg, Msg).
  232
  233reconnect_token(WSID, Token, Options) :-
  234    option(reconnect(Token), Options),
  235    visitor_session(WSID, _, Token),
  236    !.
  237
  238must_succeed(Goal) :-
  239    catch_with_backtrace(Goal, E, print_message(warning, E)),
  240    !.
  241must_succeed(Goal) :-
  242    print_message(warning, goal_failed(Goal)).
  243
  244
  245                 /*******************************
  246                 *              DATA            *
  247                 *******************************/
  248
  249%!  visitor_status(?WSID, ?Status).
  250%!  visitor_session(?WSID, ?SessionId, ?Token).
  251%!  session_user(?Session, ?TmpUser).
  252%!  visitor_data(?TmpUser, ?UserData:dict).
  253%!  subscription(?WSID, ?Channel, ?SubChannel).
  254%
  255%   These predicates represent our notion of visitors. Active modes:
  256%
  257%     - visitor_status(+WSID, -Status)
  258%       - Indexes: 1
  259%       - retract(visitor_status(+WSID, -Status))
  260%       - assertz(visitor_status(+WSID, +Status))
  261%       - retractall(visitor_status(+WSID, _))
  262%     - visitor_session(+WSID, -SessionId, -Token)
  263%       - Indexes: 1,2,3
  264%     - session_user(?Session, ?TmpUser)
  265%       - Indexes: 1
  266%     - visitor_data(?TmpUser, ?UserData)
  267%       - Indexes: 1
  268%     - subscription(?WSID, ?Channel, ?SubChannel)
  269%       - Indexes: 1,3
  270%       Currently all subscriptions are on the Channel `gitty`
  271%
  272%   @arg WSID is the identifier of the web socket. As we may have to
  273%   reconnect lost connections, this is may be replaced.
  274%   @arg Session is the session identifier.  This is used to connect
  275%   SWISH actions to WSIDs.
  276%   @arg TmpUser is the ID with which we identify the user for this
  277%   run. The value is a UUID and thus doesn't reveal the real
  278%   identity of the user.
  279%   @arg UserData is a dict that holds information about the real
  280%   user identity.  This can be empty if no information is known
  281%   about this user.
  282%   @arg Status is one of `unload` or `lost(Time)`
  283%   @arg Channel is an atom denoting a chat channel
  284%   @arg SubChannel is a related sub channel.
  285
  286:- dynamic
  287    visitor_status_db/2,            % WSID, Status
  288    visitor_session_db/3,           % WSID, Session, Token
  289    session_user_db/2,		    % Session, TmpUser
  290    visitor_data_db/2,		    % TmpUser, Data
  291    subscription_db/3.		    % WSID, Channel, SubChannel
  292
  293
  294%!  redis_key(+Which, -Server, -Key) is semidet.
  295
  296redis_key(Which, Server, Key) :-
  297    swish_config(redis, Server),
  298    swish_config(redis_prefix, Prefix),
  299    Which =.. List,
  300    atomic_list_concat([Prefix, chat | List], :, Key).
  301
  302use_redis :-
  303    swish_config(redis, _).
  304
  305
  306%!  visitor_status(+WSID, -Status)
  307%
  308%   Status is one of lost(Time) if we   lost contact at Time or `unload`
  309%   if the websocket was cleanly disconnected.
  310%
  311%   The Redis version keeps two keys per   WSID as described below. Note
  312%   that these keys only  exist  on   temporary  lost  or  disconnecting
  313%   websockets.
  314%
  315%     - unload:WSID = boolean
  316%     - lost:WSID = time
  317
  318visitor_status(WSID, Status) :-
  319    redis_key(unload(WSID), Server, UnloadKey),
  320    !,
  321    redis_key(lost(WSID), Server, LostKey),
  322    redis(Server,
  323          [ get(UnloadKey) -> Unload,
  324            get(LostKey) -> Lost
  325          ]),
  326    (   number(Lost),
  327        Status = lost(Lost)
  328    ;   Unload \== nil
  329    ->  Status = unload
  330    ).
  331visitor_status(WSID, Status) :-
  332    visitor_status_db(WSID, Status).
  333
  334visitor_status_del(WSID) :-
  335    redis_key(unload(WSID), Server, UnloadKey),
  336    !,
  337    redis_key(lost(WSID), Server, LostKey),
  338    redis(Server,
  339          [ del(UnloadKey),
  340            del(LostKey)
  341          ]).
  342visitor_status_del(WSID) :-
  343    retractall(visitor_status_db(WSID, _Status)).
  344
  345visitor_status_del_lost(WSID) :-
  346    redis_key(lost(WSID), Server, Key),
  347    !,
  348    redis(Server, del(Key)).
  349visitor_status_del_lost(WSID) :-
  350    retractall(visitor_status_db(WSID, lost(_))).
  351
  352visitor_status_set_lost(WSID, Time) :-
  353    redis_key(lost(WSID), Server, Key),
  354    !,
  355    redis(Server, set(Key, Time)).
  356visitor_status_set_lost(WSID, Time) :-
  357    assertz(visitor_status_db(WSID, lost(Time))).
  358
  359visitor_status_set_unload(WSID) :-
  360    redis_key(unload(WSID), Server, Key),
  361    !,
  362    redis(Server, set(Key, true)).
  363visitor_status_set_unload(WSID) :-
  364    assertz(visitor_status_db(WSID, unload)).
  365
  366visitor_status_del_unload(WSID) :-
  367    redis_key(unload(WSID), Server, Key),
  368    !,
  369    redis(Server, del(Key)).
  370visitor_status_del_unload(WSID) :-
  371    retract(visitor_status_db(WSID, unload)).
  372
  373%!  visitor_session(?WSID, ?Session, ?Token).
  374%!  visitor_session(?WSID, ?Session, ?Token, ?Consumer).
  375%
  376%   Redis data:
  377%
  378%     - wsid: set of WSID
  379%     - session:WSID to at(Consumer,Session,Token)
  380
  381visitor_session_create(WSID, Session, Token) :-
  382    redis_key(wsid, Server, SetKey),
  383    redis_key(session(WSID), Server, SessionKey),
  384    !,
  385    redis_consumer(Consumer),
  386    redis(Server, sadd(SetKey, WSID)),
  387    redis(Server, set(SessionKey, at(Consumer,Session,Token) as prolog)).
  388visitor_session_create(WSID, Session, Token) :-
  389    assertz(visitor_session_db(WSID, Session, Token)).
  390
  391visitor_session(WSID, Session, Token) :-
  392    visitor_session(WSID, Session, Token, _Consumer).
  393
  394visitor_session(WSID, Session, Token, Consumer) :-
  395    use_redis,
  396    !,
  397    current_wsid(WSID),
  398    redis_key(session(WSID), Server, SessionKey),
  399    redis(Server, get(SessionKey), at(Consumer,Session,Token)).
  400visitor_session(WSID, Session, Token, single) :-
  401    visitor_session_db(WSID, Session, Token).
  402
  403%!  visitor_session_reclaim(+WSID, -Session) is semidet.
  404
  405visitor_session_reclaim(WSID, Session) :-
  406    redis_key(session(WSID), Server, SessionKey),
  407    redis_key(wsid, Server, SetKey),
  408    !,
  409    redis(Server, get(SessionKey), at(_,Session,_Token)),
  410    redis(Server, srem(SetKey, WSID)).
  411visitor_session_reclaim(WSID, Session) :-
  412    retract(visitor_session_db(WSID, Session, _Token)).
  413
  414%!  visitor_session_reclaim_all(+WSID, +Session, +Token) is det.
  415
  416visitor_session_reclaim_all(WSID, _Session, _Token) :-
  417    redis_key(wsid, Server, SetKey),
  418    !,
  419    redis(Server, srem(SetKey, WSID)),
  420    redis_key(session(WSID), Server, SessionKey),
  421    redis(Server, del(SessionKey)).
  422visitor_session_reclaim_all(WSID, Session, Token) :-
  423    retractall(visitor_session_db(WSID, Session, Token)).
  424
  425visiton_session_del_session(Session) :-
  426    use_redis,
  427    !,
  428    (   current_wsid(WSID),
  429        visitor_session_reclaim(WSID, Session),
  430        fail
  431    ;   true
  432    ).
  433visiton_session_del_session(Session) :-
  434    retractall(visitor_session_db(_, Session, _)).
  435
  436%!  current_wsid(?WSID) is nondet.
  437%
  438%   True when WSID is a (Redis) known WSID.
  439
  440current_wsid(WSID) :-
  441    nonvar(WSID),
  442    !,
  443    redis_key(wsid, Server, SetKey),
  444    redis(Server, sismember(SetKey, WSID), 1).
  445current_wsid(WSID) :-
  446    redis_key(wsid, Server, SetKey),
  447    redis_sscan(Server, SetKey, List, []),
  448    member(WSID, List).
  449
  450%!  current_wsid(?WSID, -Consumer)
  451%
  452%   True when we have a visitor WSID on SWISH node Consumer.
  453
  454current_wsid(WSID, Consumer) :-
  455    current_wsid(WSID),
  456    redis_key(session(WSID), Server, SessionKey),
  457    redis(Server, get(SessionKey), at(Consumer,_Session,_Token)).
  458
  459
  460%!  session_user(?Session, ?TmpUser:atom).
  461%
  462%   Relate Session to a  tmp  user  id.   Info  about  the  tmp  user is
  463%   maintained in visitor_data/2.
  464
  465session_user(Session, TmpUser) :-
  466    http_current_session(Session, swish_user(TmpUser)).
  467
  468session_user_create(Session, User) :-
  469    http_session_asserta(swish_user(User), Session).
  470
  471session_user_del(Session, User) :-
  472    http_session_retract(swish_user(User), Session).
  473
  474%!  visitor_data(?Visitor, ?Data)
  475
  476visitor_data(Visitor, Data) :-
  477    redis_key(visitor(Visitor), Server, Key),
  478    !,
  479    redis_get_hash(Server, Key, Data).
  480visitor_data(Visitor, Data) :-
  481    visitor_data_db(Visitor, Data).
  482
  483visitor_data_set(Visitor, Data) :-
  484    redis_key(visitor(Visitor), Server, Key),
  485    !,
  486    redis_set_hash(Server, Key, Data).
  487visitor_data_set(Visitor, Data) :-
  488    retractall(visitor_data_db(Visitor, _)),
  489    assertz(visitor_data_db(Visitor, Data)).
  490
  491visitor_data_del(Visitor, Data) :-
  492    redis_key(visitor(Visitor), Server, Key),
  493    !,
  494    redis_get_hash(Server, Key, Data),
  495    redis(Server, del(Key)).
  496visitor_data_del(Visitor, Data) :-
  497    retract(visitor_data_db(Visitor, Data)).
  498
  499%!  subscription(?WSID, ?Channel, ?SubChannel)
  500%
  501%   Requires both WSID -> Channel/SubChannel and backward relation.
  502%   Redis:
  503%
  504%     channel:SubChannel --> set(WSID-Channel)
  505%     subscription:WSID  --> set(Channel-SubChannel)
  506
  507subscription(WSID, Channel, SubChannel) :-
  508    use_redis,
  509    !,
  510    (   nonvar(WSID), nonvar(Channel), nonvar(SubChannel)
  511    ->  redis_key(subscription(WSID), Server, WsKey),
  512        redis(Server, sismember(WsKey, Channel-SubChannel as prolog), 1)
  513    ;   nonvar(SubChannel)
  514    ->  redis_key(channel(SubChannel), Server, ChKey),
  515        redis_sscan(Server, ChKey, List, []),
  516        member(WSID-Channel, List)
  517    ;   current_wsid(WSID),
  518        redis_key(subscription(WSID), Server, WsKey),
  519        redis_sscan(Server, WsKey, List, []),
  520        member(Channel-SubChannel, List)
  521    ).
  522subscription(WSID, Channel, SubChannel) :-
  523    subscription_db(WSID, Channel, SubChannel).
  524
  525subscribe(WSID, Channel, SubChannel) :-
  526    use_redis,
  527    !,
  528    redis_key(channel(SubChannel), Server, ChKey),
  529    redis_key(subscription(WSID), Server, WsKey),
  530    redis(Server, sadd(ChKey, WSID-Channel as prolog)),
  531    redis(Server, sadd(WsKey, Channel-SubChannel as prolog)).
  532subscribe(WSID, Channel, SubChannel) :-
  533    (   subscription(WSID, Channel, SubChannel)
  534    ->  true
  535    ;   assertz(subscription_db(WSID, Channel, SubChannel))
  536    ).
  537
  538unsubscribe(WSID, Channel, SubChannel) :-
  539    use_redis,
  540    !,
  541    (   subscription(WSID, Channel, SubChannel),
  542        redis_key(channel(SubChannel), Server, ChKey),
  543        redis_key(subscription(WSID), Server, WsKey),
  544        redis(Server, srem(ChKey, WSID-Channel as prolog)),
  545        redis(Server, srem(WsKey, Channel-SubChannel as prolog)),
  546        fail
  547    ;   true
  548    ).
  549unsubscribe(WSID, Channel, SubChannel) :-
  550    retractall(subscription_db(WSID, Channel, SubChannel)).
  551
  552
  553		 /*******************************
  554		 *        HIGH LEVEL DB		*
  555		 *******************************/
  556
  557%!  visitor(?WSID) is nondet
  558%
  559%   True when WSID should be considered an active visitor.
  560
  561visitor(WSID) :-
  562    visitor(WSID, _).
  563
  564visitor(WSID, Consumer) :-
  565    visitor_session(WSID, _Session, _Token, Consumer),
  566    (   pending_visitor(WSID, 30)
  567    ->  fail
  568    ;   reap(WSID, Consumer)
  569    ).
  570
  571reap(WSID, _) :-
  572    hub_member(swish_chat, WSID),
  573    !.
  574reap(WSID, Consumer) :-
  575    use_redis,
  576    !,
  577    (   redis_consumer(Me)
  578    ->  (   Me == Consumer
  579        ->  reclaim_visitor(WSID),
  580            fail
  581        ;   true
  582        )
  583    ;   true
  584    ).
  585reap(WSID, _Consumer) :-            % non-redis setup
  586    reclaim_visitor(WSID),
  587    fail.
  588
  589visitor_count(Count) :-
  590    use_redis,
  591    !,
  592    sync_active_wsid,
  593    active_wsid_count(Count).
  594visitor_count(Count) :-
  595    aggregate_all(count, visitor(_), Count).
  596
  597%!  pending_visitor(+WSID, +Timeout) is semidet.
  598%
  599%   True if WSID is inactive. This means   we lost the connection at
  600%   least Timeout seconds ago.
  601
  602pending_visitor(WSID, Timeout) :-
  603    visitor_status(WSID, lost(Lost)),
  604    get_time(Now),
  605    Now - Lost > Timeout.
  606
  607%!  visitor_session(?WSID, ?Session) is nondet.
  608%
  609%   True if websocket WSID is associated with Session.
  610
  611visitor_session(WSID, Session) :-
  612    visitor_session(WSID, Session, _Token).
  613
  614%!  wsid_visitor(?WSID, ?Visitor)
  615%
  616%   True when WSID is associated with Visitor
  617
  618wsid_visitor(WSID, Visitor) :-
  619    nonvar(WSID),
  620    !,
  621    visitor_session(WSID, Session),
  622    session_user(Session, Visitor).
  623wsid_visitor(WSID, Visitor) :-
  624    session_user(Session, Visitor),
  625    visitor_session(WSID, Session).
  626
  627%!  existing_visitor(+WSID, +Session, +Token, -TmpUser, -UserData) is semidet.
  628%
  629%   True if we are dealing with  an   existing  visitor for which we
  630%   lost the connection.
  631
  632existing_visitor(WSID, Session, Token, TmpUser, UserData) :-
  633    visitor_session(WSID, Session, Token),
  634    session_user(Session, TmpUser),
  635    visitor_data(TmpUser, UserData),
  636    !.
  637existing_visitor(WSID, Session, Token, _, _) :-
  638    visitor_session_reclaim_all(WSID, Session, Token),
  639    fail.
  640
  641%!  create_visitor(+WSID, +Session, ?Token, -TmpUser, -UserData, +Options)
  642%
  643%   Create a new visitor  when  a   new  websocket  is  established.
  644%   Options provides information we have about the user:
  645%
  646%     - current_user_info(+Info)
  647%     Already logged in user with given information
  648%     - avatar(Avatar)
  649%     Avatar remembered in the browser for this user.
  650%     - nick_name(NickName)
  651%     Nick name remembered in the browser for this user.
  652
  653create_visitor(WSID, Session, Token, TmpUser, UserData, Options) :-
  654    generate_key(Token),
  655    visitor_session_create(WSID, Session, Token),
  656    create_session_user(Session, TmpUser, UserData, Options).
  657
  658%!  generate_key(-Key) is det.
  659%
  660%   Generate a random confirmation key
  661
  662generate_key(Key) :-
  663    length(Codes, 16),
  664    maplist(random_between(0,255), Codes),
  665    phrase(base64url(Codes), Encoded),
  666    atom_codes(Key, Encoded).
  667
  668%!  destroy_visitor(+WSID)
  669%
  670%   The web socket WSID has been   closed. We should not immediately
  671%   destroy the temporary user as the browser may soon reconnect due
  672%   to a page reload  or  re-establishing   the  web  socket after a
  673%   temporary network failure. We leave   the destruction thereof to
  674%   the session, but set the session timeout to a fairly short time.
  675%
  676%   @tbd    We should only inform clients that we have informed
  677%           about this user.
  678
  679destroy_visitor(WSID) :-
  680    must_be(atom, WSID),
  681    destroy_reason(WSID, Reason),
  682    (   Reason == unload
  683    ->  reclaim_visitor(WSID)
  684    ;   get_time(Now),
  685        visitor_status_set_lost(WSID, Now)
  686    ),
  687    visitor_count(Count),
  688    debug(chat(visitor), '~p left. Broadcasting ~d visitors', [WSID,Count]),
  689    chat_broadcast(_{ type:removeUser,
  690                      wsid:WSID,
  691                      reason:Reason,
  692                      visitors:Count
  693                    }).
  694
  695destroy_reason(WSID, Reason) :-
  696    visitor_status_del_unload(WSID),
  697    !,
  698    Reason = unload.
  699destroy_reason(_, close).
  700
  701%!  gc_visitors
  702%
  703%   Reclaim all visitors with whom we have   lost the connection and the
  704%   browser did not reclaim the   session  within `session_lost_timeout`
  705%   seconds.
  706
  707:- dynamic last_gc/1.  708
  709gc_visitors :-
  710    swish_config(session_lost_timeout, TMO),
  711    (   last_gc(Last),
  712        get_time(Now),
  713        Now-Last < TMO
  714    ->  true
  715    ;   with_mutex(gc_visitors, gc_visitors_sync(TMO))
  716    ).
  717
  718gc_visitors_sync(TMO) :-
  719    get_time(Now),
  720    (   last_gc(Last),
  721        Now-Last < TMO
  722    ->  true
  723    ;   retractall(last_gc(_)),
  724        asserta(last_gc(Now)),
  725        do_gc_visitors(TMO)
  726    ).
  727
  728do_gc_visitors(TMO) :-
  729    forall(( visitor_session(WSID, _Session, _Token),
  730             pending_visitor(WSID, TMO)
  731           ),
  732           reclaim_visitor(WSID)).
  733
  734reclaim_visitor(WSID) :-
  735    debug(chat(gc), 'Reclaiming idle ~p', [WSID]),
  736    reclaim_visitor_session(WSID),
  737    visitor_status_del(WSID),
  738    unsubscribe(WSID, _).
  739
  740reclaim_visitor_session(WSID) :-
  741    forall(visitor_session_reclaim(WSID, Session),
  742           http_session_retractall(websocket(_, _), Session)).
  743
  744
  745%!  create_session_user(+Session, -User, -UserData, +Options)
  746%
  747%   Associate a user with the session. The user id is a UUID that is
  748%   not associated with  any  persistent  notion   of  a  user.  The
  749%   destruction is left to the destruction of the session.
  750
  751:- listen(http_session(end(SessionID, _Peer)),
  752          destroy_session_user(SessionID)).  753
  754create_session_user(Session, TmpUser, UserData, _Options) :-
  755    session_user(Session, TmpUser),
  756    visitor_data(TmpUser, UserData),
  757    !.
  758create_session_user(Session, TmpUser, UserData, Options) :-
  759    uuid(TmpUser),
  760    get_visitor_data(UserData, Options),
  761    session_user_create(Session, TmpUser),
  762    visitor_data_set(TmpUser, UserData).
  763
  764destroy_session_user(Session) :-
  765    forall(visitor_session(WSID, Session, _Token),
  766           inform_session_closed(WSID, Session)),
  767    visiton_session_del_session(Session),
  768    forall(session_user_del(Session, TmpUser),
  769           destroy_visitor_data(TmpUser)).
  770
  771destroy_visitor_data(TmpUser) :-
  772    (   visitor_data_del(TmpUser, Data),
  773        release_avatar(Data.get(avatar)),
  774        fail
  775    ;   true
  776    ).
  777
  778inform_session_closed(WSID, Session) :-
  779    ignore(hub_send(WSID, json(_{type:session_closed}))),
  780    session_user(Session, TmpUser),
  781    update_visitor_data(TmpUser, _Data, logout).
  782
  783
  784%!  update_visitor_data(+TmpUser, +Data, +Reason) is det.
  785%
  786%   Update the user data for the visitor   TmpUser  to Data. This is
  787%   rather complicated due to all the   defaulting  rules. Reason is
  788%   one of:
  789%
  790%     - login
  791%     - logout
  792%     - 'set-nick-name'
  793%     - 'profile-edit'
  794%
  795%   @tbd Create a more declarative description  on where the various
  796%   attributes must come from.
  797
  798update_visitor_data(TmpUser, _Data, logout) :-
  799    !,
  800    anonymise_user_data(TmpUser, NewData),
  801    set_visitor_data(TmpUser, NewData, logout).
  802update_visitor_data(TmpUser, Data, Reason) :-
  803    profile_reason(Reason),
  804    !,
  805    (   visitor_data(TmpUser, Old)
  806    ;   Old = v{}
  807    ),
  808    copy_profile([name,avatar,email], Data, Old, New),
  809    set_visitor_data(TmpUser, New, Reason).
  810update_visitor_data(TmpUser, _{name:Name}, 'set-nick-name') :-
  811    !,
  812    visitor_data(TmpUser, Old),
  813    set_nick_name(Old, Name, New),
  814    set_visitor_data(TmpUser, New, 'set-nick-name').
  815update_visitor_data(TmpUser, Data, Reason) :-
  816    set_visitor_data(TmpUser, Data, Reason).
  817
  818profile_reason('profile-edit').
  819profile_reason('login').
  820
  821copy_profile([], _, Data, Data).
  822copy_profile([H|T], New, Data0, Data) :-
  823    copy_profile_field(H, New, Data0, Data1),
  824    copy_profile(T, New, Data1, Data).
  825
  826copy_profile_field(avatar, New, Data0, Data) :-
  827    !,
  828    (   Data1 = Data0.put(avatar,New.get(avatar))
  829    ->  Data  = Data1.put(avatar_source, profile)
  830    ;   email_gravatar(New.get(email), Avatar),
  831        valid_gravatar(Avatar)
  832    ->  Data = Data0.put(_{avatar:Avatar,avatar_source:email})
  833    ;   Avatar = Data0.get(anonymous_avatar)
  834    ->  Data = Data0.put(_{avatar:Avatar,avatar_source:client})
  835    ;   noble_avatar_url(Avatar, []),
  836        Data = Data0.put(_{avatar:Avatar,avatar_source:generated,
  837                           anonymous_avatar:Avatar
  838                          })
  839    ).
  840copy_profile_field(email, New, Data0, Data) :-
  841    !,
  842    (   NewMail = New.get(email)
  843    ->  update_avatar_from_email(NewMail, Data0, Data1),
  844        Data = Data1.put(email, NewMail)
  845    ;   update_avatar_from_email('', Data0, Data1),
  846        (   del_dict(email, Data1, _, Data)
  847        ->  true
  848        ;   Data = Data1
  849        )
  850    ).
  851copy_profile_field(F, New, Data0, Data) :-
  852    (   Data = Data0.put(F, New.get(F))
  853    ->  true
  854    ;   del_dict(F, Data0, _, Data)
  855    ->  true
  856    ;   Data = Data0
  857    ).
  858
  859set_nick_name(Data0, Name, Data) :-
  860    Data = Data0.put(_{name:Name, anonymous_name:Name}).
  861
  862%!  update_avatar_from_email(+Email, +DataIn, -Data)
  863%
  864%   Update the avatar after a change  of   the  known  email. If the
  865%   avatar comes from the profile, no action is needed. If Email has
  866%   a gravatar, use that. Else  use  the   know  or  a new generated
  867%   avatar.
  868
  869update_avatar_from_email(_, Data, Data) :-
  870    Data.get(avatar_source) == profile,
  871    !.
  872update_avatar_from_email('', Data0, Data) :-
  873    Data0.get(avatar_source) == email,
  874    !,
  875    noble_avatar_url(Avatar, []),
  876    Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  877                       avatar_source:generated}).
  878update_avatar_from_email(Email, Data0, Data) :-
  879    email_gravatar(Email, Avatar),
  880    valid_gravatar(Avatar),
  881    !,
  882    Data = Data0.put(avatar, Avatar).
  883update_avatar_from_email(_, Data0, Data) :-
  884    (   Avatar = Data0.get(anonymous_avatar)
  885    ->  Data = Data0.put(_{avatar:Avatar, avatar_source:client})
  886    ;   noble_avatar_url(Avatar, []),
  887        Data = Data0.put(_{avatar:Avatar, anonymous_avatar:Avatar,
  888                           avatar_source:generated})
  889    ).
  890
  891%!  anonymise_user_data(TmpUser, Data)
  892%
  893%   Create anonymous user profile.
  894
  895anonymise_user_data(TmpUser, Data) :-
  896    visitor_data(TmpUser, Old),
  897    (   _{anonymous_name:AName, anonymous_avatar:AAvatar} :< Old
  898    ->  Data = _{anonymous_name:AName, anonymous_avatar:AAvatar,
  899                 name:AName, avatar:AAvatar, avatar_source:client}
  900    ;   _{anonymous_avatar:AAvatar} :< Old
  901    ->  Data = _{anonymous_avatar:AAvatar,
  902                 avatar:AAvatar, avatar_source:client}
  903    ;   _{anonymous_name:AName} :< Old
  904    ->  noble_avatar_url(Avatar, []),
  905        Data = _{anonymous_name:AName, anonymous_avatar:Avatar,
  906                 name:AName, avatar:Avatar, avatar_source:generated}
  907    ),
  908    !.
  909anonymise_user_data(_, Data) :-
  910    noble_avatar_url(Avatar, []),
  911    Data = _{anonymous_avatar:Avatar,
  912             avatar:Avatar, avatar_source:generated}.
  913
  914%!  set_visitor_data(+TmpUser, +Data, +Reason) is det.
  915%
  916%   Update the user data for the   session  user TmpUser and forward
  917%   the changes.
  918
  919set_visitor_data(TmpUser, Data, Reason) :-
  920    visitor_data_set(TmpUser, Data),
  921    inform_visitor_change(TmpUser, Reason).
  922
  923%!  inform_visitor_change(+TmpUser, +Reason) is det.
  924%
  925%   Inform browsers showing  TmpUser  that   the  visitor  data  has
  926%   changed. The first  clause  deals   with  forwarding  from  HTTP
  927%   requests,  where  we  have  the  session  and  the  second  from
  928%   websocket requests where we have the WSID.
  929
  930inform_visitor_change(TmpUser, Reason) :-
  931    http_in_session(Session),
  932    !,
  933    public_user_data(TmpUser, Data),
  934    forall(visitor_session(WSID, Session),
  935           inform_friend_change(WSID, Data, Reason)).
  936inform_visitor_change(TmpUser, Reason) :-
  937    nb_current(wsid, WSID),
  938    !,
  939    public_user_data(TmpUser, Data),
  940    inform_friend_change(WSID, Data, Reason).
  941inform_visitor_change(_, _).
  942
  943inform_friend_change(WSID, Data, Reason) :-
  944    Message = json(_{ type:"profile",
  945                      wsid:WSID,
  946                      reason:Reason
  947                    }.put(Data)),
  948    send_friends(WSID, Message).
  949
  950%!  subscribe(+WSID, +Channel) is det.
  951
  952subscribe(WSID, Channel) :-
  953    subscribe(WSID, Channel, _SubChannel).
  954
  955unsubscribe(WSID, Channel) :-
  956    unsubscribe(WSID, Channel, _SubChannel).
  957
  958%!  sync_gazers(+WSID, +Files:list(atom)) is det.
  959%
  960%   A browser signals it has Files open.   This happens when a SWISH
  961%   instance is created as well  as   when  a SWISH instance changes
  962%   state, such as closing a tab, adding   a  tab, bringing a tab to
  963%   the foreground, etc.
  964
  965sync_gazers(WSID, Files0) :-
  966    findall(F, subscription(WSID, gitty, F), Viewing0),
  967    sort(Files0, Files),
  968    sort(Viewing0, Viewing),
  969    (   Files == Viewing
  970    ->  true
  971    ;   ord_subtract(Files, Viewing, New),
  972        add_gazing(WSID, New),
  973        ord_subtract(Viewing, Files, Left),
  974        del_gazing(WSID, Left)
  975    ).
  976
  977add_gazing(_, []) :- !.
  978add_gazing(WSID, Files) :-
  979    inform_me_about_existing_gazers(WSID, Files),
  980    inform_existing_gazers_about_newby(WSID, Files).
  981
  982inform_me_about_existing_gazers(WSID, Files) :-
  983    hub_member(swish_chat, WSID),
  984    !,
  985    findall(Gazer, files_gazer(Files, Gazer), Gazers),
  986    ignore(hub_send(WSID, json(_{type:"gazers", gazers:Gazers}))).
  987inform_me_about_existing_gazers(_, _).
  988
  989files_gazer(Files, Gazer) :-
  990    member(File, Files),
  991    subscription(WSID, gitty, File),
  992    visitor_session(WSID, Session),
  993    session_user(Session, UID),
  994    public_user_data(UID, Data),
  995    Gazer = _{file:File, uid:UID, wsid:WSID}.put(Data).
  996
  997inform_existing_gazers_about_newby(WSID, Files) :-
  998    forall(member(File, Files),
  999           signal_gazer(WSID, File)).
 1000
 1001signal_gazer(WSID, File) :-
 1002    subscribe(WSID, gitty, File),
 1003    broadcast_event(opened(File), File, WSID).
 1004
 1005del_gazing(_, []) :- !.
 1006del_gazing(WSID, Files) :-
 1007    forall(member(File, Files),
 1008           del_gazing1(WSID, File)).
 1009
 1010del_gazing1(WSID, File) :-
 1011    broadcast_event(closed(File), File, WSID),
 1012    unsubscribe(WSID, gitty, File).
 1013
 1014%!  add_user_details(+Message, -Enriched) is det.
 1015%
 1016%   Add additional information to a message.  Message must
 1017%   contain a `uid` field.
 1018
 1019add_user_details(Message, Enriched) :-
 1020    public_user_data(Message.uid, Data),
 1021    Enriched = Message.put(Data).
 1022
 1023%!  public_user_data(+UID, -Public:dict) is det.
 1024%
 1025%   True when Public provides the   information  we publically share
 1026%   about UID. This is currently the name and avatar.
 1027
 1028public_user_data(UID, Public) :-
 1029    visitor_data(UID, Data),
 1030    (   _{name:Name, avatar:Avatar} :< Data
 1031    ->  Public = _{name:Name, avatar:Avatar}
 1032    ;   _{avatar:Avatar} :< Data
 1033    ->  Public = _{avatar:Avatar}
 1034    ;   Public = _{}
 1035    ).
 1036
 1037%!  get_visitor_data(-Data:dict, +Options) is det.
 1038%
 1039%   Optain data for a new visitor.  Options include:
 1040%
 1041%     - identity(+Identity)
 1042%     Identity information provided by authenticate/2.  Always
 1043%     present.
 1044%     - avatar(+URL)
 1045%     Avatar provided by the user
 1046%     - nick_name(+Name)
 1047%     Nick name provided by the user.
 1048%
 1049%   Data always contains an `avatar` key   and optionally contains a
 1050%   `name` and `email` key. If the avatar is generated there is also
 1051%   a key `avatar_generated` with the value `true`.
 1052%
 1053%   @bug    This may check for avatar validity, which may take
 1054%           long.  Possibly we should do this in a thread.
 1055
 1056get_visitor_data(Data, Options) :-
 1057    option(identity(Identity), Options),
 1058    findall(N-V, visitor_property(Identity, Options, N, V), Pairs),
 1059    dict_pairs(Data, v, Pairs).
 1060
 1061visitor_property(Identity, Options, name, Name) :-
 1062    (   user_property(Identity, name(Name))
 1063    ->  true
 1064    ;   option(nick_name(Name), Options)
 1065    ).
 1066visitor_property(Identity, _, email, Email) :-
 1067    user_property(Identity, email(Email)).
 1068visitor_property(Identity, Options, Name, Value) :-
 1069    (   user_property(Identity, avatar(Avatar))
 1070    ->  avatar_property(Avatar, profile, Name, Value)
 1071    ;   user_property(Identity, email(Email)),
 1072        email_gravatar(Email, Avatar),
 1073        valid_gravatar(Avatar)
 1074    ->  avatar_property(Avatar, email, Name, Value)
 1075    ;   option(avatar(Avatar), Options)
 1076    ->  avatar_property(Avatar, client, Name, Value)
 1077    ;   noble_avatar_url(Avatar, Options),
 1078        avatar_property(Avatar, generated, Name, Value)
 1079    ).
 1080visitor_property(_, Options, anonymous_name, Name) :-
 1081    option(nick_name(Name), Options).
 1082visitor_property(_, Options, anonymous_avatar, Avatar) :-
 1083    option(avatar(Avatar), Options).
 1084
 1085
 1086avatar_property(Avatar, _Source, avatar,        Avatar).
 1087avatar_property(_Avatar, Source, avatar_source, Source).
 1088
 1089
 1090                 /*******************************
 1091                 *         NOBLE AVATAR         *
 1092                 *******************************/
 1093
 1094:- http_handler(swish('avatar/'), reply_avatar, [id(avatar), prefix]). 1095
 1096%!  reply_avatar(+Request)
 1097%
 1098%   HTTP handler for Noble  Avatar   images.  Using  create_avatar/2
 1099%   re-creates avatars from the file name,  so we can safely discard
 1100%   the avatar file store.
 1101%
 1102%   Not really. A new user gets a new   avatar  and this is based on
 1103%   whether or not the file exists. Probably we should maintain a db
 1104%   of handed out avatars and their last-use   time stamp. How to do
 1105%   that? Current swish stats: 400K avatars, 3.2Gb data.
 1106
 1107reply_avatar(Request) :-
 1108    cors_enable,
 1109    option(path_info(Local), Request),
 1110    (   absolute_file_name(noble_avatar(Local), Path,
 1111                           [ access(read),
 1112                             file_errors(fail)
 1113                           ])
 1114    ->  true
 1115    ;   create_avatar(Local, Path)
 1116    ),
 1117    http_reply_file(Path, [unsafe(true)], Request).
 1118
 1119
 1120noble_avatar_url(HREF, Options) :-
 1121    option(avatar(HREF), Options),
 1122    !.
 1123noble_avatar_url(HREF, _Options) :-
 1124    swish_config:config(avatars, noble),
 1125    !,
 1126    noble_avatar(_Gender, Path, true),
 1127    file_base_name(Path, File),
 1128    http_absolute_location(swish(avatar/File), HREF, []).
 1129noble_avatar_url(HREF, _Options) :-
 1130    A is random(0x1FFFFF+1),
 1131    http_absolute_location(icons('avatar.svg'), HREF0, []),
 1132    format(atom(HREF), '~w#~d', [HREF0, A]).
 1133
 1134
 1135
 1136                 /*******************************
 1137                 *         BROADCASTING         *
 1138                 *******************************/
 1139
 1140%!  chat_broadcast(+Message) is det.
 1141%!  chat_broadcast(+Message, +Channel) is det.
 1142%
 1143%   Send Message to all known SWISH  clients.   Message  is a valid JSON
 1144%   object, i.e., a dict or option list.   When  using Redis we send the
 1145%   message to the  ``swish:chat``  pubsub   channel  and  listening for
 1146%   ``swish:chat`` calls chat_broadcast_local/1,2 in each instance.
 1147%
 1148%   @arg Channel is either an atom or a term Channel/SubChannel,
 1149%   where both Channel and SubChannel are atoms.
 1150
 1151chat_broadcast(Message) :-
 1152    use_redis,
 1153    !,
 1154    redis(swish, publish(swish:chat, chat(Message) as prolog)).
 1155chat_broadcast(Message) :-
 1156    chat_broadcast_local(Message).
 1157
 1158chat_broadcast(Message, Channel) :-
 1159    use_redis,
 1160    !,
 1161    redis(swish, publish(swish:chat, chat(Message, Channel) as prolog)).
 1162chat_broadcast(Message, Channel) :-
 1163    chat_broadcast_local(Message, Channel).
 1164
 1165
 1166chat_broadcast_local(Message) :-
 1167    debug(chat(broadcast), 'Broadcast: ~p', [Message]),
 1168    hub_broadcast(swish_chat, json(Message)).
 1169
 1170chat_broadcast_local(Message, Channel/SubChannel) :-
 1171    !,
 1172    must_be(atom, Channel),
 1173    must_be(atom, SubChannel),
 1174    debug(chat(broadcast), 'Broadcast on ~p: ~p',
 1175          [Channel/SubChannel, Message]),
 1176    hub_broadcast(swish_chat, json(Message),
 1177                  subscribed(Channel, SubChannel)).
 1178chat_broadcast_local(Message, Channel) :-
 1179    must_be(atom, Channel),
 1180    debug(chat(broadcast), 'Broadcast on ~p: ~p', [Channel, Message]),
 1181    hub_broadcast(swish_chat, json(Message),
 1182                  subscribed(Channel)).
 1183
 1184%!  subscribed(+Channel, +WSID) is semidet.
 1185%!  subscribed(+Channel, +SubChannel, +WSID) is semidet.
 1186%
 1187%   Filter used by hub_broadcast/3. WSID is   always a locally known web
 1188%   and active socket.
 1189
 1190subscribed(Channel, WSID) :-
 1191    subscription(WSID, Channel, _).
 1192subscribed(Channel, SubChannel, WSID) :-
 1193    subscription(WSID, Channel, SubChannel).
 1194subscribed(gitty, SubChannel, WSID) :-
 1195    swish_config:config(hangout, SubChannel),
 1196    \+ subscription(WSID, gitty, SubChannel).
 1197
 1198%!  send_friends(+WSID, +Message)
 1199%
 1200%   Send Message to WSID and all its friends.
 1201
 1202send_friends(WSID, Message) :-
 1203    use_redis,
 1204    !,
 1205    redis(swish, publish(swish:chat, send_friends(WSID, Message) as prolog)).
 1206send_friends(WSID, Message) :-
 1207    send_friends_local(WSID, Message).
 1208
 1209send_friends_local(WSID, Message) :-
 1210    hub_send_if_on_me(WSID, Message),
 1211    forall(distinct(viewing_same_file(WSID, Friend)),
 1212           ignore(hub_send_if_on_me(Friend, Message))).
 1213
 1214hub_send_if_on_me(WSID, Message) :-
 1215    hub_member(swish_chat, WSID),
 1216    !,
 1217    hub_send(WSID, Message).
 1218hub_send_if_on_me(_, _).
 1219
 1220viewing_same_file(WSID, Friend) :-
 1221    subscription(WSID, gitty, File),
 1222    subscription(Friend, gitty, File),
 1223    Friend \== WSID.
 1224
 1225
 1226		 /*******************************
 1227		 *      REDIS CONNNECTION       *
 1228		 *******************************/
 1229
 1230:- initialization
 1231    listen(redis(_, 'swish:chat', Message),
 1232           chat_message(Message)). 1233
 1234chat_message(chat(Message)) :-
 1235    update_visitors(Message),
 1236    chat_broadcast_local(Message).
 1237chat_message(chat(Message, Channel)) :-
 1238    chat_broadcast_local(Message, Channel).
 1239chat_message(send_friends(WSID, Message)) :-
 1240    send_friends_local(WSID, Message).
 1241
 1242%!  update_visitors(+Msg) is det.
 1243%
 1244%   Maintain notion of active users  based on broadcasted (re)join and
 1245%   left messages.  We sync every 5 minutes to compensate for possible
 1246%   missed users.
 1247
 1248:- dynamic
 1249       (   last_wsid_sync/1,
 1250	   active_wsid/2
 1251       ) as volatile. 1252
 1253update_visitors(Msg),
 1254  _{type:removeUser, wsid:WSID} :< Msg =>
 1255    retractall(active_wsid(WSID, _)).
 1256update_visitors(Msg),
 1257  _{type:joined, wsid:WSID} :< Msg,
 1258  \+ active_wsid(WSID, _) =>
 1259    asserta(active_wsid(WSID, Msg.get(consumer, -))).
 1260update_visitors(Msg),
 1261  _{type:rejoined, wsid:WSID} :< Msg,
 1262  \+ active_wsid(WSID, _) =>
 1263    asserta(active_wsid(WSID, Msg.get(consumer, -))).
 1264update_visitors(_) =>
 1265    true.
 1266
 1267sync_active_wsid :-
 1268    last_wsid_sync(Last),
 1269    get_time(Now),
 1270    Now-Last < 300,
 1271    !.
 1272sync_active_wsid :-
 1273    get_time(Now),
 1274    transaction(
 1275	(   retractall(last_wsid_sync(_)),
 1276	    asserta(last_wsid_sync(Now)))),
 1277    findall(WSID-Consumer, visitor(WSID, Consumer), Pairs),
 1278    transaction(
 1279	(   retractall(active_wsid(_,_)),
 1280	    forall(member(WSID-Consumer, Pairs),
 1281		   assertz(active_wsid(WSID, Consumer))))).
 1282
 1283active_wsid_count(Count) :-
 1284    predicate_property(active_wsid(_,_), number_of_clauses(Count)),
 1285    !.
 1286active_wsid_count(0).
 1287
 1288active_wsid_count(Consumer, Count) :-
 1289    aggregate(count, WSID^active_wsid(WSID, Consumer), Count).
 1290
 1291
 1292                 /*******************************
 1293                 *           CHAT ROOM          *
 1294                 *******************************/
 1295
 1296create_chat_room :-
 1297    current_hub(swish_chat, _),
 1298    !.
 1299create_chat_room :-
 1300    with_mutex(swish_chat, create_chat_room_sync).
 1301
 1302create_chat_room_sync :-
 1303    current_hub(swish_chat, _),
 1304    !.
 1305create_chat_room_sync :-
 1306    hub_create(swish_chat, Room, _{}),
 1307    thread_create(swish_chat(Room), _, [alias(swish_chat)]).
 1308
 1309swish_chat(Room) :-
 1310    (   catch_with_backtrace(swish_chat_event(Room), E, chat_exception(E))
 1311    ->  true
 1312    ;   print_message(warning, goal_failed(swish_chat_event(Room)))
 1313    ),
 1314    swish_chat(Room).
 1315
 1316chat_exception('$aborted') :- !.
 1317chat_exception(E) :-
 1318    print_message(warning, E).
 1319
 1320swish_chat_event(Room) :-
 1321    thread_get_message(Room.queues.event, Message),
 1322    (   handle_message(Message, Room)
 1323    ->  true
 1324    ;   print_message(warning, goal_failed(handle_message(Message, Room)))
 1325    ).
 1326
 1327%!  handle_message(+Message, +Room)
 1328%
 1329%   Handle incoming messages. This handles   messages from our websocket
 1330%   connections, i.e., this does  not  see   messages  on  other (Redis)
 1331%   instances.
 1332
 1333handle_message(Message, _Room) :-
 1334    websocket{opcode:text} :< Message,
 1335    !,
 1336    atom_json_dict(Message.data, JSON, []),
 1337    debug(chat(received), 'Received from ~p: ~p', [Message.client, JSON]),
 1338    WSID = Message.client,
 1339    setup_call_cleanup(
 1340        b_setval(wsid, WSID),
 1341        json_message(JSON, WSID),
 1342        nb_delete(wsid)).
 1343handle_message(Message, _Room) :-
 1344    hub{joined:WSID} :< Message,
 1345    !,
 1346    debug(chat(visitor), 'Joined: ~p', [WSID]).
 1347handle_message(Message, _Room) :-
 1348    hub{left:WSID, reason:write(Lost)} :< Message,
 1349    !,
 1350    (   destroy_visitor(WSID)
 1351    ->  debug(chat(visitor), 'Left ~p due to write error for ~p',
 1352              [WSID, Lost])
 1353    ;   true
 1354    ).
 1355handle_message(Message, _Room) :-
 1356    hub{left:WSID} :< Message,
 1357    !,
 1358    (   destroy_visitor(WSID)
 1359    ->  debug(chat(visitor), 'Left: ~p', [WSID])
 1360    ;   true
 1361    ).
 1362handle_message(Message, _Room) :-
 1363    websocket{opcode:close, client:WSID} :< Message,
 1364    !,
 1365    debug(chat(visitor), 'Left: ~p', [WSID]),
 1366    destroy_visitor(WSID).
 1367handle_message(Message, _Room) :-
 1368    debug(chat(ignored), 'Ignoring chat message ~p', [Message]).
 1369
 1370
 1371%!  json_message(+Message, +WSID) is det.
 1372%
 1373%   Process a JSON message  translated  to   a  dict.  The following
 1374%   messages are understood:
 1375%
 1376%     - subscribe channel [subchannel]
 1377%     - unsubscribe channel [subchannel]
 1378%     Actively (un)subscribe for specific message channels.
 1379%     - unload
 1380%     A SWISH instance is cleanly being unloaded.
 1381%     - has-open-files files
 1382%     Executed after initiating the websocket to indicate loaded
 1383%     files.
 1384%     - set-nick-name name
 1385%     User set nick name for anonymous identoty
 1386
 1387json_message(Dict, WSID) :-
 1388    _{ type: "subscribe",
 1389       channel:ChannelS, sub_channel:SubChannelS} :< Dict,
 1390    !,
 1391    atom_string(Channel, ChannelS),
 1392    atom_string(SubChannel, SubChannelS),
 1393    subscribe(WSID, Channel, SubChannel).
 1394json_message(Dict, WSID) :-
 1395    _{type: "subscribe", channel:ChannelS} :< Dict,
 1396    !,
 1397    atom_string(Channel, ChannelS),
 1398    subscribe(WSID, Channel).
 1399json_message(Dict, WSID) :-
 1400    _{ type: "unsubscribe",
 1401       channel:ChannelS, sub_channel:SubChannelS} :< Dict,
 1402    !,
 1403    atom_string(Channel, ChannelS),
 1404    atom_string(SubChannel, SubChannelS),
 1405    unsubscribe(WSID, Channel, SubChannel).
 1406json_message(Dict, WSID) :-
 1407    _{type: "unsubscribe", channel:ChannelS} :< Dict,
 1408    !,
 1409    atom_string(Channel, ChannelS),
 1410    unsubscribe(WSID, Channel).
 1411json_message(Dict, WSID) :-
 1412    _{type: "unload"} :< Dict,     % clean close/reload
 1413    !,
 1414    sync_gazers(WSID, []),
 1415    visitor_status_set_unload(WSID).
 1416json_message(Dict, WSID) :-
 1417    _{type: "has-open-files", files:FileDicts} :< Dict,
 1418    !,
 1419    maplist(dict_file_name, FileDicts, Files),
 1420    sync_gazers(WSID, Files).
 1421json_message(Dict, WSID) :-
 1422    _{type: "reloaded", file:FileS, commit:Hash} :< Dict,
 1423    !,
 1424    atom_string(File, FileS),
 1425    event_html(reloaded(File), HTML),
 1426    Message = _{ type:notify,
 1427                 wsid:WSID,
 1428                 html:HTML,
 1429                 event:reloaded,
 1430                 argv:[File,Hash]
 1431               },
 1432    chat_broadcast(Message, gitty/File).
 1433json_message(Dict, WSID) :-
 1434    _{type: "set-nick-name", name:Name} :< Dict,
 1435    !,
 1436    wsid_visitor(WSID, Visitor),
 1437    update_visitor_data(Visitor, _{name:Name}, 'set-nick-name').
 1438json_message(Dict, WSID) :-
 1439    _{type: "chat-message", docid:DocID} :< Dict,
 1440    !,
 1441    chat_add_user_id(WSID, Dict, Message),
 1442    (   forbidden(Message, DocID, Why)
 1443    ->  hub_send(WSID, json(json{type:forbidden,
 1444                                 action:chat_post,
 1445                                 about:DocID,
 1446                                 message:Why
 1447                                }))
 1448    ;   chat_relay(Message)
 1449    ).
 1450json_message(Dict, _WSID) :-
 1451    debug(chat(ignored), 'Ignoring JSON message ~p', [Dict]).
 1452
 1453dict_file_name(Dict, File) :-
 1454    atom_string(File, Dict.get(file)).
 1455
 1456%!  forbidden(+Message, +DocID, -Why) is semidet.
 1457%
 1458%   True if the chat Message about DocID must be forbidden, in which
 1459%   case Why is  unified  with  a   string  indicating  the  reason.
 1460%   Currently:
 1461%
 1462%     - Demands the user to be logged on
 1463%     - Limits the size of the message and its payloads
 1464%
 1465%   @tbd Call authorized/2 with all proper identity information.
 1466
 1467forbidden(Message, DocID, Why) :-
 1468    \+ swish_config:config(chat_spam_protection, false),
 1469    \+ ws_authorized(chat(post(Message, DocID)), Message.user),
 1470    !,
 1471    Why = "Due to frequent spamming we were forced to limit \c
 1472               posting chat messages to users who are logged in.".
 1473forbidden(Message, _DocID, Why) :-
 1474    Text = Message.get(text),
 1475    string_length(Text, Len),
 1476    Len > 500,
 1477    Why = "Chat messages are limited to 500 characters".
 1478forbidden(Message, _DocID, Why) :-
 1479    Payloads = Message.get(payload),
 1480    member(Payload, Payloads),
 1481    large_payload(Payload, Why),
 1482    !.
 1483forbidden(Message, _DocID, Why) :-
 1484    \+ swish_config:config(chat_spam_protection, false),
 1485    eval_content(Message.get(text), _WC, Score),
 1486    user_score(Message, Score, Cummulative, _Count),
 1487    Score*2 + Cummulative < 0,
 1488    !,
 1489    Why = "Chat messages must be in English and avoid offensive language".
 1490
 1491large_payload(Payload, Why) :-
 1492    Selections = Payload.get(selection),
 1493    member(Selection, Selections),
 1494    (   string_length(Selection.get(string), SelLen), SelLen > 500
 1495    ;   string_length(Selection.get(context), SelLen), SelLen > 500
 1496    ),
 1497    !,
 1498    Why = "Selection too long (max. 500 characters)".
 1499large_payload(Payload, Why) :-
 1500    string_length(Payload.get(query), QLen), QLen > 1000,
 1501    !,
 1502    Why = "Query too long (max. 1000 characters)".
 1503
 1504user_score(Message, MsgScore, Cummulative, Count) :-
 1505    Profile = Message.get(user).get(profile_id),
 1506    !,
 1507    block(Profile, MsgScore, Cummulative, Count).
 1508user_score(_, _, 0, 1).
 1509
 1510%!  block(+User, +Score, -Cummulative, -Count)
 1511%
 1512%   Keep a count and cummulative score for a user.
 1513
 1514:- dynamic
 1515    blocked/4. 1516
 1517block(User, Score, Cummulative, Count) :-
 1518    blocked(User, Score0, Count0, Time),
 1519    !,
 1520    get_time(Now),
 1521    Cummulative = Score0*(0.5**((Now-Time)/600)) + Score,
 1522    Count is Count0 + 1,
 1523    asserta(blocked(User, Cummulative, Count, Now)),
 1524    retractall(blocked(User, Score0, Count0, Time)).
 1525block(User, Score, Score, 1) :-
 1526    get_time(Now),
 1527    asserta(blocked(User, Score, 1, Now)).
 1528
 1529
 1530                 /*******************************
 1531                 *         CHAT MESSAGES        *
 1532                 *******************************/
 1533
 1534%!  chat_add_user_id(+WSID, +Message0, -Message) is det.
 1535%
 1536%   Decorate a message with the user credentials.
 1537
 1538chat_add_user_id(WSID, Dict, Message) :-
 1539    visitor_session(WSID, Session),
 1540    session_user(Session, Visitor),
 1541    visitor_data(Visitor, UserData),
 1542    User0 = u{avatar:UserData.avatar,
 1543              wsid:WSID
 1544             },
 1545    (   Name = UserData.get(name)
 1546    ->  User1 = User0.put(name, Name)
 1547    ;   User1 = User0
 1548    ),
 1549    (   http_current_session(Session, profile_id(ProfileID))
 1550    ->  User = User1.put(profile_id, ProfileID)
 1551    ;   User = User1
 1552    ),
 1553    Message = Dict.put(user, User).
 1554
 1555
 1556%!  chat_about(+DocID, +Message) is det.
 1557%
 1558%   Distribute a chat message about DocID.
 1559
 1560chat_about(DocID, Message) :-
 1561    chat_relay(Message.put(docid, DocID)).
 1562
 1563%!  chat_relay(+Message) is det.
 1564%
 1565%   Store and relay a chat message.
 1566
 1567chat_relay(Message) :-
 1568    chat_enrich(Message, Message1),
 1569    chat_send(Message1).
 1570
 1571%!  chat_enrich(+Message0, -Message) is det.
 1572%
 1573%   Add time and identifier to the chat message.
 1574
 1575chat_enrich(Message0, Message) :-
 1576    get_time(Now),
 1577    uuid(ID),
 1578    Message = Message0.put(_{time:Now, id:ID}).
 1579
 1580%!  chat_send(+Message)
 1581%
 1582%   Relay the chat message Message. If  the message has a `volatile`
 1583%   property it is broadcasted, but not stored.
 1584
 1585chat_send(Message) :-
 1586    atom_concat("gitty:", File, Message.docid),
 1587    broadcast(swish(chat(Message))),
 1588    (   Message.get(volatile) == true
 1589    ->  true
 1590    ;   chat_store(Message)
 1591    ),
 1592    chat_broadcast(Message, gitty/File).
 1593
 1594
 1595                 /*******************************
 1596                 *            EVENTS            *
 1597                 *******************************/
 1598
 1599:- unlisten(swish(_)),
 1600   listen(swish(Event), chat_event(Event)). 1601
 1602%!  chat_event(+Event) is semidet.
 1603%
 1604%   Event happened inside SWISH.  Currently triggered events:
 1605%
 1606%     - updated(+File, +From, +To)
 1607%     File was updated from hash From to hash To.
 1608%     - profile(+ProfileID)
 1609%     Session was associated with user with profile ProfileID
 1610%     - logout(+ProfileID)
 1611%     User logged out. If the login was based on HTTP authentication
 1612%     ProfileID equals `http`.
 1613
 1614chat_event(Event) :-
 1615    broadcast_event(Event),
 1616    http_session_id(Session),
 1617    debug(event, 'Event: ~p, session ~q', [Event, Session]),
 1618    event_file(Event, File),
 1619    !,
 1620    (   visitor_session(WSID, Session),
 1621        subscription(WSID, gitty, File)
 1622    ->  true
 1623    ;   visitor_session(WSID, Session)
 1624    ->  true
 1625    ;   WSID = undefined
 1626    ),
 1627    session_broadcast_event(Event, File, Session, WSID).
 1628chat_event(logout(_ProfileID)) :-
 1629    !,
 1630    http_session_id(Session),
 1631    session_user(Session, User),
 1632    update_visitor_data(User, _, logout).
 1633chat_event(visitor_count(Count)) :-             % request
 1634    visitor_count(Count).
 1635chat_event(visitor_count(Cluster, Local)) :-             % request
 1636    visitor_count(Cluster),
 1637    (   use_redis,
 1638        redis_consumer(Consumer)
 1639    ->  (   active_wsid_count(Consumer, Local)
 1640        ->  true
 1641        ;   Local = 0
 1642        )
 1643    ;   Local = Cluster
 1644    ).
 1645
 1646:- if(current_predicate(current_profile/2)). 1647
 1648chat_event(profile(ProfileID)) :-
 1649    !,
 1650    current_profile(ProfileID, Profile),
 1651    http_session_id(Session),
 1652    session_user(Session, User),
 1653    update_visitor_data(User, Profile, login).
 1654
 1655%!  propagate_profile_change(+ProfileID, +Attribute, +Value)
 1656%
 1657%   Trap external changes to the profile.
 1658
 1659:- listen(user_profile(modified(ProfileID, Name, _Old, New)),
 1660          propagate_profile_change(ProfileID, Name, New)). 1661
 1662propagate_profile_change(ProfileID, _, _) :-
 1663    http_current_session(Session, profile_id(ProfileID)),
 1664    session_user(Session, User),
 1665    current_profile(ProfileID, Profile),
 1666    update_visitor_data(User, Profile, 'profile-edit').
 1667
 1668:- endif. 1669
 1670%!  broadcast_event(+Event) is semidet.
 1671%
 1672%   If true, broadcast this event.
 1673
 1674broadcast_event(updated(_File, _Commit)).
 1675
 1676
 1677%!  broadcast_event(+Event, +File, +WSID) is det.
 1678%
 1679%   Event happened that is related to File  in WSID. Broadcast it to
 1680%   subscribed users as a notification. Always succeeds, also if the
 1681%   message cannot be delivered.
 1682%
 1683%   @tbd    Extend the structure to allow other browsers to act.
 1684
 1685broadcast_event(Event, File, WSID) :-
 1686    visitor_session(WSID, Session),
 1687    session_broadcast_event(Event, File, Session, WSID),
 1688    !.
 1689broadcast_event(_, _, _).
 1690
 1691session_broadcast_event(Event, File, Session, WSID) :-
 1692    session_user(Session, UID),
 1693    event_html(Event, HTML),
 1694    Event =.. [EventName|Argv],
 1695    Message0 = _{ type:notify,
 1696                  uid:UID,
 1697                  html:HTML,
 1698                  event:EventName,
 1699                  event_argv:Argv,
 1700                  wsid:WSID
 1701                },
 1702    add_user_details(Message0, Message),
 1703    chat_broadcast(Message, gitty/File).
 1704
 1705%!  event_html(+Event, -HTML:string) is det.
 1706%
 1707%   Describe an event as an HTML  message   to  be  displayed in the
 1708%   client's notification area.
 1709
 1710event_html(Event, HTML) :-
 1711    (   phrase(event_message(Event), Tokens)
 1712    ->  true
 1713    ;   phrase(html('Unknown-event: ~p'-[Event]), Tokens)
 1714    ),
 1715    delete(Tokens, nl(_), SingleLine),
 1716    with_output_to(string(HTML), print_html(SingleLine)).
 1717
 1718event_message(created(File)) -->
 1719    html([ 'Created ', \file(File) ]).
 1720event_message(reloaded(File)) -->
 1721    html([ 'Reloaded ', \file(File) ]).
 1722event_message(updated(File, _Commit)) -->
 1723    html([ 'Saved ', \file(File) ]).
 1724event_message(deleted(File, _From, _To)) -->
 1725    html([ 'Deleted ', \file(File) ]).
 1726event_message(closed(File)) -->
 1727    html([ 'Closed ', \file(File) ]).
 1728event_message(opened(File)) -->
 1729    html([ 'Opened ', \file(File) ]).
 1730event_message(download(File)) -->
 1731    html([ 'Opened ', \file(File) ]).
 1732event_message(download(Store, FileOrHash, Format)) -->
 1733    { event_file(download(Store, FileOrHash, Format), File)
 1734    },
 1735    html([ 'Opened ', \file(File) ]).
 1736
 1737file(File) -->
 1738    html(a(href('/p/'+File), File)).
 1739
 1740%!  event_file(+Event, -File) is semidet.
 1741%
 1742%   True when Event is associated with File.
 1743
 1744event_file(created(File, _Commit), File).
 1745event_file(updated(File, _Commit), File).
 1746event_file(deleted(File, _Commit), File).
 1747event_file(download(Store, FileOrHash, _Format), File) :-
 1748    (   is_gitty_hash(FileOrHash)
 1749    ->  gitty_commit(Store, FileOrHash, Meta),
 1750        File = Meta.name
 1751    ;   File = FileOrHash
 1752    ).
 1753
 1754
 1755                 /*******************************
 1756                 *         NOTIFICATION         *
 1757                 *******************************/
 1758
 1759%!  chat_to_profile(ProfileID, :HTML) is det.
 1760%
 1761%   Send a HTML notification to users logged in using ProfileID.
 1762
 1763chat_to_profile(ProfileID, HTML) :-
 1764    (   http_current_session(Session, profile_id(ProfileID)),
 1765        visitor_session(WSID, Session),
 1766        html_string(HTML, String),
 1767        hub_send(WSID, json(_{ wsid:WSID,
 1768                               type:notify,
 1769                               html:String
 1770                             })),
 1771        debug(notify(chat), 'Notify to ~p: ~p', [ProfileID, String]),
 1772        fail
 1773    ;   true
 1774    ).
 1775
 1776html_string(HTML, String) :-
 1777    phrase(html(HTML), Tokens),
 1778    delete(Tokens, nl(_), SingleLine),
 1779    with_output_to(string(String), print_html(SingleLine)).
 1780
 1781
 1782
 1783
 1784                 /*******************************
 1785                 *             UI               *
 1786                 *******************************/
 1787
 1788%!  notifications(+Options)//
 1789%
 1790%   The  chat  element  is  added  to  the  navbar  and  managed  by
 1791%   web/js/chat.js
 1792
 1793notifications(_Options) -->
 1794    { swish_config:config(chat, true) },
 1795    !,
 1796    html(div(class(chat),
 1797             [ div(class('chat-users'),
 1798                   ul([ class([nav, 'navbar-nav', 'pull-right']),
 1799                        id(chat)
 1800                      ], [])),
 1801               div(class('user-count'),
 1802                   [ span(id('user-count'), '?'),
 1803                     ' users online'
 1804                   ])
 1805             ])).
 1806notifications(_Options) -->
 1807    [].
 1808
 1809%!  broadcast_bell(+Options)//
 1810%
 1811%   Adds a bell to indicate central chat messages
 1812
 1813broadcast_bell(_Options) -->
 1814    { swish_config:config(chat, true),
 1815      swish_config:config(hangout, Hangout),
 1816      atom_concat('gitty:', Hangout, HangoutID)
 1817    },
 1818    !,
 1819    html([ a([ class(['dropdown-toggle', 'broadcast-bell']),
 1820               'data-toggle'(dropdown)
 1821             ],
 1822             [ span([ id('broadcast-bell'),
 1823                      'data-document'(HangoutID)
 1824                    ], []),
 1825               b(class(caret), [])
 1826             ]),
 1827           ul([ class(['dropdown-menu', 'pull-right']),
 1828                id('chat-menu')
 1829              ],
 1830              [ li(a('data-action'('chat-shared'),
 1831                     'Open hangout')),
 1832                li(a('data-action'('chat-about-file'),
 1833                     'Open chat for current file'))
 1834              ])
 1835         ]).
 1836broadcast_bell(_Options) -->
 1837    [].
 1838
 1839
 1840                 /*******************************
 1841                 *            MESSAGES          *
 1842                 *******************************/
 1843
 1844:- multifile
 1845    prolog:message_context//1. 1846
 1847prolog:message_context(websocket(reconnect(Passed, Score))) -->
 1848    [ 'WebSocket: too frequent reconnect requests (~1f sec; score = ~1f)'-
 1849      [Passed, Score] ]