diff --git a/src/login.ml b/src/login.ml index 3316620..3993ba2 100644 --- a/src/login.ml +++ b/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") diff --git a/src/logout.ml b/src/logout.ml index 94a273d..9beaf53 100644 --- a/src/logout.ml +++ b/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 - let page = Tyxml.Html.txt "logged out" in - Template.render ~title ~scripts:[] page + + 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!" diff --git a/src/syntax.ml b/src/syntax.ml index 74f5f57..8b3cc40 100644 --- a/src/syntax.ml +++ b/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 diff --git a/src/user.ml b/src/user.ml index e0e9517..56aa4ba 100644 --- a/src/user.ml +++ b/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 *)