X-Git-Url: https://git.hcoop.net/hcoop/portal.git/blobdiff_plain/d5f8418bc9167e9597c463175b38830ba17624b6..ac5cb613b0f0a143eaeed801979bfc56e7c88e40:/app.sml diff --git a/app.sml b/app.sml index 117ae05..aa9fb15 100644 --- a/app.sml +++ b/app.sml @@ -9,6 +9,7 @@ datatype status = | ACCEPTED | REJECTED | ADDED + | BEING_ADDED val statusFromInt = fn 0 => CONFIRMING @@ -16,6 +17,7 @@ val statusFromInt = | 2 => ACCEPTED | 3 => REJECTED | 4 => ADDED + | 5 => BEING_ADDED | _ => raise C.Sql "Bad status" val statusToInt = @@ -24,6 +26,7 @@ val statusToInt = | ACCEPTED => 2 | REJECTED => 3 | ADDED => 4 + | BEING_ADDED => 5 fun statusFromSql v = statusFromInt (C.intFromSql v) fun statusToSql s = C.intToSql (statusToInt s) @@ -58,11 +61,11 @@ fun lookupApp id = SOME row => mkAppRow row | NONE => raise Fail "Membership application not found" -fun listApps status = +fun listApps statuses = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout FROM MemberApp - WHERE status = ^(statusToSql status) + WHERE status IN (^(String.concatWith "," (map statusToSql statuses))) AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') ORDER BY applied`) @@ -116,10 +119,10 @@ fun approve (app, msg) = OS.Process.isSuccess (Mail.mclose mail) end -fun add app = +fun preAdd app = let val _ = C.dml (getDb ()) ($`UPDATE MemberApp - SET status = 3 + SET status = 5 WHERE id = ^(C.intToSql app)`) val app = lookupApp app @@ -127,9 +130,20 @@ fun add app = val outf = TextIO.openOut (Config.passwordFiles ^ #name app) in TextIO.output (outf, #unix_passwd app); + TextIO.output1 (outf, #"\n"); TextIO.closeOut outf end +fun add app = + let + val appR = lookupApp app + in + ignore (C.dml (getDb ()) ($`UPDATE MemberApp + SET status = 4 + WHERE id = ^(C.intToSql app)`)); + OS.FileSys.remove (Config.passwordFiles ^ #name appR) + end + fun welcome app = let val app = lookupApp app @@ -169,7 +183,7 @@ fun searchPaypal paypal = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout FROM MemberApp - WHERE paypal = ^(C.stringToSql (Util.allLower paypal)) + WHERE paypal = ^(C.stringToSql (normEmail paypal)) AND status = 2 AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' ORDER BY applied`) @@ -178,7 +192,7 @@ fun searchCheckout checkout = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout FROM MemberApp - WHERE checkout = ^(C.stringToSql (Util.allLower checkout)) + WHERE checkout = ^(C.stringToSql (normEmail checkout)) AND status = 2 AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' ORDER BY applied`)