add interested api endpoint
This commit is contained in:
parent
9a8a1208db
commit
8451509cac
3 changed files with 41 additions and 1 deletions
20
app/Main.hs
20
app/Main.hs
|
|
@ -6,9 +6,10 @@ import Data.Either (lefts, rights)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.Encoding qualified as TE
|
import Data.Text.Encoding qualified as TE
|
||||||
import Data.Text.Lazy qualified as TL
|
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 Data.Time.LocalTime
|
||||||
import Ical
|
import Ical
|
||||||
|
import Interested qualified
|
||||||
import Lucid (renderText)
|
import Lucid (renderText)
|
||||||
import Network.HTTP.Simple
|
import Network.HTTP.Simple
|
||||||
import Network.HTTP.Types (status400)
|
import Network.HTTP.Types (status400)
|
||||||
|
|
@ -16,6 +17,7 @@ import Network.Wai.Middleware.Static
|
||||||
import Render
|
import Render
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
import Web.Scotty
|
import Web.Scotty
|
||||||
|
import Web.Scotty.Cookie (defaultSetCookie, setCookieExpires, setCookieName, setCookieValue)
|
||||||
|
|
||||||
getFromUrl :: String -> IO T.Text
|
getFromUrl :: String -> IO T.Text
|
||||||
getFromUrl url = do
|
getFromUrl url = do
|
||||||
|
|
@ -82,4 +84,20 @@ main =
|
||||||
liftIO $ print errors
|
liftIO $ print errors
|
||||||
|
|
||||||
html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
|
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
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -52,6 +52,7 @@ executable chipburners-club
|
||||||
-- Modules included in this executable, other than Main.
|
-- Modules included in this executable, other than Main.
|
||||||
other-modules:
|
other-modules:
|
||||||
Ical
|
Ical
|
||||||
|
Interested
|
||||||
Render
|
Render
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
|
@ -62,6 +63,7 @@ executable chipburners-club
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends:
|
build-depends:
|
||||||
|
aeson,
|
||||||
base ^>=4.20.2.0,
|
base ^>=4.20.2.0,
|
||||||
bytestring,
|
bytestring,
|
||||||
containers,
|
containers,
|
||||||
|
|
@ -71,6 +73,7 @@ executable chipburners-club
|
||||||
scotty,
|
scotty,
|
||||||
text,
|
text,
|
||||||
time,
|
time,
|
||||||
|
uuid,
|
||||||
wai-middleware-static,
|
wai-middleware-static,
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
|
|
|
||||||
19
src/Interested.hs
Normal file
19
src/Interested.hs
Normal file
|
|
@ -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)
|
||||||
Loading…
Add table
Add a link
Reference in a new issue