annotate demo/more/conference.ur @ 1004:a87495bcaeec

Start of user management
author Adam Chlipala <adamc@hcoop.net>
date Tue, 20 Oct 2009 12:48:53 -0400
parents 61c30f0742d7
children 5a0f6ec208ce
rev   line source
adamc@1004 1 open Meta
adamc@1001 2
adamc@1001 3 functor Make(M : sig
adamc@1003 4 con paper :: {(Type * Type)}
adamc@1003 5 constraint [Id, Title] ~ paper
adamc@1003 6 val paper : $(map meta paper)
adamc@1003 7
adamc@1001 8 con review :: {(Type * Type)}
adamc@1003 9 constraint [Paper, User] ~ review
adamc@1003 10 val review : $(map meta review)
adamc@1001 11 end) = struct
adamc@1001 12
adamc@1003 13 table user : {Id : int, Nam : string, Password : string, Chair : bool, OnPc : bool}
adamc@1003 14 PRIMARY KEY Id,
adamc@1003 15 CONSTRAINT Nam UNIQUE Nam
adamc@1003 16 sequence userId
adamc@1003 17
adamc@1003 18 con paper = [Id = int, Title = string] ++ map fst M.paper
adamc@1003 19 table paper : paper
adamc@1003 20 PRIMARY KEY Id
adamc@1003 21 sequence paperId
adamc@1003 22
adamc@1003 23 con review = [Paper = int, User = int] ++ map fst M.review
adamc@1003 24 table review : review
adamc@1003 25 PRIMARY KEY (Paper, User),
adamc@1003 26 CONSTRAINT Paper FOREIGN KEY Paper REFERENCES paper(Id),
adamc@1003 27 CONSTRAINT User FOREIGN KEY User REFERENCES user(Id)
adamc@1003 28 sequence reviewId
adamc@1003 29
adamc@1003 30 cookie login : {Id : int, Password : string}
adamc@1003 31
adamc@1004 32 val checkLogin =
adamc@1003 33 r <- getCookie login;
adamc@1003 34 case r of
adamc@1003 35 None => return None
adamc@1003 36 | Some r =>
adamc@1003 37 oneOrNoRows1 (SELECT user.Id, user.Nam, user.Chair, user.OnPc
adamc@1003 38 FROM user
adamc@1003 39 WHERE user.Id = {[r.Id]}
adamc@1003 40 AND user.Password = {[r.Password]})
adamc@1003 41
adamc@1004 42 structure Users = BulkEdit.Make(struct
adamc@1004 43 con keyName = #Id
adamc@1004 44 val visible = {Nam = string "Name",
adamc@1004 45 Chair = bool "Chair?",
adamc@1004 46 OnPc = bool "On PC?"}
adamc@1004 47
adamc@1004 48 val title = "Users"
adamc@1004 49 val isAllowed =
adamc@1004 50 me <- checkLogin;
adamc@1004 51 return (Option.isSome me)
adamc@1004 52
adamc@1004 53 val t = user
adamc@1004 54 end)
adamc@1004 55
adamc@1004 56
adamc@1003 57 fun doRegister r =
adamc@1003 58 n <- oneRowE1 (SELECT COUNT( * ) AS N
adamc@1003 59 FROM user
adamc@1003 60 WHERE user.Nam = {[r.Nam]});
adamc@1003 61 if n > 0 then
adamc@1003 62 register (Some "Sorry; that username is taken.")
adamc@1003 63 else
adamc@1003 64 id <- nextval userId;
adamc@1003 65 dml (INSERT INTO user (Id, Nam, Password, Chair, OnPc)
adamc@1003 66 VALUES ({[id]}, {[r.Nam]}, {[r.Password]}, FALSE, FALSE));
adamc@1003 67 setCookie login {Id = id, Password = r.Password};
adamc@1003 68 main ()
adamc@1003 69
adamc@1003 70 and register msg = return <xml><body>
adamc@1003 71 <h1>Registering a New Account</h1>
adamc@1003 72
adamc@1003 73 {case msg of
adamc@1003 74 None => <xml/>
adamc@1003 75 | Some msg => <xml><div>{[msg]}</div></xml>}
adamc@1003 76
adamc@1003 77 <form><table>
adamc@1003 78 <tr> <th>Username:</th> <td><textbox{#Nam}/></td> </tr>
adamc@1003 79 <tr> <th>Password:</th> <td><password{#Password}/></td> </tr>
adamc@1003 80 <tr> <th><submit action={doRegister}/></th> </tr>
adamc@1003 81 </table></form>
adamc@1003 82 </body></xml>
adamc@1003 83
adamc@1003 84 and main () =
adamc@1004 85 me <- checkLogin;
adamc@1003 86 return <xml><body>
adamc@1003 87 {case me of
adamc@1003 88 None => <xml><li><a link={register None}>Register for access</a></li></xml>
adamc@1004 89 | Some me => <xml>
adamc@1004 90 <div>Welcome, {[me.Nam]}!</div>
adamc@1004 91
adamc@1004 92 {if me.Chair then
adamc@1004 93 <xml><li><a link={Users.main ()}>Manage users</a></li></xml>
adamc@1004 94 else
adamc@1004 95 <xml/>}
adamc@1004 96 </xml>}
adamc@1003 97 </body></xml>
adamc@1001 98
adamc@1001 99 end