From 5965e67c4d287cb3a07aeabc5294ebc1076a9b28 Mon Sep 17 00:00:00 2001 From: Thomas Jensen <32744171+Mast3rwaf1z@users.noreply.github.com> Date: Tue, 29 Oct 2024 12:55:32 +0100 Subject: [PATCH] rewrote api (#7) * rewrote api * changed api endpoints respond with json --- app/Api/Api.hs | 184 +++++++++++++++++-------------- app/Index.hs | 2 +- app/Main.hs | 10 +- app/Pages/Admin/Admin.hs | 8 +- app/Pages/Guestbook/Guestbook.hs | 6 +- flake.nix | 2 +- static/projects/snake.js | 2 +- 7 files changed, 118 insertions(+), 96 deletions(-) diff --git a/app/Api/Api.hs b/app/Api/Api.hs index 057c66d..a69632a 100644 --- a/app/Api/Api.hs +++ b/app/Api/Api.hs @@ -15,13 +15,13 @@ import Data.Time.Clock.POSIX (getPOSIXTime) import Data.UUID.V4 (nextRandom) import Data.UUID (toString) -import Network.Wai (getRequestBodyChunk, Request) +import Network.Wai (getRequestBodyChunk, Request (requestMethod, pathInfo)) import Network.HTTP.Types.Status (Status, status404, status200, status400) import Data.Aeson (encode, decode, Value (String)) import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Password.Bcrypt (PasswordCheck(PasswordCheckSuccess, PasswordCheckFail), mkPassword, checkPassword, PasswordHash (PasswordHash)) -import Data.Text (pack, unpack) +import Data.Text (pack, unpack, intercalate) import Crypto.Random (getRandomBytes) import Data.Text.Array (Array(ByteArray)) import Text.StringRandom (stringRandomIO) @@ -31,10 +31,14 @@ import Database.Persist (selectList, Entity (Entity), insertEntity, Filter (Filt import Network.HTTP.Types (HeaderName) import Data.ByteString.UTF8 (ByteString) -import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Aeson.QQ (aesonQQ) +import Data.List (find) +import Text.Regex (matchRegex, mkRegex) type Header = (HeaderName, ByteString) type APIResponse = IO (Status, String, [Header]) +type APIEndpoint = (String, Request -> APIResponse) +type APIRoute = (String, [APIEndpoint]) j2s :: Value -> String j2s = unpackBS . toStrict .encode @@ -42,86 +46,102 @@ j2s = unpackBS . toStrict .encode defaultHeaders :: [Header] defaultHeaders = [("Content-Type", "text/plain")] +jsonHeaders :: [Header] +jsonHeaders = [("Content-Type", "application/json")] + messageResponse :: String -> String messageResponse value = j2s [aesonQQ|{ - "message":"#{value}" + "message":#{value} }|] - -handleGuestbookEntry :: T.GuestbookEntry -> APIResponse -handleGuestbookEntry (T.GuestbookEntry "" _ _) = return (status400, "Error, name cannot be empty", defaultHeaders) -handleGuestbookEntry (T.GuestbookEntry _ "" _) = return (status400, "Error, content cannot be empty", defaultHeaders) -handleGuestbookEntry (T.GuestbookEntry name content parentId) = do - time <- fmap round getPOSIXTime :: IO Int - runDb $ insertEntity $ GuestbookEntry 0 time name content parentId - return (status200, messageResponse "Success" , defaultHeaders) - -handleLeaderboardEntry :: T.LeaderboardEntry -> APIResponse -handleLeaderboardEntry (T.LeaderboardEntry name score speed fruits) = do - time <- fmap round getPOSIXTime :: IO Int - runDb $ insertEntity $ Snake 0 time name score speed fruits - return (status200, messageResponse "Success", defaultHeaders) -handleLeaderboardEntry T.EmptyLeaderboard = return (status400, messageResponse "Error", defaultHeaders) - -handleLogin :: T.Credentials -> APIResponse -handleLogin (T.Credentials username password) = do - let pass = mkPassword $ pack password - rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter UserUserName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity User]) - case rows of - [user] -> case checkPassword pass (PasswordHash $ pack (userUserPassword user)) of - PasswordCheckSuccess -> do - rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter TokenTokenName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity Token]) - if null rows then do - token <- stringRandomIO "[0-9a-zA-Z]{4}-[0-9a-ZA-Z]{10}-[0-9a-zA-Z]{15}" - runDb $ insertEntity $ Token 0 (unpack token) username - return (status200, unpack token, defaultHeaders) - else do - let row = head rows - return (status200, tokenTokenToken row, defaultHeaders) - where - PasswordCheckFail -> return (status400, messageResponse "Wrong username or password", defaultHeaders) - _ -> return (status400, messageResponse "Error, no user exists" , defaultHeaders) -handleLogin _ = return (status400, messageResponse "Invalid request", defaultHeaders) - -api :: [String] -> Request -> APIResponse -api ["visits", "new"] request = do - body <- getRequestBodyChunk request - result <- uuidExists (unpackBS body) - if result then do - time <- fmap round getPOSIXTime :: IO Int - uuid <- nextRandom - runDb $ insertEntity $ Visit 0 time $ toString uuid - info "Inserted into db" - return (status200, toString uuid, defaultHeaders) - else - return (status200, unpackBS body, defaultHeaders) -api ["visits", "get"] request = do - visits <- show . length <$> getVisits - return (status200, visits, []) -api ["guestbook", "add"] request = do - body <- getRequestBodyChunk request - let entry = getDefault T.EmptyGuestbook (decode (fromStrict body) :: Maybe T.GuestbookEntry) - handleGuestbookEntry entry -api ["guestbook", "get"] request = do - body <- getRequestBodyChunk request - entries <- getGuestbook - return (status200, unpackBS $ toStrict $ encode $ show entries, defaultHeaders) -api ["snake", "add"] request = do - body <- getRequestBodyChunk request - let entry = getDefault T.EmptyLeaderboard (decode (fromStrict body) :: Maybe T.LeaderboardEntry) - handleLeaderboardEntry entry -api ["admin", "login"] request = do - body <- getRequestBodyChunk request - let credentials = getDefault T.EmptyCredentials (decode (fromStrict body) :: Maybe T.Credentials) - handleLogin credentials -api ["hello"] _ = do - return (status200, j2s [aesonQQ|{ - "message":"Hello World!" - }|], defaultHeaders) -api ["brainfuck"] request = do - input <- getRequestBodyChunk request - let result = code $ unpackBS input - return (status200, result, [("Content-Disposition", "attachment; filename=\"brainfuck.c\"")]) - -api xs request = do - return (status404, messageResponse "Endpoint does not exist", defaultHeaders) +apiMap :: [APIRoute] +apiMap = [ + ("POST", [ + ("/visits/new", \r -> do + body <- getRequestBodyChunk r + result <- uuidExists $ unpackBS body + res <- if result then do + time <- fmap round getPOSIXTime :: IO Int + uuid <- nextRandom + runDb $ insertEntity $ Visit 0 time $ toString uuid + return $ toString uuid + else + return $ unpackBS body + return (status200, j2s [aesonQQ|{"uuid":#{res}}|], jsonHeaders) + ), + ("/admin/login", \r -> do + body <- getRequestBodyChunk r + let credentials = getDefault T.EmptyCredentials (decode (fromStrict body) :: Maybe T.Credentials) + case credentials of + (T.Credentials username password) -> do + let pass = mkPassword $ pack password + rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter UserUserName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity User]) + case rows of + [user] -> case checkPassword pass (PasswordHash $ pack (userUserPassword user)) of + PasswordCheckSuccess -> do + rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter TokenTokenName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity Token]) + response <- if null rows then do + token <- stringRandomIO "[0-9a-zA-Z]{4}-[0-9a-ZA-Z]{10}-[0-9a-zA-Z]{15}" + runDb $ insertEntity $ Token 0 (unpack token) username + return $ unpack token + else return $ tokenTokenToken $ head rows + return (status200, j2s [aesonQQ|{"token":#{response}}|], jsonHeaders) + PasswordCheckFail -> return (status400, messageResponse "Error, Wrong username or password", jsonHeaders) + _ -> return (status400, messageResponse "Error, no user exists", jsonHeaders) + _ -> return (status400, messageResponse "Error, Invalid request", jsonHeaders) + ), + ("/brainfuck", \r -> do + input <- getRequestBodyChunk r + let result = code $ unpackBS input + return (status200, result, [("Content-Disposition", "attachment; filename=\"brainfuck.c\"")]) + ) + ]), + ("GET", [ + ("/visits/get", \_ -> do + visits <- show . length <$> getVisits + return (status200, j2s [aesonQQ|{"visits":#{visits}}|], jsonHeaders) + ), + ("/guestbook/get", \_ -> do + entries <- getGuestbook + return (status200, j2s [aesonQQ|{"entries":#{unpackBS $ toStrict $ encode $ show entries}}|], jsonHeaders) + ) + ]), + ("PUT", [ + ("/guestbook/add", \r -> do + body <- getRequestBodyChunk r + let entry = getDefault T.EmptyGuestbook (decode (fromStrict body) :: Maybe T.GuestbookEntry) + case entry of + (T.GuestbookEntry "" _ _) -> return (status400, messageResponse "Error, name cannot be empty", jsonHeaders) + (T.GuestbookEntry _ "" _) -> return (status400, messageResponse "Error, content cannot be empty", jsonHeaders) + (T.GuestbookEntry name content parentId) -> do + time <- fmap round getPOSIXTime :: IO Int + runDb $ insertEntity $ GuestbookEntry 0 time name content parentId + return (status200, messageResponse "Success", jsonHeaders) + ), + ("/snake/add", \r -> do + body <- getRequestBodyChunk r + let entry = getDefault T.EmptyLeaderboard (decode (fromStrict body) :: Maybe T.LeaderboardEntry) + case entry of + T.EmptyLeaderboard -> return (status400, messageResponse "Error, leaderboard empty", jsonHeaders) + (T.LeaderboardEntry name score speed fruits) -> do + time <- fmap round getPOSIXTime :: IO Int + runDb $ insertEntity $ Snake 0 time name score speed fruits + return (status200, messageResponse "Success", jsonHeaders) + ) + ]), + ("DELETE", [ + + ]) + ] + +api :: Request -> APIResponse +api request = do + let method = unpackBS $ requestMethod request + let path = pathInfo request + case find (\(name, _) -> name == method) apiMap of + (Just (_, endpoints)) -> case find (\(regex, _) -> (case matchRegex (mkRegex ("api" ++ regex)) $ unpack (intercalate "/" path) of + Nothing -> False + _ -> True)) endpoints of + (Just (_, f)) -> f request + Nothing -> return (status400, messageResponse "Error, no endpoint found", defaultHeaders) + Nothing -> return (status400, messageResponse "Error, no endpoint found", defaultHeaders) \ No newline at end of file diff --git a/app/Index.hs b/app/Index.hs index 5029246..e4316c6 100644 --- a/app/Index.hs +++ b/app/Index.hs @@ -53,7 +53,7 @@ page = do fetch("/api/visits/new", { method: "post", body: getCookie("visitId") - }).then(res => res.text().then(uuid => setCookie("visitId="+uuid))) + }).then(res => res.json().then(data => setCookie("visitId="+data.uuid))) |] diff --git a/app/Main.hs b/app/Main.hs index d840da6..cda52c9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,7 +11,7 @@ import Data.List (intercalate, find) import System.Directory (doesFileExist) -import Network.Wai (responseBuilder, responseFile, Request (queryString)) +import Network.Wai (responseBuilder, responseFile, Request (queryString), responseLBS) import Network.Wai.Handler.Warp (run) import Network.Wai.Internal (Response(ResponseBuilder, ResponseFile), Request, pathInfo, requestMethod) import Network.HTTP.Types (statusCode, status200, status404, Status, Query, HeaderName) @@ -31,7 +31,7 @@ import Database.Database (doMigration) import Utils (unpackBS) import Settings (getPort, getCliState, getMigrate) import Logger (logger, tableify, info, warning) -import Api.Api (api) +import Api.Api (api, j2s) import Control.Concurrent (forkIO, ThreadId) import Repl (repl) import System.Environment (getArgs) @@ -41,6 +41,8 @@ import Pages.Pages (findPage) import Data.List.Split (splitOn) import Control.Monad (when) import Page (embedText, embedImage, description) +import Data.Aeson.QQ (aesonQQ) +import Data.Aeson (encode) serve :: Html -> Response @@ -66,7 +68,7 @@ serveFile path = do return $ responseFile status200 [autoContentType path] path Nothing else do warning "No file found!" - return $ responseBuilder status404 [("Content-Type", "text/json")] $ copyByteString "{\"error\":\"Error: file not found!\"}" + return $ responseLBS status404 [("Content-Type", "text/json")] $ encode [aesonQQ|{"error":"Error, file not found"}|] app :: Request -> (Response -> IO b) -> IO b app request respond = do @@ -80,7 +82,7 @@ app request respond = do serveFile "static/favicon.ico" else if x == "api" then do -- If the request is to the API - (status, value, headers) <- api (drop 1 xs) request + (status, value, headers) <- api request return $ responseBuilder status headers $ copyByteString (fromString value) else do -- If the content is to the HTML Frontend diff --git a/app/Pages/Admin/Admin.hs b/app/Pages/Admin/Admin.hs index 6560f3a..4d491a9 100644 --- a/app/Pages/Admin/Admin.hs +++ b/app/Pages/Admin/Admin.hs @@ -167,14 +167,14 @@ page x = do username:username, password:password }) - }).then(response => response.text().then(text => { + }).then(response => response.json().then(data => { if(response.ok) { - setCookie("adminToken="+text+";path=/") - window.location.href = "/admin/summary/"+text + setCookie("adminToken="+data.token+";path=/") + window.location.href = "/admin/summary/"+data.token } else { var error_display = document.getElementById("error_display") - error_display.innerHTML = text + error_display.innerHTML = data.message } })) } diff --git a/app/Pages/Guestbook/Guestbook.hs b/app/Pages/Guestbook/Guestbook.hs index a85a743..c060c87 100644 --- a/app/Pages/Guestbook/Guestbook.hs +++ b/app/Pages/Guestbook/Guestbook.hs @@ -76,7 +76,7 @@ page = do var name = document.getElementById("guestbook-name::"+id).value console.log(id) fetch("/api/guestbook/add", { - method:"POST", + method:"PUT", body: JSON.stringify({ name: name, content: text, @@ -86,8 +86,8 @@ page = do if(response.status == 200){ window.location.reload() } - else response.text().then(text => { - alert(response.status + "\n" + text) + else response.json().then(data => { + alert(response.status + "\n" + data.message) }) }) } diff --git a/flake.nix b/flake.nix index 4a1bce6..e7bdff6 100644 --- a/flake.nix +++ b/flake.nix @@ -49,7 +49,7 @@ installPhase = '' mkdir -p $out/bin ln -s ${packages.${system}.homepage}/bin/homepage $out/bin/homepage - ln -s ${packages.${system}.homepage}/bin/cli $out/bin/cli + ln -s ${packages.${system}.homepage}/bin/repl-homepage $out/bin/repl-homepage cp -r $src/static $out ''; }; diff --git a/static/projects/snake.js b/static/projects/snake.js index 900e763..5cb6351 100644 --- a/static/projects/snake.js +++ b/static/projects/snake.js @@ -90,7 +90,7 @@ async function launchGame() { if(name != "") { fetch("/api/snake/add", { - method: "post", + method: "PUT", body: JSON.stringify({ name: document.getElementById("player-name").value, timestamp: time,