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 83This module adds hooks to several parts of the HTTP libraries, making 84them JSON-aware. Notably: 85 86 - Make http_read_data/3 convert `application/json` and 87 `application/jsonrequest` content to a JSON term. 88 - Cause http_open/3 to accept post(json(Term)) to issue a POST 89 request with JSON content. 90 - Provide HTTP server and client utility predicates for reading 91 and replying JSON: 92 - http_read_json/2 93 - http_read_json/3 94 - http_read_json_dict/2 95 - http_read_json_dict/3 96 - reply_json/1 97 - reply_json/2 98 - reply_json_dict/1 99 - reply_json_dict/2 100 - Reply to exceptions in the server using an JSON document rather 101 then HTML if the =|Accept|= header prefers application/json over 102 text/html. 103 104Typically JSON is used by Prolog HTTP servers. This module supports two 105JSON representations: the classical representation and the new 106representation supported by the SWI-Prolog version 7 extended data 107types. Below is a skeleton for handling a JSON request, answering in 108JSON using the classical interface. 109 110 == 111 handle(Request) :- 112 http_read_json(Request, JSONIn), 113 json_to_prolog(JSONIn, PrologIn), 114 <compute>(PrologIn, PrologOut), % application body 115 prolog_to_json(PrologOut, JSONOut), 116 reply_json(JSONOut). 117 == 118 119When using dicts, the conversion step is generally not needed and the 120code becomes: 121 122 == 123 handle(Request) :- 124 http_read_json_dict(Request, DictIn), 125 <compute>(DictIn, DictOut), 126 reply_json(DictOut). 127 == 128 129This module also integrates JSON support into the http client provided 130by http_client.pl. Posting a JSON query and processing the JSON reply 131(or any other reply understood by http_read_data/3) is as simple as 132below, where Term is a JSON term as described in json.pl and reply is of 133the same format if the server replies with JSON. 134 135 == 136 ..., 137 http_post(URL, json(Term), Reply, []) 138 == 139 140@see JSON Requests are discussed in http://json.org/JSONRequest.html 141@see json.pl describes how JSON objects are represented in Prolog terms. 142@see json_convert.pl converts between more natural Prolog terms and json 143terms. 144*/ 145 146%! http_client:http_convert_data(+In, +Fields, -Data, +Options) 147% 148% Hook implementation that supports reading JSON documents. It 149% processes the following option: 150% 151% * json_object(+As) 152% Where As is one of =term= or =dict=. If the value is =dict=, 153% json_read_dict/3 is used. 154 155http_clienthttp_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 ). 169 170 171%! is_json_content_type(+ContentType) is semidet. 172% 173% True if ContentType is a header value (either parsed or as 174% atom/string) that denotes a JSON value. 175 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). 188 189%! json_type(?MediaType) is semidet. 190% 191% True if MediaType is a JSON media type. http_json:json_type/1 is 192% a multifile predicate and may be extended to facilitate 193% non-conforming clients. 194% 195% @arg MediaType is a term `Type`/`SubType`, where both `Type` and 196% `SubType` are atoms. 197 198json_type(application/jsonrequest). 199json_type(application/json). 200 201 202%! http:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet. 203% 204% Hook implementation that allows http_post_data/3 posting JSON 205% objects using one of the forms below. 206% 207% == 208% http_post(URL, json(Term), Reply, Options) 209% http_post(URL, json(Term, Options), Reply, Options) 210% == 211% 212% If Options are passed, these are handed to json_write/3. In 213% addition, this option is processed: 214% 215% * json_object(As) 216% If As is =dict=, json_write_dict/3 is used to write the 217% output. This is default if json(Dict) is passed. 218% 219% @tbd avoid creation of intermediate data using chunked output. 220 221httppost_data_hook(json(Dict), Out, HdrExtra) :- 222 is_dict(Dict), 223 !, 224 http:post_data_hook(json(Dict, [json_object(dict)]), 225 Out, HdrExtra). 226httppost_data_hook(json(Term), Out, HdrExtra) :- 227 http:post_data_hook(json(Term, []), Out, HdrExtra). 228httppost_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). 251 252 253%! http_read_json(+Request, -JSON) is det. 254%! http_read_json(+Request, -JSON, +Options) is det. 255% 256% Extract JSON data posted to this HTTP request. Options are 257% passed to json_read/3. In addition, this option is processed: 258% 259% * json_object(+As) 260% One of =term= (default) to generate a classical Prolog 261% term or =dict= to exploit the SWI-Prolog version 7 data type 262% extensions. See json_read_dict/3. 263% 264% @error domain_error(mimetype, Found) if the mimetype is 265% not known (see json_type/1). 266% @error domain_error(method, Method) if the request method is not 267% a =POST=, =PUT= or =PATCH=. 268 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). 296 297%! http_read_json_dict(+Request, -Dict) is det. 298%! http_read_json_dict(+Request, -Dict, +Options) is det. 299% 300% Similar to http_read_json/2,3, but by default uses the version 7 301% extended datatypes. 302 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). 309 310%! reply_json(+JSONTerm) is det. 311%! reply_json(+JSONTerm, +Options) is det. 312% 313% Formulate a JSON HTTP reply. See json_write/2 for details. 314% The processed options are listed below. Remaining options are 315% forwarded to json_write/3. 316% 317% * content_type(+Type) 318% The default =|Content-type|= is =|application/json; 319% charset=UTF8|=. =|charset=UTF8|= should not be required 320% because JSON is defined to be UTF-8 encoded, but some 321% clients insist on it. 322% 323% * status(+Code) 324% The default status is 200. REST API functions may use 325% other values from the 2XX range, such as 201 (created). 326% 327% * json_object(+As) 328% One of =term= (classical json representation) or =dict= 329% to use the new dict representation. If omitted and Term 330% is a dict, =dict= is assumed. SWI-Prolog Version 7. 331 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). 346 347%! reply_json_dict(+JSONTerm) is det. 348%! reply_json_dict(+JSONTerm, +Options) is det. 349% 350% As reply_json/1 and reply_json/2, but assumes the new dict based 351% data representation. Note that this is the default if the outer 352% object is a dict. This predicate is needed to serialize a list 353% of objects correctly and provides consistency with 354% http_read_json_dict/2 and friends. 355 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 382httpserialize_reply(json(Term), body(application/json, utf8, Content)) :- 383 with_output_to(string(Content), 384 json_write_dict(current_output, Term, [])). 385 386httpstatus_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, []). 410 411%! prefer_json(+Accept) 412% 413% True when the accept encoding prefers JSON. 414 415prefer_json(Accept) :- 416 memberchk(media(application/json, _, JSONP, []), Accept), 417 ( member(media(text/html, _, HTMLP, []), Accept) 418 -> JSONP > HTMLP 419 ; true 420 ). 421 422%! json_status_reply(+Term, -MsgLines, -ExtraJSON) is semidet. 423 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 _{})