diff of a168eb812bb2e82c699d5966c315c5660a370fec
a168eb812bb2e82c699d5966c315c5660a370fec
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 3c81431..2a86a33 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -27,14 +27,16 @@
;; works in cl universal time (epoch at 1900)
"cl-date-time-parser"
"alexandria"
- "uuid")
+ "uuid"
+ "cl-hash-util")
:description "A rewrite of the <a href=\"https://github.com/feuery/murja-blog/\">murja blogging engine</a> in lisp"
:components ((:module "src"
:components
((:module "local-lib"
:components ((:file "lisp-fixup")
(:file "halisql")
- (:file "migrations")))
+ (:file "migrations")
+ (:file "json")))
(:file "migration-list")
(:module "users"
:components ((:file "user-db")))
@@ -64,6 +66,7 @@
(:file "media-routes")
(:file "rss-routes")
(:file "rss-reader-routes")
+ (:file "user-editor")
(:file "root-routes")))
(:file "main"))))
:in-order-to ((test-op (test-op "aggressive-murja/tests"))))
diff --git a/elm-frontti/src/Ajax_cmds.elm b/elm-frontti/src/Ajax_cmds.elm
index ac13082..72123e4 100644
--- a/elm-frontti/src/Ajax_cmds.elm
+++ b/elm-frontti/src/Ajax_cmds.elm
@@ -78,10 +78,10 @@ getListOfImages managerCalled = Http.get
, expect = Http.expectJson (GotListOfImages managerCalled) (Json.list Image.imageDecoder)}
-postPicture pictureFile = Http.post
- { url = "/api/pictures"
+postPicture handler_msg url pictureFile = Http.post
+ { url = url
, body = Http.multipartBody [ Http.filePart "file" pictureFile ]
- , expect = Http.expectJson UploadedImage Image.imageResponseDecoder }
+ , expect = Http.expectJson handler_msg Image.imageResponseDecoder }
deletePictures ids = Http.request
@@ -205,3 +205,9 @@ getTopbarAlarms permissions =
, expect = Http.expectJson GotTopbarLogAlarm Logs.topbarAlarmDecoder}
else
Cmd.none
+
+submitUser user oldpasswd newpasswd =
+ Http.post
+ { url = "/api/user/submit"
+ , body = Http.jsonBody (User.encodeEditorUser user oldpasswd newpasswd)
+ , expect = Http.expectWhatever UserSubmitResult}
diff --git a/elm-frontti/src/Main.elm b/elm-frontti/src/Main.elm
index b660704..5104adf 100644
--- a/elm-frontti/src/Main.elm
+++ b/elm-frontti/src/Main.elm
@@ -48,6 +48,7 @@ import File exposing (mime)
import FeedView
import Feeds exposing (NewFeed)
import Tab exposing (..)
+import UserEditor
-- MAIN
@@ -126,6 +127,10 @@ viewStatePerUrl url =
, getAdminLogs
, getTitles
, getLogGroups])
+ RouteParser.OwnUserSettings -> ( UserSettings "" "" Nothing
+ , [ getSettings
+ , getSession
+ , getTitles])
init _ url key =
let (viewstate, cmds) = (viewStatePerUrl url)
@@ -226,13 +231,19 @@ update msg model =
GotSession result ->
case result of
Ok user ->
- if model.view_state == PostEditor then
- ({ model | loginState = LoggedIn user
- , postEditorSettings = Nothing}
- , getTopbarAlarms user.permissions)
- else
- ({model | loginState = LoggedIn user}
- , getTopbarAlarms user.permissions)
+ case model.view_state of
+ PostEditor ->
+ ({ model | loginState = LoggedIn user
+ , postEditorSettings = Nothing}
+ , getTopbarAlarms user.permissions)
+ UserSettings oldpwd newpwd _ ->
+ ( { model
+ | loginState = LoggedIn user
+ , view_state = UserSettings oldpwd newpwd (Just user)}
+ , getTopbarAlarms user.permissions)
+ _ ->
+ ({model | loginState = LoggedIn user}
+ , getTopbarAlarms user.permissions)
Err error ->
case error of
Http.BadStatus status ->
@@ -352,17 +363,17 @@ update msg model =
EditorDragLeave ->
( {model | draggingImages = False}
, Cmd.none)
- GotFiles file files ->
+ GotFiles sendPicture file files ->
if String.startsWith "image" (mime file) then
( { model | draggingImages = False }
- , postPicture file)
+ , sendPicture file)
else
( { model | draggingImages = False }
, alert ("Got " ++ (mime file) ++ ", expected an image"))
GotInputFiles files ->
if List.all (\file -> String.startsWith "image" (mime file)) files then
( model
- , Cmd.batch (List.map (\file -> postPicture file) files))
+ , Cmd.batch (List.map (\file -> postPicture UploadedImage PostEditor.editor_image_api file) files))
else
( model
, alert ("Expected images, got " ++ (String.join ", " (List.map mime files))))
@@ -811,6 +822,69 @@ update msg model =
{ settings | domain = dm })
model.settings}
, Cmd.none)
+ SetUsername usrname ->
+ case model.view_state of
+ UserSettings oldpwd newpwd usr ->
+ ({ model
+ | view_state = UserSettings oldpwd newpwd (Maybe.map (\old_usr ->
+ {old_usr | username = usrname}) usr)}
+ , Cmd.none)
+ _ -> ( model, Cmd.none)
+ SetNickname new_nickname ->
+ case model.view_state of
+ UserSettings oldpwd newpwd usr ->
+ ({ model
+ | view_state = UserSettings oldpwd newpwd (Maybe.map (\old_usr ->
+ {old_usr | nickname = new_nickname}) usr)}
+ , Cmd.none)
+ _ -> ( model, Cmd.none)
+ SetNewpwd newpwd ->
+ case model.view_state of
+ UserSettings oldpwd _ usr ->
+ ({ model
+ | view_state = UserSettings oldpwd newpwd usr}
+ , Cmd.none)
+ _ -> ( model, Cmd.none)
+ SetOldpwd oldpwd ->
+ case model.view_state of
+ UserSettings _ newpwd usr ->
+ ({ model
+ | view_state = UserSettings oldpwd newpwd usr}
+ , Cmd.none)
+ _ -> ( model, Cmd.none)
+ SubmitChangedUser oldpasswd newpasswd user ->
+ -- TODO implement
+ case model.loginState of
+ LoggedIn usr ->
+ ( model
+ , if usr.id == user.id then
+ submitUser user oldpasswd newpasswd
+ else
+ Cmd.none)
+ _ -> ( model
+ , Cmd.none)
+ UserSubmitResult r ->
+ case r of
+ Ok _ ->
+ ( model
+ , Cmd.batch [ getSettings
+ , getSession
+ , getTitles])
+ Err error ->
+ ( { model | view_state = ShowError (errToString error) }
+ , Cmd.none)
+ UploadedOwnProfilePic r ->
+ case r of
+ -- we're not really interested in the return value more than "is it 2xx instead of 4xx or 5xx?", we're just as api-compatible with the posteditor's image upload functionality as possible
+ Ok _ ->
+ ( model
+ , Cmd.batch [ getSettings
+ , getSession
+ , getTitles])
+ Err error ->
+ ( { model | view_state = ShowError (errToString error) }
+ , Cmd.none)
+
doGoHome_ model other_cmds =
(model, Cmd.batch (List.append [ getSettings
@@ -824,8 +898,6 @@ doGoHome model = doGoHome_ model []
-- VIEW
-
-
sidebarHistory : List Article.Title -> Html Msg
sidebarHistory titles =
let grouped_by_year = groupBy .year titles in
@@ -895,7 +967,10 @@ blog_tab settings model =
MediaList -> unknown_state
SettingsEditor -> unknown_state
Feeds _ _ -> unknown_state
-
+ UserSettings oldpasswd newpasswd usr_ -> case usr_ of
+ Just usr -> [ UserEditor.editor model.draggingImages oldpasswd newpasswd usr
+ , div [] [ text <| "usr: " ++ (Debug.toString usr) ]]
+ Nothing -> [ div [] [ text "Can't change user settings when there's no user"]]
)
rss_tab model settings =
@@ -986,7 +1061,7 @@ view model =
(posteditor_tab settings model)
(Just GenNewPost)
["create-post", "edit-post"])])
- , div [id "sidebar"] [ User.loginView model.loginState
+ , div [id "sidebar"] [ UserEditor.loginView model.loginState
, (sidebarHistory model.titles )
, (case model.view_state of
PostEditorList titles -> PostsAdmin.tagList titles
diff --git a/elm-frontti/src/Message.elm b/elm-frontti/src/Message.elm
index 8ac0314..1f68597 100644
--- a/elm-frontti/src/Message.elm
+++ b/elm-frontti/src/Message.elm
@@ -35,6 +35,13 @@ type ViewState
| Feeds (List Feeds.Feed) Bool -- <- show_archived?
-- v- the second List will be parsed as List Regex later
| Logs (List Logs.Log) (List Logs.Group) String
+ | UserSettings
+ -- oldpwd
+ String
+ -- newpwd
+ String
+ -- the view's user we're editing instead of the LoginState's user who is logged in here
+ (Maybe LoginUser)
-- a simplified version of ViewState type for the main.elm's tabcomponent
type TabState
@@ -58,6 +65,7 @@ viewstate_to_tabstate vs =
SettingsEditor -> SettingsTab
Feeds _ _ -> RssFeeds
Logs _ _ _ -> Blog
+ UserSettings _ _ _ -> Blog
tabstate_to_str tb =
case tb of
@@ -97,6 +105,7 @@ type alias LoginUser =
, img_location : String
, primary_group_name : String
, permissions : List String
+ , id: Int --unique and immutable key, needed because UserEditor.editor lets user change all the other values
}
type alias MediaListState =
@@ -173,7 +182,7 @@ type Msg
| SelectedImage UUID
| EditorDragEnter
| EditorDragLeave
- | GotFiles File (List File)
+ | GotFiles (File.File -> Cmd Msg) File (List File)
| GotInputFiles (List File)
| UploadedImage (Result Http.Error Image.PostImageResponse)
| MarkImageForRemoval UUID
@@ -230,7 +239,13 @@ type Msg
| GotLogGroups (Result Http.Error (List Logs.Group))
| GotTopbarLogAlarm (Result Http.Error Logs.TopbarAlarm)
| SetDomain String
-
+ | SetUsername String
+ | SetNickname String
+ | SetNewpwd String
+ | SetOldpwd String
+ | SubmitChangedUser String String LoginUser
+ | UserSubmitResult (Result Http.Error ())
+ | UploadedOwnProfilePic (Result Http.Error Image.PostImageResponse)
-- ports
port reallySetupAce : String -> Cmd msg
port addImgToAce : String -> Cmd msg
diff --git a/elm-frontti/src/PostEditor.elm b/elm-frontti/src/PostEditor.elm
index d813431..7615999 100644
--- a/elm-frontti/src/PostEditor.elm
+++ b/elm-frontti/src/PostEditor.elm
@@ -21,9 +21,9 @@ import Dict exposing (Dict)
import File exposing (File)
import File.Select as Select
-dropDecoder : D.Decoder Msg
-dropDecoder =
- D.at ["dataTransfer","files"] (D.oneOrMore GotFiles File.decoder)
+-- dropDecoder : D.Decoder Msg
+dropDecoder handler =
+ D.at ["dataTransfer","files"] (D.oneOrMore (GotFiles handler) File.decoder )
hijackOn : String -> D.Decoder msg -> Attribute msg
@@ -149,7 +149,7 @@ postEditor post tag showImageModal loadedImages draggingImages editorSettings ap
, hijackOn "dragend" (D.succeed EditorDragLeave)
, hijackOn "dragover" (D.succeed EditorDragEnter)
, hijackOn "dragleave" (D.succeed EditorDragLeave)
- , hijackOn "drop" dropDecoder
+ , hijackOn "drop" (dropDecoder (postPicture UploadedImage editor_image_api))
, hijackOn "ready" (D.succeed (RunAce post.content))])
Nothing ["*"])
, ("PreviewArticle"
@@ -157,3 +157,5 @@ postEditor post tag showImageModal loadedImages draggingImages editorSettings ap
(Article_view.articleView app_settings loginState tz post)
Nothing ["*"])])
_ -> div [] [text "You're not logged in"]]
+
+editor_image_api = "/api/pictures"
diff --git a/elm-frontti/src/RouteParser.elm b/elm-frontti/src/RouteParser.elm
index 8e70a36..a120757 100644
--- a/elm-frontti/src/RouteParser.elm
+++ b/elm-frontti/src/RouteParser.elm
@@ -17,6 +17,7 @@ type Route
| Home
| Logs
| NotFound
+ | OwnUserSettings
routeParser =
oneOf
@@ -31,7 +32,9 @@ routeParser =
, map TaggedPosts (s "blog" </> (s "tags" </> string))
, map Logs (s "blog" </> (s "logs"))
, map PostAdmin (s "blog" </> (s "postadmin"))
- , map FeedReader (s "blog" </> (s "feeds"))]
+ , map FeedReader (s "blog" </> (s "feeds"))
+ , map OwnUserSettings (s "blog" </> (s "usersettings"))]
+
url_to_route url =
Maybe.withDefault NotFound (parse routeParser url)
diff --git a/elm-frontti/src/User.elm b/elm-frontti/src/User.elm
index 53b012f..5b0ce17 100644
--- a/elm-frontti/src/User.elm
+++ b/elm-frontti/src/User.elm
@@ -1,7 +1,7 @@
module User exposing (..)
import Html exposing (..)
-import Html.Attributes exposing (..)
+import Html.Attributes as A exposing (..)
import Html.Events exposing (..)
import Message exposing (..)
@@ -10,6 +10,7 @@ import Json.Decode as Decode exposing (Decoder, succeed)
import Json.Decode.Pipeline exposing (required)
import Json.Decode.Extra as Extra
import Json.Encode as Json
+import File exposing (File)
-- {
@@ -37,7 +38,8 @@ nicknameDecoder = Decode.field "nickname" Decode.string
imgDecoder = Decode.field "img_location" Decode.string
group_name_decoder = Decode.field "primary-group-name" Decode.string
permissionsDecoder = Decode.field "permissions" (Decode.list Decode.string)
-usernameDecoder = Decode.field "username" Decode.string
+usernameDecoder = Decode.field "username" Decode.string
+idDecoder = Decode.field "userid" Decode.int
-- |> == clojure's ->>
userDecoder : Decoder LoginUser
@@ -48,6 +50,7 @@ userDecoder =
|> decodeApply imgDecoder
|> decodeApply group_name_decoder
|> decodeApply permissionsDecoder
+ |> decodeApply idDecoder
stateToText state =
case state of
@@ -55,26 +58,6 @@ stateToText state =
LoggingIn _ _ -> "LoggingIn"
LoggedOut -> "LoggedOut"
LoginFailed -> "LoginFailed"
-
-loginView loginstate =
- let actual_view = [label [for "username"] [text "Username"],
- input [name "username", id "username", attribute "data-testid" "username-input-field", onInput ChangeUsername, onFocus LoginFocus ] [],
- label [for "password"] [text "Password"],
- input [name "password", attribute "data-testid" "password-input-field", id "password", type_ "password", onInput ChangePassword ] []
- -- , label [] [text ("Loginstate: " ++ stateToText loginstate)]
- ] in
- div [] (case loginstate of
- LoggedIn usr ->
- [p [attribute "data-testid" "welcome-user-label"] [text ("Welcome, " ++ usr.nickname)]]
- LoggingIn username password ->
- (List.concat [actual_view,
- [button [attribute "data-testid" "dologin", onClick DoLogIn] [text "Login!"]]])
- LoggedOut ->
- actual_view
- LoginFailed ->
- (List.concat [actual_view,
- [button [onClick DoLogIn] [text "Login!"],
- div [attribute "data-testid" "loginfailed"] [text "Login failed! Check username and password!"]]]))
user_avatar creator = img [class "user_avatar", src creator.img_location] []
@@ -86,3 +69,15 @@ encodeLoggingIn user =
Json.object
[ ("username", Json.string user.username)
, ("password", Json.string user.password)]
+
+encodeEditorUser : LoginUser -> String -> String-> Json.Value
+encodeEditorUser usr oldpasswd newpasswd =
+ Json.object
+ [ ("nickname", Json.string usr.nickname)
+ , ("username", Json.string usr.username)
+ , ("img_location", Json.string usr.img_location)
+ , ("id", Json.int usr.id) -- unique and immutable key, needed because UserEditor.editor lets user change all the other values
+ , ("old-password", Json.string oldpasswd)
+ , ("new-password", Json.string newpasswd)]
+
+
diff --git a/elm-frontti/src/UserEditor.elm b/elm-frontti/src/UserEditor.elm
new file mode 100644
index 0000000..4237da8
--- /dev/null
+++ b/elm-frontti/src/UserEditor.elm
@@ -0,0 +1,68 @@
+module UserEditor exposing (..)
+
+import Html exposing (..)
+import Html.Attributes as A exposing (..)
+import Html.Events exposing (..)
+
+import Message exposing (..)
+import PostEditor exposing (hijackOn, dropDecoder)
+import Ajax_cmds exposing (postPicture)
+
+import Json.Decode as D
+
+editor draggingImages oldpasswd newpasswd user =
+ div [] [
+ div [ class "vertical-flex-container"
+ , hijackOn "dragenter" (D.succeed EditorDragEnter)
+ , hijackOn "dragend" (D.succeed EditorDragLeave)
+ , hijackOn "dragover" (D.succeed EditorDragEnter)
+ , hijackOn "dragleave" (D.succeed EditorDragLeave)
+ , hijackOn "drop" (dropDecoder (postPicture UploadedOwnProfilePic "/api/pictures/profile"))
+ , style "background-color" (if draggingImages then "#880088" else "")
+ ]
+ [ h1 [ ] [text <| "User " ++ user.nickname ++ "'s settings" ]
+ , img [ src user.img_location
+ , class "user_avatar" ] []
+ , div [ id "img-helper"] [ text "If you want a new profile picture, drag and drop an image file here" ]
+ , label [] [ text "Username: "
+ , input [ A.required True
+ , value user.username
+ , onInput SetUsername
+ , type_ "text" ] []]
+ , label [] [ text "Nickname: "
+ , input [ A.required True
+ , value user.nickname
+ , onInput SetNickname
+ , type_ "text"] []]
+ , label [] [ text "New password: "
+ , input [ type_ "password"
+ , onInput SetNewpwd
+ , value newpasswd] []]
+ , label [] [ text "Current password: "
+ , input [ A.required True
+ , type_ "password"
+ , value oldpasswd
+ , onInput SetOldpwd] []]]
+ , button [ onClick (SubmitChangedUser oldpasswd newpasswd user) ] [ text "Submit changes!"]]
+
+loginView loginstate =
+ let actual_view = [label [for "username"] [text "Username"],
+ input [name "username", id "username", attribute "data-testid" "username-input-field", onInput ChangeUsername, onFocus LoginFocus ] [],
+ label [for "password"] [text "Password"],
+ input [name "password", attribute "data-testid" "password-input-field", id "password", type_ "password", onInput ChangePassword ] []
+ -- , label [] [text ("Loginstate: " ++ stateToText loginstate)]
+ ] in
+ div [] (case loginstate of
+ LoggedIn usr ->
+ [p [attribute "data-testid" "welcome-user-label"] [ text "Welcome, "
+ , a [ href "/blog/usersettings" ]
+ [ text usr.nickname]]]
+ LoggingIn username password ->
+ (List.concat [actual_view,
+ [button [attribute "data-testid" "dologin", onClick DoLogIn] [text "Login!"]]])
+ LoggedOut ->
+ actual_view
+ LoginFailed ->
+ (List.concat [actual_view,
+ [button [onClick DoLogIn] [text "Login!"],
+ div [attribute "data-testid" "loginfailed"] [text "Login failed! Check username and password!"]]]))
diff --git a/resources/css/murja.css b/resources/css/murja.css
index 107b4cb..31b16f5 100644
--- a/resources/css/murja.css
+++ b/resources/css/murja.css
@@ -408,6 +408,16 @@ header {
color: #F00;
}
+.vertical-flex-container > label {
+ height: 2em;
+}
+
+input:required {
+ border-color: #ff0;
+ border-width: 0.3em;
+ border-radius: 10px;
+}
+
@media only screen and (max-device-width:480px)
{
body {
diff --git a/resources/sql/user-fns.sql b/resources/sql/user-fns.sql
index 3785556..f244d4d 100644
--- a/resources/sql/user-fns.sql
+++ b/resources/sql/user-fns.sql
@@ -6,6 +6,7 @@ SELECT
u.username,
u.nickname,
u.img_location,
+ u.password,
json_agg(DISTINCT perm.action) "permissions"
FROM
blog.users u
@@ -39,9 +40,19 @@ JOIN blog.permission perm ON perm.id = gp.permissionid
WHERE u.id = $1
GROUP BY u.Username, u.Nickname, u.Img_location, ug.Name, gm.PrimaryGroup, u.ID;
--- name: can?*
--- :? :1
-SELECT COUNT(perm.ACTION) > 0 AS "can?"
-FROM blog.GroupPermissions gp
-LEFT JOIN blog.Permission perm ON gp.PermissionID = perm.ID
-WHERE gp.GroupID = :group-id AND perm.action = :action;
+-- name: search-with-id-and-pwd*
+SELECT *
+FROM blog.Users u
+WHERE u.id = $1 AND u.password = $2;
+
+-- name: patch-user*
+UPDATE blog.Users
+SET nickname = $1,
+ username = $2,
+ password = $3
+WHERE id = $4;
+
+-- name: patch-user-img*
+UPDATE blog.Users
+SET img_location = $1
+WHERE id = $2;
diff --git a/src/local-lib/json.lisp b/src/local-lib/json.lisp
new file mode 100644
index 0000000..358f587
--- /dev/null
+++ b/src/local-lib/json.lisp
@@ -0,0 +1,37 @@
+(defpackage murja.json
+ (:use :cl)
+ (:import-from :binding-arrows :->>)
+ (:import-from :com.inuoe.jzon :stringify :parse)
+ (:export :bind-json)
+ (:documentation "Convenience tools for handling json"))
+
+(in-package :murja.json)
+
+(defmacro bind-json (requireds optionals json &rest body)
+ "Explode a json-string into required and optional bindings. When an optional binding is missing from the string, binding's value is nil. When a required is missing, an assertion fails:
+
+```
+(bind-json (a sad ) (unknown-key) \"{\\\"sad\\\": 33, \\\"a\\\": 55, \\\"unknown-key\\\": {\\\"inner\\\": \\\"object\\\"}}\"
+
+ (format t \"a and sad: ~a & ~a~%\" a sad)
+ (when unknown-key
+ (format t \"We have an optional key too: ~a~%\" unknown-key)))
+```"
+ (let* ((obj-sym (gensym))
+ (req-pairs (->>
+ requireds
+ (mapcar (lambda (sym)
+ (list sym `(gethash ,(str:downcase (format nil "~a" sym)) ,obj-sym ))))))
+ (optional-pairs (->>
+ optionals
+ (mapcar (lambda (sym)
+ (list sym `(gethash ,(str:downcase (format nil "~a" sym)) ,obj-sym ))))))
+ (all-bindings (concatenate 'list optional-pairs req-pairs))
+ (req-asserts (->>
+ requireds
+ (mapcar (lambda (sym)
+ `(assert ,sym nil ,(format nil "Didn't find key ~a from json" sym)))))))
+ `(let ((,obj-sym (parse ,json)))
+ (let ,all-bindings
+ ,@req-asserts
+ ,@body))))
diff --git a/src/main.lisp b/src/main.lisp
index e682886..72c2779 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -40,9 +40,12 @@
(defun run ()
"Starts up the aggressive-murja system. Sets logging up in a way that should show up in the logs view"
(setf hunchentoot:*catch-errors-p* nil)
- (let ((lisp-fixup:*dev?* t))
- (bordeaux-threads:make-thread
- (lambda ()
- (murja:main)))))
+ ;; for reasons I don't understand user-editor.lisp doesn't see *dev*? as t when let-bound here
+ (setf lisp-fixup:*dev?* t)
+ (log:info "Starting murja in *dev?* mode")
+
+ (bordeaux-threads:make-thread
+ (lambda ()
+ (murja:main))))
;; (start-server :port 3010)
diff --git a/src/routes/login-routes.lisp b/src/routes/login-routes.lisp
index 3a48770..fa49c04 100644
--- a/src/routes/login-routes.lisp
+++ b/src/routes/login-routes.lisp
@@ -1,5 +1,6 @@
(defpackage murja.routes.login-routes
(:use :cl)
+ (:export :get-session-key :set-session-cookies)
(:import-from :murja.session :set-session-value)
(:import-from :lisp-fixup :sha-512)
(:import-from :murja.middleware.auth :@test-now :@authenticated :*user*)
@@ -30,6 +31,26 @@
(simple-date:decode-interval max-age)
(values key (lisp-fixup:to-secs year month day hour min sec ms)))))))
+(defun set-session-cookies (username session-key max-age settings)
+ (hunchentoot:set-cookie "murja-username" :value username
+ :secure t
+ :path "/"
+ :max-age max-age
+ :http-only t
+ :domain ;;send :domain only in linux production envs
+ (unless lisp-fixup:*dev?*
+ (gethash "domain" settings))
+ :same-site "Strict")
+
+ (hunchentoot:set-cookie "murja-session" :value session-key
+ :secure t
+ :path "/"
+ :max-age max-age
+ :http-only t
+ :domain (unless lisp-fixup:*dev?*
+ (gethash "domain" settings))
+ :same-site "Strict"))
+
(defroute post-login ("/api/login/login" :method :post :decorators (@test-now @transaction @json)) ()
(let* ((body (hunchentoot:raw-post-data :force-text t))
(body-params (parse body))
@@ -47,22 +68,7 @@
(set-session-value :logged-in-username username)
(set-session-value :logged-in-user-id (gethash "userid" user-row))
- (hunchentoot:set-cookie "murja-username" :value username
- :secure t
- :max-age max-age
- :http-only t
- :domain ;;send :domain only in linux production envs
- (unless lisp-fixup:*dev?*
- (gethash "domain" settings))
- :same-site "Strict")
-
- (hunchentoot:set-cookie "murja-session" :value session-key
- :secure t
- :max-age max-age
- :http-only t
- :domain (unless lisp-fixup:*dev?*
- (gethash "domain" settings))
- :same-site "Strict")
+ (set-session-cookies username session-key max-age settings)
(stringify user-row))
(progn
diff --git a/src/routes/root-routes.lisp b/src/routes/root-routes.lisp
index 21f381a..ad4ae06 100644
--- a/src/routes/root-routes.lisp
+++ b/src/routes/root-routes.lisp
@@ -127,3 +127,5 @@
(defroute sdfdsfopsf ("/blog/feeds" :method :get) ()
*root*)
+
+(defroute kgvfokgf ("/blog/usersettings" :method :get) () *root*)
diff --git a/src/routes/user-editor.lisp b/src/routes/user-editor.lisp
new file mode 100644
index 0000000..c5b785d
--- /dev/null
+++ b/src/routes/user-editor.lisp
@@ -0,0 +1,80 @@
+(defpackage murja.routes.user-editor
+ (:use :cl)
+ (:import-from :murja.json :bind-json)
+ (:import-from :cl-hash-util :with-keys :hash)
+ (:import-from :lisp-fixup :sha-512)
+ (:import-from :murja.middleware.db :@transaction)
+ (:import-from :murja.middleware.json :@json)
+ (:import-from :murja.middleware.auth :@authenticated :@can? :*user*)
+ (:import-from :murja.media.media-db :insert-media)
+ (:import-from :com.inuoe.jzon :stringify :parse)
+ (:import-from :easy-routes :defroute)
+
+ (:local-nicknames (:user-db :murja.users.user-db)
+ (:login :murja.routes.login-routes)
+ (:settings :murja.routes.settings-routes)))
+
+(in-package :murja.routes.user-editor)
+
+(defun can-save-user? (user-id old-password)
+ (and *user*
+ (equalp (gethash "id" *user*)
+ user-id)
+ (user-db:search-with-id-and-pwd* user-id (sha-512 old-password))))
+
+(defmacro patch (map symbol)
+ (let ((symbol-str (str:downcase (format nil "~s" symbol))))
+ `(setf (gethash ,symbol-str ,map) ,symbol)))
+
+(defroute submit-user ("/api/user/submit" :method :post
+ :decorators (@transaction
+ @authenticated
+ @json)) ()
+ (bind-json (nickname username img_location id old-password) (new-password) (hunchentoot:raw-post-data :force-text t)
+ (if (can-save-user? id old-password)
+ (let* ((user (user-db:get-user-by-id id)))
+ (patch user nickname)
+ (patch user username)
+
+ (when (and new-password
+ (not (string= new-password "")))
+ (setf (gethash "password" user)
+ (sha-512 new-password)))
+
+ (user-db:patch-user user)
+ (setf (hunchentoot:return-code*) 204)
+
+ (multiple-value-bind (session-key max-age) (login:get-session-key username)
+ (login:set-session-cookies username session-key max-age (settings:get-settings))
+ (murja.session:set-session-value :logged-in-username username))
+
+ "")
+
+ (progn
+ (log:warn "can-save-user? failed due to ~a" (cond
+ ((not *user*) "*user* failing")
+ ((not (equalp (gethash "id" *user*)
+ id))
+ (format nil "id ~a != ~a" (gethash "id" *user*)
+ id))
+ ((not (user-db:search-with-id-and-pwd* id (sha-512 old-password)))
+ "password lookup failing")))
+ (setf (hunchentoot:return-code*) 500)
+ ""))))
+
+(defroute submit-profile-pic ("/api/pictures/profile" :method :post
+ :decorators (@transaction
+ @authenticated
+ @json))
+ (&post file)
+
+ (with-keys ("id" "username") *user*
+ (destructuring-bind (tmp-file filename mime) file
+ (when (str:starts-with? "image/" mime)
+ (log:info "Changing profile pic of ~a to ~a" username filename)
+ (let* ((bytes (lisp-fixup:slurp-bytes tmp-file))
+ (result (insert-media filename bytes))
+ (img-id (caar result)))
+
+ (user-db:patch-user-img* (format nil "/api/pictures/~a" img-id) id)
+ (stringify (hash (:id img-id))))))))
diff --git a/src/session.lisp b/src/session.lisp
index 95e154b..74c02da 100644
--- a/src/session.lisp
+++ b/src/session.lisp
@@ -1,5 +1,6 @@
(defpackage murja.session
(:use :cl)
+ (:export :set-session-value :get-session-value)
(:import-from :murja.session.db :assert-ownership :set-session-val* :get-session-val*)
(:import-from :murja.middleware.auth :*user* :*session-key*))
diff --git a/src/users/user-db.lisp b/src/users/user-db.lisp
index e4a5567..01c5249 100644
--- a/src/users/user-db.lisp
+++ b/src/users/user-db.lisp
@@ -1,7 +1,7 @@
(defpackage :murja.users.user-db
(:use :cl :postmodern)
(:import-from :lisp-fixup :sha-512)
- (:export :get-session-user-by-id :get-user-by-id :select-user-by-login :register-user)
+ (:export :patch-user-img* :get-session-user-by-id :search-with-id-and-pwd* :get-user-by-id :select-user-by-login :register-user :patch-user)
(:import-from :halisql :defqueries))
(in-package :murja.users.user-db)
@@ -41,3 +41,7 @@
(sha-512 password))))
;;(postmodern:connect-toplevel "blogdb" "blogadmin" "blog" "localhost")
+
+(defun patch-user (usr)
+ (cl-hash-util:with-keys ("nickname" "username" "password" "id") usr
+ (patch-user* nickname username password id)))