Compare commits
4 commits
a8b26c1661
...
2804c90aba
| Author | SHA1 | Date | |
|---|---|---|---|
| 2804c90aba | |||
|
|
8451509cac | ||
|
|
9a8a1208db | ||
|
|
7276a90ff2 |
7 changed files with 147 additions and 52 deletions
1
.envrc
Normal file
1
.envrc
Normal file
|
|
@ -0,0 +1 @@
|
|||
use flake
|
||||
2
.gitignore
vendored
2
.gitignore
vendored
|
|
@ -1,2 +1,2 @@
|
|||
flake.lock
|
||||
.direnv
|
||||
dist-newstyle
|
||||
|
|
|
|||
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
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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
61
flake.lock
generated
Normal 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
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)
|
||||
|
|
@ -49,7 +49,7 @@
|
|||
@font-face {
|
||||
src: url("/Geo-Regular.woff2");
|
||||
font-family: Geo;
|
||||
font-display: optional;
|
||||
font-display: swap;
|
||||
}
|
||||
|
||||
/* idk this is good? */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue