From 31dd2b028a6744a9d385882521cc1f0fb070973c Mon Sep 17 00:00:00 2001
From: zapashcanon <leo@ndrs.fr>
Date: Sat, 19 Feb 2022 22:13:45 +0100
Subject: [PATCH] add configuration file, add the ability to disable
 registrations

---
 src/app.ml            | 33 +++++++++++++++++++++++++++
 src/dune              |  9 ++++----
 src/permap.ml         | 53 ++++++++++++++++++++++++-------------------
 src/template.eml.html |  2 ++
 4 files changed, 70 insertions(+), 27 deletions(-)

diff --git a/src/app.ml b/src/app.ml
index 519cd28..62f4996 100644
--- a/src/app.ml
+++ b/src/app.ml
@@ -12,3 +12,36 @@ let data_dir =
   match Project_dirs.data_dir with
   | None -> failwith "can't compute data directory"
   | Some data_dir -> data_dir
+
+let config_dir =
+  match Project_dirs.config_dir with
+  | None -> failwith "can't compute configuration directory"
+  | Some config_dir -> config_dir
+
+let config =
+  let filename = Filename.concat config_dir "config.scfg" in
+  if not @@ Sys.file_exists filename then
+    failwith
+    @@ Format.sprintf "configuration file `%s` does not exist, please create it"
+         filename;
+  Dream.log "config file: %s" filename;
+  match Scfg.Parse.from_file filename with
+  | Error e -> failwith e
+  | Ok config -> config
+
+let open_registration =
+  match Scfg.Query.get_dir "open_registration" config with
+  | None -> true
+  | Some open_registration -> (
+    match Scfg.Query.get_param 0 open_registration with
+    | Error e -> failwith e
+    | Ok "true" -> true
+    | Ok "false" -> false
+    | Ok unknown ->
+      failwith
+      @@ Format.sprintf
+           "invalid value for `open_registration` in configuration file, \
+            expected `true` or `false` but got `%s`"
+           unknown )
+
+let () = Dream.log "open_registration: %s" (Bool.to_string open_registration)
diff --git a/src/dune b/src/dune
index f4802b2..dcbb750 100644
--- a/src/dune
+++ b/src/dune
@@ -18,17 +18,18 @@
   user
   user_profile)
  (libraries
-  yojson
-  uuidm
+  bos
   caqti.blocking
   caqti-driver-sqlite3
-  bos
   directories
   dream
   emile
+  lambdasoup
   omd
   safepass
-  lambdasoup)
+  scfg
+  uuidm
+  yojson)
  (preprocess
   (pps lwt_ppx)))
 
diff --git a/src/permap.ml b/src/permap.ml
index 56d56f3..4d07d63 100644
--- a/src/permap.ml
+++ b/src/permap.ml
@@ -216,32 +216,39 @@ let reply_post request =
     | `Wrong_session _ | `Wrong_content_type ->
       Dream.empty `Bad_Request )
 
+let routes =
+  (* this is just so that they're visually aligned *)
+  let get_ = Dream.get in
+  let post = Dream.post in
+
+  [ get_ "/" babillard_get
+  ; get_ "/about" about
+  ; get_ "/assets/**" (Dream.static ~loader:asset_loader "")
+  ; get_ "/img/:post_id" post_image
+  ; get_ "/login" login_get
+  ; post "/login" login_post
+  ; get_ "/logout" logout
+  ; get_ "/markers" markers
+  ; get_ "/new_thread" newthread_get
+  ; post "/new_thread" newthread_post
+  ; get_ "/post_pic/:post_id" post_image
+  ; get_ "/profile" profile_get
+  ; post "/profile" profile_post
+  ; get_ "/thread_view/:thread_id" thread_view
+  ; get_ "/user" user
+  ; get_ "/user/:user" user_profile
+  ; get_ "/user/:user/avatar" avatar_image
+  ]
+  @ ( if App.open_registration then
+      [ get_ "/register" register_get; post "/register" register_post ]
+    else [] )
+  @ (* TODO: rename these two routes *)
+  [ get_ "/:thread_id" thread_get; post "/:thread_id" reply_post ]
+
 let () =
   Dream.run ~port:3696 @@ Dream.logger @@ Dream.cookie_sessions
   (* this should replace memory/cookie sessions but it doesn't work :-(
      @@ Dream.sql_pool Db.db_uri
      @@ Dream.sql_sessions
   *)
-  @@ Dream.router
-       [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
-       ; Dream.get "/about" about
-       ; Dream.get "/register" register_get
-       ; Dream.post "/register" register_post
-       ; Dream.get "/login" login_get
-       ; Dream.post "/login" login_post
-       ; Dream.get "/user" user
-       ; Dream.get "/user/:user" user_profile
-       ; Dream.get "/user/:user/avatar" avatar_image
-       ; Dream.get "/logout" logout
-       ; Dream.get "/profile" profile_get
-       ; Dream.post "/profile" profile_post
-       ; Dream.get "/thread_view/:thread_id" thread_view
-       ; Dream.get "/markers" markers
-       ; Dream.get "/post_pic/:post_id" post_image
-       ; Dream.get "/" babillard_get
-       ; Dream.get "/new_thread" newthread_get
-       ; Dream.post "/new_thread" newthread_post
-       ; Dream.get "/:thread_id" thread_get
-       ; Dream.post "/:thread_id" reply_post
-       ; Dream.get "/img/:post_id" post_image
-       ]
+  @@ Dream.router routes
diff --git a/src/template.eml.html b/src/template.eml.html
index 8259bd0..7e8660b 100644
--- a/src/template.eml.html
+++ b/src/template.eml.html
@@ -28,9 +28,11 @@ let render_unsafe ~title ~content request =
                       <ul class="navbar-nav ms-auto mb-2 mb-md-0">
 % begin match Dream.session "nick" request with
 % | None ->
+%   begin if App.open_registration then
                           <li class="nav-item">
                               <a class="nav-link" href="/register">Register</a>
                           </li>
+%   end;
                           <li class="nav-item">
                               <a class="nav-link" href="/login">Login</a>
                           </li>