diff --git a/app/Main.hs b/app/Main.hs index 366217a..07f9028 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,9 +6,10 @@ import Data.Either (lefts, rights) import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Data.Text.Lazy qualified as TL -import Data.Time (MonthOfYear, Year, addDays, fromGregorian, getCurrentTime, toGregorian) +import Data.Time (MonthOfYear, Year, addDays, addUTCTime, fromGregorian, getCurrentTime, secondsToNominalDiffTime, toGregorian) import Data.Time.LocalTime import Ical +import Interested qualified import Lucid (renderText) import Network.HTTP.Simple import Network.HTTP.Types (status400) @@ -16,6 +17,7 @@ import Network.Wai.Middleware.Static import Render import Text.Printf (printf) import Web.Scotty +import Web.Scotty.Cookie (defaultSetCookie, setCookieExpires, setCookieName, setCookieValue) getFromUrl :: String -> IO T.Text getFromUrl url = do @@ -82,4 +84,20 @@ main = liftIO $ print errors html $ renderText $ renderMonthview (year, month) dayToday groupedEvents + get "/api/interested/register/:event" $ do + event <- pathParam "event" + let cookieName = "interested-" <> event + returnUri <- queryParam "return" + cookie <- getCookie cookieName + newCookie <- liftIO $ Interested.register event cookie + currentTime <- (liftIO $ getCurrentTime) + setCookie + ( defaultSetCookie + { setCookieName = TE.encodeUtf8 cookieName, + setCookieValue = TE.encodeUtf8 newCookie, + -- TODO: just adding one month of expire which is kind of weird + setCookieExpires = Just (addUTCTime (secondsToNominalDiffTime 60 * 60 * 24 * 30) currentTime) + } + ) + redirect returnUri ) diff --git a/chipburners-club.cabal b/chipburners-club.cabal index 9123d54..9e3a036 100644 --- a/chipburners-club.cabal +++ b/chipburners-club.cabal @@ -52,6 +52,7 @@ executable chipburners-club -- Modules included in this executable, other than Main. other-modules: Ical + Interested Render -- LANGUAGE extensions used by modules in this package. @@ -62,6 +63,7 @@ executable chipburners-club -- Other library packages from which modules are imported. build-depends: + aeson, base ^>=4.20.2.0, bytestring, containers, @@ -71,6 +73,7 @@ executable chipburners-club scotty, text, time, + uuid, wai-middleware-static, -- Directories containing source files. diff --git a/src/Interested.hs b/src/Interested.hs new file mode 100644 index 0000000..25a1e12 --- /dev/null +++ b/src/Interested.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Interested (register) where + +import Data.Text qualified as T +import Data.UUID qualified as UUID +import Data.UUID.V4 qualified as UUID.V4 + +register :: T.Text -> Maybe T.Text -> IO T.Text +register event identifier = do + cookie_uuid <- case ( case identifier of + Just i -> UUID.fromString (T.unpack i) + Nothing -> Nothing + ) of + Just i -> pure i + Nothing -> UUID.V4.nextRandom + appendFile "test.txt" (T.unpack (T.filter (\c -> c /= '\n' && c /= ',') event) <> "," <> (UUID.toString cookie_uuid) <> "\n") + + pure $ (UUID.toText cookie_uuid)