1:- module(jsonrpc_server,[
    2  handle_connection/3,
    3
    4  echo/3,
    5  crash/3,
    6
    7  request_exit_server/1
    8
    9]).   10
   11:- use_module(library(socket)).   12:- use_module(library(prolog_stack)).   13
   14:- use_module(library(log4p)).   15:- use_module('./protocol', except([message_json/2])).   16:- reexport(protocol, [message_json/2]).   17:- reexport('./methods').   18:- reexport('./errors').   19
   20% jsonrpc_server(Server, Port, ServerThreadId)
   21:- dynamic jsonrpc_server/3.   22
   23% jsonrpc_connection(Server, Port, Peer, ServerThreadId)
   24:- dynamic jsonrpc_connection/4.   25
   26handle_connection(ServerName, Peer, StreamPair) :-
   27  mark_server_as_running(ServerName),
   28  handle_messages(ServerName, Peer, StreamPair).
   29
   30handle_messages(ServerName, _Peer, _StreamPair) :-
   31  \+ is_server_running(ServerName), 
   32  info("Exiting server %s", [ServerName]),
   33  !.
   34  
   35handle_messages(ServerName, Peer, StreamPair) :-
   36  debug('handling connection for %w at %w',[Peer, ServerName]),
   37  stream_pair(StreamPair,In,Out),
   38  ( read_message(In, Message) ->
   39    ( 
   40      handle_message(ServerName, Peer,Out,Message)
   41     ) ;
   42    parse_error(Out) ),
   43    handle_messages(ServerName, Peer,StreamPair).
   44
   45handle_message(_, _Peer, Out, Message) :-  
   46  message_json(Message, Json),
   47  debug('handlng message %w',[Json]),
   48  Message.get(jsonrpc) = "2.0" ->
   49    fail ;
   50    invalid_request(Out).
   51
   52handle_message(Server, Peer,Out,Message) :-
   53  is_list(Message)
   54    -> handle_batch(Server, Peer, Out, Message)
   55    ; handle_notification_or_request(Server, Peer, Out, Message).
   56
   57handle_batch(Server, Peer,Out,[Message|Rest]) :-
   58  handle_notification_or_request(Server, Peer, Out, Message),
   59  handle_batch(Server, Peer, Out, Rest).
   60
   61handle_batch(_, _, _ , []).
   62
   63handle_notification_or_request(Server, Peer, Out, Message) :-
   64  Message.get(id) = _Id
   65    -> handle_request(Server, Peer,Out,Message)
   66    ; handle_notification(Server, Peer, Message).
   67
   68handle_request(Server, _Peer, Out, Request) :-
   69  catch_with_backtrace(
   70      dispatch_method(Server, Request.id, Request.method, Request.get(params,_{}), Response),
   71      Exception,
   72      dispatch_exception(Server,Request,Exception,Response)),
   73  write_message(Out,Response),
   74  message_json(Response, Json),
   75  debug('Sent response: %w', [Json]),
   76  !.
   77
   78handle_request(_Server, _Peer, Out, _Request) :-
   79  invalid_request(Out).
   80
   81handle_notification(Server, _Peer, Notification) :-
   82  catch(
   83      dispatch_notification(Server, Notification.method, Notification.params),
   84      Exception,
   85      (
   86        with_output_to(string(Backtrace),
   87          print_message(error, Exception)
   88          ),
   89        warn("Notification %w failed (%w):\nStacktrace\n%w", [Notification.method, Exception, Backtrace])
   90        )
   91    ),
   92  debug("Handled notification %w", [Notification.method]).
   93
   94dispatch_method(Server, Id, MethodName, Params, Response) :-
   95  find_handler(Server, MethodName, Module:Handler),
   96  debug('found handler %w:%w for %w',[Module, Handler, Server]),
   97  apply(Module:Handler,[Server, Params, Result]),
   98  Response = _{id: Id, result: Result },
   99  info("Method %w called", [MethodName]).
  100
  101dispatch_method(Server, Id, MethodName, _Params, _Response) :-
  102  warn("%w: Failed dispatchingr request %w method %w",[Server, Id, MethodName]).
  103
  104dispatch_notification(Server, MethodName, Params) :-
  105  find_handler(Server, MethodName, Module:Handler),
  106  apply(Module:Handler,[Server, Params]),
  107  info("Notification %w called", [MethodName]).
  108
  109dispatch_notification(Server, MethodName, _Params) :-
  110  warn("%w: Failed dispatchingr notification %w",[Server, MethodName]).
  111
  112% simple method to echo parameters; good for testing
  113echo(_Server, Params, Params) :-
  114  info('Echoing %w', [Params]).
  115
  116crash(_Server, Params, Params) :-
  117  warn("Intentionally crashing"),
  118  throw(crash).
  119
  120is_server_running(ServerName) :-
  121  server_running_flag(ServerName, RunningFlag),
  122  get_flag(RunningFlag, true).
  123
  124mark_server_as_running(ServerName) :-
  125  server_running_flag(ServerName, RunningFlag),
  126  set_flag(RunningFlag, true).
  127
  128% Request that the indicated server stop running;
  129% note that this is an asynchronous request and provides
  130% no feedback.
  131request_exit_server(ServerName) :-
  132  server_running_flag(ServerName, RunningFlag),
  133  set_flag(RunningFlag, false).
  134
  135server_running_flag(ServerName, RunningFlag) :-
  136  atom_concat(ServerName, '_running', RunningFlag)