Commit | Line | Data |
---|---|---|
a90da8b1 AC |
1 | structure App :> APP = |
2 | struct | |
3 | ||
4 | open Init Sql Util | |
5 | ||
6 | datatype status = | |
7 | CONFIRMING | |
8 | | PENDING | |
9 | | ACCEPTED | |
10 | | REJECTED | |
6f91863c | 11 | | ADDED |
96bd398e | 12 | | BEING_ADDED |
a90da8b1 AC |
13 | |
14 | val statusFromInt = | |
15 | fn 0 => CONFIRMING | |
16 | | 1 => PENDING | |
17 | | 2 => ACCEPTED | |
18 | | 3 => REJECTED | |
6f91863c | 19 | | 4 => ADDED |
96bd398e | 20 | | 5 => BEING_ADDED |
a90da8b1 AC |
21 | | _ => raise C.Sql "Bad status" |
22 | ||
23 | val statusToInt = | |
24 | fn CONFIRMING => 0 | |
25 | | PENDING => 1 | |
26 | | ACCEPTED => 2 | |
27 | | REJECTED => 3 | |
6f91863c | 28 | | ADDED => 4 |
96bd398e | 29 | | BEING_ADDED => 5 |
a90da8b1 AC |
30 | |
31 | fun statusFromSql v = statusFromInt (C.intFromSql v) | |
32 | fun statusToSql s = C.intToSql (statusToInt s) | |
33 | ||
f3f3ad24 | 34 | type app = { id : int, name : string, rname : string, gname : string option, email : string, |
a90da8b1 | 35 | forward : bool, uses : string, other : string, |
f3f3ad24 | 36 | passwd : string, status : status, applied : C.timestamp, ipaddr : string option, |
6f91863c | 37 | confirmed : C.timestamp option, decided : C.timestamp option, |
d5f8418b AC |
38 | msg : string, unix_passwd : string, |
39 | paypal : string option, checkout : string option } | |
a90da8b1 | 40 | |
f3f3ad24 | 41 | fun mkAppRow [id, name, rname, gname, email, forward, uses, other, passwd, status, |
d5f8418b | 42 | applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout] = |
a90da8b1 | 43 | { id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname, |
d5f8418b | 44 | gname = Init.nullableFromSql C.stringFromSql gname, |
a90da8b1 AC |
45 | email = C.stringFromSql email, forward = C.boolFromSql forward, |
46 | uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd, | |
6f91863c | 47 | status = statusFromSql status, applied = C.timestampFromSql applied, |
d5f8418b AC |
48 | ipaddr = Init.nullableFromSql C.stringFromSql ipaddr, |
49 | confirmed = Init.nullableFromSql C.timestampFromSql confirmed, | |
50 | decided = Init.nullableFromSql C.timestampFromSql decided, | |
51 | msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd, | |
52 | paypal = Init.nullableFromSql C.stringFromSql paypal, | |
53 | checkout = Init.nullableFromSql C.stringFromSql checkout} | |
a90da8b1 AC |
54 | | mkAppRow r = rowError ("app", r) |
55 | ||
56 | fun lookupApp id = | |
a2d53da2 | 57 | case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, |
d5f8418b | 58 | msg, unix_passwd, paypal, checkout |
6f91863c AC |
59 | FROM MemberApp |
60 | WHERE id = ^(C.intToSql id)`) of | |
a90da8b1 AC |
61 | SOME row => mkAppRow row |
62 | | NONE => raise Fail "Membership application not found" | |
63 | ||
96bd398e | 64 | fun listApps statuses = |
a2d53da2 | 65 | C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, |
d5f8418b | 66 | msg, unix_passwd, paypal, checkout |
6f91863c | 67 | FROM MemberApp |
96bd398e | 68 | WHERE status IN (^(String.concatWith "," (map statusToSql statuses))) |
38bfcd20 | 69 | AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') |
6f91863c AC |
70 | ORDER BY applied`) |
71 | ||
72 | fun mkVoteRow [id, name] = (C.intFromSql id, C.stringFromSql name) | |
73 | | mkVoteRow row = rowError ("app.vote", row) | |
74 | ||
75 | fun votes id = C.map (getDb ()) mkVoteRow ($`SELECT usr, name | |
76 | FROM AppVote JOIN WebUser ON usr = id | |
f3f3ad24 | 77 | WHERE AppVote.app = ^(C.intToSql id) |
6f91863c AC |
78 | ORDER BY name`) |
79 | ||
80 | fun vote (usr, app) = ignore (C.dml (getDb ()) ($`INSERT INTO AppVote (app, usr) | |
81 | VALUES (^(C.intToSql app), ^(C.intToSql usr))`)) | |
82 | ||
83 | fun unvote (usr, app) = ignore (C.dml (getDb ()) ($`DELETE FROM AppVote WHERE app = ^(C.intToSql app) AND usr = ^(C.intToSql usr)`)) | |
84 | ||
85 | fun deny (app, msg) = | |
86 | let | |
87 | val entry = lookupApp app | |
88 | val _ = C.dml (getDb ()) ($`UPDATE MemberApp | |
89 | SET status = 3, msg = ^(C.stringToSql msg), decided = CURRENT_TIMESTAMP | |
90 | WHERE id = ^(C.intToSql app)`) | |
91 | ||
92 | val mail = Mail.mopen () | |
93 | in | |
93f77ca7 AC |
94 | Mail.mwrite (mail, "From: Hcoop Application System <join"); |
95 | Mail.mwrite (mail, emailSuffix); | |
96 | Mail.mwrite (mail, ">\nTo: "); | |
6f91863c AC |
97 | Mail.mwrite (mail, #email entry); |
98 | Mail.mwrite (mail, "\nCc: "); | |
99 | Mail.mwrite (mail, boardEmail); | |
100 | Mail.mwrite (mail, "\nSubject: Application denied\n\nYour application for membership has been denied. Reason:\n\n"); | |
101 | Mail.mwrite (mail, msg); | |
102 | OS.Process.isSuccess (Mail.mclose mail) | |
103 | end | |
104 | ||
105 | fun approve (app, msg) = | |
106 | let | |
107 | val entry = lookupApp app | |
108 | val _ = C.dml (getDb ()) ($`UPDATE MemberApp | |
109 | SET status = 2, msg = ^(C.stringToSql msg), decided = CURRENT_TIMESTAMP | |
110 | WHERE id = ^(C.intToSql app)`) | |
111 | ||
112 | val mail = Mail.mopen () | |
113 | in | |
b90b0980 | 114 | Mail.mwrite (mail, "To: "); |
6f91863c | 115 | Mail.mwrite (mail, #email entry); |
b90b0980 | 116 | Mail.mwrite (mail, "\n"); |
52ed7f53 | 117 | Mail.mwrite (mail, Util.readFile (Config.staticFilesRoot ^ "welcome.txt")); |
6f91863c AC |
118 | Mail.mwrite (mail, msg); |
119 | OS.Process.isSuccess (Mail.mclose mail) | |
120 | end | |
121 | ||
96bd398e | 122 | fun preAdd app = |
688bf30c AC |
123 | let |
124 | val _ = C.dml (getDb ()) ($`UPDATE MemberApp | |
64ec9551 | 125 | SET status = 5 |
688bf30c AC |
126 | WHERE id = ^(C.intToSql app)`) |
127 | ||
128 | val app = lookupApp app | |
688bf30c | 129 | in |
bed62880 | 130 | () |
688bf30c AC |
131 | end |
132 | ||
64ec9551 | 133 | fun add app = |
ccac9b41 AC |
134 | let |
135 | val appR = lookupApp app | |
136 | in | |
137 | ignore (C.dml (getDb ()) ($`UPDATE MemberApp | |
138 | SET status = 4 | |
bed62880 | 139 | WHERE id = ^(C.intToSql app)`)) |
ccac9b41 | 140 | end |
64ec9551 | 141 | |
688bf30c AC |
142 | fun welcome app = |
143 | let | |
144 | val app = lookupApp app | |
145 | ||
146 | val mail = Mail.mopen () | |
147 | in | |
148 | Mail.mwrite (mail, "To: "); | |
149 | Mail.mwrite (mail, #email app); | |
150 | Mail.mwrite (mail, "\n"); | |
52ed7f53 | 151 | Mail.mwrite (mail, Util.readFile (Config.staticFilesRoot ^ "paid.txt")); |
688bf30c AC |
152 | ignore (Mail.mclose mail) |
153 | end | |
98a5f121 AC |
154 | |
155 | fun abortAdd app = | |
156 | ignore (C.dml (getDb ()) ($`UPDATE MemberApp | |
157 | SET status = 2 | |
158 | WHERE id = ^(C.intToSql app)`)) | |
159 | ||
f3f3ad24 AC |
160 | fun readFile fname = |
161 | let | |
162 | val inf = TextIO.openIn fname | |
163 | ||
164 | fun readLines lines = | |
165 | case TextIO.inputLine inf of | |
166 | NONE => String.concat (List.rev lines) | |
167 | | SOME line => readLines (line :: lines) | |
168 | in | |
169 | readLines [] | |
170 | before TextIO.closeIn inf | |
171 | end | |
172 | ||
52ed7f53 CE |
173 | fun readTosBody () = readFile (Config.staticFilesRoot ^ "tos.body.html") |
174 | fun readTosAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.html") | |
175 | fun readTosMinorAgree () = readFile (Config.staticFilesRoot ^ "tos.agree.minor.html") | |
f3f3ad24 | 176 | |
d5f8418b AC |
177 | fun searchPaypal paypal = |
178 | C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, | |
179 | msg, unix_passwd, paypal, checkout | |
180 | FROM MemberApp | |
9953bee7 | 181 | WHERE paypal = ^(C.stringToSql (normEmail paypal)) |
d5f8418b AC |
182 | AND status = 2 |
183 | AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' | |
184 | ORDER BY applied`) | |
185 | ||
186 | fun searchCheckout checkout = | |
187 | C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, | |
188 | msg, unix_passwd, paypal, checkout | |
189 | FROM MemberApp | |
9953bee7 | 190 | WHERE checkout = ^(C.stringToSql (normEmail checkout)) |
d5f8418b AC |
191 | AND status = 2 |
192 | AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' | |
193 | ORDER BY applied`) | |
194 | ||
93f77ca7 | 195 | end |