2024 initial setup

lib/Zureg/Hackathon.hs

@@ -17,6 +17,7 @@ import qualified Zureg.Hackathon.ZuriHac2020 as ZuriHac2020
 import qualified Zureg.Hackathon.ZuriHac2021 as ZuriHac2021
 import qualified Zureg.Hackathon.ZuriHac2022 as ZuriHac2022
 import qualified Zureg.Hackathon.ZuriHac2023 as ZuriHac2023
+import qualified Zureg.Hackathon.ZuriHac2024 as ZuriHac2024
 
 -- | Load the hackathon stored in the 'ZUREG_HACKATHON' environment variable.
 withHackathonFromEnv
@@ -43,4 +44,5 @@ hackathons =
     , ("zurihac2021", SomeHackathon <$> ZuriHac2021.newHackathon)
     , ("zurihac2022", SomeHackathon <$> ZuriHac2022.newHackathon)
     , ("zurihac2023", SomeHackathon <$> ZuriHac2023.newHackathon)
+    , ("zurihac2024", SomeHackathon <$> ZuriHac2024.newHackathon)
     ]

lib/Zureg/Hackathon/ZuriHac2024.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Zureg.Hackathon.ZuriHac2024
+    ( newHackathon
+    ) where
+
+import qualified Data.Text                           as T
+import           System.Environment                  (getEnv)
+import qualified Text.Blaze.Html5                    as H
+import qualified Zureg.Database                      as Database
+import           Zureg.Hackathon.Interface           (Hackathon)
+import qualified Zureg.Hackathon.Interface           as Hackathon
+import           Zureg.Hackathon.ZuriHac2020.Discord as Discord
+import           Zureg.Hackathon.ZuriHac2024.Form    as ZH24
+import           Zureg.Hackathon.ZuriHac2024.Model   as ZH24
+import           Zureg.Hackathon.ZuriHac2024.Views   as ZH24
+import qualified Zureg.Captcha.HCaptcha              as HCaptcha
+import qualified Zureg.SendEmail                     as SendEmail
+
+newHackathon :: IO (Hackathon RegisterInfo)
+newHackathon = do
+    scannerSecret   <- T.pack <$> getEnv "ZUREG_SCANNER_SECRET"
+    email           <- T.pack <$> getEnv "ZUREG_EMAIL"
+    captcha         <- HCaptcha.configFromEnv >>= HCaptcha.new
+
+    discord <- Discord.configFromEnv
+    channel <- Discord.getWelcomeChannelId discord
+
+    return Hackathon.Hackathon
+        { Hackathon.name = "ZuriHac 2024"
+        , Hackathon.baseUrl = "https://zureg.zfoh.ch"
+        , Hackathon.contactUrl = "https://zfoh.ch/zurihac2024/#contact"
+        , Hackathon.capacity = 500
+        , Hackathon.confirmation = True
+
+        , Hackathon.registerBadgeName = False
+        , Hackathon.registerAffiliation = False
+
+        , Hackathon.registerForm = ZH24.additionalInfoForm
+        , Hackathon.registerView = ZH24.additionalInfoView
+        , Hackathon.ticketView = mempty
+        , Hackathon.scanView = ZH24.scanView
+        , Hackathon.csvHeader = ZH24.csvHeader
+
+        , Hackathon.databaseConfig = Database.defaultConfig
+        , Hackathon.sendEmailConfig = SendEmail.Config
+            { SendEmail.cFrom = "ZuriHac Registration Bot <" <> email <> ">"
+            }
+        , Hackathon.captcha = captcha
+        , Hackathon.scannerSecret = scannerSecret
+        , Hackathon.chatUrl = Discord.generateTempInviteUrl discord channel
+        , Hackathon.chatExplanation = H.p $ do
+            "ZuriHac 2024 will use Discord as a chat platform for "
+            "coordination.  You can join the Discord server here:"
+        }

lib/Zureg/Hackathon/ZuriHac2024/Form.hs

