adam@18: (* This module provides generic user authentication functionality, backed by adam@18: * OpenID authentication. Each account (named with a short alphanumeric string) adam@18: * is associated with one or more OpenID identifiers, any of which may be used adam@18: * to log in as that user. This module provides all the code you need to sign adam@18: * users up, log them in, and check which user is logged in. adam@18: * adam@18: * Module author: Adam Chlipala adam@18: *) adam@18: adam@18: (* Instantiate this functor to create your customized authentication scheme. *) adam@16: functor Make(M: sig adam@16: con cols :: {Type} adam@16: constraint [Id] ~ cols adam@17: val folder : folder cols adam@17: val inj : $(map sql_injectable cols) adam@18: (* Extra columns of profile information to include in the user adam@18: * database table *) adam@16: adam@17: type creationState adam@18: (* The type of client-side state used while soliciting sign-up adam@18: * input *) adam@17: type creationData adam@18: (* A functional representation of the latest client-side state *) adam@18: adam@17: val creationState : transaction creationState adam@18: (* Create some fresh client-side state. *) adam@18: adam@17: val render : creationState -> xtable adam@18: (* Display widgets. *) adam@18: adam@17: val tabulate : creationState -> signal creationData adam@18: (* Functionalize current state. *) adam@18: adam@18: val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] adam@18: -> creationData -> transaction $cols adam@18: (* Use functionalized state to choose initial column values, adam@18: * given a handle to the users table. *) adam@17: adam@16: val sessionLifetime : int adam@16: (* Number of seconds a session may live *) adam@16: adam@16: val afterLogout : url adam@16: (* Where to send the user after he logs out *) adam@16: adam@16: val secureCookies : bool adam@18: (* Should authentication cookies be restricted to SSL adam@18: * connections? *) adam@16: adam@16: val association : Openid.association_mode adam@16: (* OpenID cryptography preferences *) adam@16: adam@16: val realm : option string adam@18: (* See end of [Openid] module's documentation for the meaning adam@18: * of realms. *) adam@17: adam@17: val formClass : css_class adam@18: (* CSS class for ,
, and elements used in adam@18: * sign-up form *) adam@16: end) : sig adam@16: adam@16: type user adam@16: val show_user : show user adam@16: val inj_user : sql_injectable_prim user adam@18: (* The abstract type of user IDs. It's really [string], but this is only adam@18: * exposed via some standard type class instances. *) adam@16: adam@16: table user : ([Id = user] ++ M.cols) adam@16: PRIMARY KEY Id adam@16: adam@16: val current : transaction (option user) adam@18: (* Figure out which, if any, user is logged in on this connection. *) adam@16: adam@16: val main : (string -> xbody -> transaction page) -> transaction xbody adam@18: (* Pass in your generic page template; get out the HTML snippet for user adam@18: * management, suitable for, e.g., inclusion in your standard page adam@18: * header. *) adam@16: adam@16: end