1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2025, SWI-Prolog Solutions b.v. 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(json_rpc_server, 36 [ (json_method)/1, % M1,M2,... 37 json_rpc_dispatch/2, % :Stream, +Options 38 json_rpc_error/2, % +Code, +Message 39 json_rpc_error/3, % +Code, +Message, +Data 40 41 op(1100, fx, json_method) 42 ]). 43:- use_module(library(json_rpc_common)). 44:- autoload(library(json), [json_read_dict/3]). 45:- autoload(library(apply), [maplist/3, include/3]). 46:- autoload(library(error), [must_be/2]). 47:- autoload(library(json_schema), [json_compile_schema/3, json_check/3]). 48:- autoload(library(lists), [append/3]). 49:- autoload(library(prolog_code), [extend_goal/3]). 50:- use_module(library(debug), [debug/3, assertion/1]). 51 52:- meta_predicate 53 json_rpc_dispatch(, ). 54 55:- public 56 json_rpc_dispatch_request/4. % +M, +Stream, +Request, +Options
81 /******************************* 82 * DECLARATIONS * 83 *******************************/
For example:
:- json_method
subtract(#{type:number}, #{type:number}): #{type:number}.
subtract(A, B, R) :- R is A-B.
Methods with named arguments can be implemented using a single
argument that is an object with specified properties. For example,
the program below implements a depositing to a bank account. The
method takes an account and amount parameter and returns the new
balance. The json_rpc_error/2 throws a JSON RPC application error.
:- json_method
deposit(#{ properties:
#{ account: #{type:string},
amount: #{type:number}
}}): #{type:number},
deposit(Request, Reply),
#{account: Account, amount: Amount} :< Request =>
transaction(( retract(account(Account, Old))
-> New is Old+Amount,
asserta(account(Account, New))
; json_rpc_error(2, "Account does not exist")
)),
Reply = New.
131json_method(Methods) :- 132 throw(error(context_error(nodirective, json_method(Methods)), _)). 133 134compile_methods((A,B)) ==> 135 compile_methods(A), 136 compile_methods(B). 137compile_methods(M:Reply), callable(M) ==> 138 { M =.. [Name|Args], 139 argv_type(Args, Type), 140 arg_type(Reply, RType) 141 }, 142 [ '$json_method'(Name, Type, RType) ]. 143compile_methods(M), callable(M) ==> 144 { M =.. [Name|Args], 145 argv_type(Args, Type) 146 }, 147 [ '$json_method'(Name, Type) ]. 148 149argv_type([Named], QType), is_dict(Named) => 150 arg_type(Named.put(type, "object"), Type), 151 QType = named(Type). 152argv_type([Args], Type), is_list(Args) => 153 maplist(arg_type, Args, Types), 154 Type = positional(Types). 155argv_type(Args, Type) => 156 maplist(arg_type, Args, Types), 157 Type = positional(Types). 158 159arg_type(Schema, Type) => 160 json_compile_schema(Schema, Type, []). 161 162:- multifile system:term_expansion/2. 163 164systemterm_expansion((:- json_method(Methods)), Clauses) :- 165 \+ current_prolog_flag(xref, true), 166 phrase(compile_methods(Methods), Clauses0), 167 sort(Clauses0, Clauses). % Avoid the need for discontiguous 168 169 170 /******************************* 171 * DISPATCHING * 172 *******************************/
184json_rpc_dispatch(M:Stream, Options) :- 185 json_rpc_dispatch_1(M, Stream, EOF, Options), 186 ( EOF == true 187 -> true 188 ; json_rpc_dispatch(M:Stream, Options) 189 ). 190 191:- det(json_rpc_dispatch_1/4). 192json_rpc_dispatch_1(M, Stream, EOF, Options) :- 193 Error = error(Formal,_), 194 catch(json_read_dict(Stream, Request, 195 [ end_of_file(end_of_file(true)) 196 | Options 197 ]), 198 Error, 199 true), 200 debug(json_rpc(server), 'Request: ~p', [Request]), 201 ( Request == end_of_file(true) 202 -> EOF = true 203 ; var(Formal) 204 -> json_rpc_dispatch_request(M, Stream, Request, Options) 205 ; print_message(error, Error) 206 ).
214:- meta_predicate 215 with_stream(, ). 216 217json_rpc_dispatch_request(M, Stream, Requests, Options) :- 218 is_list(Requests), 219 !, % batch processing 220 with_stream(Stream, 221 maplist(json_rpc_result_r(M, Options), 222 Requests, AllResults)), 223 include(nonvar, AllResults, Results), 224 json_rpc_reply(Stream, Results, Options). 225json_rpc_dispatch_request(M, Stream, Request, Options) :- 226 with_stream(Stream, json_rpc_result(M, Request, Result, Options)), 227 json_rpc_reply(Stream, Result, Options). 228 229with_stream(Stream, Goal) :- 230 setup_call_cleanup( 231 b_setval(json_rpc_stream, Stream), 232 Goal, 233 nb_delete(json_rpc_stream)).
238json_rpc_reply(Stream, Result, Options), 239 is_dict(Result), 240 Id = Result.get(id) => 241 debug(json_rpc(server), 'Replying ~p for request ~p', [Result,Id]), 242 json_rpc_send(Stream, Result, Options). 243json_rpc_reply(Stream, Results, Options), is_list(Results) => 244 debug(json_rpc(server), 'Replying batch results: ~p', [Results]), 245 json_rpc_send(Stream, Results, Options). 246json_rpc_reply(_Stream, Result, _Options), var(Result) => 247 true. % notification 248 249json_rpc_result(M, Request, Result, Options) :- 250 Error = error(_,_), 251 catch(json_rpc_result_(M, Request, Result, Options), 252 Error, 253 json_exception_to_reply(Error, Request, Result)). 254 255json_rpc_result_r(M, Options, Request, Result) :- 256 json_rpc_result(M, Request, Result, Options). 257 258:- det(json_rpc_result_/4). 259json_rpc_result_(M, Request, Result, Options) :- 260 ( #{jsonrpc: "2.0", method:MethodS} :< Request 261 -> Params = Request.get(params, #{}), 262 atom_string(Method, MethodS), 263 ( Id = Request.get(id) 264 -> json_rpc_result(M, Method, Params, Id, Result, Options) 265 ; json_rpc_notify(M, Method, Params, Options) 266 ) 267 ; Id = Request.get(id) 268 -> Result = #{ jsonrpc: "2.0", 269 id: Id, 270 error: #{code: -32600, 271 message: "Invalid Request"} 272 } 273 ; print_message(error, json_rpc(invalid_request(Request))) 274 ). 275 276json_rpc_result(M, Method, Params0, Id, Reply, Options) :- 277 M:'$json_method'(Method, Types, RType), 278 !, 279 check_params(Params0, Types, Params, Options), 280 debug(json_rpc(server), 'Calling method ~q for request ~p', [Method,Id]), 281 run_method(M:Method, Params, Result), 282 json_check_result(RType, Result, Options), 283 Reply = #{ jsonrpc: "2.0", 284 result: Result, 285 id: Id 286 }. 287json_rpc_result(M, Method, Params0, Id, Reply, Options) :- 288 M:'$json_method'(Method, Types), 289 !, 290 check_params(Params0, Types, Params, Options), 291 debug(json_rpc(server), 'Calling method ~q for request ~p', [Method,Id]), 292 ( apply(M:Method, Params) 293 -> Result = true 294 ; Result = false 295 ), 296 Reply = #{ jsonrpc: "2.0", 297 result: Result, 298 id: Id 299 }. 300json_rpc_result(_M, Method, _Params, Id, Reply, _Options) :- 301 Reply = #{ jsonrpc: "2.0", 302 id: Id, 303 error: #{ code: -32601, 304 message: "Method not found", 305 data: Method 306 } 307 }.
311check_params(#{}, positional([]), Params, _Options) :- 312 !, 313 Params = []. 314check_params(Params, positional(Types), Params, Options) :- 315 must_be(list, Params), 316 maplist(json_check_param(Options), Types, Params), 317 !. 318check_params(Params, positional(Types), _Params, _Options) :- 319 length(Types, Expected), 320 length(Params, Found), 321 format(string(Msg), "Expected ~d parameters, found ~d", 322 [Expected, Found]), 323 raise_param_error_data(Msg). 324check_params(Param, named(Type), [Param], Options) :- 325 json_check_param(Options, Type, Param). 326 327json_rpc_notify(M, Method, Params0, Options) :- 328 M:'$json_method'(Method, Types), 329 !, 330 check_params(Params0, Types, Params, Options), 331 apply(M:Method, Params). 332json_rpc_notify(M, Method, Params0, Options) :- 333 M:'$json_method'(Method, Types, _RType), 334 !, 335 check_params(Params0, Types, Params, Options), 336 run_method(M:Method, Params, _Result). 337json_rpc_notify(M, Method, Params0, _Options) :- 338 print_message(warning, 339 json_rpc(not_implemented(M:Method, Params0))).
id field. Else it is a notification, so we simply print the
message in the server.347:- det(json_exception_to_reply/3). 348json_exception_to_reply(error(json_rpc_error(Dict),_), Request, Reply), 349 Id = Request.get(id) => 350 assertion(#{code:_, message:_} :< Dict), 351 Reply = #{ jsonrpc: "2.0", 352 id: Id, 353 error: Dict 354 }. 355json_exception_to_reply(Error, Request, Reply), 356 Id = Request.get(id) => 357 message_to_string(Error, Msg), 358 Reply = #{ jsonrpc: "2.0", 359 id: Id, 360 error: #{ code: -32603, 361 message: "Internal error", 362 data: Msg} 363 }. 364json_exception_to_reply(Error, _Request, _Reply) => 365 print_message(error, Error). 366 367json_check_param(Option, Schema, Data) :- 368 catch(json_check(Schema, Data, Option), 369 Error, 370 raise_param_error(Error)). 371 372raise_param_error(Error) :- 373 message_to_string(Error, Msg), 374 raise_param_error_data(Msg). 375 376raise_param_error_data(Msg) :- 377 throw(error(json_rpc_error(#{ code: -32602, 378 message: "Invalid params", 379 data: Msg 380 }), 381 _)). 382 383json_check_result(Schema, Data, Options) :- 384 catch(json_check(Schema, Data, Options), 385 Error, 386 raise_result_error(Error)). 387 388raise_result_error(Error) :- 389 message_to_string(Error, Msg), 390 throw(error(json_rpc_error(#{ code: -32000, 391 message: "Invalid return", 392 data: Msg 393 }), 394 _)). 395 396run_method(Method, Params, Result) :- 397 append(Params, [Result], Args), 398 Error = error(_,_), 399 ( catch(apply(Method, Args), Error, 400 raise_run_error(Error)) 401 -> true 402 ; throw(error(json_rpc_error(#{ code: -32002, 403 message: "Execution failed" 404 }), 405 _)) 406 ).
414raise_run_error(Error), 415 Error = error(json_rpc_error(_),_) => 416 throw(Error). 417raise_run_error(Error) => 418 message_to_string(Error, Msg), 419 throw(error(json_rpc_error(#{ code: -32001, 420 message: "Execution error", 421 data: Msg 422 }), 423 _)).
439json_rpc_error(Code, Message) :- 440 throw(error(json_rpc_error(#{ code: Code, 441 message: Message 442 }), 443 _)). 444json_rpc_error(Code, Message, Data) :- 445 throw(error(json_rpc_error(#{ code: Code, 446 message: Message, 447 data: Data 448 }), 449 _)). 450 451 452 /******************************* 453 * IDE * 454 *******************************/ 455 456:- multifile 457 prolog_colour:directive_colours/2, 458 prolog:called_by/4. 459 460prolog_colourdirective_colours(json_method(Decl), 461 expanded-[Colour]) :- 462 decl_colours(Decl, Colour). 463 464decl_colours((A,B), Colour) => 465 Colour = punctuation-[CA, CB], 466 decl_colours(A, CA), 467 decl_colours(B, CB). 468decl_colours(Head:_Type, Colour) => 469 extend_goal(Head, [_Ret], ExHead), 470 Colour = punctuation-[body(ExHead),classify]. 471decl_colours(Head, Colour), callable(Head) => 472 Colour = body. 473decl_colours(_Error, Colour) => 474 Colour = error(method_expected). 475 476prologcalled_by(json_method(Decl), _M, _C, Called) :- 477 phrase(json_rpc_called_by(Decl), Called). 478 479json_rpc_called_by((A,B)) ==> 480 json_rpc_called_by(A), 481 json_rpc_called_by(B). 482json_rpc_called_by(Head:_Type) ==> 483 { extend_goal(Head, [_Ret], ExHead) 484 }, 485 [ExHead]. 486json_rpc_called_by(Head), callable(Head) ==> 487 [Head]. 488json_rpc_called_by(_) ==> 489 []
JSON RPC Server
This module implements an JSON RPC server. It provides declarations that bind Prolog predicates to JSON RPC methods and a dispatch loop that acts on a bi-directional stream. This module assumes a two-directional stream and provides json_rpc_dispatch/2 that receiveds JSON messages on the input side of this stream and sends the replies through the output. This module does not implement obtaining such a stream. Obvious candidates for obtaining a stream are:
This library defines json_method/1 for declaring predicates to act as a JSON method. The declaration accepts a JSON Schema specification, represented as a SWI-Prolog dict to specify the input parameters as well as the output.