1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(**[Router] is a module which contains handlers for authentication and creates routes for them.*)
open Dream
open Base
(**[Make] creates an instance of Router with all its dependencies*)
module Make (M : Auth_sign.MODEL)
(A : Auth_sign.AUTHENTICATOR with type entity = M.t)
(V : Auth_sign.VARIABLES) : (Auth_sign.ROUTER with type entity = M.t) = struct
type entity = M.t
type strategy = (module Auth_sign.STRATEGY with type entity = entity)
let login_handler (strat_list : A.strategy list) (module R : Auth_sign.RESPONSES) request =
match%lwt A.authenticate strat_list request with
| Authenticated -> R.login_successful request
| Rescue-> R.login_error request
| Redirect url -> url
let logout_handler (module R : Auth_sign.RESPONSES) request =
let%lwt () = A.logout request in
R.logout request
let strategy_routes strat_list =
let rec acc = function
| [] -> acc
| strat::strats -> let module S = (val strat : Auth_sign.STRATEGY with type entity = M.t) in
extractor ((S.routes)::acc) strats
in
extractor [] strat_list |> List.rev
let call ?(root="/") ~responses ~ strat_list =
let strat_routes = strategy_routes strat_list in
let all_routes = List.append [
post "/auth" (login_handler strat_list responses);
get "/auth" (login_handler strat_list responses);
post "/logout" (logout_handler responses);
get "/logout" (logout_handler responses);
] strat_routes in
scope root [Static.Params.set_params ~extractor] all_routes
end