Commit 5277aaf2 authored by Sebastian Seufert's avatar Sebastian Seufert
Browse files

- General tidying

- Added predicate documentation in web_api.pl
- refactored generic handlers into own include (include/common/generic_handlers.pl)
- helper preds
parent 3ce787c1
% :- module(api_response, []).
/** Provide response formatting
/*
This include provides simple formatting predicates that form a json response.
%To Discuss - codes used correctly?
200 -> gets
201 -> created
202 -> accepted (still working)
......@@ -10,6 +12,14 @@
501 -> not implemented
*/
action_reply_success(Code, Msg) :-
format(atom(Reply), 'Endpoint: ~q', [Msg]),
reply_json(Reply, [status(Code)]).
action_reply_success(Code, Endpoint, Action) :-
Reply =_{endpoint:Endpoint,action:Action},
reply_json(Reply, [status(Code)]).
action_reply_success(Code, Msg, Reply) :-
format(atom(Reply), 'Endpoint: ~q', [Msg]),
reply_json(Reply, [status(Code)]).
......
echo(_Req) :-
format('Status: 204~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Could not match url: ~q", ''),
reply_json(Reply).
toProlog(InProlog, OutTerm, OutBindings) :-
atom_to_term(InProlog, OutTerm, OutBindings).
read_json_request(InRequest, OutProlog) :-
http_read_json(InRequest, JSON),
json_to_prolog(JSON, OutProlog).
handle_add(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
assert(Term),
format('Status: 201~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Added fact to base: ~q", Term),
reply_json(Reply).
jsonize(X, Y) :-
Y = json( X ).
evaluate_query(InTerm, InBindings, OutStringResult) :-
Goal =.. [findall, InBindings, InTerm, IR],
call(Goal),
sort(IR, Result),
maplist(jsonize, Result, OutStringResult).
handle_query(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, Bindings),
evaluate_query(Term, Bindings, Result),
reply_json(Result,
[
serialize_unknown(true)
]).
handle_remove(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
(
(Term = _/_, abolish(Term)) ;
retract(Term)
),
format('Status: 200~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Removed fact: ~q", Term),
reply_json(Reply).
......@@ -16,7 +16,9 @@ item(Path, Dict) :- item_(Path, Dict).
add_item(Path, Dict) :-
with_mutex(theory_bg, (retractall_item_(Path,_), assert_item_(Path, Dict))).
rem_item(Path, Dict) :-
with_mutex(theory_bg, retract_item_(Path, Dict)).
/* Helpers */
rem_item(Path, Dict) :-
with_mutex(theory_bg, retract_item_(Path, Dict)).
\ No newline at end of file
get_size(X) :- persistency:db_size(theory_bg,X).
\ No newline at end of file
:- module(web_api, [server_main/0]).
:- include(include/common/api_response).
:- include(include/common/generic_handlers).
:- use_module(library(http/thread_httpd)).
:- use_module(library(http/http_error)).
......@@ -17,7 +18,259 @@
% Structure of items & persistency
:- use_module(theory_bg).
init :- server_main.
%%%%%%%%%%%%%%%%
%% Mocks for Michael to test GUI
getMock(explanation, JSONContent) :-
working_directory(CWD, CWD),
atom_concat(CWD, 'mocks/expl-response-example.json', Mock),
open(Mock, read, Stream),
json_read(Stream, JSONContent).
getMock(irrelevant, JSONContent) :-
working_directory(CWD, CWD),
atom_concat(CWD, 'mocks/irr-response-example.json', Mock),
open(Mock, read, Stream),
json_read(Stream, JSONContent).
%%%%%%%%%%%%%%%%
server_main :-
server_opts(Opts),
debug(Opts.debug),
http_server(http_dispatch,[port(Opts.port)]),
set_setting(http:logfile, Opts.log).
debug(false).
debug(true) :-
set_prolog_flag(answer_write_options,[max_depth(0)]),
prolog_ide(debug_monitor).
server_opts(Opts) :-
OptsSpec =
[[opt(port), type(integer), default(4444), longflags([port]),
help('Server port')],
[opt(log), type(atom), default('log.txt'), longflags([log]),
help('Logfile')],
[opt(debug), type(boolean), default(false), longflags([debug])]
],
opt_arguments(OptsSpec, Opts0, PositionalArgs),
dict_create(Opts, opts, Opts0),
( PositionalArgs == []
-> true
; throw(error(extra_args,
context(PositionalArgs),
'Unknown positional arg(s)'))
).
/* +++++++++++++++++++++++++++++++++++++++++++++ */
/* World state and runtime information handlers */
:- http_handler(root(state), state(post), []).
:- http_handler(root(bg), bg(Method), [methods(get,post), method(Method)]).
:- http_handler(root(clear), clear_bg, [method(post)]).
/* Handlers for irr & explanation */
:- http_handler(root(irrelevant/file), handle_irrelevant, [method(post)]).
:- http_handler(root(explain), handle_explain, [method(post)]).
/* Generic handlers */
:- http_handler(root(.), echo, []).
:- http_handler(root(add), handle_add, []).
:- http_handler(root(remove), handle_remove, []).
:- http_handler(root(query), handle_query, []).
/* Closures for handlers */
handle_explain(Req) :-
http_read_json(Req, json(Content),[value_string_as(string)]),
%% Limit as int, Path as string
% TODO: improve error handling on required parameter
( member(abs_path=Path, Content) -> true ; throw("abs_path is required!")),
( member(limit=Limit, Content) -> true; Limit=5 ),
% TODO: improve error handling
( bagof([abs_path=Path, reasoning=Message, reasoning_details=Details, references=References],
explain(irrelevant(Path),Message,Details,References),
AllExplanations )
-> true
; throw("No explanation found!")
),
Exceeded = true,
reply_json(json([explanations=AllExplanations,'answers-exceeded'=Exceeded])).
handle_irrelevant(Req) :-
http_read_json(Req, json(Content), [value_string_as(string)]),
%% Path as string
% TODO: improve error handling on required parameter
( Content=[file=Path] -> true ; throw("file is required!")),
( irrelevant(Path) -> AllIrrelevant=[Path] ; AllIrrelevant = []),
reply_json(json([irrelevant=AllIrrelevant,'list-exhaustive'=true])).
/**
* bg(-Arg:type) is nondet
*
* Predicate ...
*/
bg(get, Req) :- get_bg(Req).
bg(post, Req) :- set_bg(Req).
%! set_bg(++Request) is det
%
% Handles HTTP requests adding background facts.
% @Request is a POST that contains a json body denoting what facts to add.
% (defined in @see ./schema/filesystem-data-schema.json)
%
% Replies with:
%
% - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
% - status 400 in case of malformed body or header
%
* @tbd advanced error handling
*/
set_bg(Request) :-
http_read_json_dict(Request, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict)
-> maplist(assert_dict, Dict, Accs),
length(Dict,L),
sum_list(Accs,Total)
; assert_dict(Dict, Total)
),
(
Total is 0
-> action_reply_success(204, set_bg, 'fact(s) already present, no change')
; L == Total
-> format(atom(Message), 'Received: ~q, Added: ~q', [L,Total]),
action_reply_success(201, set_bg, Message)
; Diff is (L - Total),
format(atom(Message), 'Received: ~q, Added: ~q, Skipped: ~q (already present)', [L,Total, Diff]),
action_reply_success(201, set_bg, Message)
).
/**
* assert_dict(+Dict,-Acc) is det
*
* Auxiliary predicate adding items from a Dict, skipping existing entries.
*
* @Acc tracks the number of effectively added items
*/
assert_dict(D,Acc) :-
dict_create(Dict,tag(type),D),
(
occurs(Dict)
-> Acc = 0
;
Acc = 1,
Abs_path = Dict.abs_path,
add_item(Abs_path, Dict)
).
%! clear_bg(++Request) is det
%
% Handles HTTP requests removing background facts.
% @Request is a POST that contains a json body denoting what facts to remove.
% (defined in @see ./schema/filesystem-data-schema.json)
%
% Replies with:
%
% - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
% - status 400 in case of empty body
%
clear_bg(Req) :-
option(content_length(0),Req)
-> action_reply_success(400, clear_bg, 'no change (is the body empty?)')
;
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
catch(
(
(is_list(Dict)
-> length(Dict,Length),
retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
),
E, throw(server_error(E))
),
(
Failed == []
-> format(atom(Message), 'Received: ~q, Removed: ~q', [Length,Length]),
action_reply_success(200, clear_bg, Message)
; length(Failed, FailedCnt),
Diff is (Length - FailedCnt),
format(atom(Message), 'Received: ~q, Removed: ~q, Skipped: ~q (not found)', [Length, Diff, FailedCnt]),
action_reply_success(200, clear_bg, Message)
).
/**
* retract_list(+Dict,-Failed) is det
*
* Auxiliary predicate removing items, skipping nonexisting entries.
*
* @Failed tracks the items that could not be removed, hopefully _only_ because they are not existing.
*
* @tbd advanced error handling
*/
retract_list([], []).
retract_list([In|Ins],Outs) :-
rem_item(In.abs_path,In),!,
retract_list(Ins,Outs).
retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs).
%! get_bg(@Request) is det
%
% A handler returning information on all currently existing items in theory_bg.
% @Request is a GET, ignoring any transmitted body.
%
% Replies with:
%
% - status 200 containing a json body listing all items (defined in @see ./schema/filesystem-data-schema.json)
%
get_bg(_Req) :-
theory_bg:get_size(Size),
get_all(_Type,List),
Reply =_{item_count:Size,list:List},
reply_json(Reply, [status(200)]).
/* Helpers */
occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true.
list_dyns :-
predicate_property(S, dynamic),
clause(S, T),
writeln(S :- T),
fail.
getPath(Dict, Dict.abs_path). :- module(web_api, [server_main/0]).
:- include(include/common/api_response).
:- include(include/common/generic_handlers).
:- use_module(library(http/thread_httpd)).
:- use_module(library(http/http_error)).
:- use_module(library(http/http_dispatch)).
:- use_module(library(http/http_json)).
:- use_module(library(http/json)).
:- use_module(library(http/json_convert)).
:- use_module(library(http/http_header)).
:- use_module(library(http/http_client)).
:- use_module(library(http/http_log)).
:- use_module(library(pairs)).
:- use_module(library(optparse), [opt_arguments/3]).
% Structure of items & persistency
:- use_module(theory_bg).
init :- server_main.
......@@ -112,11 +365,31 @@ handle_irrelevant(Req) :-
reply_json(json([irrelevant=AllIrrelevant,'list-exhaustive'=true])).
/**
* bg(-Arg:type) is nondet
*
* Predicate ...
*/
bg(get, Req) :- get_bg(Req).
bg(post, Req) :- set_bg(Req).
set_bg(Req) :-
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
/**
*! set_bg(++Request) is det
*
* Handles HTTP requests adding background facts.
* @Request is a POST that contains a json body denoting what facts to add.
* (defined in @see ./schema/filesystem-data-schema.json)
*
* Replies with:
*
* - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
* - status 400 in case of malformed body or header
*
* @tbd advanced error handling
*
*/
set_bg(Request) :-
http_read_json_dict(Request, Dict,[value_string_as(atom), tag(type)]),
(is_list(Dict)
-> maplist(assert_dict, Dict, Accs),
length(Dict,L),
......@@ -125,16 +398,23 @@ set_bg(Req) :-
),
(
Total is 0
-> action_reply_success(204, add, 'fact(s) already present, no change', Reply)
-> action_reply_success(204, set_bg, 'fact(s) already present, no change')
; L == Total
-> format(atom(Message), 'Received: ~q, Added: ~q', [L,Total]),
action_reply_success(201, add, Message, Reply)
action_reply_success(201, set_bg, Message)
; Diff is (L - Total),
format(atom(Message), 'Received: ~q, Added: ~q, Skipped: ~q', [L,Total, Diff]),
action_reply_success(201, add, Message, Reply)
format(atom(Message), 'Received: ~q, Added: ~q, Skipped: ~q (already present)', [L,Total, Diff]),
action_reply_success(201, set_bg, Message)
).
/**
*! assert_dict(+Dict,-Acc) is det
*
* Auxiliary predicate adding items from a Dict, skipping existing entries.
*
* @Acc tracks the number of effectively added items
*/
assert_dict(D,Acc) :-
dict_create(Dict,tag(type),D),
(
......@@ -146,27 +426,52 @@ assert_dict(D,Acc) :-
add_item(Abs_path, Dict)
).
%ToDo: StatusCodes bei verschiedenen returns
%! clear_bg(++Request) is det
%
% Handles HTTP requests removing background facts.
% @Request is a POST that contains a json body denoting what facts to remove.
% (defined in @see ./schema/filesystem-data-schema.json)
%
% Replies with:
%
% - status 200 containing a json body describing the changes in detail (defined in @see ./schema/status-schema.json)
% - status 400 in case of empty body
%
clear_bg(Req) :-
option(content_length(0),Req)
-> action_reply_success(400, clear_bg, 'no change (is the body empty?)', Reply)
-> action_reply_success(400, clear_bg, 'no change (is the body empty?)')
;
http_read_json_dict(Req, Dict,[value_string_as(atom), tag(type)]),
catch(
(
(is_list(Dict)
-> retract_list(Dict,Failed)
; retract_list([Dict],Failed)
-> length(Dict,Length),
retract_list(Dict,Failed)
; retract_list([Dict],Failed)
)
),
E, throw(server_error(E))
),
(
Failed==[]
-> action_reply_success(200, clear_bg, 'facts removed', Reply)
; action_reply_success(200, clear_bg, 'some facts not existing, skipping', Reply)
Failed == []
-> format(atom(Message), 'Received: ~q, Removed: ~q', [Length,Length]),
action_reply_success(200, clear_bg, Message)
; length(Failed, FailedCnt),
Diff is (Length - FailedCnt),
format(atom(Message), 'Received: ~q, Removed: ~q, Skipped: ~q (not found)', [Length, Diff, FailedCnt]),
action_reply_success(200, clear_bg, Message)
).
/**
*! retract_list(+Dict,-Failed) is det
*
* Auxiliary predicate removing items, skipping nonexisting entries.
*
* @Failed tracks the items that could not be removed, hopefully _only_ because they are not existing.
*
* @tbd advanced error handling
*/
retract_list([], []).
retract_list([In|Ins],Outs) :-
rem_item(In.abs_path,In),!,
......@@ -175,76 +480,22 @@ retract_list([In|Ins],Outs) :-
retract_list([In|Ins],[In|Outs]) :-
retract_list(Ins,Outs).
%%ToDo Merge mit State
%! get_bg(@Request) is det
%
% A handler returning information on all currently existing items in theory_bg.
% @Request is a GET, ignoring any transmitted body.
%
% Replies with:
%
% - status 200 containing a json body listing all items (defined in @see ./schema/filesystem-data-schema.json)
%
get_bg(_Req) :-
get_all(_type,X),
reply_json(X).
state(get, _Req) :-
generic_reply(state, get, Reply),
reply_json(Reply).
state(put, _Req) :-
generic_reply(state, put, Reply),
reply_json(Reply).
echo(_Req) :-
format('Status: 204~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Could not match url: ~q", ''),
reply_json(Reply).
toProlog(InProlog, OutTerm, OutBindings) :-
atom_to_term(InProlog, OutTerm, OutBindings).
read_json_request(InRequest, OutProlog) :-
http_read_json(InRequest, JSON),
json_to_prolog(JSON, OutProlog).
handle_add(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
assert(Term),
format('Status: 201~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Added fact to base: ~q", Term),
reply_json(Reply).
jsonize(X, Y) :-
Y = json( X ).
evaluate_query(InTerm, InBindings, OutStringResult) :-
Goal =.. [findall, InBindings, InTerm, IR],
call(Goal),
sort(IR, Result),
maplist(jsonize, Result, OutStringResult).
handle_query(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, Bindings),
evaluate_query(Term, Bindings, Result),
reply_json(Result,
[
serialize_unknown(true)
]).
handle_remove(Req) :-
read_json_request(Req, Unpackable),
toProlog(Unpackable, Term, _),
(
(Term = _/_, abolish(Term)) ;
retract(Term)
),
format('Status: 200~n'),
format('Content-type: text/plain~n~n'),
format(atom(Reply), "Removed fact: ~q", Term),
reply_json(Reply).
theory_bg:get_size(Size),
get_all(_Type,List),
Reply =_{item_count:Size,list:List},
reply_json(Reply, [status(200)]).
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
/* Helpers */
occurs(Dict) :- theory_bg:item(_Abs_path,X), X = Dict, true.
......@@ -261,7 +512,42 @@ get_all(Type, Res) :- findall(T, (theory_bg:item(_,T), is_dict(T,Type)), Res).
get_one(Type, Res) :- is_dict(Res,Type), !.
match_with(Tag, Field, Dict, Value) :- theory_bg:item(_,Dict), is_dict(Dict,Tag), Dict.Field = Value.
%! write_to_tty(+Msg)
%
% For debugging:
% Switches the output stream of the thread to write to the interpreter.
%
write_to_tty(Msg) :-
tell(user),
writeln(Msg),
told.
%! http_stop
%
% For debugging:
% syncs the db file & gracefully exits the http server.
%
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
%%
match_with(Tag, Field, Dict, Value) :- theory_bg:item(_,Dict), is_dict(Dict,Tag), Dict.Field = Value.
h :- http_stop, halt.
\ No newline at end of file
%! write_to_tty(+Msg)
%
% For debugging:
% Switches the output stream of the thread to write to the interpreter.
%
write_to_tty(Msg) :-
tell(user),
writeln(Msg),
told.
%! http_stop
%
% For debugging:
% syncs the db file & gracefully exits the http server.
%
http_stop :-
db_sync_all(gc),
http_stop_server(4444,[]).
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment