diff --git a/albatross.ml b/albatross.ml index 6eab542d..e8274218 100644 --- a/albatross.ml +++ b/albatross.ml @@ -104,9 +104,23 @@ module Make (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6) = struct (Vmm_core.Name.create_of_path path) t.policies) in - let cmd = Option.map (fun p -> `Policy_cmd (`Policy_add p)) policy in + let policy = + Option.value + ~default: + Vmm_core.( + Policy. + { + vms = 0; + cpuids = IS.empty; + memory = 0; + block = None; + bridges = String_set.empty; + }) + policy + in + let cmd = `Policy_cmd (`Policy_add policy) in let* key, cert = - key_cert ~is_ca:true ?cmd t.key domain + key_cert ~is_ca:true ~cmd t.key domain (X509.Certificate.subject t.cert) in Ok (key, cert, [ cert ]) diff --git a/assets/main.js b/assets/main.js index 988b6222..c9b682d6 100644 --- a/assets/main.js +++ b/assets/main.js @@ -241,4 +241,20 @@ function buttonLoading(btn, load, text) { } } - +async function toggleUserStatus(uuid) { + try { + const response = await fetch("/api/admin/user/status/toggle", { + method: 'POST', + body: JSON.stringify({"uuid":uuid}) + }) + const data = await response.json(); + if(data.status === 200) { + postAlert("bg-primary-300", data.data); + setTimeout(function () { window.location.reload()}, 1000); + } else { + postAlert("bg-secondary-300", data.data); + } + } catch (error) { + postAlert("bg-secondary-300", error); + } +} diff --git a/dashboard.ml b/dashboard.ml index b032bbed..c120db6b 100644 --- a/dashboard.ml +++ b/dashboard.ml @@ -1,29 +1,7 @@ open Tyxml -let display_banner message = - if message != "" then - Tyxml_html.( - section - ~a: - [ - a_class - [ - "w-full bg-primary-200 py-4 text-center text-gray-200 border \ - border-primary-400 font-semibold flex justify-center px-5 \ - space-x-5"; - ]; - a_id "banner-message"; - ] - [ - p [ txt message ]; - button - ~a:[ a_id "close-banner-btn"; a_onclick "closeBanner()" ] - [ i ~a:[ a_class [ "fa-solid fa-x text-sm" ] ] [] ]; - ]) - else Tyxml_html.div [] - -let dashboard_layout ~icon ?(page_title = "Dashboard | Mollymawk") - ?(message = "") ~content () = +let dashboard_layout (user : User_model.user) ~icon + ?(page_title = "Dashboard | Mollymawk") ?message ~content () = let page = Html.( html @@ -152,17 +130,17 @@ let dashboard_layout ~icon ?(page_title = "Dashboard | Mollymawk") a_class [ "flex space-x-1 items-center \ - cursor-pointer \ + cursor-pointer uppercase \ hover:text-primary-500"; ]; ] - [ span [ txt "Account" ] ]; + [ span [ txt user.name ] ]; ]; ]; ]; ]; ]; - display_banner message; + Utils.display_banner message; section ~a:[ a_class [ "grid grid-cols-12 bg-gray-100 min-h-screen" ] ] [ diff --git a/middleware.ml b/middleware.ml index d9f2abf2..50444767 100644 --- a/middleware.ml +++ b/middleware.ml @@ -105,7 +105,9 @@ let user_of_cookie users now reqd = let auth_middleware now users handler reqd = match user_of_cookie users now reqd with - | Ok _user -> handler reqd + | Ok user -> + if user.User_model.active then handler reqd + else redirect_to_login ~msg:"User account is deactivated." reqd () | Error (`Msg msg) -> Logs.err (fun m -> m "auth-middleware: No molly-session in cookie header."); diff --git a/sign_up.ml b/sign_up.ml index 53c5a230..759e5736 100644 --- a/sign_up.ml +++ b/sign_up.ml @@ -41,6 +41,18 @@ let register_page ~icon () = div ~a:[ a_class [ "w-full max-w-lg mt-16 pb-16 mx-auto" ] ] [ + div + ~a: + [ + a_id "alert-container"; + a_class + [ + "absolute top-1/4 rounded-md right-4 z-50 \ + w-fit space-y-2 p-4 shadow border \ + text-wrap hidden"; + ]; + ] + []; h1 ~a: [ @@ -296,21 +308,22 @@ let register_page ~icon () = \ })\n\ \ const data = await response.json();\n\ \ if (data.status === 200) {\n\ - \ window.location.replace('/dashboard')\n\ + \ postAlert('bg-primary-300', \ + 'Account created. Waiting for activation by an administrator.')\n\ + \ setTimeout(function () \ + {window.location.replace('/dashboard')}, 3000);\n\ \ } else {\n\ \ \ form_alert.classList.remove('hidden')\n\ \ \ form_alert.classList.add('text-secondary-500', 'block')\n\ \ form_alert.textContent = data.data\n\ - \ console.log(data);\n\ \ }\n\ \ } catch (error) {\n\ \ form_alert.classList.remove('hidden')\n\ \ \ form_alert.classList.add('text-secondary-500', 'block')\n\ \ form_alert.textContent = error\n\ - \ return;\n\ \ }\n\ \ })\n\ \ "; diff --git a/storage.ml b/storage.ml index 625f1bff..92a3be91 100644 --- a/storage.ml +++ b/storage.ml @@ -1,17 +1,13 @@ open Utils.Json -type t = { - version : int; - users : User_model.user list; - configuration : Configuration.t; -} +type t = { users : User_model.user list; configuration : Configuration.t } -let current_version = 1 +let current_version = 2 let t_to_json t = `Assoc [ - ("version", `Int t.version); + ("version", `Int current_version); ("users", `List (List.map User_model.user_to_json t.users)); ("configuration", Configuration.to_json t.configuration); ] @@ -24,6 +20,7 @@ let t_of_json json = | Some (`Int v), Some (`List users), Some configuration -> let* () = if v = current_version then Ok () + else if v = 1 then Ok () else Error (`Msg @@ -34,12 +31,15 @@ let t_of_json json = List.fold_left (fun acc js -> let* acc = acc in - let* user = User_model.user_of_json js in + let* user = + if v = 1 then User_model.user_v1_of_json js + else User_model.user_of_json js + in Ok (user :: acc)) (Ok []) users in let* configuration = Configuration.of_json configuration in - Ok { version = v; users; configuration } + Ok { users; configuration } | _ -> Error (`Msg "invalid data: no version and users field")) | _ -> Error (`Msg "invalid data: not an assoc") @@ -66,13 +66,7 @@ module Make (BLOCK : Mirage_block.S) = struct let* t = t_of_json json in Ok (disk, t) | Ok None -> - Ok - ( disk, - { - version = current_version; - users = []; - configuration = Configuration.empty (); - } ) + Ok (disk, { users = []; configuration = Configuration.empty () }) | Error e -> error_msgf "error while reading storage: %a" Stored_data.pp_error e diff --git a/unikernel.ml b/unikernel.ml index 79ccdd1d..0b350d84 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -233,7 +233,9 @@ struct | None -> ( let created_at = Ptime.v (P.now_d_ps ()) in let user = + let active = if List.length users = 0 then true else false in User_model.create_user ~name ~email ~password ~created_at + ~active in Store.add_user !store user >>= function | Ok store' -> @@ -476,6 +478,124 @@ struct (Utils.Status.to_json status)) | Error (`Msg s) -> Middleware.redirect_to_login reqd ~msg:s () + let toggle_user store reqd user = + decode_request_body reqd >>= fun data -> + let json = + try Ok (Yojson.Basic.from_string data) + with Yojson.Json_error s -> Error (`Msg s) + in + match json with + | Error (`Msg err) -> + Logs.warn (fun m -> m "Failed to parse JSON: %s" err); + let status = + { + Utils.Status.code = 400; + title = "Error"; + data = String.escaped err; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)) + | Ok (`Assoc json) -> ( + match Utils.Json.get "uuid" json with + | Some (`String uuid) -> ( + let users = + User_model.create_user_uuid_map (snd !store).Storage.users + in + match List.assoc_opt uuid users with + | None -> + let status = + { + Utils.Status.code = 400; + title = "Error"; + data = "Account not found"; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)) + | Some user -> ( + let is_last_active_user = + user.active + && List.length + (List.filter + (fun u -> u.User_model.active) + (snd !store).Storage.users) + <= 1 + in + if is_last_active_user then + let status = + { + Utils.Status.code = 400; + title = "Error"; + data = "Refusing to deactivate last active user"; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)) + else + let user = + User_model.update_user user ~active:(not user.active) + ~updated_at:(Ptime.v (P.now_d_ps ())) + () + in + Store.update_user !store user >>= function + | Ok store' -> + store := store'; + let status = + { + Utils.Status.code = 200; + title = "OK"; + data = "Updated user successfully"; + success = true; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)) + | Error (`Msg msg) -> + let status = + { + Utils.Status.code = 500; + title = "Error"; + data = String.escaped msg; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)))) + | _ -> + Logs.warn (fun m -> m "Failed to parse JSON - no UUID found"); + let status = + { + Utils.Status.code = 400; + title = "Error"; + data = "Couldn't find a UUID in the json."; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status))) + | Ok _ -> + let status = + { + Utils.Status.code = 400; + title = "Error"; + data = "Provided JSON is not a dictionary"; + success = false; + } + in + Lwt.return + (reply reqd ~content_type:"application/json" + (Utils.Status.to_json status)) + let dashboard albatross reqd (user : User_model.user) = (* TODO use uuid in the future *) (Albatross.query albatross ~domain:user.name @@ -495,25 +615,25 @@ struct >>= fun unikernels -> Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout + (Dashboard.dashboard_layout user ~content: (Unikernel_index.unikernel_index_layout unikernels (Ptime.v (P.now_d_ps ()))) ~icon:"/images/robur.png" ())) - let users store reqd _user = + let users store reqd user = Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout ~page_title:"Users | Mollymawk" + (Dashboard.dashboard_layout user ~page_title:"Users | Mollymawk" ~content: (Users_index.users_index_layout (snd store).Storage.users (Ptime.v (P.now_d_ps ()))) ~icon:"/images/robur.png" ())) - let settings store reqd _user = + let settings store reqd user = Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout ~page_title:"Settings | Mollymawk" + (Dashboard.dashboard_layout user ~page_title:"Settings | Mollymawk" ~content: (Settings_page.settings_layout (snd store).Storage.configuration) ~icon:"/images/robur.png" ())) @@ -589,10 +709,10 @@ struct (reply reqd ~content_type:"application/json" (Utils.Status.to_json status))) - let deploy_form reqd _user = + let deploy_form reqd user = Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout + (Dashboard.dashboard_layout user ~page_title:"Deploy a Unikernel | Mollymawk" ~content:Unikernel_create.unikernel_create_layout ~icon:"/images/robur.png" ())) @@ -659,7 +779,7 @@ struct if List.length unikernels > 0 then Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout + (Dashboard.dashboard_layout user ~content: (Unikernel_single.unikernel_single_layout (List.hd unikernels) (Ptime.v (P.now_d_ps ()))) @@ -675,7 +795,7 @@ struct in Lwt.return (reply reqd ~content_type:"text/html" - (Dashboard.dashboard_layout ~page_title:"404 | Mollymawk" + (Dashboard.dashboard_layout user ~page_title:"404 | Mollymawk" ~content:(Error_page.error_layout error) ~icon:"/images/robur.png" ())) @@ -984,6 +1104,10 @@ struct (* TODO: a middleware for admins *) authenticate !store reqd (update_settings stack store albatross reqd)) + | "/api/admin/user/status/toggle" -> + check_meth `POST (fun () -> + (* TODO: a middleware for admins *) + authenticate !store reqd (toggle_user store reqd)) | "/unikernel-info" -> check_meth `GET (fun () -> authenticate !store reqd (unikernel_info !albatross reqd)) diff --git a/unikernel_single.ml b/unikernel_single.ml index a3c6f196..a290ac48 100644 --- a/unikernel_single.ml +++ b/unikernel_single.ml @@ -439,11 +439,14 @@ let unikernel_single_layout unikernel now = (match data.fail_behaviour with | `Quit -> p [ txt "Quit" ] | `Restart None -> p [ txt "Restart" ] - | `Restart (Some _codes) -> - p [ txt "" ] - (* List.map - (fun code -> p [ txt (string_of_int code) ]) - (Vmm_core.IS.elements codes); *)); + | `Restart (Some codes) -> + p + [ + txt + (String.concat ", " + (List.map string_of_int + (Vmm_core.IS.elements codes))); + ]); ]; ]; div diff --git a/user_model.ml b/user_model.ml index 1bfd19a6..04e019e3 100644 --- a/user_model.ml +++ b/user_model.ml @@ -27,6 +27,7 @@ type user = { created_at : Ptime.t; updated_at : Ptime.t; email_verification_uuid : Uuidm.t option; + active : bool; } let week = 604800 (* a week = 7 days * 24 hours * 60 minutes * 60 seconds *) @@ -175,9 +176,10 @@ let user_to_json (u : user) : Yojson.Basic.t = match u.email_verification_uuid with | None -> `Null | Some s -> `String (Uuidm.to_string s) ); + ("active", `Bool u.active); ] -let user_of_json = function +let user_v1_of_json = function | `Assoc xs -> ( let ( let* ) = Result.bind in match @@ -253,6 +255,90 @@ let user_of_json = function created_at = Option.get created_at; updated_at = Option.get updated_at; email_verification_uuid; + active = true; + } + | _ -> Error (`Msg "invalid json for user")) + | _ -> Error (`Msg "invalid json for user") + +let user_of_json = function + | `Assoc xs -> ( + let ( let* ) = Result.bind in + match + ( get "name" xs, + get "email" xs, + get "email_verified" xs, + get "password" xs, + get "uuid" xs, + get "tokens" xs, + get "cookies" xs, + get "created_at" xs, + get "updated_at" xs, + get "email_verification_uuid" xs, + get "active" xs ) + with + | ( Some (`String name), + Some (`String email), + Some email_verified, + Some (`String password), + Some (`String uuid), + Some (`List tokens), + Some (`List cookies), + Some (`String updated_at_str), + Some (`String created_at_str), + Some email_verification_uuid, + Some (`Bool active) ) -> + let created_at = + match Utils.TimeHelper.ptime_of_string created_at_str with + | Ok ptime -> Some ptime + | Error _ -> None + in + let updated_at = + match Utils.TimeHelper.ptime_of_string updated_at_str with + | Ok ptime -> Some ptime + | Error _ -> None + in + let* email_verified = Utils.TimeHelper.ptime_of_json email_verified in + let* tokens = + List.fold_left + (fun acc js -> + let* acc = acc in + let* token = token_of_json js in + Ok (token :: acc)) + (Ok []) tokens + in + let* cookies = + List.fold_left + (fun acc js -> + let* acc = acc in + let* cookie = cookie_of_json js in + Ok (cookie :: acc)) + (Ok []) cookies + in + let* email_verification_uuid = + match email_verification_uuid with + | `Null -> Ok None + | `String s -> + let* uuid = + Option.to_result + ~none:(`Msg "invalid UUID for email verification UUID") + (Uuidm.of_string s) + in + Ok (Some uuid) + | _ -> Error (`Msg "invalid json data for email verification UUID") + in + Ok + { + name; + email; + email_verified; + password; + uuid; + tokens; + cookies; + created_at = Option.get created_at; + updated_at = Option.get updated_at; + email_verification_uuid; + active; } | _ -> Error (`Msg "invalid json for user")) | _ -> Error (`Msg "invalid json for user") @@ -305,7 +391,7 @@ let find_user_by_key (uuid : string) (user_map : (string * user) list) : user option = List.assoc_opt uuid user_map -let create_user ~name ~email ~password ~created_at = +let create_user ~name ~email ~password ~created_at ~active = let uuid = Uuidm.to_string (generate_uuid ()) in let password = hash_password password uuid in let auth_token = generate_token ~created_at () in @@ -324,13 +410,14 @@ let create_user ~name ~email ~password ~created_at = created_at; updated_at = created_at; email_verification_uuid = None; + active; } let check_if_user_exists email users = List.find_opt (fun user -> user.email = Utils.Json.clean_string email) users let update_user user ?name ?email ?email_verified ?password ?tokens ?cookies - ?updated_at ?email_verification_uuid () = + ?updated_at ?email_verification_uuid ?active () = { user with name = Option.value ~default:user.name name; @@ -342,6 +429,7 @@ let update_user user ?name ?email ?email_verified ?password ?tokens ?cookies updated_at = Option.value ~default:user.updated_at updated_at; email_verification_uuid = Option.value ~default:user.email_verification_uuid email_verification_uuid; + active = Option.value ~default:user.active active; } let is_valid_cookie (cookie : cookie) now = @@ -390,15 +478,19 @@ let login_user ~email ~password users now = match user with | None -> Error (`Msg "This account does not exist.") | Some u -> ( - let pass = hash_password password u.uuid in - match String.equal u.password pass with - | true -> - let new_session = - generate_cookie ~name:"molly_session" ~expires_in:week ~uuid:u.uuid - ~created_at:now () - in - let cookies = new_session :: u.cookies in - let updated_user = update_user u ~cookies () in - Ok updated_user - | false -> Error (`Msg "Invalid email or password.")) + if not u.active then + (* TODO move to a middleware, provide instructions how to reactive an account *) + Error (`Msg "This account is not active") + else + let pass = hash_password password u.uuid in + match String.equal u.password pass with + | true -> + let new_session = + generate_cookie ~name:"molly_session" ~expires_in:week + ~uuid:u.uuid ~created_at:now () + in + let cookies = new_session :: u.cookies in + let updated_user = update_user u ~cookies () in + Ok updated_user + | false -> Error (`Msg "Invalid email or password.")) (* Invalid email or password is a trick error message to at least prevent malicious users from guessing login details :).*) diff --git a/users_index.ml b/users_index.ml index 2c611b44..33511be5 100644 --- a/users_index.ml +++ b/users_index.ml @@ -104,6 +104,17 @@ let users_index_layout (users : User_model.user list) current_time = ]; ] [ txt "Last Modified" ]; + th + ~a: + [ + a_class + [ + "px-6 py-3 text-start text-xs \ + font-bold text-primary-600 \ + uppercase"; + ]; + ] + [ txt "Action" ]; ]; ]) (List.map @@ -120,7 +131,43 @@ let users_index_layout (users : User_model.user list) current_time = text-gray-800"; ]; ] - [ txt user.name ]; + [ + div + ~a: + [ + a_class + [ + "flex justify-start space-x-1 \ + items-center"; + ]; + ] + [ + p [ txt user.name ]; + (match user.active with + | true -> + i + ~a: + [ + a_class + [ + "text-primary-500 \ + fa-solid fa-check"; + ]; + ] + [] + | false -> + i + ~a: + [ + a_class + [ + "text-secondary-500 \ + fa-solid fa-x"; + ]; + ] + []); + ]; + ]; td ~a: [ @@ -192,6 +239,52 @@ let users_index_layout (users : User_model.user list) current_time = (Utils.TimeHelper.time_ago current_time user.updated_at); ]; + td + ~a: + [ + a_class + [ + "px-6 py-4 whitespace-nowrap \ + text-sm font-medium \ + text-gray-800"; + ]; + ] + [ + (if user.active then + button + ~a: + [ + a_onclick + ("toggleUserStatus('" + ^ user.uuid ^ "')"); + a_class + [ + "px-3 py-2 rounded \ + bg-secondary-500 \ + text-secondary-50 \ + hover:bg-secondary-700 \ + font-semibold"; + ]; + ] + [ txt "Deactivate" ] + else + button + ~a: + [ + a_onclick + ("toggleUserStatus('" + ^ user.uuid ^ "')"); + a_class + [ + "px-3 py-2 rounded \ + bg-primary-500 \ + text-primary-50 \ + hover:bg-primary-700 \ + font-semibold"; + ]; + ] + [ txt "Activate" ]); + ]; ]) users); ]; diff --git a/utils.ml b/utils.ml index 2ee6339e..fe85a954 100644 --- a/utils.ml +++ b/utils.ml @@ -92,3 +92,25 @@ module Status = struct ] |> Yojson.Safe.to_string end + +let display_banner = function + | Some message -> + Tyxml_html.( + section + ~a: + [ + a_class + [ + "w-full bg-primary-200 py-4 text-center text-gray-200 border \ + border-primary-400 font-semibold flex justify-center px-5 \ + space-x-5"; + ]; + a_id "banner-message"; + ] + [ + p [ txt message ]; + button + ~a:[ a_id "close-banner-btn"; a_onclick "closeBanner()" ] + [ i ~a:[ a_class [ "fa-solid fa-x text-sm" ] ] [] ]; + ]) + | None -> Tyxml_html.div []