View source with formatted 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-2015, 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:- if(current_predicate(is_dict/1)).   37:- module(http_json,
   38          [ reply_json/1,               % +JSON
   39            reply_json/2,               % +JSON, Options
   40            reply_json_dict/1,          % +JSON
   41            reply_json_dict/2,          % +JSON, Options
   42            http_read_json/2,           % +Request, -JSON
   43            http_read_json/3,           % +Request, -JSON, +Options
   44            http_read_json_dict/2,      % +Request, -Dict
   45            http_read_json_dict/3       % +Request, -Dict, +Options
   46          ]).   47:- else.   48:- module(http_json,
   49          [ reply_json/1,               % +JSON
   50            reply_json/2,               % +JSON, Options
   51            http_read_json/2,           % +Request, -JSON
   52            http_read_json/3            % +Request, -JSON, +Options
   53          ]).   54:- endif.   55:- use_module(http_client).   56:- use_module(http_header).   57:- use_module(http_stream).   58:- use_module(json).   59:- use_module(library(option)).   60:- use_module(library(error)).   61:- use_module(library(lists)).   62:- use_module(library(memfile)).   63
   64:- multifile
   65    http_client:http_convert_data/4,
   66    http:post_data_hook/3,
   67    json_type/1.   68
   69:- public
   70    json_type/1.   71
   72:- predicate_options(http_read_json/3, 3,
   73                     [ content_type(any),
   74                       false(ground),
   75                       null(ground),
   76                       true(ground),
   77                       value_string_as(oneof([atom, string])),
   78                       json_object(oneof([term,dict]))
   79                     ]).   80:- predicate_options(reply_json/2, 2,
   81                     [ content_type(any),
   82                       status(integer),
   83                       json_object(oneof([term,dict])),
   84                       pass_to(json:json_write/3, 3)
   85                     ]).   86
   87
   88/** <module> HTTP JSON Plugin module
   89
   90This  module  inserts  the  JSON  parser  for  documents  of  MIME  type
   91=|application/jsonrequest|= and =|application/json|=   requested through
   92the http_client.pl library.
   93
   94Typically JSON is used by Prolog HTTP  servers. This module supports two
   95JSON  representations:  the  classical  representation    and   the  new
   96representation supported by  the  SWI-Prolog   version  7  extended data
   97types. Below is a skeleton for  handling   a  JSON request, answering in
   98JSON using the classical interface.
   99
  100  ==
  101  handle(Request) :-
  102        http_read_json(Request, JSONIn),
  103        json_to_prolog(JSONIn, PrologIn),
  104        <compute>(PrologIn, PrologOut),         % application body
  105        prolog_to_json(PrologOut, JSONOut),
  106        reply_json(JSONOut).
  107  ==
  108
  109When using dicts, the conversion step is   generally  not needed and the
  110code becomes:
  111
  112  ==
  113  handle(Request) :-
  114        http_read_json_dict(Request, DictIn),
  115        <compute>(DictIn, DictOut),
  116        reply_json(DictOut).
  117  ==
  118
  119This module also integrates JSON support   into the http client provided
  120by http_client.pl. Posting a JSON query   and  processing the JSON reply
  121(or any other reply understood  by   http_read_data/3)  is  as simple as
  122below, where Term is a JSON term as described in json.pl and reply is of
  123the same format if the server replies with JSON.
  124
  125  ==
  126        ...,
  127        http_post(URL, json(Term), Reply, [])
  128  ==
  129
  130@see    JSON Requests are discussed in http://json.org/JSONRequest.html
  131@see    json.pl describes how JSON objects are represented in Prolog terms.
  132@see    json_convert.pl converts between more natural Prolog terms and json
  133terms.
  134*/
  135
  136%!  http_client:http_convert_data(+In, +Fields, -Data, +Options)
  137%
  138%   Hook implementation that supports  reading   JSON  documents. It
  139%   processes the following option:
  140%
  141%     * json_object(+As)
  142%     Where As is one of =term= or =dict=.  If the value is =dict=,
  143%     json_read_dict/3 is used.
  144
  145http_client:http_convert_data(In, Fields, Data, Options) :-
  146    memberchk(content_type(Type), Fields),
  147    is_json_type(Type),
  148    !,
  149    (   memberchk(content_length(Bytes), Fields)
  150    ->  setup_call_cleanup(
  151            ( stream_range_open(In, Range, [size(Bytes)]),
  152              set_stream(Range, encoding(utf8))
  153            ),
  154            json_read_to(Range, Data, Options),
  155            close(Range))
  156    ;   set_stream(In, encoding(utf8)),
  157        json_read_to(In, Data, Options)
  158    ).
  159
  160
  161is_json_type(String) :-
  162    http_parse_header_value(content_type, String,
  163                            media(Type, _Attributes)),
  164    json_type(Type),
  165    !.
  166
  167:- if(current_predicate(is_dict/1)).  168json_read_to(In, Data, Options) :-
  169    memberchk(json_object(dict), Options),
  170    !,
  171    json_read_dict(In, Data, Options).
  172:- endif.  173json_read_to(In, Data, Options) :-
  174    json_read(In, Data, Options).
  175
  176%!  json_type(?MediaType) is semidet.
  177%
  178%   True if MediaType is a JSON media type. http_json:json_type/1 is
  179%   a  multifile  predicate  and  may   be  extended  to  facilitate
  180%   non-conforming clients.
  181%
  182%   @arg MediaType is a term `Type`/`SubType`, where both `Type` and
  183%   `SubType` are atoms.
  184
  185json_type(application/jsonrequest).
  186json_type(application/json).
  187
  188
  189%!  http:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet.
  190%
  191%   Hook implementation that allows   http_post_data/3  posting JSON
  192%   objects using one of the  forms   below.
  193%
  194%     ==
  195%     http_post(URL, json(Term), Reply, Options)
  196%     http_post(URL, json(Term, Options), Reply, Options)
  197%     ==
  198%
  199%   If Options are passed, these are handed to json_write/3. In
  200%   addition, this option is processed:
  201%
  202%     * json_object(As)
  203%     If As is =dict=, json_write_dict/3 is used to write the
  204%     output.  This is default if json(Dict) is passed.
  205%
  206%   @tbd avoid creation of intermediate data using chunked output.
  207
  208:- if(current_predicate(is_dict/1)).  209http:post_data_hook(json(Dict), Out, HdrExtra) :-
  210    is_dict(Dict),
  211    !,
  212    http:post_data_hook(json(Dict, [json_object(dict)]),
  213                        Out, HdrExtra).
  214:- endif.  215http:post_data_hook(json(Term), Out, HdrExtra) :-
  216    http:post_data_hook(json(Term, []), Out, HdrExtra).
  217http:post_data_hook(json(Term, Options), Out, HdrExtra) :-
  218    option(content_type(Type), HdrExtra, 'application/json'),
  219    setup_call_cleanup(
  220        ( new_memory_file(MemFile),
  221          open_memory_file(MemFile, write, Handle)
  222        ),
  223        ( format(Handle, 'Content-type: ~w~n~n', [Type]),
  224          json_write_to(Handle, Term, Options)
  225        ),
  226        close(Handle)),
  227    setup_call_cleanup(
  228        open_memory_file(MemFile, read, RdHandle,
  229                         [ free_on_close(true)
  230                         ]),
  231        http_post_data(cgi_stream(RdHandle), Out, HdrExtra),
  232        close(RdHandle)).
  233
  234:- if(current_predicate(is_dict/1)).  235json_write_to(Out, Term, Options) :-
  236    memberchk(json_object(dict), Options),
  237    !,
  238    json_write_dict(Out, Term, Options).
  239:- endif.  240json_write_to(Out, Term, Options) :-
  241    json_write(Out, Term, Options).
  242
  243
  244%!  http_read_json(+Request, -JSON) is det.
  245%!  http_read_json(+Request, -JSON, +Options) is det.
  246%
  247%   Extract JSON data posted  to  this   HTTP  request.  Options are
  248%   passed to json_read/3.  In addition, this option is processed:
  249%
  250%     * json_object(+As)
  251%     One of =term= (default) to generate a classical Prolog
  252%     term or =dict= to exploit the SWI-Prolog version 7 data type
  253%     extensions.  See json_read_dict/3.
  254%
  255%   @error  domain_error(mimetype, Found) if the mimetype is
  256%           not known (see json_type/1).
  257%   @error  domain_error(method, Method) if the request is not
  258%           a =POST= or =PUT= request.
  259
  260http_read_json(Request, JSON) :-
  261    http_read_json(Request, JSON, []).
  262
  263http_read_json(Request, JSON, Options) :-
  264    select_option(content_type(Type), Options, Rest),
  265    !,
  266    delete(Request, content_type(_), Request2),
  267    request_to_json([content_type(Type)|Request2], JSON, Rest).
  268http_read_json(Request, JSON, Options) :-
  269    request_to_json(Request, JSON, Options).
  270
  271request_to_json(Request, JSON, Options) :-
  272    option(method(Method), Request),
  273    option(content_type(Type), Request),
  274    (   data_method(Method)
  275    ->  true
  276    ;   domain_error(method, Method)
  277    ),
  278    (   is_json_type(Type)
  279    ->  true
  280    ;   domain_error(mimetype, Type)
  281    ),
  282    http_read_data(Request, JSON, Options).
  283
  284data_method(post).
  285data_method(put).
  286data_method(patch).
  287
  288:- if(current_predicate(is_dict/1)).  289
  290%!  http_read_json_dict(+Request, -Dict) is det.
  291%!  http_read_json_dict(+Request, -Dict, +Options) is det.
  292%
  293%   Similar to http_read_json/2,3, but by default uses the version 7
  294%   extended datatypes.
  295
  296http_read_json_dict(Request, Dict) :-
  297    http_read_json_dict(Request, Dict, []).
  298
  299http_read_json_dict(Request, Dict, Options) :-
  300    merge_options([json_object(dict)], Options, Options1),
  301    http_read_json(Request, Dict, Options1).
  302
  303:- endif.  304
  305%!  reply_json(+JSONTerm) is det.
  306%!  reply_json(+JSONTerm, +Options) is det.
  307%
  308%   Formulate a JSON  HTTP  reply.   See  json_write/2  for details.
  309%   The processed options are listed below.  Remaining options are
  310%   forwarded to json_write/3.
  311%
  312%       * content_type(+Type)
  313%       The default =|Content-type|= is =|application/json;
  314%       charset=UTF8|=. =|charset=UTF8|= should not be required
  315%       because JSON is defined to be UTF-8 encoded, but some
  316%       clients insist on it.
  317%
  318%       * status(+Code)
  319%       The default status is 200.  REST API functions may use
  320%       other values from the 2XX range, such as 201 (created).
  321%
  322%       * json_object(+As)
  323%       One of =term= (classical json representation) or =dict=
  324%       to use the new dict representation.  If omitted and Term
  325%       is a dict, =dict= is assumed.  SWI-Prolog Version 7.
  326
  327:- if(current_predicate(is_dict/1)).  328reply_json(Dict) :-
  329    is_dict(Dict),
  330    !,
  331    reply_json_dict(Dict).
  332:- endif.  333reply_json(Term) :-
  334    format('Content-type: application/json; charset=UTF-8~n~n'),
  335    json_write(current_output, Term).
  336
  337:- if(current_predicate(is_dict/1)).  338reply_json(Dict, Options) :-
  339    is_dict(Dict),
  340    !,
  341    reply_json_dict(Dict, Options).
  342:- endif.  343reply_json(Term, Options) :-
  344    reply_json2(Term, Options).
  345
  346%!  reply_json_dict(+JSONTerm) is det.
  347%!  reply_json_dict(+JSONTerm, +Options) is det.
  348%
  349%   As reply_json/1 and reply_json/2, but assumes the new dict based
  350%   data representation. Note that this is  the default if the outer
  351%   object is a dict. This predicate is   needed to serialize a list
  352%   of   objects   correctly   and     provides   consistency   with
  353%   http_read_json_dict/2 and friends.
  354
  355:- if(current_predicate(is_dict/1)).  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:- endif.  364
  365
  366reply_json2(Term, Options) :-
  367    select_option(content_type(Type), Options, Rest0, 'application/json'),
  368    (   select_option(status(Code), Rest0, Rest)
  369    ->  format('Status: ~d~n', [Code])
  370    ;   Rest = Rest0
  371    ),
  372    format('Content-type: ~w~n~n', [Type]),
  373    json_write_to(current_output, Term, Rest)