From 20acb9257f2b32de71c09455c77f758df1d99b1c Mon Sep 17 00:00:00 2001 From: adamch Date: Thu, 22 Nov 2007 19:24:00 +0000 Subject: [PATCH] Using saved PayPal and Checkout e-mail addresses --- app.sig | 6 ++- app.sml | 39 ++++++++++---- app/app.sig | 3 +- app/app.sml | 18 +++++-- app/join.mlt | 15 ++++-- apps.mlt | 14 ++++- balance.sml | 2 +- group.sml | 9 ++-- init.sig | 7 ++- init.sml | 44 ++++++++++++---- location.sml | 11 ++-- money.mlt | 142 +++++++++++++++++++++++++++++++++++++++++++++++++-- money.sml | 2 +- payment.mlt | 10 ++++ poll.sml | 4 +- portal.mlt | 4 +- pref.mlt | 17 +++++- tables.sql | 10 ++-- util.sig | 2 + util.sml | 2 + 20 files changed, 305 insertions(+), 56 deletions(-) diff --git a/app.sig b/app.sig index 00cc343..f31c5be 100644 --- a/app.sig +++ b/app.sig @@ -16,7 +16,8 @@ sig passwd : string, status : status, applied : Init.C.timestamp, ipaddr : string option, confirmed : Init.C.timestamp option, decided : Init.C.timestamp option, - msg : string, unix_passwd : string } + msg : string, unix_passwd : string, + paypal : string option, checkout : string option } val lookupApp : int -> app val listApps : status -> app list @@ -30,4 +31,7 @@ sig val add : int -> unit val abortAdd : int -> unit val welcome : int -> unit + + val searchPaypal : string -> app list + val searchCheckout : string -> app list end diff --git a/app.sml b/app.sml index 93a94eb..117ae05 100644 --- a/app.sml +++ b/app.sml @@ -32,24 +32,27 @@ type app = { id : int, name : string, rname : string, gname : string option, ema forward : bool, uses : string, other : string, passwd : string, status : status, applied : C.timestamp, ipaddr : string option, confirmed : C.timestamp option, decided : C.timestamp option, - msg : string, unix_passwd : string} + msg : string, unix_passwd : string, + paypal : string option, checkout : string option } fun mkAppRow [id, name, rname, gname, email, forward, uses, other, passwd, status, - applied, ipaddr, confirmed, decided, msg, unix_passwd] = + applied, ipaddr, confirmed, decided, msg, unix_passwd, paypal, checkout] = { id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname, - gname = (if C.isNull gname then NONE else SOME (C.stringFromSql gname)), + gname = Init.nullableFromSql C.stringFromSql gname, email = C.stringFromSql email, forward = C.boolFromSql forward, uses = C.stringFromSql uses, other = C.stringFromSql other, passwd = C.stringFromSql passwd, status = statusFromSql status, applied = C.timestampFromSql applied, - ipaddr = (if C.isNull ipaddr then NONE else SOME (C.stringFromSql ipaddr)), - confirmed = if C.isNull confirmed then NONE else SOME (C.timestampFromSql confirmed), - decided = if C.isNull decided then NONE else SOME (C.timestampFromSql decided), - msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd} + ipaddr = Init.nullableFromSql C.stringFromSql ipaddr, + confirmed = Init.nullableFromSql C.timestampFromSql confirmed, + decided = Init.nullableFromSql C.timestampFromSql decided, + msg = C.stringFromSql msg, unix_passwd = C.stringFromSql unix_passwd, + paypal = Init.nullableFromSql C.stringFromSql paypal, + checkout = Init.nullableFromSql C.stringFromSql checkout} | mkAppRow r = rowError ("app", r) fun lookupApp id = case C.oneOrNoRows (getDb ()) ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, - msg, unix_passwd + msg, unix_passwd, paypal, checkout FROM MemberApp WHERE id = ^(C.intToSql id)`) of SOME row => mkAppRow row @@ -57,7 +60,7 @@ fun lookupApp id = fun listApps status = C.map (getDb ()) mkAppRow ($`SELECT id, name, rname, gname, email, forward, uses, other, passwd, status, applied, ipaddr, confirmed, decided, - msg, unix_passwd + msg, unix_passwd, paypal, checkout FROM MemberApp WHERE status = ^(statusToSql status) AND NOT (status = 2 AND decided < CURRENT_TIMESTAMP - INTERVAL '1 MONTH') @@ -162,4 +165,22 @@ fun readTosBody () = readFile "/home/hcoop/public_html/tos.body.html" fun readTosAgree () = readFile "/home/hcoop/public_html/tos.agree.html" fun readTosMinorAgree () = readFile "/home/hcoop/public_html/tos.agree.minor.html" +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)) + AND status = 2 + AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' + ORDER BY applied`) + +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)) + AND status = 2 + AND decided >= CURRENT_TIMESTAMP - INTERVAL '1 MONTH' + ORDER BY applied`) + end diff --git a/app/app.sig b/app/app.sig index 86f8118..8df47d8 100644 --- a/app/app.sig +++ b/app/app.sig @@ -10,7 +10,8 @@ sig val readTosMinorAgree : unit -> string type application = { name : string, rname : string, gname : string option, email : string, - forward : bool, uses : string, other : string } + forward : bool, uses : string, other : string, + paypal : string option, checkout : string option } val apply : application -> string option diff --git a/app/app.sml b/app/app.sml index f142e1b..fde065e 100644 --- a/app/app.sml +++ b/app/app.sml @@ -93,7 +93,8 @@ fun sendMail (to, subj, intro, footer, id) = end type application = { name : string, rname : string, gname : string option, email : string, - forward : bool, uses : string, other : string } + forward : bool, uses : string, other : string, + paypal : string option, checkout : string option } fun randomPassword () = let @@ -107,7 +108,14 @@ fun randomPassword () = | _ => raise Fail "Couldn't parse output of apg" end -fun apply {name, rname, gname, email, forward, uses, other} = +val allLower = CharVector.map Char.toLower + +fun emailToSql so = + case so of + NONE => "NULL" + | SOME s => C.stringToSql (allLower s) + +fun apply {name, rname, gname, email, forward, uses, other, paypal, checkout} = let val db = getDb () in @@ -118,12 +126,14 @@ fun apply {name, rname, gname, email, forward, uses, other} = val passwd = Int.toString (Int.abs (Random.randInt (!rnd))) val unix_passwd = randomPassword () in - C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd, status, applied, msg, unix_passwd) + C.dml db ($`INSERT INTO MemberApp (id, name, rname, gname, email, forward, uses, other, passwd, + status, applied, msg, unix_passwd, paypal, checkout) VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(case gname of NONE => "NULL" | SOME gname => C.stringToSql gname), ^(C.stringToSql email), ^(C.boolToSql forward), ^(C.stringToSql uses), ^(C.stringToSql other), ^(C.stringToSql passwd), 0, CURRENT_TIMESTAMP, - '', ^(C.stringToSql unix_passwd))`); + '', ^(C.stringToSql unix_passwd), + ^(emailToSql paypal), ^(emailToSql checkout))`); if sendMail (email, "Confirm membership application", "We've received a request to join the Internet Hosting Cooperative (hcoop.net) with this e-mail address.", fn mwrite => (mwrite ("To confirm this application, visit "); diff --git a/app/join.mlt b/app/join.mlt index dbe8d08..3e715b6 100644 --- a/app/join.mlt +++ b/app/join.mlt @@ -30,7 +30,9 @@ %>

