From 993a3d05e20db9ae8b131375fd5604706ed328e3 Mon Sep 17 00:00:00 2001
From: Eike Kettner <eike.kettner@posteo.de>
Date: Fri, 3 Jan 2020 20:42:38 +0100
Subject: [PATCH] Fix redirection after login
---
modules/webapp/src/main/elm/Page.elm | 43 ++++++++++++++++++++++------
1 file changed, 34 insertions(+), 9 deletions(-)
diff --git a/modules/webapp/src/main/elm/Page.elm b/modules/webapp/src/main/elm/Page.elm
index 32355252..c9e7633e 100644
--- a/modules/webapp/src/main/elm/Page.elm
+++ b/modules/webapp/src/main/elm/Page.elm
@@ -18,13 +18,14 @@ import Browser.Navigation as Nav
import Html exposing (Attribute)
import Html.Attributes as Attr
import Url exposing (Url)
-import Url.Parser as Parser exposing ((</>), Parser, oneOf, s, string)
+import Url.Parser as Parser exposing ((</>), (<?>), Parser, oneOf, s, string)
+import Url.Parser.Query as Query
import Util.Maybe
type Page
= HomePage
- | LoginPage (Maybe String)
+ | LoginPage (Maybe Page)
| ManageDataPage
| CollectiveSettingPage
| UserSettingPage
@@ -81,7 +82,7 @@ loginPage p =
LoginPage Nothing
_ ->
- LoginPage (Just (pageToString p |> String.dropLeft 2))
+ LoginPage (Just p)
pageName : Page -> String
@@ -127,7 +128,7 @@ loginPageReferrer : Page -> Maybe Page
loginPageReferrer page =
case page of
LoginPage r ->
- Maybe.andThen pageFromString r
+ r
_ ->
Nothing
@@ -150,9 +151,15 @@ pageToString page =
"/app/home"
LoginPage referer ->
- Maybe.map (\p -> "/" ++ p) referer
- |> Maybe.withDefault ""
- |> (++) "/app/login"
+ case referer of
+ Just (LoginPage _) ->
+ "/app/login"
+
+ Just p ->
+ "/app/login?r=" ++ pageToString p
+
+ Nothing ->
+ "/app/login"
ManageDataPage ->
"/app/managedata"
@@ -221,8 +228,7 @@ parser : Parser (Page -> a) a
parser =
oneOf
[ Parser.map HomePage (oneOf [ Parser.top, s pathPrefix </> s "home" ])
- , Parser.map (\s -> LoginPage (Just s)) (s pathPrefix </> s "login" </> string)
- , Parser.map (LoginPage Nothing) (s pathPrefix </> s "login")
+ , Parser.map LoginPage (s pathPrefix </> s "login" <?> pageQuery)
, Parser.map ManageDataPage (s pathPrefix </> s "managedata")
, Parser.map CollectiveSettingPage (s pathPrefix </> s "csettings")
, Parser.map UserSettingPage (s pathPrefix </> s "usettings")
@@ -238,3 +244,22 @@ parser =
fromUrl : Url -> Maybe Page
fromUrl url =
Parser.parse parser url
+
+
+fromString : String -> Maybe Page
+fromString str =
+ let
+ url =
+ Url Url.Http "localhost" Nothing str Nothing Nothing
+ in
+ fromUrl url
+
+
+pageQuery : Query.Parser (Maybe Page)
+pageQuery =
+ let
+ parsePage ms =
+ Maybe.andThen fromString ms
+ in
+ Query.string "r"
+ |> Query.map parsePage