add VIPs

zfoh · May 2, 2024 · a91f9b4 · a91f9b4
1 parent 1d3f90c
commit a91f9b4
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 1 deletion.
diff --git a/lib/Zureg/Hackathon/ZuriHac2024/Model.hs b/lib/Zureg/Hackathon/ZuriHac2024/Model.hs
@@ -107,6 +107,7 @@ csvHeader = Csv.header
     [ "UUID"
     , "State"
     , "Scanned"
+    , "VIP"
     , "Name"
     , "Email"
     , "Region"

diff --git a/lib/Zureg/Main/Web.hs b/lib/Zureg/Main/Web.hs
@@ -126,6 +126,13 @@ app hackathon =
             Database.writeEvents db uuid [MarkSpam :: Event a]
             respond . redirect $ "ticket?uuid=" <> E.uuidToText 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=" <> E.uuidToText uuid
+
         ["cancel"] -> do
             reqBody <- TL.decodeUtf8 <$> Wai.strictRequestBody req
             (view, mbCancel) <- runForm req reqBody "cancel" $

diff --git a/lib/Zureg/Model.hs b/lib/Zureg/Model.hs
@@ -68,6 +68,7 @@ data Event a
     | Uncancel UncancelInfo
     | JoinChat JoinChatInfo
     | MarkSpam
+    | MarkVip
     deriving (Eq, Show)
 
 --------------------------------------------------------------------------------
@@ -82,11 +83,19 @@ data Registrant a = Registrant
     , rAdditionalInfo :: Maybe a
     , rState          :: Maybe RegisterState
     , rScanned        :: Bool
+    , rVip            :: Bool
     } deriving (Eq, Show)
 
 registrantProjection :: E.UUID -> E.Projection (Registrant a) (Event a)
 registrantProjection uuid = E.Projection
-    { E.projectionSeed         = Registrant uuid Nothing Nothing Nothing False
+    { E.projectionSeed         = Registrant
+        { rUuid           = uuid
+        , rInfo           = Nothing
+        , rAdditionalInfo = Nothing
+        , rState          = Nothing
+        , rScanned        = False
+        , rVip            = False
+        }
     , E.projectionEventHandler = \registrant event -> case event of
         Cancel | Just Spam /= rState registrant ->
             registrant {rState = Just Cancelled}
@@ -101,6 +110,7 @@ registrantProjection uuid = E.Projection
         Uncancel _ | Just Cancelled <- rState registrant ->
             registrant {rState = Just Registered}
         MarkSpam -> registrant {rState = Just Spam}
+        MarkVip -> registrant {rVip = True}
         _ -> registrant
     }
 

diff --git a/lib/Zureg/Model/Csv.hs b/lib/Zureg/Model/Csv.hs
@@ -25,6 +25,7 @@ instance ToNamedRecord a => ToNamedRecord (Registrant a) where
                         Just ai -> toNamedRecord ai
                         Nothing -> HM.empty
                      , namedRecord [ "Scanned" .= rScanned ]
+                     , namedRecord [ "VIP" .= rVip ]
                      ]
 
 instance ToNamedRecord RegisterState where

diff --git a/lib/Zureg/Views.hs b/lib/Zureg/Views.hs
@@ -234,6 +234,8 @@ scan hackathon registrant@Registrant {..} = H.ul $ do
     H.li $ H.strong $
         let (html, ok) = registerState rState in (if ok then id else red) html
 
+    when rVip $ H.li $ "⭐ " <> H.strong "VIP"
+
     H.li $ case (registrantRegisteredAt registrant, registrantToBadge registrant) of
         (_, Nothing)                        -> red "No Badge"
         (_, Just badge)                     ->