open Rresult.R.Infix let or_die exit_code = function | Ok r -> r | Error e -> Format.eprintf "Database error: %a" Caqti_error.pp e; exit exit_code let do_migrate dbpath = Caqti_blocking.connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ()) >>= fun (module Db : Caqti_blocking.CONNECTION) -> List.fold_left (fun r migrate -> r >>= fun () -> Logs.debug (fun m -> m "Executing migration query: %a" Caqti_request.pp migrate); Db.exec migrate ()) (Ok ()) Builder_db.migrate let migrate () dbpath = or_die 1 (do_migrate dbpath) let user_mod action dbpath password_iter username = let r = Caqti_blocking.connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) >>= fun (module Db : Caqti_blocking.CONNECTION) -> print_string "Password: "; flush stdout; (* FIXME: getpass *) let password = read_line () in let user_info = Builder_web_auth.hash ?password_iter ~username ~password () in match action with | `Add -> Db.exec Builder_db.User.add user_info | `Update -> Db.exec Builder_db.User.update_user user_info in or_die 1 r let user_add () dbpath username = user_mod `Add dbpath username let user_update () dbpath username = user_mod `Update dbpath username let user_list () dbpath = let r = Caqti_blocking.connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) >>= fun (module Db : Caqti_blocking.CONNECTION) -> Db.iter_s Builder_db.User.get_all (fun username -> Ok (print_endline username)) () in or_die 1 r let user_remove () dbpath username = let r = Caqti_blocking.connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) >>= fun (module Db : Caqti_blocking.CONNECTION) -> Db.exec Builder_db.User.remove_user username in or_die 1 r let help man_format cmds = function | None -> `Help (man_format, None) | Some cmd -> if List.mem cmd cmds then `Help (man_format, Some cmd) else `Error (true, "Unknown command: " ^ cmd) let dbpath = let doc = "sqlite3 database path" in Cmdliner.Arg.(value & opt non_dir_file "/var/db/builder-web/builder.sqlite3" & info ~doc ["dbpath"]) let dbpath_new = let doc = "sqlite3 database path" in Cmdliner.Arg.(value & opt string "/var/db/builder-web/builder.sqlite3" & info ~doc ["dbpath"]) let username = let doc = "username" in Cmdliner.Arg.(required & pos 0 (some string) None & info ~doc ~docv:"USERNAME" []) let password_iter = let doc = "password hash count" in Cmdliner.Arg.(value & opt (some int) None & info ~doc ["hash-count"]) let setup_log = let setup_log level = Logs.set_level level; Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ()); Logs.debug (fun m -> m "Set log level %s" (Logs.level_to_string level)) in Cmdliner.Term.(const setup_log $ Logs_cli.level ()) let migrate_cmd = let doc = "create database and add tables" in Cmdliner.Term.(pure migrate $ setup_log $ dbpath_new), Cmdliner.Term.info ~doc "migrate" let user_add_cmd = let doc = "add a user" in (Cmdliner.Term.(pure user_add $ setup_log $ dbpath $ password_iter $ username), Cmdliner.Term.info ~doc "user-add") let user_update_cmd = let doc = "update a user password" in (Cmdliner.Term.(pure user_update $ setup_log $ dbpath $ password_iter $ username), Cmdliner.Term.info ~doc "user-update") let user_remove_cmd = let doc = "remove a user" in (Cmdliner.Term.(pure user_remove $ setup_log $ dbpath $ username), Cmdliner.Term.info ~doc "user-remove") let user_list_cmd = let doc = "list all users" in (Cmdliner.Term.(pure user_list $ setup_log $ dbpath), Cmdliner.Term.info ~doc "user-list") let help_cmd = let topic = let doc = "Command to get help on" in Cmdliner.Arg.(value & pos 0 (some string) None & info ~doc ~docv:"COMMAND" []) in let doc = "Builder database help" in Cmdliner.Term.(ret (const help $ man_format $ choice_names $ topic)), Cmdliner.Term.info ~doc "help" let default_cmd = let doc = "Builder database command" in Cmdliner.Term.(ret (const help $ man_format $ choice_names $ const None)), Cmdliner.Term.info ~doc "builder-db" let () = Mirage_crypto_rng_unix.initialize (); Cmdliner.Term.eval_choice default_cmd [help_cmd; migrate_cmd; user_add_cmd; user_update_cmd; user_remove_cmd; user_list_cmd] |> Cmdliner.Term.exit