fixed all indentation

Mast3rwaf1z · Nov 2, 2024 · 60514dc · 60514dc
1 parent 78a9533
commit 60514dc
Show file tree

Hide file tree

Showing 28 changed files with 691 additions and 974 deletions.
diff --git a/app/Api/Api.hs b/app/Api/Api.hs
@@ -49,133 +49,100 @@ jsonHeaders :: [Header]
 jsonHeaders = [("Content-Type", "application/json")]
 
 messageResponse :: String -> String
-messageResponse value =
-  j2s
-    [aesonQQ|{
+messageResponse value = j2s [aesonQQ|{
     "message":#{value}
 }|]
 
 apiMap :: [APIRoute]
-apiMap =
-  [
-    ( "POST"
-    ,
-      [
-        ( "/visits/new"
-        , \r -> do
+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
+            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
+        ),
+        ("/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 UserName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity User])
-                case rows of
-                  [user] -> case checkPassword pass (PasswordHash $ pack (userPassword user)) of
-                    PasswordCheckSuccess -> do
-                      rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter TokenName (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 $ tokenToken $ 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
+                (T.Credentials username password) -> do
+                    let pass = mkPassword $ pack password
+                    rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter UserName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity User])
+                    case rows of
+                        [user] -> case checkPassword pass (PasswordHash $ pack (userPassword user)) of
+                            PasswordCheckSuccess -> do
+                                rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter TokenName (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 $ tokenToken $ 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
+    ]),
+    ("GET", [
+        ("/visits/get", \_ -> do
             visits <- show . length <$> getVisits
             return (status200, j2s [aesonQQ|{"visits":#{visits}}|], jsonHeaders)
-        )
-      ,
-        ( "/guestbook/get"
-        , \_ -> do
+        ),
+        ("/guestbook/get", \_ -> do
             entries <- getGuestbook
             return (status200, j2s [aesonQQ|{"entries":#{unpackBS $ toStrict $ encode $ show entries}}|], jsonHeaders)
         )
-      ]
-    )
-  ,
-    ( "PUT"
-    ,
-      [
-        ( "/guestbook/add"
-        , \r -> do
+    ]),
+    ("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
+                (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)
+                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"
-    , []
-    )
-  ]
+    ]),
+    ("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)
+    let method = unpackBS $ requestMethod request
+    let path = pathInfo request
+    case find (\(name, _) -> name == method) apiMap of
+        (Just (_, endpoints)) -> case find (checkEndpoint path) endpoints of
+            (Just (_, f)) -> f request
+            Nothing -> return (status400, messageResponse "Error, no endpoint found", defaultHeaders)
+        Nothing -> return (status400, messageResponse "Error, no endpoint found", defaultHeaders)
+    where
+        checkEndpoint path (regex, _) = case matchRegex (mkRegex ("api" ++ regex)) $ unpack (intercalate "/" path) of
+            Nothing -> False
+            _ -> True
diff --git a/app/Footer.hs b/app/Footer.hs
@@ -4,8 +4,7 @@ import IHP.HSX.QQ (hsx)
 import Text.Blaze.Html (Html)
 
 footer :: Html
-footer =
-  [hsx|
+footer = [hsx|
     <div>
     </div>
 |]
diff --git a/app/Header.hs b/app/Header.hs
@@ -5,8 +5,7 @@ import Text.Blaze.Html (Html)
 
 makeLinks :: [(String, String)] -> Html
 makeLinks [] = [hsx||]
-makeLinks [(display, url)] =
-  [hsx|
+makeLinks [(display, url)] = [hsx|
     <a href={url}>{display}</a> | 
     <input id="search" placeholder="search">
     <script>
@@ -18,15 +17,13 @@ makeLinks [(display, url)] =
         }
     </script>
 |]
-makeLinks ((display, url) : xs) =
-  [hsx|
+makeLinks ((display, url) : xs) = [hsx|
     <a href={url}>{display}</a> |
     {makeLinks xs}
 |]
 
 header :: [(String, String)] -> Html
-header links =
-  [hsx|
+header links = [hsx|
     <div>
         {makeLinks links}
     </div>

diff --git a/app/Index.hs b/app/Index.hs
@@ -10,9 +10,7 @@ import Page (Page, PageSetting (Description, EmbedImage, EmbedText, Route))
 import Section (section)
 
 intro :: Html
-intro =
-  section
-    [hsx|
+intro = section [hsx|
     Welcome to my home page, returning visitors might notice that the same layout that i always use is still present, and yes the site is still written in Haskell.
     <br><br>
     I was using the whole IHP development suite to work on the site originally, but i have a problem with that framework: its huge and very overkill for what i'm trying to do.
@@ -42,30 +40,29 @@ intro =
 
 page :: IO Html
 page = do
-  visits <- show . length <$> getVisits
-  return
-    [hsx|
-    <h1>Skademaskinen</h1>
-    <img src="/static/icon.png" style="border-radius:50%">
-    <br>
-    <hr>
-    {intro}
-    Visitors: <p id="visits">{visits}</p>
-    <script>
-        fetch("/api/visits/new", {
-            method: "post",
-            body: getCookie("visitId")
-        }).then(res => res.json().then(data => setCookie("visitId="+data.uuid)))
-    </script>
-|]
+    visits <- show . length <$> getVisits
+    return [hsx|
+        <h1>Skademaskinen</h1>
+        <img src="/static/icon.png" style="border-radius:50%">
+        <br>
+        <hr>
+        {intro}
+        Visitors: <p id="visits">{visits}</p>
+        <script>
+            fetch("/api/visits/new", {
+                method: "post",
+                body: getCookie("visitId")
+            }).then(res => res.json().then(data => setCookie("visitId="+data.uuid)))
+        </script>
+    |]
 
 settings :: [PageSetting]
-settings =
-  [ Route "/"
-  , Description "This is the front page for Skademaskinen, a server built as a passion project."
-  , EmbedImage "/static/icon.png"
-  , EmbedText "Skademaskinen - Index"
-  ]
+settings = [
+    Route "/",
+    Description "This is the front page for Skademaskinen, a server built as a passion project.",
+    EmbedImage "/static/icon.png",
+    EmbedText "Skademaskinen - Index"
+    ]
 
 index :: Page
 index = (settings, const $ layout <$> page)
diff --git a/app/Layout.hs b/app/Layout.hs
@@ -7,8 +7,7 @@ import Footer (footer)
 import Header (header)
 
 layout :: Html -> Html
-layout content =
-  [hsx|
+layout content = [hsx|
     <!DOCTYPE html>
     <html>
         <head>