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-2018, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(http_json, 37 [ reply_json/1, % +JSON 38 reply_json/2, % +JSON, Options 39 reply_json_dict/1, % +JSON 40 reply_json_dict/2, % +JSON, Options 41 http_read_json/2, % +Request, -JSON 42 http_read_json/3, % +Request, -JSON, +Options 43 http_read_json_dict/2, % +Request, -Dict 44 http_read_json_dict/3, % +Request, -Dict, +Options 45 46 is_json_content_type/1 % +HeaderValue 47 ]). 48:- use_module(library(http/http_client)). 49:- use_module(library(http/http_header)). 50:- use_module(library(http/http_stream)). 51:- use_module(library(http/json)). 52:- use_module(library(option)). 53:- use_module(library(error)). 54:- use_module(library(lists)). 55:- use_module(library(memfile)). 56 57:- multifile 58 http_client:http_convert_data/4, 59 http:post_data_hook/3, 60 json_type/1. 61 62:- public 63 json_type/1. 64 65:- predicate_options(http_read_json/3, 3, 66 [ content_type(any), 67 false(ground), 68 null(ground), 69 true(ground), 70 value_string_as(oneof([atom, string])), 71 json_object(oneof([term,dict])) 72 ]). 73:- predicate_options(reply_json/2, 2, 74 [ content_type(any), 75 status(integer), 76 json_object(oneof([term,dict])), 77 pass_to(json:json_write/3, 3) 78 ]).

HTTP JSON Plugin module

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. */

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

176is_json_content_type(String) :- 177 http_parse_header_value(content_type, String, 178 media(Type, _Attributes)), 179 json_type(Type), 180 !. 181 182json_read_to(In, Data, Options) :- 183 memberchk(json_object(dict), Options), 184 !, 185 json_read_dict(In, Data, Options). 186json_read_to(In, Data, Options) :- 187 json_read(In, Data, Options).

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

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

303http_read_json_dict(Request, Dict) :- 304 http_read_json_dict(Request, Dict, []). 305 306http_read_json_dict(Request, Dict, Options) :- 307 merge_options([json_object(dict)], Options, Options1), 308 http_read_json(Request, Dict, Options1).

332reply_json(Dict) :- 333 is_dict(Dict), 334 !, 335 reply_json_dict(Dict). 336reply_json(Term) :- 337 format('Content-type: application/json; charset=UTF-8~n~n'), 338 json_write(current_output, Term). 339 340reply_json(Dict, Options) :- 341 is_dict(Dict), 342 !, 343 reply_json_dict(Dict, Options). 344reply_json(Term, Options) :- 345 reply_json2(Term, Options).

356reply_json_dict(Dict) :- 357 format('Content-type: application/json; charset=UTF-8~n~n'), 358 json_write_dict(current_output, Dict). 359 360reply_json_dict(Dict, Options) :- 361 merge_options([json_object(dict)], Options, Options1), 362 reply_json2(Dict, Options1). 363 364reply_json2(Term, Options) :- 365 select_option(content_type(Type), Options, Rest0, 'application/json'), 366 ( select_option(status(Code), Rest0, Rest) 367 -> format('Status: ~d~n', [Code]) 368 ; Rest = Rest0 369 ), 370 format('Content-type: ~w~n~n', [Type]), 371 json_write_to(current_output, Term, Rest). 372 373 374 /******************************* 375 * STATUS HANDLING * 376 *******************************/ 377 378:- multifile 379 http:status_reply/3, 380 http:serialize_reply/2. 381 382http:serialize_reply(json(Term), body(application/json, utf8, Content)) :- 383 with_output_to(string(Content), 384 json_write_dict(current_output, Term, [])). 385 386http:status_reply(Term, json(Reply), Options) :- 387 prefer_json(Options.get(accept)), 388 json_status_reply(Term, Lines, Extra), 389 phrase(txt_message_lines(Lines), Codes), 390 string_codes(Message, Codes), 391 Reply = _{code:Options.code, message:Message}.put(Extra). 392 393txt_message_lines([]) --> 394 []. 395txt_message_lines([nl|T]) --> 396 !, 397 "\n", 398 txt_message_lines(T). 399txt_message_lines([flush]) --> 400 !. 401txt_message_lines([FmtArgs|T]) --> 402 dcg_format(FmtArgs), 403 txt_message_lines(T). 404 405dcg_format(Fmt-Args, List, Tail) :- 406 !, 407 format(codes(List,Tail), Fmt, Args). 408dcg_format(Fmt, List, Tail) :- 409 format(codes(List,Tail), Fmt, []).

415prefer_json(Accept) :- 416 memberchk(media(application/json, _, JSONP, []), Accept), 417 ( member(media(text/html, _, HTMLP, []), Accept) 418 -> JSONP > HTMLP 419 ; true 420 ).

424json_status_reply(created(Location), 425 [ 'Created: ~w'-[Location] ], 426 _{location:Location}). 427json_status_reply(moved(Location), 428 [ 'Moved to: ~w'-[Location] ], 429 _{location:Location}). 430json_status_reply(moved_temporary(Location), 431 [ 'Moved temporary to: ~w'-[Location] ], 432 _{location:Location}). 433json_status_reply(see_other(Location), 434 [ 'See: ~w'-[Location] ], 435 _{location:Location}). 436json_status_reply(bad_request(ErrorTerm), Lines, _{}) :- 437 '$messages':translate_message(ErrorTerm, Lines, []). 438json_status_reply(authorise(Method), 439 [ 'Authorization (~p) required'-[Method] ], 440 _{}). 441json_status_reply(forbidden(Location), 442 [ 'You have no permission to access: ~w'-[Location] ], 443 _{location:Location}). 444json_status_reply(not_found(Location), 445 [ 'Path not found: ~w'-[Location] ], 446 _{location:Location}). 447json_status_reply(method_not_allowed(Method,Location), 448 [ 'Method not allowed: ~w'-[UMethod] ], 449 _{location:Location, method:UMethod}) :- 450 upcase_atom(Method, UMethod). 451json_status_reply(not_acceptable(Why), 452 [ 'Request is not aceptable: ~p'-[Why] 453 ], 454 _{}). 455json_status_reply(server_error(ErrorTerm), Lines, _{}) :- 456 '$messages':translate_message(ErrorTerm, Lines, []). 457json_status_reply(service_unavailable(Why), 458 [ 'Service unavailable: ~p'-[Why] 459 ], 460 _{})