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 ]). 79 80 81/** <module> HTTP JSON Plugin module 82 83Most code doesn't need to use this directly; instead use 84library(http/http_server), which combines this library with the 85typical HTTP libraries that most servers need. 86 87This module adds hooks to several parts of the HTTP libraries, making 88them JSON-aware. Notably: 89 90 - Make http_read_data/3 convert `application/json` and 91 `application/jsonrequest` content to a JSON term. 92 - Cause http_open/3 to accept post(json(Term)) to issue a POST 93 request with JSON content. 94 - Provide HTTP server and client utility predicates for reading 95 and replying JSON: 96 - http_read_json/2 97 - http_read_json/3 98 - http_read_json_dict/2 99 - http_read_json_dict/3 100 - reply_json/1 101 - reply_json/2 102 - reply_json_dict/1 103 - reply_json_dict/2 104 - Reply to exceptions in the server using an JSON document rather 105 then HTML if the =|Accept|= header prefers application/json over 106 text/html. 107 108Typically JSON is used by Prolog HTTP servers. This module supports two 109JSON representations: the classical representation and the new 110representation supported by the SWI-Prolog version 7 extended data 111types. Below is a skeleton for handling a JSON request, answering in 112JSON using the classical interface. 113 114 == 115 handle(Request) :- 116 http_read_json(Request, JSONIn), 117 json_to_prolog(JSONIn, PrologIn), 118 <compute>(PrologIn, PrologOut), % application body 119 prolog_to_json(PrologOut, JSONOut), 120 reply_json(JSONOut). 121 == 122 123When using dicts, the conversion step is generally not needed and the 124code becomes: 125 126 == 127 handle(Request) :- 128 http_read_json_dict(Request, DictIn), 129 <compute>(DictIn, DictOut), 130 reply_json(DictOut). 131 == 132 133This module also integrates JSON support into the http client provided 134by http_client.pl. Posting a JSON query and processing the JSON reply 135(or any other reply understood by http_read_data/3) is as simple as 136below, where Term is a JSON term as described in json.pl and reply is of 137the same format if the server replies with JSON. 138 139 == 140 ..., 141 http_post(URL, json(Term), Reply, []) 142 == 143 144@see JSON Requests are discussed in http://json.org/JSONRequest.html 145@see json.pl describes how JSON objects are represented in Prolog terms. 146@see json_convert.pl converts between more natural Prolog terms and json 147terms. 148*/ 149 150%! http_client:http_convert_data(+In, +Fields, -Data, +Options) 151% 152% Hook implementation that supports reading JSON documents. It 153% processes the following option: 154% 155% * json_object(+As) 156% Where As is one of =term= or =dict=. If the value is =dict=, 157% json_read_dict/3 is used. 158 159http_clienthttp_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 ). 173 174 175%! is_json_content_type(+ContentType) is semidet. 176% 177% True if ContentType is a header value (either parsed or as 178% atom/string) that denotes a JSON value. 179 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). 192 193%! json_type(?MediaType) is semidet. 194% 195% True if MediaType is a JSON media type. http_json:json_type/1 is 196% a multifile predicate and may be extended to facilitate 197% non-conforming clients. 198% 199% @arg MediaType is a term `Type`/`SubType`, where both `Type` and 200% `SubType` are atoms. 201 202json_type(application/jsonrequest). 203json_type(application/json). 204 205 206%! http:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet. 207% 208% Hook implementation that allows http_post_data/3 posting JSON 209% objects using one of the forms below. 210% 211% == 212% http_post(URL, json(Term), Reply, Options) 213% http_post(URL, json(Term, Options), Reply, Options) 214% == 215% 216% If Options are passed, these are handed to json_write/3. In 217% addition, this option is processed: 218% 219% * json_object(As) 220% If As is =dict=, json_write_dict/3 is used to write the 221% output. This is default if json(Dict) is passed. 222% 223% @tbd avoid creation of intermediate data using chunked output. 224 225httppost_data_hook(json(Dict), Out, HdrExtra) :- 226 is_dict(Dict), 227 !, 228 http:post_data_hook(json(Dict, [json_object(dict)]), 229 Out, HdrExtra). 230httppost_data_hook(json(Term), Out, HdrExtra) :- 231 http:post_data_hook(json(Term, []), Out, HdrExtra). 232httppost_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). 255 256 257%! http_read_json(+Request, -JSON) is det. 258%! http_read_json(+Request, -JSON, +Options) is det. 259% 260% Extract JSON data posted to this HTTP request. Options are 261% passed to json_read/3. In addition, this option is processed: 262% 263% * json_object(+As) 264% One of =term= (default) to generate a classical Prolog 265% term or =dict= to exploit the SWI-Prolog version 7 data type 266% extensions. See json_read_dict/3. 267% 268% @error domain_error(mimetype, Found) if the mimetype is 269% not known (see json_type/1). 270% @error domain_error(method, Method) if the request method is not 271% a =POST=, =PUT= or =PATCH=. 272 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). 300 301%! http_read_json_dict(+Request, -Dict) is det. 302%! http_read_json_dict(+Request, -Dict, +Options) is det. 303% 304% Similar to http_read_json/2,3, but by default uses the version 7 305% extended datatypes. 306 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). 313 314%! reply_json(+JSONTerm) is det. 315%! reply_json(+JSONTerm, +Options) is det. 316% 317% Formulate a JSON HTTP reply. See json_write/2 for details. 318% The processed options are listed below. Remaining options are 319% forwarded to json_write/3. 320% 321% * content_type(+Type) 322% The default =|Content-type|= is =|application/json; 323% charset=UTF8|=. =|charset=UTF8|= should not be required 324% because JSON is defined to be UTF-8 encoded, but some 325% clients insist on it. 326% 327% * status(+Code) 328% The default status is 200. REST API functions may use 329% other values from the 2XX range, such as 201 (created). 330% 331% * json_object(+As) 332% One of =term= (classical json representation) or =dict= 333% to use the new dict representation. If omitted and Term 334% is a dict, =dict= is assumed. SWI-Prolog Version 7. 335 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). 350 351%! reply_json_dict(+JSONTerm) is det. 352%! reply_json_dict(+JSONTerm, +Options) is det. 353% 354% As reply_json/1 and reply_json/2, but assumes the new dict based 355% data representation. Note that this is the default if the outer 356% object is a dict. This predicate is needed to serialize a list 357% of objects correctly and provides consistency with 358% http_read_json_dict/2 and friends. 359 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 386httpserialize_reply(json(Term), body(application/json, utf8, Content)) :- 387 with_output_to(string(Content), 388 json_write_dict(current_output, Term, [])). 389 390httpstatus_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(Fmt, List, Tail) :- 413 format(codes(List,Tail), Fmt, []). 414 415%! prefer_json(+Accept) 416% 417% True when the accept encoding prefers JSON. 418 419prefer_json(Accept) :- 420 memberchk(media(application/json, _, JSONP, []), Accept), 421 ( member(media(text/html, _, HTMLP, []), Accept) 422 -> JSONP > HTMLP 423 ; true 424 ). 425 426%! json_status_reply(+Term, -MsgLines, -ExtraJSON) is semidet. 427 428json_status_reply(created(Location), 429 [ 'Created: ~w'-[Location] ], 430 _{location:Location}). 431json_status_reply(moved(Location), 432 [ 'Moved to: ~w'-[Location] ], 433 _{location:Location}). 434json_status_reply(moved_temporary(Location), 435 [ 'Moved temporary to: ~w'-[Location] ], 436 _{location:Location}). 437json_status_reply(see_other(Location), 438 [ 'See: ~w'-[Location] ], 439 _{location:Location}). 440json_status_reply(bad_request(ErrorTerm), Lines, _{}) :- 441 '$messages':translate_message(ErrorTerm, Lines, []). 442json_status_reply(authorise(Method), 443 [ 'Authorization (~p) required'-[Method] ], 444 _{}). 445json_status_reply(forbidden(Location), 446 [ 'You have no permission to access: ~w'-[Location] ], 447 _{location:Location}). 448json_status_reply(not_found(Location), 449 [ 'Path not found: ~w'-[Location] ], 450 _{location:Location}). 451json_status_reply(method_not_allowed(Method,Location), 452 [ 'Method not allowed: ~w'-[UMethod] ], 453 _{location:Location, method:UMethod}) :- 454 upcase_atom(Method, UMethod). 455json_status_reply(not_acceptable(Why), 456 [ 'Request is not acceptable: ~p'-[Why] 457 ], 458 _{}). 459json_status_reply(server_error(ErrorTerm), Lines, _{}) :- 460 '$messages':translate_message(ErrorTerm, Lines, []). 461json_status_reply(service_unavailable(Why), 462 [ 'Service unavailable: ~p'-[Why] 463 ], 464 _{})