X-Git-Url: https://git.hcoop.net/bpt/portal.git/blobdiff_plain/59eb5381735d29cc1e985cf8bc8a328640fede44..7be17e399998dd47138ad59821dde0447c207b61:/init.sml

diff --git a/init.sml b/init.sml
index c5f5fa9..cd066b1 100644
--- a/init.sml
+++ b/init.sml
@@ -4,6 +4,16 @@ struct
 open Util Sql Config
 structure C = PgClient
 
+fun nullableFromSql f x =
+    if C.isNull x then
+	NONE
+    else
+	SOME (f x)
+fun nullableToSql f x =
+    case x of
+	NONE => "NULL"
+      | SOME x => f x
+
 exception Access of string
 exception NeedTos
 
@@ -11,7 +21,7 @@ fun conn () = C.conn dbstring
 val close = C.close
 
 type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
-	     app : int, shares : int}
+	     app : int, shares : int, paypal : string option, checkout : string option }
 
 val db = ref (NONE : C.conn option)
 val user = ref (NONE : user option)
@@ -26,10 +36,12 @@ fun rowError (tab, vs) = raise Fail ("Bad " ^ tab ^ "row: " ^ makeSet fromSql vs
 
 fun getDb () = valOf (!db)
 
-fun mkUserRow [id, name, rname, bal, joined, app, shares] =
+fun mkUserRow [id, name, rname, bal, joined, app, shares, paypal, checkout] =
     {id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
      bal = C.intFromSql bal, joined = C.timestampFromSql joined,
-     app = C.intFromSql app, shares = C.intFromSql shares}
+     app = C.intFromSql app, shares = C.intFromSql shares,
+     paypal = nullableFromSql C.stringFromSql paypal,
+     checkout = nullableFromSql C.stringFromSql checkout}
   | mkUserRow row = rowError ("user", row)
 
 fun init () =
@@ -50,7 +62,7 @@ fun init () =
 		    else
 			name
 	    in
-		case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares
+		case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
   				        FROM WebUserActive
 					WHERE name=^(C.stringToSql name)`) of
 		    NONE => raise Fail "User not found"
@@ -92,17 +104,17 @@ fun getUserId () = #id (getUser ())
 fun getUserName () = #name (getUser ())
 
 fun lookupUser id =
-    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app, shares
+    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
 				      FROM WebUser
 			     	      WHERE id = ^(C.intToSql id)`))
 
 fun listUsers () =
-    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
 			          ORDER BY name`)
 
 fun listActiveUsers () =
-    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 WebUserActive
 			          ORDER BY name`)
 
@@ -116,9 +128,11 @@ fun addUser (name, rname, bal, app, shares) =
 	val db = getDb ()
 	val id = nextSeq (db, "WebUserSeq")
     in
-	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app, shares)
+	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app, shares, paypal, checkout)
 		    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal),
-			    CURRENT_TIMESTAMP, ^(C.intToSql app), ^(C.intToSql shares))`);
+			    CURRENT_TIMESTAMP, ^(C.intToSql app), ^(C.intToSql shares),
+			    (SELECT paypal FROM MemberApp WHERE id = ^(C.intToSql app)),
+			    (SELECT checkout FROM MemberApp WHERE id = ^(C.intToSql app)))`);
 	id
     end
 
@@ -129,12 +143,14 @@ fun modUser (user : user) =
 	ignore (C.dml db ($`UPDATE WebUser SET
 			    name = ^(C.stringToSql (#name user)), rname = ^(C.stringToSql (#rname user)),
 			       bal = ^(C.intToSql (#bal user)), app = ^(C.intToSql (#app user)),
-			       shares = ^(C.intToSql (#shares user))
+			       shares = ^(C.intToSql (#shares user)),
+			       paypal = ^(nullableToSql (C.stringToSql o Util.normEmail) (#paypal user)),
+			       checkout = ^(nullableToSql (C.stringToSql o Util.normEmail) (#checkout user))
 			    WHERE id = ^(C.intToSql (#id user))`))
     end
 
 fun byPledge () =
-    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
 				  WHERE shares > 1
 			          ORDER BY shares DESC, name`)
@@ -283,4 +299,16 @@ fun usersInAfs () =
 	List.map OS.Path.file acc
     end
 
+fun searchPaypal paypal =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
+			          FROM WebUser
+				  WHERE paypal = ^(C.stringToSql (normEmail paypal))
+			          ORDER BY name`)
+    
+fun searchCheckout checkout =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout
+			          FROM WebUser
+				  WHERE checkout = ^(C.stringToSql (normEmail checkout))
+			          ORDER BY name`)
+
 end