Make it compile

flake.nix

@@ -44,15 +44,6 @@
                 -p ${postgres.port}:5432 \
                 -d postgres
             '';
-
-            ZUREG_DB =
-              "postgresql://postgres:${postgres.password}@localhost:${postgres.port}/${postgres.db}";
-
-            ZUREG_HACKATHON_NAME = "ZuriHac 2025";
-            ZUREG_HACKATHON_URL = "https://zureg.zfoh.ch";
-            ZUREG_HACKATHON_CONTACT_URL = "https://zfoh.ch/zurihac2025/#contact";
-            ZUREG_HACKATHON_CAPACITY = "500";
-            ZUREG_HACKATHON_CONFIRMATION = "true";
           };
         };
         formatter = pkgs.nixfmt;

lib/Zureg/AWS.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Zureg.AWS
+    ( Config
+    , smartEnv
+    ) where
+
+import           Amazonka
+import           Amazonka.Auth
+import qualified Amazonka.Data          as Amazonka
+import qualified Data.Aeson             as A
+import qualified Data.Aeson.TH.Extended as A
+import qualified Data.Text              as T
+import qualified Data.Text.Encoding     as T
+import           System.Environment     (lookupEnv)
+import qualified System.IO              as IO
+
+data Config = Config
+    { configRegion    :: !T.Text
+    , configAccessKey :: !T.Text
+    , configSecretKey :: !T.Text
+    } deriving (Show)
+
+-- | AWS region is not retrieved correctly from environment variables, and
+-- neither from the AWS profile.
+smartEnv :: Config -> IO Env
+smartEnv conf = do
+    logger' <- newLogger Info IO.stderr
+    region' <- either fail pure $ Amazonka.fromText (configRegion conf)
+    env <- newEnvNoAuth
+    pure $ fromKeys
+        (AccessKey $ T.encodeUtf8 $ configAccessKey conf)
+        (SecretKey $ T.encodeUtf8 $ configSecretKey conf)
+        env
+        { logger = logger'
+        , region = region'
+        }
+
+$(A.deriveJSON A.options ''Config)

lib/Zureg/Config.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Zureg.Config
+    ( Config (..)
+    , load
+    ) where
+
+import qualified Data.Aeson                          as A
+import qualified Data.Aeson.TH.Extended              as A
+import qualified Data.Text                           as T
+import qualified Zureg.AWS                           as AWS
+import qualified Zureg.Captcha.HCaptcha              as HCaptcha
+import qualified Zureg.Database                      as Database
+import qualified Zureg.Hackathon.Interface           as Hackathon
+import qualified Zureg.Hackathon.ZuriHac2020.Discord as Discord
+
+data Config = Config
+    { configHackathon     :: !Hackathon.Hackathon
+    , configDatabase      :: !Database.Config
+    , configDiscord       :: !Discord.Config
+    , configCaptcha       :: !(Maybe HCaptcha.Config)
+    , configAws           :: !AWS.Config
+    , configScannerSecret :: !T.Text
+    } deriving (Show)
+
+$(A.deriveFromJSON A.options ''Config)
+
+load :: IO Config
+load = either fail pure =<< A.eitherDecodeFileStrict "config.json"

lib/Zureg/Database.hs

@@ -1,13 +1,16 @@
 -- | Storing the registrants in a DynamoDB table.  Uses the `Eventful` library.
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
 module Zureg.Database
     ( Config (..)
     , configFromEnv
     , Handle
     , withHandle
+    , Transaction
+    , withTransaction
 
     -- Old stuff
     , getRegistrant
@@ -22,16 +25,24 @@ module Zureg.Database
     , putRegistrantsSummary
 
     -- New stuff
+    , migrate
     , insertRegistration
+    , selectRegistration
+    , selectRegistrationByEmail
+    , selectAttending
     , setRegistrationState
     , setRegistrationScanned
     ) where
 
-import           Control.Exception      (Exception)
-import qualified Data.Aeson.TH.Extended as A
-import qualified Data.Text              as T
-import           Data.UUID              (UUID)
-import           System.Environment     (lookupEnv)
+import           Control.Exception          (Exception)
+import qualified Data.Aeson                 as A
+import qualified Data.Aeson.TH.Extended     as A
+import qualified Data.Text                  as T
+import           Data.UUID                  (UUID)
+import qualified Database.PostgreSQL.Simple as Pg
+import           System.Environment         (lookupEnv)
+import           Zureg.Database.Internal
+import           Zureg.Database.Migrations
 import           Zureg.Database.Models
 
 data DatabaseException
