View source with raw comments or as raw
    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:

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. */
 http_client:http_convert_data(+In, +Fields, -Data, +Options)
Hook implementation that supports reading JSON documents. It processes the following option:
json_object(+As)
Where As is one of term or dict. If the value is dict, json_read_dict/3 is used.
  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    ).
 is_json_content_type(+ContentType) is semidet
True if ContentType is a header value (either parsed or as atom/string) that denotes a JSON value.
  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).
 json_type(?MediaType) is semidet
True if MediaType is a JSON media type. http_json:json_type/1 is a multifile predicate and may be extended to facilitate non-conforming clients.
Arguments:
MediaType- is a term Type/SubType, where both Type and SubType are atoms.
  202json_type(application/jsonrequest).
  203json_type(application/json).
 http:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet
Hook implementation that allows http_post_data/3 posting JSON objects using one of the forms below.
http_post(URL, json(Term), Reply, Options)
http_post(URL, json(Term, Options), Reply, Options)

If Options are passed, these are handed to json_write/3. In addition, this option is processed:

json_object(As)
If As is dict, json_write_dict/3 is used to write the output. This is default if json(Dict) is passed.
To be done
- avoid creation of intermediate data using chunked output.
  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).
 http_read_json(+Request, -JSON) is det
 http_read_json(+Request, -JSON, +Options) is det
Extract JSON data posted to this HTTP request. Options are passed to json_read/3. In addition, this option is processed:
json_object(+As)
One of term (default) to generate a classical Prolog term or dict to exploit the SWI-Prolog version 7 data type extensions. See json_read_dict/3.
Errors
- domain_error(mimetype, Found) if the mimetype is not known (see json_type/1).
- domain_error(method, Method) if the request method is not a POST, PUT or PATCH.
  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).
 http_read_json_dict(+Request, -Dict) is det
 http_read_json_dict(+Request, -Dict, +Options) is det
Similar to http_read_json/2,3, but by default uses the version 7 extended datatypes.
  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).
 reply_json(+JSONTerm) is det
 reply_json(+JSONTerm, +Options) is det
Formulate a JSON HTTP reply. See json_write/2 for details. The processed options are listed below. Remaining options are forwarded to json_write/3.
content_type(+Type)
The default Content-type is application/json; charset=UTF8. charset=UTF8 should not be required because JSON is defined to be UTF-8 encoded, but some clients insist on it.
status(+Code)
The default status is 200. REST API functions may use other values from the 2XX range, such as 201 (created).
json_object(+As)
One of term (classical json representation) or dict to use the new dict representation. If omitted and Term is a dict, dict is assumed. SWI-Prolog Version 7.
  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).
 reply_json_dict(+JSONTerm) is det
 reply_json_dict(+JSONTerm, +Options) is det
As reply_json/1 and reply_json/2, but assumes the new dict based data representation. Note that this is the default if the outer object is a dict. This predicate is needed to serialize a list of objects correctly and provides consistency with http_read_json_dict/2 and friends.
  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]).
 prefer_json(+Accept)
True when the accept encoding prefers JSON.
  444prefer_json(Accept) :-
  445    memberchk(media(application/json, _, JSONP,  []), Accept),
  446    (   member(media(text/html, _, HTMLP,  []), Accept)
  447    ->  JSONP > HTMLP
  448    ;   true
  449    ).
 json_status_reply(+Term, -MsgLines, -ExtraJSON) is semidet
  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                  _{})