1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2007-2025, University of Amsterdam 7 VU University 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(http_json, 38 [ reply_json/1, % +JSON 39 reply_json/2, % +JSON, Options 40 reply_json_dict/1, % +JSON 41 reply_json_dict/2, % +JSON, Options 42 http_read_json/2, % +Request, -JSON 43 http_read_json/3, % +Request, -JSON, +Options 44 http_read_json_dict/2, % +Request, -Dict 45 http_read_json_dict/3, % +Request, -Dict, +Options 46 47 is_json_content_type/1 % +HeaderValue 48 ]). 49:- use_module(library(http/http_client)). 50:- use_module(library(http/http_header)). 51:- use_module(library(http/http_stream)). 52:- use_module(library(json)). 53:- use_module(library(option)). 54:- use_module(library(error)). 55:- use_module(library(lists)). 56:- use_module(library(memfile)). 57 58:- multifile 59 http_client:http_convert_data/4, 60 http:post_data_hook/3, 61 json_type/1. 62 63:- public 64 json_type/1. 65 66:- predicate_options(http_read_json/3, 3, 67 [ content_type(any), 68 false(ground), 69 null(ground), 70 true(ground), 71 value_string_as(oneof([atom, string])), 72 json_object(oneof([term,dict])) 73 ]). 74:- predicate_options(reply_json/2, 2, 75 [ content_type(any), 76 status(integer), 77 json_object(oneof([term,dict])), 78 pass_to(json:json_write/3, 3) 79 ]).

HTTP JSON Plugin module

Most code doesn't need to use this directly; instead use library(http/http_server), which combines this library with the typical HTTP libraries that most servers need.

This module adds hooks to several parts of the HTTP libraries, making them JSON-aware. Notably:

Make http_read_data/3 convert application/json and application/jsonrequest content to a JSON term.
Cause http_open/3 to accept post(json(Term)) to issue a POST request with JSON content.
Provide HTTP server and client utility predicates for reading and replying JSON:
Reply to exceptions in the server using an JSON document rather then HTML if the Accept header prefers application/json over text/html.

Typically JSON is used by Prolog HTTP servers. This module supports two JSON representations: the classical representation and the new representation supported by the SWI-Prolog version 7 extended data types. Below is a skeleton for handling a JSON request, answering in JSON using the classical interface.

handle(Request) :-
      http_read_json(Request, JSONIn),
      json_to_prolog(JSONIn, PrologIn),
      <compute>(PrologIn, PrologOut),         % application body
      prolog_to_json(PrologOut, JSONOut),
      reply_json(JSONOut).

When using dicts, the conversion step is generally not needed and the code becomes:

handle(Request) :-
      http_read_json_dict(Request, DictIn),
      <compute>(DictIn, DictOut),
      reply_json(DictOut).

This module also integrates JSON support into the http client provided by http_client.pl. Posting a JSON query and processing the JSON reply (or any other reply understood by http_read_data/3) is as simple as below, where Term is a JSON term as described in json.pl and reply is of the same format if the server replies with JSON.

      ...,
      http_post(URL, json(Term), Reply, [])

See also: - JSON Requests are discussed in http://json.org/JSONRequest.html; - json.pl describes how JSON objects are represented in Prolog terms.; - json_convert.pl converts between more natural Prolog terms and json terms. */

160http_client:http_convert_data(In, Fields, Data, Options) :- 161 memberchk(content_type(Type), Fields), 162 is_json_content_type(Type), 163 !, 164 ( memberchk(content_length(Bytes), Fields) 165 -> setup_call_cleanup( 166 ( stream_range_open(In, Range, [size(Bytes)]), 167 set_stream(Range, encoding(utf8)) 168 ), 169 json_read_to(Range, Data, Options), 170 close(Range)) 171 ; set_stream(In, encoding(utf8)), 172 json_read_to(In, Data, Options) 173 ).

