Removed /v1/ prefix from Haskell source code. Optimised backend image. Added newlines to frontend.

This commit is contained in:
Xnoe 2022-07-12 02:24:45 +01:00
parent e3c27c6609
commit ba75a239e6
Signed by: xnoe
GPG Key ID: 45AC398F44F0DAFE
5 changed files with 62 additions and 24 deletions

View File

@ -1,4 +1,4 @@
FROM haskell:8
FROM haskell:8 as build
WORKDIR /opt/backend
RUN apt-get update
RUN yes | apt-get install postgresql libpq-dev
@ -7,4 +7,9 @@ COPY ./backend.cabal /opt/backend
RUN cabal build --only-dependencies -j4
COPY . /opt/backend
RUN cabal install
CMD ["backend"]
FROM debian:buster
RUN apt-get update
RUN yes | apt-get install postgresql libpq-dev
COPY --from=build /root/.cabal/bin/backend ./
CMD ["./backend"]

View File

@ -316,8 +316,8 @@ handleWhoami c = do
Just u -> ok $ toResponse $ showJSON $ toJSObject [("success", toJSString "true"), ("username", toJSString u)]
Nothing -> ok $ toResponse $ showJSON $ toJSObject [("success", toJSString "false"), ("username", toJSString "")]
main :: IO ()
main = do
appMain :: IO ()
appMain = do
dbhostvar <- lookupEnv "DB_HOST"
dbuservar <- lookupEnv "DB_USER"
dbpassvar <- lookupEnv "DB_PASS"
@ -360,48 +360,55 @@ main = do
userExists <- fetchAllRows queryUser
if user /= "" then
case userExists of
[_] -> do return Nothing
[_] -> do return ()
[] -> do
let passwordHashBS = SHA256.hash (C.pack pass)
let passwordHash = hexOfBS passwordHashBS
createUser <- prepare c "INSERT INTO users(username, password) VALUES(?, ?);"
execute createUser [toSql user, toSql passwordHash]
commit c
return Nothing
return ()
else
do return Nothing
do return ()
simpleHTTP config $ do
decodeBody (defaultBodyPolicy "/tmp/" 0 4096 4096)
msum [ dir "v1" $ dir "post" $ path $ \pid -> require (getPostContent c pid) $ \post -> ok $ toResponse post
, dir "v1" $ dir "category" $ path $ \cid -> do
msum [ dir "post" $ path $ \pid -> require (getPostContent c pid) $ \post -> ok $ toResponse post
, dir "category" $ path $ \cid -> do
page <- look "page"
let p = read page :: Int
if (p < 0) then
ok $ toResponse ""
else
require (getPostsInCategory c cid p) $ \cat -> ok $ toResponse cat
, dir "v1" $ dir "posts" $ do
, dir "posts" $ do
page <- look "page"
let p = read page :: Int
if (p < 0) then
ok $ toResponse ""
else
require (getPostListing c p) $ \posts -> ok $ toResponse posts
, dir "v1" $ dir "categories" $ do
, dir "categories" $ do
page <- look "page"
let p = read page :: Int
if (p < 0) then
ok $ toResponse ""
else
require (getCategoryListing c p) $ \cats -> ok $ toResponse cats
, dir "v1" $ dir "login" $ handleLogin c
, dir "v1" $ dir "createPost" $ handleCreatePost c
, dir "v1" $ dir "whoami" $ handleWhoami c
, dir "v1" $ dir "logout" $ do
, dir "login" $ handleLogin c
, dir "createPost" $ handleCreatePost c
, dir "whoami" $ handleWhoami c
, dir "logout" $ do
expireCookie "token"
ok $ toResponse $ showJSON $ toJSObject [("success", toJSString "true")]
, dir "v1" $ dir "editPost" $ handleEditPost c
, dir "v1" $ dir "deletePost" $ handleDeletePost c
, dir "editPost" $ handleEditPost c
, dir "deletePost" $ handleDeletePost c
, notFound $ toResponse "Endpoint does not exist"
]
main :: IO ()
main = do
result <- try appMain :: IO (Either SomeException ())
case result of
Left _ -> main
Right _ -> return ()

View File

@ -12,6 +12,9 @@ services:
image: registry.xnopyt.com/xnoeblog-backend:latest
depends_on:
- database
environment:
- XNOEBLOG_USER=user
- XNOEBLOG_PASS=password
nginx:
restart: unless-stopped
@ -27,4 +30,9 @@ services:
environment:
- POSTGRES_PASSWORD=password
- POSTGRES_USER=root
- POSTGRES_DB=xnoeblog
- POSTGRES_DB=xnoeblog
volumes:
- postgres:/var/lib/postgres/data
volumes:
postgres:

View File

@ -342,10 +342,26 @@ htmlView model =
] ++
case model.user of
Nothing -> [xa [href "/login"] [text "Login"]]
Just u -> [xa [onClick Logout] [text "Logout"], text " - ", xa [href "/create"] [text "Create Post"]]
Just u -> [text ("Hello, " ++ u.username), text " - ", xa [onClick Logout, href "#"] [text "Logout"], text " - ", xa [href "/create"] [text "Create Post"]]
),
renderModel model
]
prod_list : List (Html Msg) -> String -> List Char -> List (Html Msg)
prod_list accl accs chars =
case chars of
(hd::tl) ->
case hd of
'\n' -> prod_list (accl++[text accs, br [] []]) "" tl
'\r' -> prod_list accl accs tl
c -> prod_list (accl) (accs++(String.fromChar c)) tl
[] -> accl
parseContent : String -> List (Html Msg)
parseContent content =
let chars = String.toList content in
prod_list [] "" chars
renderModel : Model -> Html Msg
renderModel model =
case (model.errMessage) of
@ -354,7 +370,7 @@ renderModel model =
case model.route of
Just route -> case route of
PostPageView _ -> div [style "padding" "5px"] [h1 [] [text "Welcome to my blog."],cardListing model "/post"]
PostView _ -> div [] ([h1 [] [text (model.post.title)], p [] [text(model.post.content)], h3 [] [text(model.post.category.name ++ " ")]] ++ case model.user of
PostView _ -> div [] ([h1 [] [text (model.post.title)], div [style "margin-left" "10px", style "margin-right" "10px"] (parseContent model.post.content), h3 [] [text(model.post.category.name ++ " ")]] ++ case model.user of
Nothing -> []
Just u -> [xa [href "", onClick DeletePost] [text "Delete Post"], text " - ", xa [href "", onClick GotoEditPost] [text "Edit Post"]])
CategoryPageView (_,c) -> div [style "padding" "5px"] [h1 [] [text (model.header)], cardListing model ("/category/" ++ c)]

View File

@ -6,13 +6,15 @@ http {
server {
listen 80;
server_name _;
location /v1 {
proxy_pass http://backend:80;
}
location / {
rewrite ^/.* / break;
rewrite ^/.+ / break;
proxy_pass http://frontend:80/index.html;
}
location /v1 {
rewrite ^/v1/(.*) /$1 break;
proxy_pass http://backend:80;
}
}
}