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:- autoload(library(json), 44 [json_read_dict/3, json_write_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), Clauses). 167 168 169 /******************************* 170 * DISPATCHING * 171 *******************************/
183json_rpc_dispatch(M:Stream, Options) :- 184 json_rpc_dispatch_1(M, Stream, EOF, Options), 185 ( EOF == true 186 -> true 187 ; json_rpc_dispatch(M:Stream, Options) 188 ). 189 190:- det(json_rpc_dispatch_1/4). 191json_rpc_dispatch_1(M, Stream, EOF, Options) :- 192 Error = error(Formal,_), 193 catch(json_read_dict(Stream, Request, 194 [ end_of_file(end_of_file(true)) 195 | Options 196 ]), 197 Error, 198 true), 199 debug(json_rpc(server), 'Request: ~p', [Request]), 200 ( Request == end_of_file(true) 201 -> EOF = true 202 ; var(Formal) 203 -> json_rpc_dispatch_request(M, Stream, Request, Options) 204 ; print_message(error, Error) 205 ).
213json_rpc_dispatch_request(M, Stream, Requests, Options) :- 214 is_list(Requests), 215 !, % batch processing 216 maplist(json_rpc_result_r(M, Options), Requests, AllResults), 217 include(nonvar, AllResults, Results), 218 json_rpc_reply(Stream, Results, Options). 219json_rpc_dispatch_request(M, Stream, Request, Options) :- 220 json_rpc_result(M, Request, Result, Options), 221 json_rpc_reply(Stream, Result, Options).
225json_rpc_reply(Stream, Result, Options), 226 is_dict(Result), 227 Id = Result.get(id) => 228 debug(json_rpc(server), 'Replying ~p for request ~p', [Result,Id]), 229 with_output_to(Stream, json_write_dict(Stream, Result, Options)), 230 flush_output(Stream). 231json_rpc_reply(Stream, Results, Options), is_list(Results) => 232 debug(json_rpc(server), 'Replying batch results: ~p', [Results]), 233 with_output_to(Stream, json_write_dict(Stream, Results, Options)), 234 flush_output(Stream). 235json_rpc_reply(_Stream, Result, _Options), var(Result) => 236 true. % notification 237 238json_rpc_result(M, Request, Result, Options) :- 239 Error = error(_,_), 240 catch(json_rpc_result_(M, Request, Result, Options), 241 Error, 242 json_exception_to_reply(Error, Request, Result)). 243 244json_rpc_result_r(M, Options, Request, Result) :- 245 json_rpc_result(M, Request, Result, Options). 246 247:- det(json_rpc_result_/4). 248json_rpc_result_(M, Request, Result, Options) :- 249 ( #{jsonrpc: "2.0", method:MethodS, params:Params} :< Request 250 -> atom_string(Method, MethodS), 251 ( Id = Request.get(id) 252 -> json_rpc_result(M, Method, Params, Id, Result, Options) 253 ; json_rpc_notify(M, Method, Params, Options) 254 ) 255 ; Id = Request.get(id) 256 -> Result = #{ jsonrpc: "2.0", 257 id: Id, 258 error: #{code: -32600, 259 message: "Invalid Request"} 260 } 261 ; print_message(error, json_rpc(invalid_request(Request))) 262 ). 263 264json_rpc_result(M, Method, Params0, Id, Reply, Options) :- 265 M:'$json_method'(Method, Types, RType), 266 !, 267 check_params(Params0, Types, Params, Options), 268 debug(json_rpc(server), 'Calling method ~q for request ~p', [Method,Id]), 269 run_method(M:Method, Params, Result), 270 json_check_result(RType, Result, Options), 271 Reply = #{ jsonrpc: "2.0", 272 result: Result, 273 id: Id 274 }. 275json_rpc_result(M, Method, Params0, Id, Reply, Options) :- 276 M:'$json_method'(Method, Types), 277 !, 278 check_params(Params0, Types, Params, Options), 279 debug(json_rpc(server), 'Calling method ~q for request ~p', [Method,Id]), 280 ( apply(M:Method, Params) 281 -> Result = true 282 ; Result = false 283 ), 284 Reply = #{ jsonrpc: "2.0", 285 result: Result, 286 id: Id 287 }. 288json_rpc_result(_M, Method, _Params, Id, Reply, _Options) :- 289 Reply = #{ jsonrpc: "2.0", 290 id: Id, 291 error: #{ code: -32601, 292 message: "Method not found", 293 data: Method 294 } 295 }. 296 297check_params(Params, positional(Types), Params, Options) :- 298 must_be(list, Params), 299 maplist(json_check_param(Options), Types, Params), 300 !. 301check_params(Params, positional(Types), _Params, _Options) :- 302 length(Types, Expected), 303 length(Params, Found), 304 format(string(Msg), "Expected ~d parameters, found ~d", [Expected, Found]), 305 raise_param_error_data(Msg). 306check_params(Param, named(Type), [Param], Options) :- 307 json_check_param(Options, Type, Param). 308 309json_rpc_notify(M, Method, Params0, Options) :- 310 M:'$json_method'(Method, Types), 311 !, 312 check_params(Params0, Types, Params, Options), 313 apply(M:Method, Params). 314json_rpc_notify(M, Method, Params0, Options) :- 315 M:'$json_method'(Method, Types, _RType), 316 !, 317 check_params(Params0, Types, Params, Options), 318 run_method(M:Method, Params, _Result).
id field. Else it is a notification, so we simply print the
message in the server.326:- det(json_exception_to_reply/3). 327json_exception_to_reply(error(json_rpc_error(Dict),_), Request, Reply), 328 Id = Request.get(id) => 329 assertion(#{code:_, message:_} :< Dict), 330 Reply = #{ jsonrpc: "2.0", 331 id: Id, 332 error: Dict 333 }. 334json_exception_to_reply(Error, Request, Reply), 335 Id = Request.get(id) => 336 message_to_string(Error, Msg), 337 Reply = #{ jsonrpc: "2.0", 338 id: Id, 339 error: #{ code: -32603, 340 message: "Internal error", 341 data: Msg} 342 }. 343json_exception_to_reply(Error, _Request, _Reply) => 344 print_message(error, Error). 345 346json_check_param(Option, Schema, Data) :- 347 catch(json_check(Schema, Data, Option), 348 Error, 349 raise_param_error(Error)). 350 351raise_param_error(Error) :- 352 message_to_string(Error, Msg), 353 raise_param_error_data(Msg). 354 355raise_param_error_data(Msg) :- 356 throw(error(json_rpc_error(#{ code: -32602, 357 message: "Invalid params", 358 data: Msg 359 }), 360 _)). 361 362json_check_result(Schema, Data, Options) :- 363 catch(json_check(Schema, Data, Options), 364 Error, 365 raise_result_error(Error)). 366 367raise_result_error(Error) :- 368 message_to_string(Error, Msg), 369 throw(error(json_rpc_error(#{ code: -32000, 370 message: "Invalid return", 371 data: Msg 372 }), 373 _)). 374 375run_method(Method, Params, Result) :- 376 append(Params, [Result], Args), 377 Error = error(_,_), 378 ( catch(apply(Method, Args), Error, 379 raise_run_error(Error)) 380 -> true 381 ; throw(error(json_rpc_error(#{ code: -32002, 382 message: "Execution failed" 383 }), 384 _)) 385 ).
393raise_run_error(Error), 394 Error = error(json_rpc_error(_),_) => 395 throw(Error). 396raise_run_error(Error) => 397 message_to_string(Error, Msg), 398 throw(error(json_rpc_error(#{ code: -32001, 399 message: "Execution error", 400 data: Msg 401 }), 402 _)).
418json_rpc_error(Code, Message) :- 419 throw(error(json_rpc_error(#{ code: Code, 420 message: Message 421 }), 422 _)). 423json_rpc_error(Code, Message, Data) :- 424 throw(error(json_rpc_error(#{ code: Code, 425 message: Message, 426 data: Data 427 }), 428 _)). 429 430 431 /******************************* 432 * MESSAGES * 433 *******************************/ 434 435:- multifile prolog:error_message//1. 436 437prologerror_message(json_rpc_error(Obj)) --> 438 { is_dict(Obj) }, 439 json_rpc_error_message(Obj). 440 441json_rpc_error_message(Obj), 442 Data = Obj.get(Data) ==> 443 json_rpc_error_message_(Obj), 444 [ nl, ' Data: ~p'-[Data] ]. 445json_rpc_error_message(Obj) ==> 446 json_rpc_error_message_(Obj). 447 448json_rpc_error_message_(Obj), 449 #{code:Code, message:Message} :< Obj, 450 between(-32768, -32000, Code) ==> 451 [ 'JSON RPC error ~d: ~s'-[Code, Message] ]. 452json_rpc_error_message_(Obj), 453 #{code:Code, message:Message} :< Obj ==> 454 [ 'JSON RPC application error ~d: ~s'-[Code, Message] ]. 455 456 /******************************* 457 * IDE * 458 *******************************/ 459 460:- multifile 461 prolog_colour:directive_colours/2, 462 prolog:called_by/4. 463 464prolog_colourdirective_colours(json_method(Decl), 465 expanded-[Colour]) :- 466 decl_colours(Decl, Colour). 467 468decl_colours((A,B), Colour) => 469 Colour = punctuation-[CA, CB], 470 decl_colours(A, CA), 471 decl_colours(B, CB). 472decl_colours(Head:_Type, Colour) => 473 extend_goal(Head, [_Ret], ExHead), 474 Colour = punctuation-[body(ExHead),classify]. 475decl_colours(Head, Colour), callable(Head) => 476 Colour = body. 477decl_colours(_Error, Colour) => 478 Colour = error(method_expected). 479 480prologcalled_by(json_method(Decl), _M, _C, Called) :- 481 phrase(json_rpc_called_by(Decl), Called). 482 483json_rpc_called_by((A,B)) ==> 484 json_rpc_called_by(A), 485 json_rpc_called_by(B). 486json_rpc_called_by(Head:_Type) ==> 487 { extend_goal(Head, [_Ret], ExHead) 488 }, 489 [ExHead]. 490json_rpc_called_by(Head), callable(Head) ==> 491 [Head]. 492json_rpc_called_by(_) ==> 493 []
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.