Bump

lib/Zureg/Database.hs

@@ -22,7 +22,9 @@ module Zureg.Database
     , putRegistrantsSummary
 
     -- New stuff
+    , insertRegistration
     , setRegistrationState
+    , setRegistrationScanned
     ) where
 
 import           Control.Exception      (Exception)
@@ -90,5 +92,11 @@ putRegistrantsSummary _ _ = pure ()
 lookupRegistrantsSummary :: Handle -> IO RegistrantsSummary
 lookupRegistrantsSummary _ = undefined
 
+insertRegistration :: Handle -> UUID -> InsertRegistration -> IO Registration
+insertRegistration _ _ _ = undefined
+
 setRegistrationState :: Handle -> UUID -> RegistrationState -> IO Registration
 setRegistrationState _ _ _ = undefined
+
+setRegistrationScanned :: Handle -> UUID -> IO Registration
+setRegistrationScanned _ _ = undefined

lib/Zureg/Database/Migrations/01-init.sql

@@ -32,7 +32,7 @@ INSERT INTO occupations (occupation) VALUES ('Tech');
 INSERT INTO occupations (occupation) VALUES ('Academia');
 INSERT INTO occupations (occupation) VALUES ('Other');
 
-CREATE TABLE registrants (
+CREATE TABLE registrations (
     id UUID NOT NULL PRIMARY KEY DEFAULT GEN_RANDOM_UUID(),
     email TEXT NOT NULL,
     name TEXT NOT NULL,
@@ -45,12 +45,17 @@ CREATE TABLE registrants (
     region TEXT,
     CONSTRAINT region_fk FOREIGN KEY (region) REFERENCES regions (region),
     occupation TEXT,
-    CONSTRAINT registrants_occupation_fk FOREIGN KEY (occupation)
+    CONSTRAINT registrations_occupation_fk FOREIGN KEY (occupation)
         REFERENCES occupations (occupation),
-    beginner_track_interest BOOLEAN NOT NULL
+    beginner_track_interest BOOLEAN NOT NULL,
+    state TEXT NOT NULL,
+    CONSTRAINT state_fk FOREIGN KEY (state)
+      REFERENCES registration_states (state),
+    scanned_at TIMESTAMPTZ,
+    vip BOOLEAN NOT NULL DEFAULT false
 );
 
-CREATE UNIQUE INDEX registrants_email_idx ON registrants (email);
+CREATE UNIQUE INDEX registrations_email_idx ON registrations (email);
 
 CREATE TABLE projects (
     id UUID NOT NULL PRIMARY KEY DEFAULT GEN_RANDOM_UUID(),
@@ -62,5 +67,5 @@ CREATE TABLE projects (
     contributor_level_advanced BOOLEAN NOT NULL,
     registrant_id UUID NOT NULL,
     CONSTRAINT registrant_id_fk FOREIGN KEY (registrant_id)
-        REFERENCES registrants (id)
+        REFERENCES registrations (id)
 );

lib/Zureg/Hackathon/Interface.hs

@@ -23,6 +23,8 @@ data Hackathon = Hackathon
     , emailFrom      :: T.Text
     -- | When T-shirt order is sent.
     , tShirtDeadline :: Maybe Time.UTCTime
+    -- | Secret for accessing the scanner page.
+    , scannerSecret :: T.Text
     }
 
 hackathonFromEnv :: IO Hackathon

lib/Zureg/Main/Web.hs

@@ -29,6 +29,7 @@ import qualified Zureg.Captcha             as Captcha
 import qualified Zureg.Database            as Database
 import           Zureg.Database.Models
 import           Zureg.Form
+import qualified Zureg.Hackathon.ZuriHac2020.Discord as Discord
 import qualified Zureg.Hackathon           as Hackathon
 import           Zureg.Hackathon           (Hackathon)
 import           Zureg.Http
@@ -39,10 +40,15 @@ import qualified Zureg.Views               as Views
 main :: forall a. (A.FromJSON a, A.ToJSON a) => Hackathon a -> IO ()
 main hackathon = do
     dbConfig <- Database.configFromEnv
+    discord <- Discord.configFromEnv
     app dbConfig hackathon >>= Warp.run 8000
 
-app :: forall a. (A.FromJSON a, A.ToJSON a) => Database.Config -> Hackathon a -> IO Wai.Application
-app dbConfig hackathon =
+app
+    :: Database.Config
+    -> Discord.Config
+    -> Hackathon
+    -> IO Wai.Application
+app dbConfig discord hackathon =
     fmap httpExceptionMiddleware $
     Http.newManager Http.tlsManagerSettings >>= \httpManager ->
     Database.withHandle dbConfig $ \db ->
@@ -88,7 +94,7 @@ app dbConfig hackathon =
 
         ["ticket"] | Wai.requestMethod req == Http.methodGet -> do
             uuid <- getUuidParam req
-            registrant <- Database.getRegistrant db uuid :: IO (Registrant a)
+            registrant <- Database.getRegistrant db uuid
             respond . html $ Views.ticket hackathon registrant
 
         ["scanner"] | Wai.requestMethod req == Http.methodGet  ->
@@ -99,56 +105,38 @@ app dbConfig hackathon =
             scannerAuthorized req $ do
                 time <- Time.getCurrentTime
                 uuid <- getUuidParam req
-                registrant <- Database.getRegistrant db uuid :: IO (Registrant a)
-                Database.writeEvents db uuid [Scan $ ScanInfo time :: Event a]
+                Database.setRegistrationScanned db uuid
+                registrant <- Database.getRegistrant db uuid
                 respond . html $ Views.scan hackathon registrant
 
         ["chat"] -> do
             time <- Time.getCurrentTime
             uuid <- getUuidParam req
-            registrant <- Database.getRegistrant db uuid :: IO (Registrant a)
+            registrant <- Database.getRegistrant db uuid
             unless (registrantCanJoinChat $ rState registrant) $ throwIO $
                 HttpException 400
                 "Invalid registrant state"
 
-            url <- Hackathon.chatUrl hackathon
-            Database.writeEvents db uuid
-                [JoinChat $ JoinChatInfo time :: Event a]
+            welcomeChannel <- Discord.getWelcomeChannelId discord
+            url <- Discord.generateTempInviteUrl discord welcomeChannel
             respond $ redirect url
 
         ["confirm"] | Hackathon.confirmation hackathon -> do
             uuid <- getUuidParam req
-            registrant <- Database.getRegistrant db uuid :: IO (Registrant a)
+            registrant <- Database.getRegistrant db uuid
             case rState registrant of
-              Just Registered -> Database.writeEvents db uuid [Confirm :: Event a]
+              Just Registered -> Database.setRegistrationState db uuid Confirmed
               _               -> return ()
             respond . redirect $ "ticket?uuid=" <> UUID.toText uuid
 
-        ["spam"] | Wai.requestMethod req == Http.methodPost -> do
-            uuid <- getUuidParam req
-            _    <- Database.getRegistrant db uuid :: IO (Registrant a)
-            Database.writeEvents db uuid [MarkSpam :: Event a]
-            respond . redirect $ "ticket?uuid=" <> UUID.toText uuid
-
-        ["vip"] | Wai.requestMethod req == Http.methodPost ->
-            scannerAuthorized req $ do
-            uuid <- getUuidParam req
-            _    <- Database.getRegistrant db uuid :: IO (Registrant a)
-            Database.writeEvents db uuid [MarkVip :: Event a]
-            respond . redirect $ "ticket?uuid=" <> UUID.toText uuid
-
         ["cancel"] -> do
             reqBody <- TL.decodeUtf8 <$> Wai.strictRequestBody req
             (view, mbCancel) <- runForm req reqBody "cancel" $
                 cancelForm (lookupUuidParam req)
             case mbCancel of
                 Just (uuid, True) -> do
-                    registrant <- Database.getRegistrant db uuid :: IO (Registrant a)
                     -- TODO: Check that not yet cancelled?
-                    Database.writeEvents db uuid [Cancel :: Event a]
-                    case rInfo registrant of
-                        Nothing   -> return ()
-                        Just info ->  Database.deleteEmail db $ riEmail info
+                    registrant <- Database.setRegistrationState db uuid Cancelled
                     respond . html $ Views.cancelSuccess
                 _ -> respond . html $
                     Views.cancel (lookupUuidParam req) view