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

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

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

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

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

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

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

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

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

439prefer_json(Accept) :- 440 memberchk(media(application/json, _, JSONP, []), Accept), 441 ( member(media(text/html, _, HTMLP, []), Accept) 442 -> JSONP > HTMLP 443 ; true 444 ).

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