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
21:- dynamic jsonrpc_server/3. 22
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
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
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)