From 80568be359a23782396c7a86db0ea23bda4b38ec Mon Sep 17 00:00:00 2001 From: Thomas Jensen Date: Mon, 26 Aug 2024 18:15:55 +0200 Subject: [PATCH] guestbook reimplementation --- .ghci | 3 +- app/Api/Api.hs | 30 +++++- app/Helpers/Database.hs | 11 ++- app/Helpers/Tables.hs | 28 ++++++ app/Helpers/Utils.hs | 7 +- app/Index.hs | 7 +- app/Layout.hs | 1 + app/Main.hs | 16 +-- app/Pages/Guestbook/Guestbook.hs | 95 ++++++++++++++++++ app/Pages/Projects/Projects.hs | 163 ++++++++++++++----------------- app/Pages/Projects/Snake.hs | 4 +- homepage.cabal | 5 +- static/stylesheet.css | 31 ++++++ 13 files changed, 295 insertions(+), 106 deletions(-) create mode 100644 app/Helpers/Tables.hs create mode 100644 app/Pages/Guestbook/Guestbook.hs diff --git a/.ghci b/.ghci index 394c83f..0297eea 100644 --- a/.ghci +++ b/.ghci @@ -1,2 +1 @@ -:set prompt "[\ESC[38;2;255;100;0mHomepage dev\ESC[0m] > " -:seti -fdiagnostics-color=auto \ No newline at end of file +:set prompt "[\ESC[38;2;255;100;0mHomepage dev\ESC[0m] > " \ No newline at end of file diff --git a/app/Api/Api.hs b/app/Api/Api.hs index 58f5d0e..4ce5bfe 100644 --- a/app/Api/Api.hs +++ b/app/Api/Api.hs @@ -1,7 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} + module Api.Api where -import Helpers.Database (getVisits, uuidExists, insert) -import Helpers.Utils (unpackBS) + +import Helpers.Tables +import Helpers.Database (getVisits, uuidExists, insert, getGuestbook) +import Helpers.Utils (unpackBS, getDefault) import IHP.HSX.QQ (hsx) import Text.Blaze.Html (Html) @@ -11,9 +15,21 @@ import Data.UUID.V4 (nextRandom) import Data.UUID (toString) import Network.Wai (getRequestBodyChunk, Request) -import Network.HTTP.Types.Status (Status, status404, status200) +import Network.HTTP.Types.Status (Status, status404, status200, status400) + +import Data.Aeson +import Data.ByteString.Lazy (fromStrict, toStrict) +import Control.Applicative +handleGuestbookEntry :: GuestbookEntry -> IO (Status, String) +handleGuestbookEntry (GuestbookEntry name content parentId) = do + time <- fmap round getPOSIXTime :: IO Int + insert "INSERT INTO guestbook (name, timestamp, content, parentId) values (?, ?, ?, ?)" (name :: String, time :: Int, content :: String, parentId :: Int) + return (status200, "Success") +handleGuestbookEntry EmptyGuestbook = do + return (status400, "Error") + api :: [String] -> Request -> IO (Status, String) api ["visits", "new"] request = do body <- getRequestBodyChunk request @@ -29,5 +45,13 @@ api ["visits", "new"] request = do api ["visits", "get"] request = do visits <- show . length <$> getVisits return (status200, visits) +api ["guestbook", "add"] request = do + body <- getRequestBodyChunk request + let entry = getDefault EmptyGuestbook (decode (fromStrict body) :: Maybe GuestbookEntry) + handleGuestbookEntry entry +api ["guestbook", "get"] request = do + body <- getRequestBodyChunk request + entries <- getGuestbook + return (status200, unpackBS $ toStrict $ encode entries) api xs request = do return (status404, "{\"error\":\"Endpoint does not exist\"}") diff --git a/app/Helpers/Database.hs b/app/Helpers/Database.hs index e3e49e8..a316964 100644 --- a/app/Helpers/Database.hs +++ b/app/Helpers/Database.hs @@ -5,6 +5,7 @@ module Helpers.Database where import Database.SQLite.Simple (close, execute, open, query, Only(Only), ToRow, Query (Query), Connection) import Helpers.Globals (getDbPath) +import Helpers.Tables import Data.List (intercalate, inits) import Data.Text (pack, Text) @@ -27,6 +28,13 @@ getVisits = do close conn return visits +getGuestbook :: IO [(Int, Int, String, String, Int)] +getGuestbook = do + conn <- getConn + entries <- query conn "SELECT * FROM guestbook" () :: IO [(Int, Int, String, String, Int)] + close conn + return entries + uuidExists :: String -> IO Bool uuidExists uuid = do conn <- getConn @@ -48,7 +56,8 @@ schema = [ Column "id" "INTEGER PRIMARY KEY", Column "timestamp" "INTEGER NOT NULL", Column "name" "VARCHAR NOT NULL", - Column "message" "VARCHAR NOT NULL" + Column "content" "VARCHAR NOT NULL", + Column "parentId" "INTEGER NOT NULL" ], Table "snake" [ Column "id" "INTEGER PRIMARY KEY", diff --git a/app/Helpers/Tables.hs b/app/Helpers/Tables.hs new file mode 100644 index 0000000..aa8ef28 --- /dev/null +++ b/app/Helpers/Tables.hs @@ -0,0 +1,28 @@ +module Helpers.Tables where + +import Data.Aeson +import Data.ByteString.Lazy (fromStrict) +import Control.Applicative + +import Database.SQLite.Simple +import Database.SQLite.Simple.FromRow + +data GuestbookEntry = GuestbookEntry { + name :: String, + content :: String, + parent :: Int +} | EmptyGuestbook + deriving Show + +instance FromJSON GuestbookEntry where + parseJSON (Object v) = GuestbookEntry <$> + v .: "name" <*> + v .: "content" <*> + v .: "parentId" + parseJSON _ = empty + +instance ToJSON GuestbookEntry where + toJSON (GuestbookEntry name content parent) = object ["name" .= name, "content" .= content, "parent" .= parent] + +instance FromRow GuestbookEntry where + fromRow = GuestbookEntry <$> field <*> field <*> field \ No newline at end of file diff --git a/app/Helpers/Utils.hs b/app/Helpers/Utils.hs index c962769..10ea500 100644 --- a/app/Helpers/Utils.hs +++ b/app/Helpers/Utils.hs @@ -38,4 +38,9 @@ row values = [hsx| |] unpackBS :: ByteString -> String -unpackBS = unpack . decodeUtf8 \ No newline at end of file +unpackBS = unpack . decodeUtf8 + +getDefault :: a -> Maybe a -> a +getDefault def a = case a of + (Just v) -> v + Nothing -> def \ No newline at end of file diff --git a/app/Index.hs b/app/Index.hs index c7c0428..d660832 100644 --- a/app/Index.hs +++ b/app/Index.hs @@ -27,7 +27,12 @@ intro = section [hsx| HSX is actually pretty cool, i just toss in html inline with haskell and it just works:

{hsxIntroCodeBlock} - I had to do a little hack around the preprocessor to make it not compile that little snippet of code, and as such you won't see me show any more hsx code xD + I had to do a little hack around the preprocessor to make it not compile that little snippet of code, and as such you won't see me show any more hsx code xD
+ Running the above code: +
+
+ {introCodeIndex} +
|] visitorCounter :: Html diff --git a/app/Layout.hs b/app/Layout.hs index 58f8cc2..ee66f8f 100644 --- a/app/Layout.hs +++ b/app/Layout.hs @@ -17,6 +17,7 @@ layout content = [hsx| ("Contact", "/contact"), ("Projects", "/projects"), ("Sources", "/sources"), + ("Guestbook", "/guestbook"), ("Old Site", "https://about.skademaskinen.win") ]} Skademaskinen diff --git a/app/Main.hs b/app/Main.hs index 66f09f7..ae0d329 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -24,6 +24,7 @@ import Index (index) import Pages.Contact.Contact (contact) import Pages.Projects.Projects (projects) import Pages.Sources.Sources (sources) +import Pages.Guestbook.Guestbook (guestbook) import Helpers.Database (initDb) import Helpers.Utils (unpackBS) @@ -49,16 +50,19 @@ serveFile path = do handleRequest :: [String] -> Request -> IO Response -handleRequest ("static":xs) request = do serveFile $ intercalate "/" ("static":xs) +handleRequest ("static":xs) request = serveFile $ intercalate "/" ("static":xs) handleRequest ("api":args) request = do (status, value) <- api args request return $ responseBuilder status [("Content-Type", "text/plain")] $ copyByteString (fromString value) -handleRequest ["contact"] request = do return $ serve (layout contact) -handleRequest ["sources"] request = do return $ serve (layout sources) -handleRequest ("projects":project) request = do return $ serve (layout (projects project)) +handleRequest ["contact"] request = return $ serve (layout contact) +handleRequest ["sources"] request = return $ serve (layout sources) +handleRequest ["guestbook"] request = do + page <- guestbook + return $ serve (layout page) +handleRequest ("projects":project) request = return $ serve (layout (projects project)) handleRequest ["favicon.ico"] request = do serveFile "static/favicon.ico" -handleRequest [] request = do return $ serve (layout index) -handleRequest x request = do return $ page404 x +handleRequest [] request = return $ serve (layout index) +handleRequest x request = return $ page404 x colorStatus :: Int -> String colorStatus code | code < 300 = "\ESC[38;2;0;255;0m"++show code++"\ESC[0m" diff --git a/app/Pages/Guestbook/Guestbook.hs b/app/Pages/Guestbook/Guestbook.hs new file mode 100644 index 0000000..c97b937 --- /dev/null +++ b/app/Pages/Guestbook/Guestbook.hs @@ -0,0 +1,95 @@ +module Pages.Guestbook.Guestbook where + +import IHP.HSX.QQ (hsx) +import Text.Blaze.Html (Html) + +import Helpers.Database (getGuestbook) +import Helpers.Section (section) + +import Data.List (filter) + +import Data.Time.Format.ISO8601 +import Data.Time.Format +import Data.Time.Clock.POSIX + +type Guestbook = [(Int, Int, String, String, Int)] + +toPosix :: Int -> POSIXTime +toPosix n = read ((show n) ++ "s") :: POSIXTime + +prettify_guestbook :: Guestbook -> Html +prettify_guestbook ((id, timestamp, name, content, parent):xs) = mconcat [section [hsx| +

{name} said:

+
+ id: {id} + parent: {parent} + timestamp: {formatTime defaultTimeLocale "%c" $ posixSecondsToUTCTime (toPosix timestamp)} +

+ {content} +
+ {prettify_guestbook $ children} + {guestbook_input id True} +

+|], prettify_guestbook rest] + where + children :: Guestbook + children = filter (\(_, _, _, _, childParent) -> childParent == id) xs + rest :: Guestbook + rest = filter (\(_, _, _, _, childParent) -> childParent /= id) xs +prettify_guestbook [] = [hsx||] + +guestbook_input :: Int -> Bool -> Html +guestbook_input parent False = [hsx| + +
+ Name: + +|] +guestbook_input parent True = [hsx| + +
+ +|] + +guestbook :: IO Html +guestbook = do + guestbook <- getGuestbook + return [hsx| + +

Guestbook

+ Write a message for me :)
+ {guestbook_input (-1) False} +
+