@@ -42,23 +53,11 @@ data DatabaseException
 
 instance Exception DatabaseException
 
-data Config = Config
-    { cConnectionString :: !T.Text
-    }
-
 configFromEnv :: IO Config
 configFromEnv = do
     cstring <- lookupEnv "ZUREG_DB" >>= maybe (fail "ZUREG_DB not set") pure
     pure Config {cConnectionString = T.pack cstring}
 
-data Handle = Handle
-    { hConfig :: !Config
-    }
-
-withHandle :: Config -> (Handle -> IO a) -> IO a
-withHandle hConfig f = do
-    f Handle {..}
-
 getRegistrant :: Handle -> UUID -> IO Registration
 getRegistrant _ _ = undefined
 
@@ -92,11 +91,73 @@ 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
+insertRegistration :: Transaction -> InsertRegistration -> IO Registration
+insertRegistration (Transaction conn) ir@InsertRegistration {..} = do
+    rows <- Pg.query conn
+        "INSERT INTO registrations (\n\
+        \    name,\n\
+        \    badge_name,\n\
+        \    email,\n\
+        \    affiliation,\n\
+        \    tshirt_size,\n\
+        \    region,\n\
+        \    occupation,\n\
+        \    beginner_track_interest\n\
+        \) VALUES (?, ?, ?, ?, ?, ?, ?, ?)\n\
+        \RETURNING *"
+        ( irName
+        , irBadgeName
+        , irEmail
+        , irAffiliation
+        , irTShirtSize
+        , irRegion
+        , irOccupation
+        , irBeginnerTrackInterest
+        )
+    case rows of
+        [registration] -> pure registration
+        _              -> fail "insertRegistration: expected one row"
+
+
+selectAttending :: Transaction -> IO Int
+selectAttending (Transaction conn) = do
+    rows <- Pg.query conn
+        "SELECT COUNT(*) FROM registrations WHERE state = ? OR state = ?"
+        (Registered, Confirmed) :: IO [Pg.Only Int]
+    case rows of
+        [Pg.Only c] -> pure c
+        _           -> fail "selectAttending: expected one row"
+
+selectRegistration :: Transaction -> UUID -> IO (Maybe Registration)
+selectRegistration (Transaction conn) uuid = do
+    rows <- Pg.query conn
+        "SELECT * FROM registrations WHERE id = ?"
+        (Pg.Only uuid)
+    case rows of
+        [registration] -> pure $ Just registration
+        []             -> pure Nothing
+        _              -> fail
+            "selectRegistration: expected one or zero rows"
+
+selectRegistrationByEmail :: Transaction -> T.Text -> IO (Maybe Registration)
+selectRegistrationByEmail (Transaction conn) email = do
+    rows <- Pg.query conn
+        "SELECT * FROM registrations WHERE email = ?"
+        (Pg.Only email)
+    case rows of
+        [registration] -> pure $ Just registration
+        []             -> pure Nothing
+        _              -> fail
+            "selectRegistrationByEmail: expected one or zero rows"
+
+setRegistrationState :: Transaction -> UUID -> RegistrationState -> IO Registration
+setRegistrationState (Transaction conn) uuid state = do
+    rows <- Pg.query conn
+        "UPDATE registrations SET state = ? WHERE id = ? RETURNING *"
+        (state, uuid)
+    case rows of
+        [registration] -> pure registration
+        _              -> fail "setRegistrationState: expected one row"
+
+setRegistrationScanned :: Transaction -> UUID -> IO Registration
 setRegistrationScanned _ _ = undefined

lib/Zureg/Database/Internal.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards            #-}
+module Zureg.Database.Internal
+    ( Config (..)
+    , Handle (..)
+    , withHandle
+    , Transaction (..)
+    , withTransaction
+    ) where
+
+import           Control.Exception          (bracket)
+import qualified Data.Aeson                 as A
+import qualified Data.ByteString.Char8      as BS8
+import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as T
+import qualified Database.PostgreSQL.Simple as Pg
+
+newtype Config = Config
+    { cConnectionString :: T.Text
+    } deriving (A.FromJSON, Show)
+
+data Handle = Handle
+    { hConfig :: !Config
+    }
+
+withHandle :: Config -> (Handle -> IO a) -> IO a
+withHandle hConfig f = do
+    f Handle {..}
+
+newtype Transaction = Transaction Pg.Connection
+
+withTransaction :: Handle -> (Transaction -> IO a) -> IO a
+withTransaction Handle {..} = bracket
+    (fmap Transaction $ Pg.connectPostgreSQL $
+        T.encodeUtf8 $ cConnectionString hConfig)
+    (\(Transaction conn) -> Pg.close conn)

