From b21671b56a20416a67c5ef0c91d133f148ff8d7e Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Sun, 20 Feb 2022 18:02:25 +0100
Subject: [PATCH] wip: login redirect

---
 src/babillard_page.eml.html |  9 +++++++--
 src/login.eml.html          | 37 +++++++++++++------------------------
 src/newthread_page.eml.html |  4 +++-
 src/permap.ml               | 20 ++++++++++++++++----
 src/thread_page.eml.html    |  3 ++-
 5 files changed, 41 insertions(+), 32 deletions(-)

diff --git a/src/babillard_page.eml.html b/src/babillard_page.eml.html
index b5f93bb..ddaffba 100644
--- a/src/babillard_page.eml.html
+++ b/src/babillard_page.eml.html
@@ -7,12 +7,17 @@ let f request =
       <div id="map"></div>
       <br />
       <button class="btn btn-primary" id="geolocalize">Geolocalize me</button>
-% if Option.is_some @@ Dream.session "nick" request then begin
+% begin match Dream.session "nick" request with
+% | None ->
+% let redirect = Dream.to_percent_encoded "/new_thread" in
+% ()
+<a class="btn btn-primary" href="/login?redirect=<%s redirect%>">New Thread</a>
+% | Some _ ->
       <a class="btn btn-primary" href="/new_thread">New Thread</a>
-% end;
     </div>
     <div class="col-md-6">
       <div id="thread_preview_div"></div>
       <a id="thread_link"></a>
     </div>
   </div>
+% end;
diff --git a/src/login.eml.html b/src/login.eml.html
index 9968db5..56d7754 100644
--- a/src/login.eml.html
+++ b/src/login.eml.html
@@ -1,24 +1,13 @@
-let f ?nick ?password request =
-
-%   begin match nick, password with
-%   | Some nick, Some password ->
-%     begin match User.login ~nick ~password request with
-%     | Error e ->
-Error: <%s e %>
-%     | Ok () ->
-Logged in ! Happy planting XD
-%     end;
-%   | _ ->
-    <%s! Dream.form_tag ~action:"/login" request %>
-      <div class="mb-3">
-        <label for="nick" class="form-label">Nick</label>
-        <input name="nick" type="text" class="form-control" id="nick" aria-describedby="nickHelp">
-        <div id="nickHelp" class="form-text">Who are u ?</div>
-      </div>
-      <div class="mb-3">
-        <label for="password" class="form-label">Password</label>
-        <input name="password" type="password" class="form-control" id="password">
-      </div>
-      <button type="submit" class="btn btn-primary">Submit</button>
-    </form>
-%   end;
+let f request =
+<%s! Dream.form_tag ~action:"/login" request %>
+  <div class="mb-3">
+    <label for="nick" class="form-label">Nick</label>
+    <input name="nick" type="text" class="form-control" id="nick" aria-describedby="nickHelp">
+    <div id="nickHelp" class="form-text">Who are u ?</div>
+  </div>
+  <div class="mb-3">
+    <label for="password" class="form-label">Password</label>
+    <input name="password" type="password" class="form-control" id="password">
+  </div>
+  <button type="submit" class="btn btn-primary">Submit</button>
+</form>
diff --git a/src/newthread_page.eml.html b/src/newthread_page.eml.html
index 0c55a9f..0b3f55e 100644
--- a/src/newthread_page.eml.html
+++ b/src/newthread_page.eml.html
@@ -1,7 +1,9 @@
 let f request =
 % begin match Dream.session "nick" request with
 % | None ->
-  <a href="/login">Login</a> to make a new thread.
+% let redirect = Dream.to_percent_encoded "/new_thread" in
+% Format.printf "%s@." redirect;
+<a href="/login?redirect=<%s redirect%>">Login</a> to make a new thread.
 % | Some _nick ->
   <script type="text/javascript" src="/assets/js/js_newthread.js" defer="defer"></script>
   <h1>New thread</h1>
diff --git a/src/permap.ml b/src/permap.ml
index 610f53f..93fc019 100644
--- a/src/permap.ml
+++ b/src/permap.ml
@@ -42,15 +42,27 @@ let register_post request =
     render_unsafe (Register.f ~nick ~email ~password request) request
   | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
   | `Wrong_session _ | `Expired _ | `Wrong_content_type ->
-    assert false
+    Dream.empty `Bad_Request
 
 let login_get request = render_unsafe (Login.f request) request
 
 let login_post request =
   match%lwt Dream.form request with
-  | `Ok [ ("nick", nick); ("password", password) ] ->
-    render_unsafe (Login.f ~nick ~password request) request
-  | _ -> assert false
+  | `Ok [ ("nick", nick); ("password", password) ] -> (
+    match User.login ~nick ~password request with
+    | Error e -> render_unsafe e request
+    | Ok () ->
+      let url =
+        match Dream.query request "redirect" with
+        | None -> "/jpp"
+        | Some redirect -> Dream.from_percent_encoded redirect
+      in
+      Dream.respond ~status:`See_Other
+        ~headers:[ ("Location", url) ]
+        "Logged in: Happy geo-posting!" )
+  | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
+  | `Wrong_session _ | `Expired _ | `Wrong_content_type ->
+    Dream.empty `Bad_Request
 
 let user request =
   render_unsafe (Result.fold ~ok:Fun.id ~error:Fun.id (User.list ())) request
diff --git a/src/thread_page.eml.html b/src/thread_page.eml.html
index f83e4eb..de145ef 100644
--- a/src/thread_page.eml.html
+++ b/src/thread_page.eml.html
@@ -3,7 +3,8 @@ let f thread_view thread_id request =
       <%s! thread_view %>
 % begin match Dream.session "nick" request with
 % | None ->
-
+% let redirect = Dream.to_percent_encoded (Format.sprintf "redirect=/thread/%s" thread_id) in
+<a href="/login?<%s redirect%>">Login to reply!</a>
 % | Some _ ->
     <div class="post-form">
         <%s! Dream.form_tag ~action:( Format.sprintf "/thread/%s" thread_id)