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 default_json_content_type(Type), 342 format('Content-type: ~w~n~n', [Type]), 343 json_write(current_output, Term). 344 345reply_json(Dict, Options) :- 346 is_dict(Dict), 347 !, 348 reply_json_dict(Dict, Options). 349reply_json(Term, Options) :- 350 reply_json2(Term, Options).

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

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

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