lib/Zureg/Database/Migrations.hs

@@ -3,18 +3,17 @@ module Zureg.Database.Migrations
     ( migrate
     ) where
 
-import qualified Data.ByteString.Char8      as BS8
 import           Data.Char                  (isDigit)
 import           Data.Foldable              (for_)
 import           Data.List                  (sortOn)
 import           Data.String                (fromString)
 import           Data.Traversable           (for)
 import qualified Database.PostgreSQL.Simple as Pg
 import qualified System.Directory           as Directory
-import           System.Environment         (lookupEnv)
 import           System.FilePath            ((</>))
 import qualified System.IO                  as IO
 import           Text.Read                  (readMaybe)
+import           Zureg.Database.Internal
 
 listMigrations :: IO [(Int, FilePath)]
 listMigrations = sortOn fst <$> do
@@ -27,18 +26,17 @@ listMigrations = sortOn fst <$> do
   where
     dir = "lib/Zureg/Database/Migrations"
 
-migrate :: IO ()
-migrate = do
-    pgstring <- lookupEnv "ZUREG_DB" >>= maybe (fail "ZUREG_DB not set") pure
-    conn <- Pg.connectPostgreSQL $ BS8.pack pgstring
-    _ <- Pg.execute_ conn "\
+migrate :: Handle -> IO ()
+migrate h = do
+    _ <- withTransaction h $ \(Transaction conn) -> Pg.execute_ conn "\
         \CREATE TABLE IF NOT EXISTS migrations (\n\
         \    version INT NOT NULL PRIMARY KEY,\n\
         \    path TEXT NOT NULL\n\
         \)"
 
     migrations <- listMigrations
-    for_ migrations $ \(version, path) -> Pg.withTransaction conn $ do
+    for_ migrations $ \(version, path) -> withTransaction h $
+        \(Transaction conn) -> do
         rows <- Pg.query conn
             "SELECT version FROM migrations WHERE version = ?"
             (Pg.Only version) :: IO [Pg.Only Int]
@@ -53,5 +51,3 @@ migrate = do
                     "INSERT INTO migrations (version, path) VALUES (?, ?)"
                     (version, path)
                 pure ()
-
-    Pg.close conn

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

@@ -32,11 +32,21 @@ INSERT INTO occupations (occupation) VALUES ('Tech');
 INSERT INTO occupations (occupation) VALUES ('Academia');
 INSERT INTO occupations (occupation) VALUES ('Other');
 
+CREATE TABLE registration_states (
+    state TEXT NOT NULL PRIMARY KEY
+);
+
+INSERT INTO registration_states (state) VALUES ('Registered');
+INSERT INTO registration_states (state) VALUES ('Confirmed');
+INSERT INTO registration_states (state) VALUES ('Cancelled');
+INSERT INTO registration_states (state) VALUES ('Waitlisted');
+INSERT INTO registration_states (state) VALUES ('Spam');
+
 CREATE TABLE registrations (
     id UUID NOT NULL PRIMARY KEY DEFAULT GEN_RANDOM_UUID(),
-    email TEXT NOT NULL,
     name TEXT NOT NULL,
     badge_name TEXT,
+    email TEXT NOT NULL,
     affiliation TEXT,
     registered_at TIMESTAMPTZ NOT NULL DEFAULT NOW(),
     tshirt_size TEXT,
@@ -48,7 +58,7 @@ CREATE TABLE registrations (
     CONSTRAINT registrations_occupation_fk FOREIGN KEY (occupation)
         REFERENCES occupations (occupation),
     beginner_track_interest BOOLEAN NOT NULL,
-    state TEXT NOT NULL,
+    state TEXT NOT NULL DEFAULT 'Waitlisted',
     CONSTRAINT state_fk FOREIGN KEY (state)
       REFERENCES registration_states (state),
     scanned_at TIMESTAMPTZ,