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)).

   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).

 start_chat(+Request)

HTTP handler that establishes a websocket connection where a user gets an avatar and optionally a name.

  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).

 check_flooding(+Session)

See whether the client associated with a session is flooding us and if so, return a resource error.

  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    ).

 accept_chat(+Session, +Options, +WebSocket)

  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                 *******************************/

 visitor_status(?WSID, ?Status)

 visitor_session(?WSID, ?SessionId, ?Token)

 session_user(?Session, ?TmpUser)

 visitor_data(?TmpUser, ?UserData:dict)

 subscription(?WSID, ?Channel, ?SubChannel)

These predicates represent our notion of visitors. Active modes:

• visitor_status(+WSID, -Status)
  • Indexes: 1
  • retract(visitor_status(+WSID, -Status))
  • assertz(visitor_status(+WSID, +Status))
  • retractall(visitor_status(+WSID, _))
• visitor_session(+WSID, -SessionId, -Token)
  • Indexes: 1,2,3
• session_user(?Session, ?TmpUser)
  • Indexes: 1
• visitor_data(?TmpUser, ?UserData)
  • Indexes: 1
• subscription(?WSID, ?Channel, ?SubChannel)

  Indexes:1,3

  Currently all subscriptions are on the Channel gitty

Arguments:

WSID	- is the identifier of the web socket. As we may have to reconnect lost connections, this is may be replaced.
Session	- is the session identifier. This is used to connect SWISH actions to WSIDs.
TmpUser	- is the ID with which we identify the user for this run. The value is a UUID and thus doesn't reveal the real identity of the user.
UserData	- is a dict that holds information about the real user identity. This can be empty if no information is known about this user.
Status	- is one of unload or lost(Time)
Channel	- is an atom denoting a chat channel
SubChannel	- is a related sub channel.

  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

 redis_key(+Which, -Server, -Key) is semidet

  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, _).

 visitor_status(+WSID, -Status)

Status is one of lost(Time) if we lost contact at Time or unload if the websocket was cleanly disconnected.

The Redis version keeps two keys per WSID as described below. Note that these keys only exist on temporary lost or disconnecting websockets.

• unload:WSID = boolean
• lost:WSID = time

  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)).

 visitor_session(?WSID, ?Session, ?Token)

 visitor_session(?WSID, ?Session, ?Token, ?Consumer)

Redis data:

• wsid: set of WSID
• session:WSID to at(Consumer,Session,Token)

  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).

 visitor_session_reclaim(+WSID, -Session) is semidet

  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)).

 visitor_session_reclaim_all(+WSID, +Session, +Token) is det

  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, _)).

 current_wsid(?WSID) is nondet

True when WSID is a (Redis) known WSID.

  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).

 current_wsid(?WSID, -Consumer)

True when we have a visitor WSID on SWISH node Consumer.

  454current_wsid(WSID, Consumer) :-
  455    current_wsid(WSID),
  456    redis_key(session(WSID), Server, SessionKey),
  457    redis(Server, get(SessionKey), at(Consumer,_Session,_Token)).

 session_user(?Session, ?TmpUser:atom)

Relate Session to a tmp user id. Info about the tmp user is maintained in visitor_data/2.

  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).

 visitor_data(?Visitor, ?Data)

  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)).

 subscription(?WSID, ?Channel, ?SubChannel)

Requires both WSID -> Channel/SubChannel and backward relation. Redis:

channel:SubChannel --> set(WSID-Channel) subscription:WSID --> set(Channel-SubChannel)

  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		 *******************************/

 visitor(?WSID) is nondet

True when WSID should be considered an active visitor.

  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).

 pending_visitor(+WSID, +Timeout) is semidet

True if WSID is inactive. This means we lost the connection at least Timeout seconds ago.

  602pending_visitor(WSID, Timeout) :-
  603    visitor_status(WSID, lost(Lost)),
  604    get_time(Now),
  605    Now - Lost > Timeout.

 visitor_session(?WSID, ?Session) is nondet