Invalid e-mail address

<% else switch App.apply { name = name, rname = rname, email = email, gname = (case gname of "" => NONE | _ => SOME gname), - forward = forward, uses = uses, other = other } of + forward = forward, uses = uses, other = other, + paypal = (case $"paypal" of "" => NONE | s => SOME s), + checkout = (case $"checkout" of "" => NONE | s => SOME s) } of NONE => %>

Error sending confirmation e-mail

<% | SOME unix_passwd => %>

Application recorded

@@ -53,11 +55,14 @@ else <% else %> Your "real" name: Please enter your full name, as you would on a normal, legally binding contract. <% end %> - Contact e-mail address - Check this box if you would like to use hcoop as your primary e-mail provider.
+ Contact e-mail address + PayPal account e-mail: + Google Checkout account e-mail:
+ These payment service provider e-mail addresses are optional. You will probably end up using one or the other of these providers if your application is approved, and entering here the e-mail address that you've used to sign up with that provider will help us process your payment accurately and promptly. E-mail addresses you enter here should match those seen by recipients of payments that you send. + Check this box if you would like to use HCoop as your primary e-mail provider.
If you don't select this option and you are approved to join, e-mail to your account will be forwarded to the address you provide here.
- You can change this option later, but we'll probably have helpful things to e-mail you as soon as you join. It's important that we be able to reach members reliably, so please don't decide to use us as your primary e-mail provider unless you can commit to checking your hcoop mailbox just as often as any other personal accounts you have. - How do you plan to use a hcoop membership? + You can change this option later, but we'll probably have helpful things to e-mail you as soon as you join. It's important that we be able to reach members reliably, so please don't decide to use us as your primary e-mail provider unless you can commit to checking your HCoop mailbox just as often as any other personal accounts you have. + How do you plan to use a HCoop membership? Any other information about yourself diff --git a/apps.mlt b/apps.mlt index 395beca..c59d18a 100644 --- a/apps.mlt +++ b/apps.mlt @@ -71,6 +71,12 @@ elseif $"cmd" = "approved" then Username: <% #name appl %> Real name: <% Web.html (#rname appl) %> E-mail address: <% #email appl %> + <% switch #paypal appl of + SOME s => %> PayPal: <% s %> + <% end; + switch #checkout appl of + SOME s => %> Google Checkout: <% s %> + <% end %> Forward e-mail? <% if #forward appl then %>yes<% else %>no<% end %> Proposed uses: <% Web.htmlNl (#uses appl) %> Other information: <% Web.htmlNl (#other appl) %> @@ -102,7 +108,7 @@ First, run this on deleuze: <% end %> Initial transaction amount: - Initial transaction description: + Initial transaction description: Subscribe to hcoop-announce Groups: - + @@ -342,7 +345,121 @@ foreach (name, cha) in Money.listChargesWithNames id do end %>
Description:
Date:
Date: ">
Amount:
Member:
-<% end %> +<% elseif $"cmd" = "paypal" then + showNormal := false; + val apps = App.searchPaypal ($"email"); + val users = Init.searchPaypal ($"email"); + + switch apps of + _ :: _ => + %>

