1:- module(stormpath, []).

Access to Stormpath, an identity management system

Stormpath [http://www.stormpath.com/] is a commercial service that offloads the hassle of user management.

To be done
- stop accepting any cert

*/

   10:- use_module(library(http/http_header)).  % needed for POST
   11:- use_module(library(http/http_open)).   12:- use_module(library(http/http_ssl_plugin)).   13:- use_module(library(http/json)).   14:- use_module(library(http/json_convert)).   15
   16cert_verify(_SSL, ProblemCert, _AllCerts, _FirstCert, _Error) :-
   17        format(user_error, 'Accepting certificate ~w~n', [ProblemCert]).
   18
   19
   20base_uri('https://api.stormpath.com/v1').
   21
   22with_base_uri(RelURI, AbsURI) :-
   23	atom_concat('/', _, RelURI), !,
   24	base_uri(Base),
   25	atom_concat(Base, RelURI, AbsURI).
   26with_base_uri(RelURI, AbsURI) :-
   27	base_uri(Base),
   28	atomic_list_concat([Base, '/', RelURI], AbsURI).
   29
   30% todo add exception handling
   31stormpath_post(RelURI, JSONIn, JSONOut) :-
   32	with_base_uri(RelURI, AbsURI),
   33	setting(stormpath_user, stormpath(Name, PassWord, _)),
   34	prolog_to_json(JSONIn, JSONInJSON),
   35	atom_json_term(In, JSONInJSON, []),
   36        http_open(AbsURI, Stream,
   37                  [ cert_verify_hook(cert_verify),
   38		    authorization(Name, PassWord),
   39		    method(post),
   40		    data(In)
   41                  ]),
   42	json_read(Stream, JSONOutJSON),
   43	json_to_prolog(JSONOutJSON, JSONOut),
   44	close(Stream).
   45
   46stormpath_get(RelURI, JSONOut) :-
   47	with_base_uri(RelURI, AbsURI),
   48	setting(stormpath_user, stormpath(Name, PassWord, _)),
   49        http_open(AbsURI, Stream,
   50                  [ cert_verify_hook(cert_verify),
   51		    authorization(Name, PassWord),
   52		    method(get)
   53                  ]),
   54	json_read(Stream, JSONOutJSON),
   55	json_to_prolog(JSONOutJSON, JSONOut),
   56	close(Stream)