True if websocket WSID is associated with Session.

  611visitor_session(WSID, Session) :-
  612    visitor_session(WSID, Session, _Token).

 wsid_visitor(?WSID, ?Visitor)

True when WSID is associated with Visitor

  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).

 existing_visitor(+WSID, +Session, +Token, -TmpUser, -UserData) is semidet

True if we are dealing with an existing visitor for which we lost the connection.

  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.

 create_visitor(+WSID, +Session, ?Token, -TmpUser, -UserData, +Options)

Create a new visitor when a new websocket is established. Options provides information we have about the user:

current_user_info(+Info)

Already logged in user with given information

avatar(Avatar)

Avatar remembered in the browser for this user.

nick_name(NickName)

Nick name remembered in the browser for this user.

  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).

 generate_key(-Key) is det

Generate a random confirmation key

  662generate_key(Key) :-
  663    length(Codes, 16),
  664    maplist(random_between(0,255), Codes),
  665    phrase(base64url(Codes), Encoded),
  666    atom_codes(Key, Encoded).

 destroy_visitor(+WSID)

The web socket WSID has been closed. We should not immediately destroy the temporary user as the browser may soon reconnect due to a page reload or re-establishing the web socket after a temporary network failure. We leave the destruction thereof to the session, but set the session timeout to a fairly short time.

To be done

- We should only inform clients that we have informed about this user.

  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).

 gc_visitors

Reclaim all visitors with whom we have lost the connection and the browser did not reclaim the session within session_lost_timeout seconds.

  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)).

 create_session_user(+Session, -User, -UserData, +Options)

Associate a user with the session. The user id is a UUID that is not associated with any persistent notion of a user. The destruction is left to the destruction of the session.

  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).

 update_visitor_data(+TmpUser, +Data, +Reason) is det

Update the user data for the visitor TmpUser to Data. This is rather complicated due to all the defaulting rules. Reason is one of:

• login
• logout
• 'set-nick-name'
• 'profile-edit'

To be done

- Create a more declarative description on where the various attributes must come from.

  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}).

 update_avatar_from_email(+Email, +DataIn, -Data)

Update the avatar after a change of the known email. If the avatar comes from the profile, no action is needed. If Email has a gravatar, use that. Else use the know or a new generated avatar.

  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    ).

 anonymise_user_data(TmpUser, Data)

Create anonymous user profile.

  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}.

 set_visitor_data(+TmpUser, +Data, +Reason) is det

Update the user data for the session user TmpUser and forward the changes.

  919set_visitor_data(TmpUser, Data, Reason) :-
  920    visitor_data_set(TmpUser, Data),
  921    inform_visitor_change(TmpUser, Reason).

 inform_visitor_change(+TmpUser, +Reason) is det

Inform browsers showing TmpUser that the visitor data has changed. The first clause deals with forwarding from HTTP requests, where we have the session and the second from websocket requests where we have the WSID.

  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).

 subscribe(+WSID, +Channel) is det

  952subscribe(WSID, Channel) :-
  953    subscribe(WSID, Channel, _SubChannel).
  954
  955unsubscribe(WSID, Channel) :-
  956    unsubscribe(WSID, Channel, _SubChannel).

 sync_gazers(+WSID, +Files:list(atom)) is det

A browser signals it has Files open. This happens when a SWISH instance is created as well as when a SWISH instance changes state, such as closing a tab, adding a tab, bringing a tab to the foreground, etc.

  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).

 add_user_details(+Message, -Enriched) is det

Add additional information to a message. Message must contain a uid field.

 1019add_user_details(Message, Enriched) :-
 1020    public_user_data(Message.uid, Data),
 1021    Enriched = Message.put(Data).

 public_user_data(+UID, -Public:dict) is det

True when Public provides the information we publically share about UID. This is currently the name and avatar.

 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    ).

 get_visitor_data(-Data:dict, +Options) is det

