Fix redirection after login

This commit is contained in:
Eike Kettner 2020-01-03 20:42:38 +01:00
parent 1705aa084d
commit 993a3d05e2

View File

@ -18,13 +18,14 @@ import Browser.Navigation as Nav
import Html exposing (Attribute) import Html exposing (Attribute)
import Html.Attributes as Attr import Html.Attributes as Attr
import Url exposing (Url) 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 import Util.Maybe
type Page type Page
= HomePage = HomePage
| LoginPage (Maybe String) | LoginPage (Maybe Page)
| ManageDataPage | ManageDataPage
| CollectiveSettingPage | CollectiveSettingPage
| UserSettingPage | UserSettingPage
@ -81,7 +82,7 @@ loginPage p =
LoginPage Nothing LoginPage Nothing
_ -> _ ->
LoginPage (Just (pageToString p |> String.dropLeft 2)) LoginPage (Just p)
pageName : Page -> String pageName : Page -> String
@ -127,7 +128,7 @@ loginPageReferrer : Page -> Maybe Page
loginPageReferrer page = loginPageReferrer page =
case page of case page of
LoginPage r -> LoginPage r ->
Maybe.andThen pageFromString r r
_ -> _ ->
Nothing Nothing
@ -150,9 +151,15 @@ pageToString page =
"/app/home" "/app/home"
LoginPage referer -> LoginPage referer ->
Maybe.map (\p -> "/" ++ p) referer case referer of
|> Maybe.withDefault "" Just (LoginPage _) ->
|> (++) "/app/login" "/app/login"
Just p ->
"/app/login?r=" ++ pageToString p
Nothing ->
"/app/login"
ManageDataPage -> ManageDataPage ->
"/app/managedata" "/app/managedata"
@ -221,8 +228,7 @@ parser : Parser (Page -> a) a
parser = parser =
oneOf oneOf
[ Parser.map HomePage (oneOf [ Parser.top, s pathPrefix </> s "home" ]) [ Parser.map HomePage (oneOf [ Parser.top, s pathPrefix </> s "home" ])
, Parser.map (\s -> LoginPage (Just s)) (s pathPrefix </> s "login" </> string) , Parser.map LoginPage (s pathPrefix </> s "login" <?> pageQuery)
, Parser.map (LoginPage Nothing) (s pathPrefix </> s "login")
, Parser.map ManageDataPage (s pathPrefix </> s "managedata") , Parser.map ManageDataPage (s pathPrefix </> s "managedata")
, Parser.map CollectiveSettingPage (s pathPrefix </> s "csettings") , Parser.map CollectiveSettingPage (s pathPrefix </> s "csettings")
, Parser.map UserSettingPage (s pathPrefix </> s "usettings") , Parser.map UserSettingPage (s pathPrefix </> s "usettings")
@ -238,3 +244,22 @@ parser =
fromUrl : Url -> Maybe Page fromUrl : Url -> Maybe Page
fromUrl url = fromUrl url =
Parser.parse parser 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