unit PM.Handler.Folders; (* GET /folders -> [{name, color, icon}, ...] POST /folders body {name, color?, icon?} -> {message, name} PUT /folders/{name} body {color?, icon?} -> {message} DELETE /folders/{name} -> {message} *) interface implementation uses System.SysUtils, System.JSON, System.NetEncoding, System.Generics.Collections, FireDAC.Comp.Client, FireDAC.Stan.Param, IdCustomHTTPServer, PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit; // ===== GET /folders ========================================================== procedure HandleGetFolders(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; LArr: TJSONArray; LObj: TJSONObject; begin try LUserId := Authenticate(ARequest, AResponse); except on ESessionRejected do Exit; end; LArr := TJSONArray.Create; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'SELECT name, color, icon FROM folders ' + 'WHERE user_id = :uid ORDER BY sort_order, name'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.Open; while not LQ.Eof do begin LObj := TJSONObject.Create; LObj.AddPair('name', LQ.FieldByName('name').AsString); LObj.AddPair('color', LQ.FieldByName('color').AsString); LObj.AddPair('icon', LQ.FieldByName('icon').AsString); LArr.Add(LObj); LQ.Next; end; finally LQ.Free; end; finally DB.Unlock; end; TJSONHelper.SendJSON(AResponse, LArr); end; // ===== POST /folders ========================================================= procedure HandleCreateFolder(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LBody: TJSONObject; LName, LColor, LIcon: string; LQ: TFDQuery; LObj: TJSONObject; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LName := Trim(LBody.GetValue('name', '')); LColor := Trim(LBody.GetValue('color', '')); LIcon := Trim(LBody.GetValue('icon', '')); finally LBody.Free; end; if LName = '' then begin TJSONHelper.SendError(AResponse, 400, 'Folder name required'); Exit; end; if SameText(LName, 'All') then begin TJSONHelper.SendError(AResponse, 400, 'Cannot use All'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'INSERT INTO folders (user_id, name, color, icon) ' + 'VALUES (:uid, :name, :color, :icon)'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('name').AsString := LName; if LColor = '' then LQ.ParamByName('color').Clear else LQ.ParamByName('color').AsString := LColor; if LIcon = '' then LQ.ParamByName('icon').Clear else LQ.ParamByName('icon').AsString := LIcon; try LQ.ExecSQL; except on E: Exception do begin TJSONHelper.SendError(AResponse, 409, 'Folder exists'); Exit; end; end; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'add_folder', GetClientIP(ARequest)); LObj := TJSONObject.Create; LObj.AddPair('message', 'Created'); LObj.AddPair('name', LName); TJSONHelper.SendJSON(AResponse, LObj); end; // ===== PUT /folders/{name} =================================================== // Body: {color?, icon?} — pass empty string to clear. procedure HandleUpdateFolder(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LBody: TJSONObject; LName, LColor, LIcon: string; LHasColor, LHasIcon: Boolean; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; if Length(AParams) < 1 then begin TJSONHelper.SendError(AResponse, 400, 'Folder name required'); Exit; end; LName := TNetEncoding.URL.Decode(AParams[0]); if SameText(LName, 'All') then begin TJSONHelper.SendError(AResponse, 400, 'Cannot customise All'); Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LHasColor := LBody.GetValue('color') <> nil; LHasIcon := LBody.GetValue('icon') <> nil; LColor := LBody.GetValue('color', ''); LIcon := LBody.GetValue('icon', ''); finally LBody.Free; end; if not (LHasColor or LHasIcon) then begin TJSONHelper.SendOK(AResponse, 'No change'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; // Build SET clause dynamically based on which fields the caller sent. var LSet := ''; if LHasColor then LSet := 'color = :color'; if LHasIcon then begin if LSet <> '' then LSet := LSet + ', '; LSet := LSet + 'icon = :icon'; end; LQ.SQL.Text := 'UPDATE folders SET ' + LSet + ' WHERE user_id = :uid AND name = :name'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('name').AsString := LName; if LHasColor then begin if LColor = '' then LQ.ParamByName('color').Clear else LQ.ParamByName('color').AsString := LColor; end; if LHasIcon then begin if LIcon = '' then LQ.ParamByName('icon').Clear else LQ.ParamByName('icon').AsString := LIcon; end; LQ.ExecSQL; if LQ.RowsAffected = 0 then begin TJSONHelper.SendError(AResponse, 404, 'Not found'); Exit; end; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'update_folder', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Updated'); end; // ===== POST /folders/reorder ================================================= // Body: {names: ["Work", "Personal", "Misc"]} — write sort_order = index+1 // for each. Names not in the list keep their previous sort_order (so a // partial reorder still works after another tab created a folder). procedure HandleReorderFolders(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LBody: TJSONObject; LArr: TJSONArray; LQ: TFDQuery; I: Integer; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LArr := LBody.GetValue('names'); if (LArr = nil) or (LArr.Count = 0) then begin TJSONHelper.SendError(AResponse, 400, 'names array required'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE folders SET sort_order = :ord ' + 'WHERE user_id = :uid AND name = :name'; for I := 0 to LArr.Count - 1 do begin LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('ord').AsInteger := I + 1; LQ.ParamByName('name').AsString := LArr.Items[I].Value; LQ.ExecSQL; end; finally LQ.Free; end; finally DB.Unlock; end; finally LBody.Free; end; LogAudit(LUserId, 'reorder_folders', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Reordered'); end; // ===== DELETE /folders/{name} ================================================ procedure HandleDeleteFolder(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LName: string; LQ: TFDQuery; LChanges: Integer; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; if Length(AParams) < 1 then begin TJSONHelper.SendError(AResponse, 400, 'Folder name required'); Exit; end; LName := TNetEncoding.URL.Decode(AParams[0]); if SameText(LName, 'All') then begin TJSONHelper.SendError(AResponse, 400, 'Cannot delete All'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'DELETE FROM folders WHERE user_id = :uid AND name = :name'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('name').AsString := LName; LQ.ExecSQL; LChanges := LQ.RowsAffected; finally LQ.Free; end; if LChanges = 0 then begin TJSONHelper.SendError(AResponse, 404, 'Not found'); Exit; end; // Reassign entries from the deleted folder to 'All' LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'UPDATE vault_entries SET folder = ''All'' ' + 'WHERE user_id = :uid AND folder = :name'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('name').AsString := LName; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'delete_folder', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Deleted'); end; initialization Router.Register('GET', '/folders', HandleGetFolders); Router.Register('POST', '/folders', HandleCreateFolder); Router.Register('POST', '/folders/reorder', HandleReorderFolders); Router.Register('PUT', '/folders/(.+)', HandleUpdateFolder); Router.Register('DELETE', '/folders/(.+)', HandleDeleteFolder); end.