implement redirection when user should be logged in/logged out

src/login.ml

@@ -5,6 +5,13 @@ open Syntax
 let get request =
   let** () = User.assert_not_logged request in
   let title = "Pellest|Login" in
+
+  let action =
+    match Dream.query request "redirect" with
+    | None -> "/login"
+    | Some r -> Format.sprintf "/login?redirect=%s" r
+  in
+
   let login =
     let submit = button ~a:[ a_id "submit_login" ] [ txt "submit" ] in
     let login =
@@ -13,8 +20,7 @@ let get request =
     let password =
       input ~a:[ a_id "password"; a_name "password"; a_input_type `Password ] ()
     in
-    div
-      [ make_form request ~action:"/login" ~items:[ login; password; submit ] ]
+    div [ make_form request ~action ~items:[ login; password; submit ] ]
   in
   let text = div [ txt "login ~!" ] in
   let page = div [ text; login ] in
@@ -32,5 +38,5 @@ let post request =
     in
     Dream.respond ~status:`See_Other
       ~headers:[ ("Location", url) ]
-      "Logged in: Happy geo-posting!"
+      "Logged in: Happy pellesting!"
   | _form -> Template.err (`Bad_Request, "invalid form")

src/logout.ml

@@ -4,5 +4,13 @@ let get request =
   let** () = User.assert_logged request in
   let title = "Logout" in
   let%lwt () = Dream.invalidate_session request in
+
+  match Dream.query request "redirect" with
+  | None ->
     let page = Tyxml.Html.txt "logged out" in
     Template.render ~title ~scripts:[] page
+  | Some redirect ->
+    let url = Dream.from_percent_encoded redirect in
+    Dream.respond ~status:`See_Other
+      ~headers:[ ("Location", url) ]
+      "Logged out: Happy nopellesting!"

src/syntax.ml

@@ -1,6 +1,16 @@
-(* let bindings for early return when encountering an error *)
-(* see https://ocaml.org/releases/4.13/htmlman/bindingops.html *)
-
 let ( let* ) o f = Result.fold ~ok:f ~error:Result.error o
 
-let ( let** ) o f = match o with Error e -> Template.err e | Ok v -> f v
+type extended_status =
+  [ Dream.status
+  | `See_Other_Redirect of (string * string) list
+  ]
+
+let ( let** ) o f =
+  match o with
+  | Error (kind, msg) -> begin
+    match kind with
+    | `See_Other_Redirect headers ->
+      Dream.respond ~status:`See_Other ~headers msg
+    | #Dream.status as status -> Template.err (status, msg)
+  end
+  | Ok v -> f v

src/user.ml

@@ -218,10 +218,20 @@ let public_profile user_id =
 
 let assert_logged request =
   if is_logged_in request then Ok ()
-  else Error (`Forbidden, "you should be logged in")
+  else
+    let target = Dream.target request in
+    let redirect_url =
+      Format.sprintf "/login?redirect=%s" (Dream.to_percent_encoded target)
+    in
+    Error
+      ( `See_Other_Redirect [ ("Location", redirect_url) ]
+      , "you should be logged in" )
 
 let assert_not_logged request =
-  if is_logged_in request then Error (`Forbidden, "you shoudn't be logged in")
+  if is_logged_in request then
+    (* redirect to the home page *)
+    Error
+      (`See_Other_Redirect [ ("Location", "/") ], "you shouldn't be logged in")
   else Ok ()
 
 (* TODO save states *)