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.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
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue