Compare commits

...

4 commits

Author SHA1 Message Date
2804c90aba fix style, add lock 2026-02-04 13:24:15 +01:00
Josep Mengual
8451509cac add interested api endpoint 2026-02-04 09:43:15 +01:00
Josep Mengual
9a8a1208db format cabal 2026-02-04 09:43:15 +01:00
Josep Mengual
7276a90ff2 use direnv for automatic environment loading 2026-02-04 09:43:15 +01:00
7 changed files with 147 additions and 52 deletions

1
.envrc Normal file
View file

@ -0,0 +1 @@
use flake

2
.gitignore vendored
View file

@ -1,2 +1,2 @@
flake.lock
.direnv
dist-newstyle

View file

@ -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
)

View file

@ -1,18 +1,16 @@
cabal-version: 3.0
cabal-version: 3.0
-- The cabal-version field refers to the version of the .cabal specification,
-- and can be different from the cabal-install (the tool) version and the
-- Cabal (the library) version you are using. As such, the Cabal (the library)
-- version used must be equal or greater than the version stated in this field.
-- Starting from the specification version 2.2, the cabal-version field must be
-- the first thing in the cabal file.
-- Initial package description 'chipburners-club' generated by
-- 'cabal init'. For further documentation, see:
-- http://haskell.org/cabal/users-guide/
--
-- The name of the package.
name: chipburners-club
name: chipburners-club
-- The package version.
-- See the Haskell package versioning policy (PVP) for standards
-- guiding when and how versions should be incremented.
@ -20,70 +18,68 @@ name: chipburners-club
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.1.0.0
version: 0.1.0.0
-- A short (one-line) description of the package.
-- synopsis:
-- A longer description of the package.
-- description:
-- The license under which the package is released.
license: BSD-3-Clause
license: BSD-3-Clause
-- The file containing the license text.
license-file: LICENSE
license-file: LICENSE
-- The package author(s).
author: Daniel Kauss Serna
author: Daniel Kauss Serna
-- An email address to which users can send suggestions, bug reports, and patches.
maintainer: daniel.kauss.serna@gmail.com
maintainer: daniel.kauss.serna@gmail.com
-- A copyright notice.
-- copyright:
category: Web
build-type: Simple
category: Web
build-type: Simple
-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
-- extra-doc-files: CHANGELOG.md
-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
-- extra-source-files:
common warnings
ghc-options: -Wall
ghc-options: -Wall
executable chipburners-club
-- Import common warning flags.
import: warnings
ghc-options: -threaded
-- Import common warning flags.
import: warnings
ghc-options: -threaded
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
-- Modules included in this executable, other than Main.
other-modules:
Ical
Interested
Render
-- .hs or .lhs file containing the Main module.
main-is: Main.hs
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
extra-libraries:
z
zstd
-- Modules included in this executable, other than Main.
other-modules: Ical, Render
-- Other library packages from which modules are imported.
build-depends:
aeson,
base ^>=4.20.2.0,
bytestring,
containers,
http-conduit,
http-types,
lucid,
scotty,
text,
time,
uuid,
wai-middleware-static,
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
extra-libraries: z zstd
-- Directories containing source files.
hs-source-dirs:
app
src
-- Other library packages from which modules are imported.
build-depends:
base ^>=4.20.2.0,
http-conduit,
text,
bytestring,
containers,
scotty,
wai-middleware-static,
lucid,
http-types,
time
-- Directories containing source files.
hs-source-dirs: app, src
-- Base language which the package is written in.
default-language: GHC2024
-- Base language which the package is written in.
default-language: GHC2024

61
flake.lock generated Normal file
View file

@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1770115704,
"narHash": "sha256-KHFT9UWOF2yRPlAnSXQJh6uVcgNcWlFqqiAZ7OVlHNc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e6eae2ee2110f3d31110d5c222cd395303343b08",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

19
src/Interested.hs Normal file
View 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)

View file

@ -49,7 +49,7 @@
@font-face {
src: url("/Geo-Regular.woff2");
font-family: Geo;
font-display: optional;
font-display: swap;
}
/* idk this is good? */