|
adam@18
|
1 (* This module provides generic user authentication functionality, backed by
|
|
adam@18
|
2 * OpenID authentication. Each account (named with a short alphanumeric string)
|
|
adam@18
|
3 * is associated with one or more OpenID identifiers, any of which may be used
|
|
adam@18
|
4 * to log in as that user. This module provides all the code you need to sign
|
|
adam@18
|
5 * users up, log them in, and check which user is logged in.
|
|
adam@18
|
6 *
|
|
adam@18
|
7 * Module author: Adam Chlipala
|
|
adam@18
|
8 *)
|
|
adam@18
|
9
|
|
adam@18
|
10 (* Instantiate this functor to create your customized authentication scheme. *)
|
|
adam@16
|
11 functor Make(M: sig
|
|
adam@16
|
12 con cols :: {Type}
|
|
adam@16
|
13 constraint [Id] ~ cols
|
|
adam@17
|
14 val folder : folder cols
|
|
adam@17
|
15 val inj : $(map sql_injectable cols)
|
|
adam@18
|
16 (* Extra columns of profile information to include in the user
|
|
adam@18
|
17 * database table *)
|
|
adam@16
|
18
|
|
adam@17
|
19 type creationState
|
|
adam@18
|
20 (* The type of client-side state used while soliciting sign-up
|
|
adam@18
|
21 * input *)
|
|
adam@17
|
22 type creationData
|
|
adam@18
|
23 (* A functional representation of the latest client-side state *)
|
|
adam@18
|
24
|
|
adam@17
|
25 val creationState : transaction creationState
|
|
adam@18
|
26 (* Create some fresh client-side state. *)
|
|
adam@18
|
27
|
|
adam@17
|
28 val render : creationState -> xtable
|
|
adam@18
|
29 (* Display widgets. *)
|
|
adam@18
|
30
|
|
adam@20
|
31 val ready : creationState -> signal bool
|
|
adam@20
|
32 (* Is the data ready to send? *)
|
|
adam@20
|
33
|
|
adam@17
|
34 val tabulate : creationState -> signal creationData
|
|
adam@18
|
35 (* Functionalize current state. *)
|
|
adam@18
|
36
|
|
adam@18
|
37 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]]
|
|
adam@18
|
38 -> creationData -> transaction $cols
|
|
adam@18
|
39 (* Use functionalized state to choose initial column values,
|
|
adam@18
|
40 * given a handle to the users table. *)
|
|
adam@17
|
41
|
|
adam@16
|
42 val sessionLifetime : int
|
|
adam@16
|
43 (* Number of seconds a session may live *)
|
|
adam@16
|
44
|
|
adam@16
|
45 val afterLogout : url
|
|
adam@16
|
46 (* Where to send the user after he logs out *)
|
|
adam@16
|
47
|
|
adam@16
|
48 val secureCookies : bool
|
|
adam@18
|
49 (* Should authentication cookies be restricted to SSL
|
|
adam@18
|
50 * connections? *)
|
|
adam@16
|
51
|
|
adam@16
|
52 val association : Openid.association_mode
|
|
adam@16
|
53 (* OpenID cryptography preferences *)
|
|
adam@16
|
54
|
|
adam@16
|
55 val realm : option string
|
|
adam@18
|
56 (* See end of [Openid] module's documentation for the meaning
|
|
adam@18
|
57 * of realms. *)
|
|
adam@17
|
58
|
|
adam@17
|
59 val formClass : css_class
|
|
adam@18
|
60 (* CSS class for <table>, <th>, and <td> elements used in
|
|
adam@18
|
61 * sign-up form *)
|
|
adam@16
|
62 end) : sig
|
|
adam@16
|
63
|
|
adam@16
|
64 type user
|
|
adam@16
|
65 val show_user : show user
|
|
adam@16
|
66 val inj_user : sql_injectable_prim user
|
|
adam@18
|
67 (* The abstract type of user IDs. It's really [string], but this is only
|
|
adam@18
|
68 * exposed via some standard type class instances. *)
|
|
adam@16
|
69
|
|
adam@16
|
70 table user : ([Id = user] ++ M.cols)
|
|
adam@16
|
71 PRIMARY KEY Id
|
|
adam@16
|
72
|
|
adam@16
|
73 val current : transaction (option user)
|
|
adam@18
|
74 (* Figure out which, if any, user is logged in on this connection. *)
|
|
adam@16
|
75
|
|
adam@16
|
76 val main : (string -> xbody -> transaction page) -> transaction xbody
|
|
adam@18
|
77 (* Pass in your generic page template; get out the HTML snippet for user
|
|
adam@18
|
78 * management, suitable for, e.g., inclusion in your standard page
|
|
adam@18
|
79 * header. *)
|
|
adam@16
|
80
|
|
adam@16
|
81 end
|