Optain data for a new visitor. Options include:

identity(+Identity)

Identity information provided by authenticate/2. Always present.

avatar(+URL)

Avatar provided by the user

nick_name(+Name)

Nick name provided by the user.

Data always contains an avatar key and optionally contains a name and email key. If the avatar is generated there is also a key avatar_generated with the value true.

bug

- This may check for avatar validity, which may take long. Possibly we should do this in a thread.

 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]).

 reply_avatar(+Request)

HTTP handler for Noble Avatar images. Using create_avatar/2 re-creates avatars from the file name, so we can safely discard the avatar file store.

Not really. A new user gets a new avatar and this is based on whether or not the file exists. Probably we should maintain a db of handed out avatars and their last-use time stamp. How to do that? Current swish stats: 400K avatars, 3.2Gb data.

 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                 *******************************/

 chat_broadcast(+Message) is det

 chat_broadcast(+Message, +Channel) is det

Send Message to all known SWISH clients. Message is a valid JSON object, i.e., a dict or option list. When using Redis we send the message to the swish:chat pubsub channel and listening for swish:chat calls chat_broadcast_local/1,2 in each instance.

Arguments:

Channel

- is either an atom or a term Channel/SubChannel, where both Channel and SubChannel are atoms.

 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)).

 subscribed(+Channel, +WSID) is semidet

 subscribed(+Channel, +SubChannel, +WSID) is semidet

Filter used by hub_broadcast/3. WSID is always a locally known web and active socket.

 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).

 send_friends(+WSID, +Message)

Send Message to WSID and all its friends.

 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).

 update_visitors(+Msg) is det

Maintain notion of active users based on broadcasted (re)join and left messages. We sync every 5 minutes to compensate for possible missed users.

 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    ).

 handle_message(+Message, +Room)

Handle incoming messages. This handles messages from our websocket connections, i.e., this does not see messages on other (Redis) instances.

 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]).

 json_message(+Message, +WSID) is det

Process a JSON message translated to a dict. The following messages are understood:

• subscribe channel [subchannel]
• unsubscribe channel [subchannel] Actively (un)subscribe for specific message channels.
• unload A SWISH instance is cleanly being unloaded.
• has-open-files files Executed after initiating the websocket to indicate loaded files.
• set-nick-name name User set nick name for anonymous identoty

 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)).

 forbidden(+Message, +DocID, -Why) is semidet

True if the chat Message about DocID must be forbidden, in which case Why is unified with a string indicating the reason. Currently:

• Demands the user to be logged on
• Limits the size of the message and its payloads

To be done

- Call authorized/2 with all proper identity information.

 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).

 block(+User, +Score, -Cummulative, -Count)

Keep a count and cummulative score for a user.

 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                 *******************************/

 chat_add_user_id(+WSID, +Message0, -Message) is det

Decorate a message with the user credentials.

 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).

 chat_about(+DocID, +Message) is det

Distribute a chat message about DocID.

 1560chat_about(DocID, Message) :-
 1561    chat_relay(Message.put(docid, DocID)).

 chat_relay(+Message) is det

Store and relay a chat message.

 1567chat_relay(Message) :-
 1568    chat_enrich(Message, Message1),
 1569    chat_send(Message1).

 chat_enrich(+Message0, -Message) is det

Add time and identifier to the chat message.

 1575chat_enrich(Message0, Message) :-
 1576    get_time(Now),
 1577    uuid(ID),
 1578    Message = Message0.put(_{time:Now, id:ID}).

 chat_send(+Message)

Relay the chat message Message. If the message has a volatile property it is broadcasted, but not stored.

 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)).

 chat_event(+Event) is semidet

Event happened inside SWISH. Currently triggered events:

updated(+File, +From, +To)

File was updated from hash From to hash To.

profile(+ProfileID)

Session was associated with user with profile ProfileID

logout(+ProfileID)

User logged out. If the login was based on HTTP authentication ProfileID equals http.

 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).