@@ -0,0 +1,106 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Zureg.Hackathon.ZuriHac2024.Form
+    ( additionalInfoForm
+    , additionalInfoView
+    ) where
+
+import qualified Data.Text                         as T
+import qualified Text.Blaze.Html5                  as H
+import qualified Text.Blaze.Html5.Attributes       as A
+import qualified Text.Digestive                    as D
+import qualified Text.Digestive.Blaze.Html5        as DH
+import           Zureg.Hackathon.ZuriHac2024.Model as ZH24
+
+additionalInfoForm :: Monad m => D.Form H.Html m ZH24.RegisterInfo
+additionalInfoForm = RegisterInfo
+    <$> ("tshirtSize" D..: D.choice (
+            [(Just s, H.toHtml $ show s) | s <- [minBound .. maxBound]] ++
+            [(Nothing, "I don't want a T-Shirt")])
+            (Just (Just M)))
+    <*> "region" D..: D.choice (
+            (Nothing, "I'd rather not say") :
+            [(Just s, H.toHtml $ show s) | s <- [minBound .. maxBound]])
+            (Just Nothing)
+    <*> "occupation" D..: D.choice
+            [ (Nothing,       "I'd rather not say")
+            , (Just Student,  "I am a student")
+            , (Just Tech,     "I work in the tech sector")
+            , (Just Academia, "I work in academia")
+            , (Just Other,    "Other")
+            ]
+            (Just Nothing)
+    <*> ("beginnerTrackInterest" D..: D.bool Nothing)
+    <*> ("project" D..: (Project
+            <$> "name" D..: optionalText
+            <*> "website" D..: optionalText
+            <*> "description" D..: optionalText
+            <*> ("contributorLevel" D..: (ContributorLevel
+                    <$> "beginner" D..: D.bool Nothing
+                    <*> "intermediate" D..: D.bool Nothing
+                    <*> "advanced" D..: D.bool Nothing))))
+  where
+    optionalText =
+        (\t -> let t' = T.strip t in if T.null t' then Nothing else Just t') <$>
+        (D.text Nothing)
+
+additionalInfoView :: D.View H.Html -> H.Html
+additionalInfoView view = do
+    H.h2 "Optional information"
+
+    H.p $ H.strong "T-Shirt"
+    {-
+    H.p $ H.strong $ do
+        "Please note that we have ordered the T-Shirts and cannot guarantee "
+        "that you will receive one if you register at this time."
+    -}
+    H.p $ "In what size would you like the free T-Shirt?"
+
+    DH.label "tshirtSize" view "Size"
+    DH.inputSelect "tshirtSize" view
+    H.br
+
+    H.p $ H.strong "Region"
+    DH.label "region" view $ do
+        "From what area will you attend ZuriHac?  This is purely for our "
+        "statistics."
+    DH.inputSelect "region" view
+    H.br
+
+    H.p $ H.strong "Occupation"
+    DH.label "occupation" view $
+        "What is your occupation?  This is purely for our statistics."
+    DH.inputSelect "occupation" view
+    H.br
+
+    H.p $ H.strong "Beginner Track"
+    DH.inputCheckbox "beginnerTrackInterest" view H.! A.class_ "checkbox"
+    DH.label "beginnerTrackInterest" view $ do
+        "I'm interested in attending the beginner track.  You don't need to "
+        "commit to this, but it helps us gauge interest."
+    H.br
+
+    H.h2 "Project (optional)"
+    H.p $ do
+        "Do you have a project or an idea to hack on with others? Do you have "
+        "something you want to teach people?"
+    H.p $ do
+        "We greatly appreciate projects. We have had very good experience with "
+        "announcing the project early on the homepage, so that potential "
+        "participants can prepare before the Hackathon.  Of course, we're also "
+        "happy to add projects during the Hackathon itself, so if you're not "
+        "sure yet, don't worry about it."
+    DH.label "project.name" view "Project name"
+    DH.inputText "project.name" view
+    DH.label "project.website" view "Project website"
+    DH.inputText "project.website" view
+    DH.label "project.description" view "Project description"
+    DH.inputText "project.description" view
+    H.p "Recommended contributor level(s)"
+    DH.inputCheckbox "project.contributorLevel.beginner" view H.! A.class_ "checkbox"
+    DH.label "project.contributorLevel.beginner" view $ "Beginner"
+    H.br
+    DH.inputCheckbox "project.contributorLevel.intermediate" view H.! A.class_ "checkbox"
+    DH.label "project.contributorLevel.intermediate" view $ "Intermediate"
+    H.br
+    DH.inputCheckbox "project.contributorLevel.advanced" view H.! A.class_ "checkbox"
+    DH.label "project.contributorLevel.advanced" view $ "Advanced"

lib/Zureg/Hackathon/ZuriHac2024/Model.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Zureg.Hackathon.ZuriHac2024.Model
+    ( TShirtSize (..)
+    , Region (..)
+    , Occupation (..)
+    , ContributorLevel (..)
+    , Project (..)
+    , RegisterInfo (..)
+    , csvHeader
+    ) where
+
+import qualified Data.Aeson.TH.Extended as A
+import           Data.Csv               as Csv
+import qualified Data.HashMap.Strict    as HM
+import qualified Data.Text              as T
+import           Zureg.Model.Csv        ()
+
+data TShirtSize = XS | S | M | L | XL | XXL deriving (Bounded, Enum, Eq, Show)
+
+data Region
+    = Switzerland
+    | Europe
+    | Africa
+    | AmericaCentral
+    | AmericaNorth
+    | AmericaSouth
+    | Asia
+    | MiddleEast
+    | Oceania
+    deriving (Bounded, Enum, Eq, Show)
+
+data Occupation
+    = Student
+    | Tech
+    | Academia
+    | Other
+    deriving (Bounded, Enum, Eq, Show)
+
+data ContributorLevel = ContributorLevel
+    { clBeginner     :: !Bool
+    , clIntermediate :: !Bool
+    , clAdvanced     :: !Bool
+    } deriving (Eq, Show)
+
+data Project = Project
+    { pName             :: !(Maybe T.Text)
+    , pWebsite          :: !(Maybe T.Text)
+    , pShortDescription :: !(Maybe T.Text)
+    , pContributorLevel :: !ContributorLevel
+    } deriving (Eq, Show)
+
+data RegisterInfo = RegisterInfo
+    { riTShirtSize            :: !(Maybe TShirtSize)
+    , riRegion                :: !(Maybe Region)
+    , riOccupation            :: !(Maybe Occupation)
+    , riBeginnerTrackInterest :: !Bool
+    , riProject               :: !Project
+    } deriving (Eq, Show)
+
+$(A.deriveJSON A.options ''TShirtSize)
+$(A.deriveJSON A.options ''Region)
+$(A.deriveJSON A.options ''Occupation)
+$(A.deriveJSON A.options ''ContributorLevel)
+$(A.deriveJSON A.options ''Project)
+$(A.deriveJSON A.options ''RegisterInfo)
+
+instance Csv.ToField TShirtSize where
+    toField = toField . show
+
+instance Csv.ToNamedRecord Project where
+    toNamedRecord Project {..}
+        = HM.unions [ namedRecord [ "Project Name"              .= pName
+                                  , "Project Website"           .= pWebsite
+                                  , "Project Short Description" .= pShortDescription
+                                  ]
+                    , toNamedRecord pContributorLevel
+                    ]
+
+instance Csv.ToNamedRecord ContributorLevel where
+    toNamedRecord ContributorLevel {..}
+        = namedRecord [ "CL Beginner"     .= clBeginner
+                      , "CL Intermediate" .= clIntermediate
+                      , "CL Advanced"     .= clAdvanced
+                      ]
+
+instance Csv.ToField Region where
+    toField = toField . show
+
+instance Csv.ToField Occupation where
+    toField = toField . show
+
+instance Csv.ToNamedRecord RegisterInfo where
+    toNamedRecord RegisterInfo {..}
+        = HM.unions [ namedRecord [ "Region"                  .= riRegion
+                                  , "Occupation"              .= riOccupation
+                                  , "T-Shirt Size"            .= riTShirtSize
+                                  , "Beginner Track Interest" .= riBeginnerTrackInterest
+                                  ]
+                    , toNamedRecord riProject
+                    ]
+
+csvHeader :: Csv.Header
+csvHeader = Csv.header
+    [ "UUID"
+    , "State"
+    , "Scanned"
+    , "Name"
+    , "Email"
+    , "Region"
+    , "Occupation"
+    , "Project Name"
+    , "Project Website"
+    , "Project Short Description"
+    , "CL Beginner"
+    , "CL Intermediate"
+    , "CL Advanced"
+    , "Registered At"
+    , "T-Shirt Size"
+    , "Beginner Track Interest"
+    ]

lib/Zureg/Hackathon/ZuriHac2024/Views.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+module Zureg.Hackathon.ZuriHac2024.Views
+    ( scanView
+    ) where
+
+import qualified Data.Time                         as Time
+import qualified Text.Blaze.Html5                  as H
+
+import qualified Zureg.Hackathon.ZuriHac2024.Model as ZH24
+import           Zureg.Model
+
+tShirtDeadline :: Time.UTCTime
+tShirtDeadline = Time.UTCTime (Time.fromGregorian 2024 5 5) (12 * 3600)
+
+scanView :: Registrant ZH24.RegisterInfo -> H.Html
+scanView r@Registrant {..} = case rAdditionalInfo of
+    Nothing                -> mempty
+    Just ZH24.RegisterInfo {..} -> case riTShirtSize of
+        Nothing   -> "No T-Shirt"
+        Just size -> case registrantRegisteredAt r of
+            Just at | at >= tShirtDeadline ->
+                H.p $ H.strong "Pick up T-Shirt later"
+            _ -> do
+                "T-Shirt: "
+                H.strong $ H.toHtml (show size)

shell.nix

@@ -0,0 +1,7 @@
+{ pkgs ? import <nixpkgs> {} }:
+pkgs.mkShell {
+    buildInputs = [
+        pkgs.awscli2
+        pkgs.jq
+    ];
+}

zureg.cabal

@@ -54,6 +54,10 @@ Library
     Zureg.Hackathon.ZuriHac2023.Form
     Zureg.Hackathon.ZuriHac2023.Model
     Zureg.Hackathon.ZuriHac2023.Views
+    Zureg.Hackathon.ZuriHac2024
+    Zureg.Hackathon.ZuriHac2024.Form
+    Zureg.Hackathon.ZuriHac2024.Model
+    Zureg.Hackathon.ZuriHac2024.Views
     Zureg.Http
     Zureg.Main.Badges
     Zureg.Main.Email