35
36:- module(http_json,
37 [ reply_json/1, 38 reply_json/2, 39 reply_json_dict/1, 40 reply_json_dict/2, 41 http_read_json/2, 42 http_read_json/3, 43 http_read_json_dict/2, 44 http_read_json_dict/3, 45
46 is_json_content_type/1 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
149
158
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 ).
173
174
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
201
202json_type(application/jsonrequest).
203json_type(application/json).
204
205
224
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).
255
256
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
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
335
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).
351
360
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 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]).
438
439
443
444prefer_json(Accept) :-
445 memberchk(media(application/json, _, JSONP, []), Accept),
446 ( member(media(text/html, _, HTMLP, []), Accept)
447 -> JSONP > HTMLP
448 ; true
449 ).
450
452
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 _{})