1:- module(bc_api_auth, [
    2    bc_auth/1,            % :Next
    3    bc_auth_user_by_key/1 % -User
    4]).    5
    6:- use_module(library(http/http_wrapper)).    7:- use_module(library(dict_schema)).    8:- use_module(library(docstore)).    9:- use_module(library(arouter)).   10
   11:- use_module(bc_data).   12:- use_module(bc_api_io).   13:- use_module(bc_api_error).   14:- use_module(bc_data_user).   15:- use_module(bc_api_actor).
 bc_auth(:Next) is det
Pre-action for handlers that need the user to be authenticated.
   22:- meta_predicate(bc_auth(0)).   23
   24bc_auth(Next):-
   25    (   bc_auth_user_by_key(User)
   26    ->  setup_call_cleanup(
   27            bc_set_actor(User),
   28            bc_call_handle_error(Next),
   29            bc_unset_actor)
   30    ;   bc_handle_error(error(invalid_api_key))).
   31
   32% Authenticates the current user
   33% by the API key given in the "X-Key"
   34% HTTP header.
   35
   36bc_auth_user_by_key(User):-
   37    http_current_request(Request),
   38    memberchk(x_key(Key), Request),
   39    ds_find(user, key=Key, [User]).
   40
   41% Authenticates the user.
   42
   43:- route_post(api/auth,
   44    bc_call_handle_error, user_auth).   45
   46user_auth:-
   47    bc_read_by_schema(bc_user_auth, Auth),
   48    bc_user_auth(Auth, Info),
   49    bc_reply_success(Info).
   50
   51% Schema for authentication requests.
   52
   53:- register_schema(bc_user_auth, _{
   54    type: dict,
   55    tag: user,
   56    keys: _{
   57        username: _{ type: atom, min_length: 1 },
   58        password: _{ type: atom, min_length: 1 }
   59    }
   60}).