181is_json_content_type(String) :- 182 http_parse_header_value(content_type, String, 183 media(Type, _Attributes)), 184 json_type(Type), 185 !. 186 187json_read_to(In, Data, Options) :- 188 memberchk(json_object(dict), Options), 189 !, 190 json_read_dict(In, Data, Options). 191json_read_to(In, Data, Options) :- 192 json_read(In, Data, Options).

226http:post_data_hook(json(Dict), Out, HdrExtra) :- 227 is_dict(Dict), 228 !, 229 http:post_data_hook(json(Dict, [json_object(dict)]), 230 Out, HdrExtra). 231http:post_data_hook(json(Term), Out, HdrExtra) :- 232 http:post_data_hook(json(Term, []), Out, HdrExtra). 233http:post_data_hook(json(Term, Options), Out, HdrExtra) :- 234 option(content_type(Type), HdrExtra, 'application/json'), 235 setup_call_cleanup( 236 ( new_memory_file(MemFile), 237 open_memory_file(MemFile, write, Handle) 238 ), 239 ( format(Handle, 'Content-type: ~w~n~n', [Type]), 240 json_write_to(Handle, Term, Options) 241 ), 242 close(Handle)), 243 setup_call_cleanup( 244 open_memory_file(MemFile, read, RdHandle, 245 [ free_on_close(true) 246 ]), 247 http_post_data(cgi_stream(RdHandle), Out, HdrExtra), 248 close(RdHandle)). 249 250json_write_to(Out, Term, Options) :- 251 memberchk(json_object(dict), Options), 252 !, 253 json_write_dict(Out, Term, Options). 254json_write_to(Out, Term, Options) :- 255 json_write(Out, Term, Options).

274http_read_json(Request, JSON) :- 275 http_read_json(Request, JSON, []). 276 277http_read_json(Request, JSON, Options) :- 278 select_option(content_type(Type), Options, Rest), 279 !, 280 delete(Request, content_type(_), Request2), 281 request_to_json([content_type(Type)|Request2], JSON, Rest). 282http_read_json(Request, JSON, Options) :- 283 request_to_json(Request, JSON, Options). 284 285request_to_json(Request, JSON, Options) :- 286 option(method(Method), Request), 287 option(content_type(Type), Request), 288 ( data_method(Method) 289 -> true 290 ; domain_error(method, Method) 291 ), 292 ( is_json_content_type(Type) 293 -> true 294 ; domain_error(mimetype, Type) 295 ), 296 http_read_data(Request, JSON, Options). 297 298data_method(post). 299data_method(put). 300data_method(patch).

308http_read_json_dict(Request, Dict) :- 309 http_read_json_dict(Request, Dict, []). 310 311http_read_json_dict(Request, Dict, Options) :- 312 merge_options([json_object(dict)], Options, Options1), 313 http_read_json(Request, Dict, Options1).

337reply_json(Dict) :- 338 is_dict(Dict), 339 !, 340 reply_json_dict(Dict). 341reply_json(Term) :- 342 default_json_content_type(Type), 343 format('Content-type: ~w~n~n', [Type]), 344 json_write(current_output, Term). 345 346reply_json(Dict, Options) :- 347 is_dict(Dict), 348 !, 349 reply_json_dict(Dict, Options). 350reply_json(Term, Options) :- 351 reply_json2(Term, Options).

