payment: note that Stripe has instituted an additional 1% fee for non-US cards

[hcoop/portal.git] / poll.sml

diff --git a/poll.sml b/poll.sml
index 1d08f70..34868cf 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -3,47 +3,52 @@ struct
 
 open Util Sql Init
 
-type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int}
+type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool, ready : bool}
 
-fun mkPollRow [id, usr, title, descr, starts, ends, votes] =
+fun mkPollRow [id, usr, title, descr, starts, ends, votes, official, ready] =
     {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title,
      descr = C.stringFromSql descr, starts = C.stringFromSql starts,
-     ends = C.stringFromSql ends, votes = C.intFromSql votes}
+     ends = C.stringFromSql ends, votes = C.intFromSql votes, official = C.boolFromSql official,
+     ready = C.boolFromSql ready}
   | mkPollRow row = Init.rowError ("poll", row)
 
 fun lookupPoll id =
-    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes
+    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                     FROM Poll
                                     WHERE id = ^(C.intToSql id)`) of
        NONE => raise Fail "Poll not found"
       | SOME row => mkPollRow row
 
 fun listPolls () =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
+                                 WHERE ready
                                  ORDER BY ends, starts DESC, title`)
 
 fun listCurrentPolls () =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
                                  WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE)
                                     AND EXTRACT(EPOCH FROM ends) >= EXTRACT(EPOCH FROM CURRENT_DATE)
+                                    AND (ready OR usr = ^(C.intToSql (Init.getUserId ()))) 
                                  ORDER BY ends, starts DESC, title`)
 
 fun listPollsLimit lim =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
                                  ORDER BY starts DESC, ends, title
+                                 WHERE (ready OR usr = ^(C.intToSql (Init.getUserId ())))
                                  LIMIT ^(C.intToSql lim)`)
 
-fun addPoll (usr, title, descr, starts, ends, votes) =
+fun addPoll (usr, title, descr, starts, ends, votes, official, ready) =
     let
        val db = getDb ()
        val id = nextSeq (db, "PollSeq")
     in
-       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes)
+       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official, ready)
                    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr),
-                           ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes))`);
+                           ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes), ^(C.boolToSql official),
+                           ^(C.boolToSql ready))`);
        id
     end
 
@@ -55,7 +60,8 @@ fun modPoll (poll : poll) =
                            usr = ^(C.intToSql (#usr poll)), title = ^(C.stringToSql (#title poll)),
                            descr = ^(C.stringToSql (#descr poll)),
                            starts = ^(C.stringToSql (#starts poll)), ends = ^(C.stringToSql (#ends poll)),
-                           votes = ^(C.intToSql (#votes poll))
+                           votes = ^(C.intToSql (#votes poll)), official = ^(C.boolToSql (#official poll)),
+                           ready = ^(C.boolToSql (#ready poll))
                            WHERE id = ^(C.intToSql (#id poll))`))
     end
 
@@ -171,8 +177,9 @@ fun dateLtNow d =
 
 fun canModify (poll : poll) =
     Group.inGroupName "poll"
-    orelse (#usr poll = Init.getUserId()
-           andalso dateLtNow (#starts poll))
+    orelse ((#usr poll = Init.getUserId()
+            andalso (dateLtNow (#starts poll)
+                     orelse not (#ready poll))))
 
 fun requireCanModify poll =
     if canModify poll then
@@ -188,7 +195,7 @@ fun nextSeq pol =
       | row => Init.rowError ("nextSeq", row)
 
 fun takingVotes (poll : poll) =
-    dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
+    #ready poll andalso dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
 
 fun noDupes l =
     case l of
@@ -196,7 +203,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,10 +216,19 @@ 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
                                  ORDER BY name`)
 
+val votingMembershipRequirement = 45
+
+fun membershipLength id =
+    case C.oneRow (getDb ()) ($`SELECT EXTRACT(DAY FROM (CURRENT_TIMESTAMP - joined))
+                               FROM WebUser
+                               WHERE id = ^(C.intToSql id)`) of
+       [days] => C.intFromSql days
+      | row => Init.rowError ("membershipLength", row)
+
 end