Approved applications

+ + <% foreach appl in apps do %> +

+ + + + + + + <% switch #paypal appl of + SOME s => %> + <% end; + switch #checkout appl of + SOME s => %> + <% end %> + + + +
Received: <% #applied appl %>
Approved by: <% + ref first = true; + ref found = false; + foreach (id, name) in App.votes (#id appl) do + if first then + first := false + else + %>, <% + end + %><% name %><% + end %>
Username: <% #name appl %>
Real name: <% Web.html (#rname appl) %>
E-mail address: <% #email appl %>
PayPal: <% s %>
Google Checkout: <% s %>
Forward e-mail? <% if #forward appl then %>yes<% else %>no<% end %>
Proposed uses: <% Web.htmlNl (#uses appl) %>
Other information: <% Web.htmlNl (#other appl) %>
+ + <% if root then %> + Add this member.
+ <% end + end + end; + + switch users of + _ :: _ => + %>

Members

+ + <% foreach user in users do %> +
  • <% #name user %> [add payment]
    • + <% end + end; + + switch (apps, users) of + (nil, nil) => %>No matches.<% + end + +elseif $"cmd" = "checkout" then + showNormal := false; + val apps = App.searchCheckout ($"email"); + val users = Init.searchCheckout ($"email"); + + switch apps of + _ :: _ => + %>

    Approved applications

    + + <% foreach appl in apps do %> +

    + + + + + + + <% switch #paypal appl of + SOME s => %> + <% end; + switch #checkout appl of + SOME s => %> + <% end %> + + + +
    Received: <% #applied appl %>
    Approved by: <% + ref first = true; + ref found = false; + foreach (id, name) in App.votes (#id appl) do + if first then + first := false + else + %>, <% + end + %><% name %><% + end %>
    Username: <% #name appl %>
    Real name: <% Web.html (#rname appl) %>
    E-mail address: <% #email appl %>
    PayPal: <% s %>
    Google Checkout: <% s %>
    Forward e-mail? <% if #forward appl then %>yes<% else %>no<% end %>
    Proposed uses: <% Web.htmlNl (#uses appl) %>
    Other information: <% Web.htmlNl (#other appl) %>
    + + <% if root then %> + Add this member.
    + <% end + end + end; + + switch users of + _ :: _ => + %>

    Members

    + + <% foreach user in users do %> +
  • <% #name user %> [add payment]
    • + <% end + end; + + switch (apps, users) of + (nil, nil) => %>No matches.<% + end + +end %> <% if showNormal then %> @@ -364,6 +481,21 @@ end %> Generic/even

    Equalize balances
    +
    + +

    Look up a PayPal e-mail address

    + +
    + + +
    + +

    Look up a Google Checkout e-mail address

    + +
    + + +

    Most recent transactions

    diff --git a/money.sml b/money.sml index 6aae9c4..f4423ac 100644 --- a/money.sml +++ b/money.sml @@ -86,7 +86,7 @@ val mkUserRow' = | row => Init.rowError ("listUsers", row) fun listUsers trn = - C.map (getDb ()) mkUserRow' ($`SELECT trn, id, name, rname, bal, joined, app, shares + C.map (getDb ()) mkUserRow' ($`SELECT trn, id, name, rname, bal, joined, app, shares, paypal, checkout FROM WebUser LEFT OUTER JOIN Charge ON usr = id AND trn = ^(C.intToSql trn) ORDER BY name`) diff --git a/payment.mlt b/payment.mlt index 067bf49..c3881bc 100644 --- a/payment.mlt +++ b/payment.mlt @@ -1,5 +1,11 @@ +<% val you = Init.getUser () %> +

    Add to your balance with PayPal

    +<% switch #paypal you of + NONE => %>

    You haven't set a PayPal e-mail address. If you are going to send a payment by PayPal, please set a PayPal e-mail address on the Preferences page first to ensure that you are credited promptly and accurately.

    <% +end %> +

    Add to your balance with Google Checkout: @@ -19,3 +25,7 @@

    + +<% switch #checkout you of + NONE => %>

    You haven't set a Google Checkout e-mail address. If you are going to send a payment by Google Checkout, please set a Checkout e-mail address on the Preferences page first to ensure that you are credited promptly and accurately.

    <% +end %> \ No newline at end of file diff --git a/poll.sml b/poll.sml index 1d08f70..06d49a8 100644 --- a/poll.sml +++ b/poll.sml @@ -196,7 +196,7 @@ fun noDupes l = | h::t => List.all (fn x => x <> h) t andalso noDupes t fun listVoters cho = - C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares + C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout FROM WebUser, Vote WHERE usr = id AND cho = ^(C.intToSql cho) @@ -209,7 +209,7 @@ fun countVoters pol = | row => Init.rowError ("countVoters", row) fun listPollVoters pol = - C.map (getDb ()) mkUserRow ($`SELECT DISTINCT WebUser.id, name, rname, bal, joined, app, shares + C.map (getDb ()) mkUserRow ($`SELECT DISTINCT WebUser.id, name, rname, bal, joined, app, shares, paypal, checkout FROM WebUser, Vote JOIN PollChoice ON cho = PollChoice.id WHERE pol = ^(C.intToSql pol) AND usr = WebUser.id diff --git a/portal.mlt b/portal.mlt index 42d2eb7..3492692 100644 --- a/portal.mlt +++ b/portal.mlt @@ -40,6 +40,6 @@ switch issues of end %>
    <% end -end %> +end; -<% @footer [] %> \ No newline at end of file +@footer [] %> diff --git a/pref.mlt b/pref.mlt index 1db9f8b..deea051 100644 --- a/pref.mlt +++ b/pref.mlt @@ -1,10 +1,17 @@ <% val you = Init.getUserId (); + val yourname = Init.getUserName (); val youremail = yourname ^ "@hcoop.net"; @header [("title", ["Member preferences"])]; if $"cmd" = "mod" then + val you_all = Init.getUser (); + + Init.modUser {you_all with + paypal = (case $"paypal" of "" => NONE | s => SOME s), + checkout = (case $"checkout" of "" => NONE | s => SOME s)}; + if $"dir" = "on" then Pref.setDirectory you else @@ -33,13 +40,19 @@ if $"cmd" = "mod" then end; %>

    Preferences updated

    <% -end %> +end; + +val you_all = Init.lookupUser you %> -

    This page doesn't work yet. You should visit the corresponding page on the old portal if you want to change anything.

    +

    The mailing list checkboxes on this page don't work yet. You should visit the corresponding page on the old portal if you want to change subscriptions.

    + + + + diff --git a/tables.sql b/tables.sql index f0067e8..56a68ed 100644 --- a/tables.sql +++ b/tables.sql @@ -14,7 +14,9 @@ CREATE TABLE MemberApp( confirmed TIMESTAMP, decided TIMESTAMP, msg TEXT NOT NULL, - unix_passwd TEXT NOT NULL); + unix_passwd TEXT NOT NULL, + paypal TEXT, + checkout TEXT); CREATE SEQUENCE MemberAppSeq START 1; @@ -37,6 +39,8 @@ CREATE TABLE WebUser( joined TIMESTAMP NOT NULL, app INTEGER NOT NULL, shares INTEGER NOT NULL, + paypal TEXT, + checkout TEXT FOREIGN KEY (bal) REFERENCES Balance(id) ON DELETE CASCADE, FOREIGN KEY (app) REFERENCES MemberApp(id) ON DELETE CASCADE); @@ -270,7 +274,7 @@ CREATE TABLE AppVote( FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE); CREATE VIEW WebUserPaying - AS SELECT id, name, rname, bal, joined, app, shares + AS SELECT id, name, rname, bal, joined, app, shares, paypal, checkout FROM WebUser JOIN (SELECT usr FROM Membership JOIN WebGroup ON grp = WebGroup.id @@ -278,7 +282,7 @@ CREATE VIEW WebUserPaying ON usr = WebUser.id; CREATE VIEW WebUserActive - AS SELECT id, name, rname, bal, joined, app, shares + AS SELECT id, name, rname, bal, joined, app, shares, paypal, checkout FROM WebUser LEFT OUTER JOIN (SELECT usr FROM Membership JOIN WebGroup ON grp = WebGroup.id AND (WebGroup.name IN ('retired', 'phantom'))) AS mem diff --git a/util.sig b/util.sig index 5a5697b..9c7b4fc 100644 --- a/util.sig +++ b/util.sig @@ -29,4 +29,6 @@ sig val readFile : string -> string val mem : ''a * ''a list -> bool + + val allLower : string -> string end diff --git a/util.sml b/util.sml index d1c7214..a0a649c 100644 --- a/util.sml +++ b/util.sml @@ -81,4 +81,6 @@ fun readFile fname = fun mem (x, ls) = List.exists (fn y => y = x) ls +val allLower = CharVector.map Char.toLower + end -- 2.20.1
    PayPal e-mail address: s end %>">
    Google Checkout e-mail address: s end %>">
    (E-mail addresses you enter here should match those seen by recipients of payments that you send.)
    checked<% end %>> Include me in the public member directory.
    checked<% end %>> Include me on the hcoop-discuss mailing list. (On-topic discussion and sporadically high volume)
    checked<% end %>> Include me on the hcoop-sysadmin mailing list. (Discussion about technical adminstrative planning and related issues, not dealing directly with member support requests)