From 421c71c8922731563771ed75be7f28c9a559c068 Mon Sep 17 00:00:00 2001 From: William Carroll Date: Fri, 31 Jul 2020 18:32:00 +0100 Subject: Support a basic client-side login flow I will need to remove some of the baggage like: - Scrub any copy about restaurants - delete Restaurant.elm - Change Owner.elm -> Manager.elm --- client/src/State.elm | 482 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 468 insertions(+), 14 deletions(-) (limited to 'client/src/State.elm') diff --git a/client/src/State.elm b/client/src/State.elm index 8c56a7ecce1d..8595ee4dd3e8 100644 --- a/client/src/State.elm +++ b/client/src/State.elm @@ -1,29 +1,322 @@ module State exposing (..) +import Array exposing (Array) +import Browser +import Browser.Navigation as Nav +import Http +import Json.Decode as JD +import Json.Decode.Extra as JDE +import Json.Encode as JE +import Process +import RemoteData exposing (WebData) +import Shared +import Task +import Time +import Url +import Url.Builder as UrlBuilder +import Url.Parser exposing ((), Parser, int, map, oneOf, s, string) +import Utils + + + +-------------------------------------------------------------------------------- +-- Types +-------------------------------------------------------------------------------- + type Msg = DoNothing - | SetView View + | UpdateUsername String + | UpdatePassword String + | UpdateRole String + | UpdateAdminTab AdminTab + | ClearErrors + -- SPA + | LinkClicked Browser.UrlRequest + | UrlChanged Url.Url + -- Outbound network + | AttemptGetUsers + | AttemptSignUp Role + | AttemptLogin + | AttemptLogout + | AttemptDeleteUser String + -- Inbound network + | GotUsers (WebData AllUsers) + | GotSignUp (Result Http.Error Session) + | GotLogin (Result Http.Error Session) + | GotLogout (Result Http.Error String) + | GotDeleteUser (Result Http.Error String) + + +type Route + = Login + | UserHome + | ManagerHome + | AdminHome + + +type Role + = User + | Manager + | Admin + + +type alias AllUsers = + { user : List String + , manager : List String + , admin : List String + } + + +type alias Session = + { role : Role + , username : String + } + + +type alias Review = + { rowid : Int + , content : String + , rating : Int + , user : String + , dateOfVisit : String + } + + +type alias Reviews = + { hi : Maybe Review + , lo : Maybe Review + , all : List Review + } -type View - = Landing - | Login +type AdminTab + = Users type alias Model = - { isLoading : Bool - , view : View + { route : Maybe Route + , url : Url.Url + , key : Nav.Key + , session : Maybe Session + , username : String + , password : String + , role : Maybe Role + , users : WebData AllUsers + , adminTab : AdminTab + , loginError : Maybe Http.Error + , logoutError : Maybe Http.Error + , signUpError : Maybe Http.Error + , deleteUserError : Maybe Http.Error + } + + + +-------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------- + + +roleToString : Role -> String +roleToString role = + case role of + User -> + "user" + + Manager -> + "manager" + + Admin -> + "admin" + + +endpoint : List String -> List UrlBuilder.QueryParameter -> String +endpoint = + UrlBuilder.crossOrigin Shared.serverOrigin + + +decodeRole : JD.Decoder Role +decodeRole = + let + toRole : String -> JD.Decoder Role + toRole s = + case s of + "user" -> + JD.succeed User + + "manager" -> + JD.succeed Manager + + "admin" -> + JD.succeed Admin + + _ -> + JD.succeed User + in + JD.string |> JD.andThen toRole + + +decodeSession : JD.Decoder Session +decodeSession = + JD.map2 + Session + (JD.field "role" decodeRole) + (JD.field "username" JD.string) + + +encodeLoginRequest : String -> String -> JE.Value +encodeLoginRequest username password = + JE.object + [ ( "username", JE.string username ) + , ( "password", JE.string password ) + ] + + +login : String -> String -> Cmd Msg +login username password = + Utils.postWithCredentials + { url = endpoint [ "login" ] [] + , body = Http.jsonBody (encodeLoginRequest username password) + , expect = Http.expectJson GotLogin decodeSession + } + + +logout : Cmd Msg +logout = + Utils.getWithCredentials + { url = endpoint [ "logout" ] [] + , expect = Http.expectString GotLogout + } + + +signUp : + { username : String + , password : String + , role : Role } + -> Cmd Msg +signUp { username, password, role } = + Utils.postWithCredentials + { url = endpoint [ "create-account" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "username", JE.string username ) + , ( "password", JE.string password ) + , ( "role" + , case role of + User -> + JE.string "user" + + Manager -> + JE.string "manager" + + Admin -> + JE.string "admin" + ) + ] + ) + , expect = Http.expectJson GotSignUp decodeSession + } + + +deleteUser : String -> Cmd Msg +deleteUser username = + Utils.deleteWithCredentials + { url = endpoint [ "user", username ] [] + , expect = Http.expectString GotDeleteUser + } + + +decodeReview : JD.Decoder Review +decodeReview = + JD.map5 + Review + (JD.field "rowid" JD.int) + (JD.field "content" JD.string) + (JD.field "rating" JD.int) + (JD.field "user" JD.string) + (JD.field "timestamp" JD.string) + + +fetchUsers : Cmd Msg +fetchUsers = + Utils.getWithCredentials + { url = endpoint [ "all-usernames" ] [] + , expect = + Http.expectJson + (RemoteData.fromResult >> GotUsers) + (JD.map3 + AllUsers + (JD.field "user" (JD.list JD.string)) + (JD.field "manager" (JD.list JD.string)) + (JD.field "admin" (JD.list JD.string)) + ) + } + + +sleepAndClearErrors : Cmd Msg +sleepAndClearErrors = + Process.sleep 4000 + |> Task.perform (\_ -> ClearErrors) + + +isAuthorized : Role -> Route -> Bool +isAuthorized role route = + case ( role, route ) of + ( User, _ ) -> + True + + ( Manager, _ ) -> + True + + ( Admin, _ ) -> + True + + +homeRouteForRole : Role -> String +homeRouteForRole role = + case role of + User -> + "/user" + + Manager -> + "/manager" + + Admin -> + "/admin" + + +routeParser : Parser (Route -> a) a +routeParser = + oneOf + [ map Login (s "topic") + , map UserHome (s "user") + , map ManagerHome (s "manager") + , map AdminHome (s "admin") + ] {-| The initial state for the application. -} -init : Model -init = - { isLoading = False - , view = Login - } +init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +init _ url key = + ( { route = Nothing + , url = url + , key = key + , session = Nothing + , username = "" + , password = "" + , role = Nothing + , users = RemoteData.NotAsked + , adminTab = Users + , loginError = Nothing + , logoutError = Nothing + , signUpError = Nothing + , deleteUserError = Nothing + } + , Cmd.none + ) {-| Now that we have state, we need a function to change the state. @@ -34,10 +327,171 @@ update msg model = DoNothing -> ( model, Cmd.none ) - SetView x -> + UpdateUsername x -> + ( { model | username = x }, Cmd.none ) + + UpdatePassword x -> + ( { model | password = x }, Cmd.none ) + + UpdateAdminTab x -> + ( { model | adminTab = x }, Cmd.none ) + + UpdateRole x -> + let + maybeRole = + case x of + "user" -> + Just User + + "owner" -> + Just Manager + + "admin" -> + Just Admin + + _ -> + Nothing + in + ( { model | role = maybeRole }, Cmd.none ) + + ClearErrors -> ( { model - | view = x - , isLoading = True + | loginError = Nothing + , logoutError = Nothing + , signUpError = Nothing + , deleteUserError = Nothing } , Cmd.none ) + + LinkClicked urlRequest -> + case urlRequest of + Browser.Internal url -> + ( model, Nav.pushUrl model.key (Url.toString url) ) + + Browser.External href -> + ( model, Nav.load href ) + + UrlChanged url -> + let + route = + Url.Parser.parse routeParser url + in + case route of + Just UserHome -> + ( { model + | url = url + , route = route + } + , Cmd.none + ) + + Just ManagerHome -> + case model.session of + Nothing -> + ( { model + | url = url + , route = route + } + , Cmd.none + ) + + Just session -> + ( { model + | url = url + , route = route + } + , Cmd.none + ) + + Just AdminHome -> + ( { model + | url = url + , route = route + , users = RemoteData.Loading + } + , Cmd.none + ) + + _ -> + ( { model + | url = url + , route = route + } + , Cmd.none + ) + + -- GET /all-usernames + AttemptGetUsers -> + ( { model | users = RemoteData.Loading }, fetchUsers ) + + GotUsers xs -> + ( { model | users = xs }, Cmd.none ) + + -- DELETE /user/:username + AttemptDeleteUser username -> + ( model, deleteUser username ) + + GotDeleteUser result -> + case result of + Ok _ -> + ( model, fetchUsers ) + + Err e -> + ( { model | deleteUserError = Just e } + , sleepAndClearErrors + ) + + -- /create-account + AttemptSignUp role -> + ( model + , signUp + { username = model.username + , password = model.password + , role = role + } + ) + + GotSignUp result -> + case result of + Ok session -> + ( { model | session = Just session } + , Nav.pushUrl model.key (homeRouteForRole session.role) + ) + + Err x -> + ( { model | signUpError = Just x } + , sleepAndClearErrors + ) + + -- /login + AttemptLogin -> + ( model, login model.username model.password ) + + GotLogin result -> + case result of + Ok session -> + ( { model | session = Just session } + , Nav.pushUrl model.key (homeRouteForRole session.role) + ) + + Err x -> + ( { model | loginError = Just x } + , sleepAndClearErrors + ) + + -- / logout + AttemptLogout -> + ( model, logout ) + + GotLogout result -> + case result of + Ok _ -> + ( { model | session = Nothing } + , Nav.pushUrl model.key "/login" + ) + + Err e -> + ( { model | logoutError = Just e } + , sleepAndClearErrors + ) -- cgit 1.4.1