362reply_json_dict(Dict) :- 363 default_json_content_type(Type), 364 format('Content-type: ~w~n~n', [Type]), 365 json_write_dict(current_output, Dict). 366 367reply_json_dict(Dict, Options) :- 368 merge_options([json_object(dict)], Options, Options1), 369 reply_json2(Dict, Options1). 370 371reply_json2(Term, Options) :- 372 default_json_content_type(DefType), 373 select_option(content_type(Type), Options, Rest0, DefType), 374 ( select_option(status(Code), Rest0, Rest) 375 -> format('Status: ~d~n', [Code]) 376 ; Rest = Rest0 377 ), 378 format('Content-type: ~w~n~n', [Type]), 379 json_write_to(current_output, Term, Rest). 380 381default_json_content_type('application/json; charset=UTF-8'). 382 383 384 /******************************* 385 * STATUS HANDLING * 386 *******************************/ 387 388:- multifile 389 http:status_reply/3, 390 http:serialize_reply/2. 391 392http:serialize_reply(json(Term), body(application/json, utf8, Content)) :- 393 with_output_to(string(Content), 394 json_write_dict(current_output, Term, [])). 395 396http:status_reply(Term, json(Reply), Options) :- 397 prefer_json(Options.get(accept)), 398 json_status_reply(Term, Lines, Extra), 399 phrase(txt_message_lines(Lines), Codes), 400 string_codes(Message, Codes), 401 Reply = _{code:Options.code, message:Message}.put(Extra). 402 403txt_message_lines([]) --> 404 []. 405txt_message_lines([nl|T]) --> 406 !, 407 "\n", 408 txt_message_lines(T). 409txt_message_lines([flush]) --> 410 !. 411txt_message_lines([FmtArgs|T]) --> 412 dcg_format(FmtArgs), 413 txt_message_lines(T). 414 415dcg_format(Fmt-Args, List, Tail) :- 416 !, 417 format(codes(List,Tail), Fmt, Args). 418dcg_format(ansi(_Style, Fmt,Args), List, Tail) :- 419 !, 420 format(codes(List,Tail), Fmt, Args). 421dcg_format(url(Pos), List, Tail) :- 422 !, 423 dcg_url(Pos, List, Tail). 424dcg_format(url(_URL, Label), List, Tail) :- 425 !, 426 format(codes(List,Tail), '~w', [Label]). 427dcg_format(Fmt, List, Tail) :- 428 format(codes(List,Tail), Fmt, []). 429 430dcg_url(File:Line:Column, List, Tail) :- 431 !, 432 format(codes(List,Tail), '~w:~d:~d', [File, Line, Column]). 433dcg_url(File:Line, List, Tail) :- 434 !, 435 format(codes(List,Tail), '~w:~d', [File, Line]). 436dcg_url(File, List, Tail) :- 437 !, 438 format(codes(List,Tail), '~w', [File]).

445prefer_json(Accept) :- 446 memberchk(media(application/json, _, JSONP, []), Accept), 447 ( member(media(text/html, _, HTMLP, []), Accept) 448 -> JSONP > HTMLP 449 ; true 450 ).

454json_status_reply(created(Location), 455 [ 'Created: ~w'-[Location] ], 456 _{location:Location}). 457json_status_reply(moved(Location), 458 [ 'Moved to: ~w'-[Location] ], 459 _{location:Location}). 460json_status_reply(moved_temporary(Location), 461 [ 'Moved temporary to: ~w'-[Location] ], 462 _{location:Location}). 463json_status_reply(see_other(Location), 464 [ 'See: ~w'-[Location] ], 465 _{location:Location}). 466json_status_reply(bad_request(ErrorTerm), Lines, _{}) :- 467 '$messages':translate_message(ErrorTerm, Lines, []). 468json_status_reply(authorise(Method), 469 [ 'Authorization (~p) required'-[Method] ], 470 _{}). 471json_status_reply(forbidden(Location), 472 [ 'You have no permission to access: ~w'-[Location] ], 473 _{location:Location}). 474json_status_reply(not_found(Location), 475 [ 'Path not found: ~w'-[Location] ], 476 _{location:Location}). 477json_status_reply(method_not_allowed(Method,Location), 478 [ 'Method not allowed: ~w'-[UMethod] ], 479 _{location:Location, method:UMethod}) :- 480 upcase_atom(Method, UMethod). 481json_status_reply(not_acceptable(Why), 482 [ 'Request is not acceptable: ~p'-[Why] 483 ], 484 _{}). 485json_status_reply(server_error(ErrorTerm), Lines, _{}) :- 486 '$messages':translate_message(ErrorTerm, Lines, []). 487json_status_reply(service_unavailable(Why), 488 [ 'Service unavailable: ~p'-[Why] 489 ], 490 _{})