History

+ {prettify_guestbook guestbook} + |] + \ No newline at end of file diff --git a/app/Pages/Projects/Projects.hs b/app/Pages/Projects/Projects.hs index 178906c..a3fd0db 100644 --- a/app/Pages/Projects/Projects.hs +++ b/app/Pages/Projects/Projects.hs @@ -7,83 +7,66 @@ import Data.List (replicate, intercalate, find) import Helpers.Tree ( Tree(..) ) import Helpers.Utils (forEach) +import Helpers.Section (section) import Pages.Projects.Snake (snake) import Helpers.Database (schema, prettyPrintSchema) import Helpers.CodeBlock (codeBlock) defaultProject :: (String, Html) -defaultProject = ("", [hsx| +defaultProject = ("", (section [hsx| Use the sidebar to find a project :)

This page is inspired by my friend Mohamad, his site is available below

Mohamad's site -|]) +|])) projectsTree :: Tree (String, Html) projectsTree = Tree defaultProject [ - Tree ("Semester Projects", [hsx| + Tree ("Semester Projects", (section [hsx| Here's all the projects i've done at Aalborg University, they're defined as Pn where n is the semester they were done at. for example, P6 and P8 is my bachelor and master's projects respectively. - |]) [ - Tree ("P1", [hsx| -
- P1 was about Random Linear Network Coding -
- It was cool -
- |]) [], - Tree ("P2", [hsx| -
- A Project about adaptive cruise control in cars -
- |]) [], - Tree ("P3", [hsx| -
- We made a satellite ground station to be full duplex, as the previous implementation could only send data one way at a time, would be cool to use two channels. -
- |]) [], - Tree ("P4", [hsx| -
- Detecting fires on a map, it wasn't particularly interesting. -
- |]) [], - Tree ("P5", [hsx| -
+ |])) [ + Tree ("P1", (section [hsx| + P1 was about Random Linear Network Coding +
+ It was cool + |])) [], + Tree ("P2", (section [hsx| + A Project about adaptive cruise control in cars + |])) [], + Tree ("P3", (section [hsx| + We made a satellite ground station to be full duplex, as the previous implementation could only send data one way at a time, would be cool to use two channels. + |])) [], + Tree ("P4", (section [hsx| + Detecting fires on a map, it wasn't particularly interesting. + |])) [], + Tree ("P5", (section [hsx| Testing TCP performance using NS3, we learned a bit of C++, it was nice. -
- |]) [], - Tree ("P6", [hsx| -
- Modeling a testbed for edge nodes for measurement in real world scenarios

+ |])) [], + Tree ("P6", (section [hsx| + Modeling a testbed for edge nodes for measurement in real world scenarios

- It was a pretty interesting project, as we designed our own dataframe instead of using like HTTP, it made it very fast, but as could be read in our semester report, our system could be even faster if we optimized language and protocols.

+ It was a pretty interesting project, as we designed our own dataframe instead of using like HTTP, it made it very fast, but as could be read in our semester report, our system could be even faster if we optimized language and protocols.

- It would probably be beyond our expectations if we went and implemented our own solution at the data-link layer of networking instead of at the routing layer (or whatever its called again in TCP/IP) -
- |]) [], - Tree ("P7", [hsx| -
- The semester we learned haskell! Honestly i think i spent more time in my free time in total on haskell than i did thinking about this project. The project was about measuring the amount of people in a room using IoT devices and bluetooth.

+ It would probably be beyond our expectations if we went and implemented our own solution at the data-link layer of networking instead of at the routing layer (or whatever its called again in TCP/IP) + |])) [], + Tree ("P7", (section [hsx| + The semester we learned haskell! Honestly i think i spent more time in my free time in total on haskell than i did thinking about this project. The project was about measuring the amount of people in a room using IoT devices and bluetooth.

- The coolest part of this project was definitely with fidding with low-level promisquous mode on an IoT device. -
- |]) [], - Tree ("P8", [hsx| -
- This was a project about conducting a user-study, measuring people's stress and questioning them through an app on a mobile phone. -
- (this project was very, very bad imo, but i learned more C++) -
- |]) [] + The coolest part of this project was definitely with fidding with low-level promisquous mode on an IoT device. + |])) [], + Tree ("P8", (section [hsx| + This was a project about conducting a user-study, measuring people's stress and questioning them through an app on a mobile phone. +
+ (this project was very, very bad imo, but i learned more C++) + |])) [] ], - Tree ("Personal Projects", [hsx| -
- I find it fun coding in my free time, i do it a lot and as such this website was also born! -
- |]) [ + Tree ("Personal Projects", (section [hsx| + I find it fun coding in my free time, i do it a lot and as such this website was also born! + |])) [ Tree ("Snake", snake) [], - Tree ("Website", [hsx| -
+ Tree ("Website", (mconcat [section [hsx| +
Written in Haskell using IHP-HSX as the primary library, and sqlite-simple as the database implementation.
The database is actually pretty cool, its implemented as a list of table objects, and since i'm writing html directly inside my haskell code i can easily print the database structure inline here:

@@ -97,43 +80,43 @@ projectsTree = Tree defaultProject [

This page about projects is actually also pretty cool, its defined as a tree data structure, so i can also easily print it: {codeBlock "haskell" $ show (Tree ("projects", "") [Tree ("page2", "") [], Tree ("page3", "") [], Tree ("page4", "") []])} +

Versions

+ In the sidebar, or below you can choose to read about each version of this website.
- |]) [ - Tree ("Version 1", [hsx| -
- Was written on github pages using markdown
- barely had any content. -
- |]) [], - Tree ("Version 2", [hsx| -
- Was written in html, css and javascript, had a lot of client side javascript and is still available at https://about.skademaskinen.win
- The guestbook and the interests page was my main goal and i finished both of them.
- Source code is available at https://github.com/Skademaskinen/Frontend
-
- |]) [], - Tree ("Version 3", [hsx| -
- This was written in haskell using the full IHP framework, it was a lot of framework to code around compared to the older sites, ofc this made it possible to write more functionality with less code, but with such a feature also comes a lot of restrictions, such as the database being very hard to implement, and dependencies being less easily managed and coding an API using raw HTTP was very restrictive. hence version 4.
- Source code is available at https://github.com/Skademaskinen/F3 -
- |]) [], - Tree ("Version 4", [hsx| -
- This version is also written in haskell, but this time also using Warp directly to translate HSX to blaze and parse blaze to a bytestring. Its this current site and doesn't require a link :P
- Source code is available at https://github.com/Mast3rwaf1z/homepage -
- |]) [] + |], + [hsx|

Version 1

|], + snd (findItem ["", "Personal Projects", "Website", "Version 1"] projectsTree), + [hsx|

Version 2

|], + snd (findItem ["", "Personal Projects", "Website", "Version 2"] projectsTree), + [hsx|

Version 3

|], + snd (findItem ["", "Personal Projects", "Website", "Version 3"] projectsTree), + [hsx|

Version 4

|], + snd (findItem ["", "Personal Projects", "Website", "Version 4"] projectsTree)])) [ + Tree ("Version 1", (section [hsx| + Was written on github pages using markdown
+ barely had any content. + |])) [], + Tree ("Version 2", (section [hsx| + Was written in html, css and javascript, had a lot of client side javascript and is still available at https://about.skademaskinen.win
+ The guestbook and the interests page was my main goal and i finished both of them.
+ Source code is available at https://github.com/Skademaskinen/Frontend
+ |])) [], + Tree ("Version 3", (section [hsx| + This was written in haskell using the full IHP framework, it was a lot of framework to code around compared to the older sites, ofc this made it possible to write more functionality with less code, but with such a feature also comes a lot of restrictions, such as the database being very hard to implement, and dependencies being less easily managed and coding an API using raw HTTP was very restrictive. hence version 4.
+ Source code is available at https://github.com/Skademaskinen/F3 + |])) [], + Tree ("Version 4", (section [hsx| + This version is also written in haskell, but this time also using Warp directly to translate HSX to blaze and parse blaze to a bytestring. Its this current site and doesn't require a link :P
+ Source code is available at https://github.com/Mast3rwaf1z/homepage + |])) [] ], - Tree ("Skademaskinen", [hsx| -
- This is about my server, it hosts a lot of things, but the things accessible from HTTP is available at: -
-
+ Tree ("Skademaskinen", (section [hsx| + This is about my server, it hosts a lot of things, but the things accessible from HTTP is available at: +
+
{services} -
- |]) []]] + |])) []]] services :: Html services = mconcat $ map (\(name, d) -> [hsx| diff --git a/app/Pages/Projects/Snake.hs b/app/Pages/Projects/Snake.hs index f1a5107..95b60e9 100644 --- a/app/Pages/Projects/Snake.hs +++ b/app/Pages/Projects/Snake.hs @@ -13,7 +13,9 @@ tile id = [hsx| tileRow :: Int -> Html tileRow offset = [hsx| - {forEach [(offset*20)..19+(offset*20)] tile} +
+ {forEach [(offset*20)..19+(offset*20)] tile} +

|] diff --git a/homepage.cabal b/homepage.cabal index 236c291..a2df7ee 100644 --- a/homepage.cabal +++ b/homepage.cabal @@ -15,10 +15,12 @@ executable homepage Helpers.Utils, Helpers.Database, Helpers.Globals, + Helpers.Tables, Api.Api, Pages.Contact.Contact, Pages.Projects.Projects, Pages.Projects.Snake, + Pages.Guestbook.Guestbook, Pages.Sources.Sources build-depends: @@ -35,7 +37,8 @@ executable homepage sqlite-simple, time, uuid, - directory + directory, + aeson hs-source-dirs: app default-language: Haskell2010 diff --git a/static/stylesheet.css b/static/stylesheet.css index d0f0b8c..9e3f0f3 100644 --- a/static/stylesheet.css +++ b/static/stylesheet.css @@ -68,4 +68,35 @@ button:active { .inline_container:active { background-color:black; +} + +.guestbook-text { + all:unset; + min-width: 50%; + min-height: 200px; + text-align: left; + background-color: #222222; + border: 1px solid #ff5500; + border-radius: 5px; + padding: 5px; + display: inline; + white-space:pre-wrap; +} + +.guestbook-text:focus { + background-color: #262626; +} + +.guestbook-name { + all:unset; + text-align:left; + background-color: #222222; + border: 1px solid #ff5500; + border-radius: 5px; + min-height: 24px; + padding: 5px; + display: inline; +} +.guestbook-name:focus { + background-color: #262626; } \ No newline at end of file