Commit 736a449b authored by Martin Bittermann's avatar Martin Bittermann
Browse files

User Editing WiP3

Last Admin cannot decrease their account level anymore // Changed email address must now be verified, except when an admin edits another user's account // There are now green alert bubbles indicating which user setting(s) have been changed // For admins there is now a 'Edit user' button on the user profile page.
parent 41db3d47
......@@ -72,8 +72,8 @@ loginHandler enLoginField enPassField env = do
loginController >>= getForm
else do
loginToSession (head dbUsers)
defaultController >>= return . (loginAlert (userName (head dbUsers)) : ) >>= getForm
where loginAlert uname = alert "alert-success" [htxt $ "Welcome, " ++ uname ++ "!"]
defaultController >>= loginAlert (userName (head dbUsers)) >>= getForm
where loginAlert uname = prependAlert "alert-success" [htxt $ "Welcome, " ++ uname ++ "!"]
-----------------------------------------------------------------------------
--- Controller for showing and selecting user processes.
......
......@@ -9,6 +9,7 @@ import View.Shared
import Maybe
import List
import Char
import Controller.DefaultController
import System.SessionInfo
import System.Authentication
import System.Authorization
......@@ -47,7 +48,7 @@ mainUserController = do
getUserByName :: String -> IO (Maybe User)
getUserByName name = do
dbUsers <- runQ (queryCondUser ((==name) . userName))
dbUsers <- runQ (queryCondUser ((~= name) . userName))
if null dbUsers
then return Nothing
else return (Just (head dbUsers))
......@@ -73,14 +74,6 @@ signupControllerWithDefaults dUname dEmail dPubMail =
$ (\sinfo ->
do return (signupForm sinfo dUname dEmail dPubMail signupHandler))
--- Basic user name check. Cannot contain '@' character because it might be eqaul to another user's
--- email address. This could cause problems during login.
--- Furthermore, the user name cannot be one of the basic CRUD controllers
allowedUserName :: String -> Bool
allowedUserName s = not ( ('@' `elem` s) || (s `elem` ["list", "new", "show", "edit", "delete"]) )
--- Submit button Handler for the signup form. First arg is the tuple of the cgirefs of all input fields.
signupHandler :: (CgiRef, CgiRef, CgiRef, CgiRef, CgiRef) -> CgiEnv -> IO HtmlForm
signupHandler (a,b,c,d,e) env = do
......@@ -93,7 +86,6 @@ signupHandler (a,b,c,d,e) env = do
getForm
where
(uname, email, pass1, pass2, pubEmail) = (env a, env b, env c, env d, env e)
--staticChecks = signupStaticChecks inFields
checks = signupChecks uname email pass1 pass2 pubEmail
trySignupWithDB = do
-- prepare the public email field
......@@ -194,14 +186,14 @@ validateEmail email rejectExisting =
then return InputValid
else return $ InputInvalid $ "The email address " ++ email ++ " is already in use!"
--- The public email address can be empty. If not empty, validate it the same way like the primary email
--- The public email address can be empty. If not empty, validate it the same way as the primary email
validatePublicEmail :: String -> IO InputValResult
validatePublicEmail s
| null s = return InputValid
| otherwise = liftIO (\v -> v==InputValid =? InputValid ## InputInvalid "Invalid public email address!")
(validateEmail s False)
--- Validate the to password inputs. The must be the same, and at least 9 chars in length.
--- Validate the two password inputs. They must be the same, and at least 9 chars in length.
validatePasswords :: String -> String -> Bool -> IO InputValResult
validatePasswords pass1 pass2 rejectEmpty
| pass1 /= pass2 = return $ InputInvalid "The password confirmation does not match!"
......@@ -209,6 +201,18 @@ validatePasswords pass1 pass2 rejectEmpty
| length pass1 < 9 = return $ InputInvalid "The password must be at least 9 characters!"
| otherwise = return InputValid
--- Validate a new user role. The role must be at least USER, and if the user is the last ADMIN,
--- the role must not be changed to ensure there is always an Admin.
validateRole :: URole -> URole -> IO InputValResult
validateRole role oldRole
| role < USER = return $ InputInvalid "Invalid user role!"
| oldRole == ADMIN && role < ADMIN = do
existingAdmins <- runQ $ queryCondUser $ ("ADMIN" ==) . userRole
if length existingAdmins > 1
then return InputValid
else return $ InputInvalid "The only ADMIN in the system cannot change their own role."
| otherwise = return InputValid
--- Shows a small success message after signup, containing a field fot the confirm code
--- TODO: Remove leakToken before production use.
signupSuccessController :: String -> String -> String -> Controller
......@@ -224,15 +228,15 @@ mailConfirmController :: String -> Controller
mailConfirmController ccode = do
-- get all users with the specified confirmation token.
mbUserAndTokens <- getUserWhoHasMailToken ccode
cTime <- getClockTime
case mbUserAndTokens of
Nothing -> -- no user in the DB has a token with this confirmation code
(setPageMessage "Email confirmation failed! Unknown confirmation code.") >>
listUserController
Just (dbUser, mailTokens, mt@(UserT expiry _)) -> do -- a user has the supplied confirmation code
cTime <- getClockTime
if (clockTimeToInt cTime) > expiry && ((userRole dbUser) == "NONE")
defaultController
Just (dbUser, mailTokens, mt@(UserT expiry _)) -> -- a user has the supplied confirmation code
if (clockTimeToInt cTime) > expiry
then
-- code has expired, delete the user if the role is NONE
-- code has expired, delete the user.
-- todo: Additionally, expired unconfirmed users should be automatically deleted on a schedule.
-- That would help keep the DB clean at all times, even if this code is not called.
(runT (deleteUser dbUser)) >>
......@@ -249,21 +253,29 @@ mailConfirmController ccode = do
-- and delete the activation token.
let modifiedUser = setUserRole (setUserToken dbUser (show (delete mt mailTokens)))
(null existingAdmins =? "ADMIN" ## "USER")
(runT (updateUser modifiedUser))
runT $ updateUser modifiedUser
return (activatedAccountForm (userName dbUser))
Just (dbUser, mailTokens, mt@(PassT expiry _)) -> do
cTime <- getClockTime
Just (dbUser, mailTokens, mt@(PassT expiry _)) ->
if (clockTimeToInt cTime) > expiry
then
-- code has expired, just remove the token
(runT (updateUser (setUserToken dbUser (show (delete mt mailTokens))))) >>
(setPageMessage "This confirmation code has expired.") >>
listUserController
defaultController
else -- the ccode is valid, the user can now create a new password!
return $ passResetView (userName dbUser) (passResetHandler (userKey dbUser) ccode mt)
_ -> --todo: implement the email type of token
(setPageMessage "Unsupported type of confirm code!") >>
listUserController
Just (dbUser, mailTokens, mt@(MailT expiry _ newMail)) ->
if (clockTimeToInt cTime) > expiry
then
-- code has expired, just remove the token
(runT (updateUser (setUserToken dbUser (show (delete mt mailTokens))))) >>
(setPageMessage "This confirmation code has expired.") >>
defaultController
else do -- the ccode is valid, the new email address can be set!
let modifiedUser = setUserEmail dbUser newMail
runT $ updateUser modifiedUser
userSettingsController (userName dbUser) >>=
prependAlert "alert-success" [htxt "Your Email address has been changed."]
-- Handler to handle the receipt of a new password pair
passResetHandler :: UserID -> String -> MailToken -> CgiRef -> CgiRef -> CgiEnv -> IO HtmlForm
......@@ -347,6 +359,7 @@ userProfileController uname = do
case mbUser of
Nothing -> displayError ("User '" ++ uname ++ "' not found!")
Just user -> do
sinfo <- getUserSessionInfo
maintainedPackages <- runQ (getUserMaintainedPackages user)
let pkgNames = map packageName maintainedPackages
let pkgDescs = map packageDescription maintainedPackages
......@@ -359,55 +372,107 @@ userProfileController uname = do
packagesMaintainers <- mapM (\pkg -> runQ $ getPackageMaintainers pkg) maintainedPackages
let pkgCoMaintainers = map (\ulist -> map userName (delete user ulist)) packagesMaintainers
let pkgInfoList = zipWith (\(a,b) (c,d) -> (a,b,c,d)) (zip pkgNames pkgDescs) (zip pkgLatestUploads pkgCoMaintainers)
return $ userProfileView user pkgInfoList
return $ userProfileView sinfo user pkgInfoList
--- Controller for editing user preferences. Each user should be allowed to edit the own account.
--- Admins should be allowed to edit anyone's account, and have more editing rights.
--- @param uname - User name to display the settings view for.
userSettingsController :: String -> Controller
userSettingsController uname = do
userSettingsController uname = userSettingsControllerWithResponse [] uname
--- Controller for editing user preferences. Prepends response messages to the view.
userSettingsControllerWithResponse :: [HtmlExp] -> String -> Controller
userSettingsControllerWithResponse responseExps uname = do
mbUser <- getUserByName uname
case mbUser of
Nothing -> displayError ("User '" ++ uname ++ "' not found!")
Just user -> checkAuthorization (userProfileEditAllowed user)
(\sinfo -> return $ userSettingsView sinfo user (userSettingsHandler user))
(\sinfo -> return $ userSettingsView sinfo user (userSettingsHandler user) responseExps)
--- Handler for changing the basic user information
userSettingsHandler :: User -> CgiRef -> CgiRef -> CgiRef -> CgiRef -> Maybe CgiRef -> HtmlHandler
userSettingsHandler userToEdit emailRef pass1Ref pass2Ref pubEmailRef mbRoleRef env =
(checkAuthorization (userProfileEditAllowed userToEdit) -- check permission again, the session may have expired
(\_ -> do
mbInputErr <- doInputChecks $ settingsChecks (userEmail userToEdit) newEmail newPass1 newPass2 newPubEmail
(\sinfo -> do
mbInputErr <- doInputChecks $ settingsChecks (userEmail userToEdit) newEmail newPass1 newPass2
newPubEmail newRole (readUserRole $ userRole userToEdit)
case mbInputErr of
Nothing -> changeSettingsWithDB
Nothing -> changeSettingsWithDB sinfo
Just (err,_) -> setPageMessage err >>
(userSettingsController (userName userToEdit))
)) >>= getForm
where
(newEmail, newPass1, newPass2, newPubEmail) = (env emailRef, env pass1Ref, env pass2Ref, env pubEmailRef)
newRole = maybe (userRole userToEdit)
(\ref -> readUserRole (env ref) > GUEST =? env ref ## userRole userToEdit)
mbRoleRef --todo: make check from this
changeSettingsWithDB = do
let modUserEmail = setUserEmail userToEdit newEmail
let modUserRole = setUserRole modUserEmail newRole
let modUserPubEmail = setUserPublicEmail modUserRole (null newPubEmail =? "null" ## newPubEmail)
newPassField <- do if null newPass1
then return $ userPassword userToEdit
else do
let (userSalt, _) = splitPassField (userPassword userToEdit)
userHash <- getUserHash userSalt newPass1
return $ composePassField userSalt userHash
let modUserPass = setUserPassword modUserPubEmail newPassField
runT (updateUser modUserPass)
setPageMessage "Your changes have been saved."
userSettingsController $ userName userToEdit
--- Form input checks for signup
settingsChecks :: String -> String -> String -> String -> String -> [(IO InputValResult, [Int])]
settingsChecks oldEmail email pass1 pass2 pubEmail =
newRole = maybe (readUserRole $ userRole userToEdit) (readUserRole . env) mbRoleRef
changeSettingsWithDB :: UserSessionInfo -> IO [HtmlExp]
changeSettingsWithDB sinfo = do
let editingUserID = maybe (-1) ldKey (userLoginOfSession sinfo)
-- is this an admin editing someone else's account?
let adminEdit = isAdmin sinfo && editingUserID /= (userKeyToInt $ userKey userToEdit)
-- user role
let newRoleField = writeUserRole newRole
let moddedRole = newRoleField /= userRole userToEdit
-- public mail
let newPubEmailField = null newPubEmail =? "null" ## newPubEmail
let moddedPubEmail = newPubEmailField /= userPublicEmail userToEdit
(newPassField, moddedPass) <- if null newPass1
then return (userPassword userToEdit, False)
else do
let userSalt = fst $ splitPassField (userPassword userToEdit)
userHash <- getUserHash userSalt newPass1
return (composePassField userSalt userHash, True)
-- primary email
let newEmailField = adminEdit =? newEmail ## userEmail userToEdit
let moddedEmail = newEmailField /= userEmail userToEdit
-- token field
(newTokenField, mbMailChangeInfo) <- if userEmail userToEdit == newEmail || adminEdit
then return $ (userToken userToEdit, Nothing)
else do
(expiry, emailToken, userTokenHash) <- getNewMailToken userToEdit
-- get current confirm tokens of the user and remove all MailTokens
let mailTokens = readMailTokens (userToken userToEdit)
let cleanedTokens = mailTokens \\ [t | t@MailT {} <- mailTokens]
-- send the confirmation email
let email = userEmail userToEdit
(rc, _, _) <- sendMailEvalOutput
mailProfDefault
["Masala: Please verify your new email address", email]
("A request has been received to change your primary email address to " ++ newEmail ++ ". \n\n" ++
"Please follow this link to confirm the change: \n" ++
rootUrl ++ "/spicey.cgi?Confirm/" ++ emailToken ++ "\n\n" ++
"Alternatively, paste this code into the Confirmation Code field on the website.\n" ++
emailToken ++ "\n\n" ++
"The code is valid for " ++ (show confirmCodeDuration) ++ " minutes.")
unless (rc == 0) $ setPageMessage ("Error sending the confirmation code by email: Code " ++ (show rc))
-- compose the confirmation token field for storage in the database
return $ ( show $ (MailT { tExpiry = expiry, tCode = userTokenHash, tEmail = newEmail } : cleanedTokens)
, Just (email, newEmail, confirmCodeDuration, emailToken,
(\cCodeRef env' -> redirectHandler ("?Confirm/" ++ (env' cCodeRef)) env')) )
let modifiedUser = setUserEmail (setUserPublicEmail (setUserRole (setUserPassword (setUserToken userToEdit
newTokenField) newPassField) newRoleField) newPubEmailField) newEmailField
-- todo: use updateUserT when checkboxes are implemented
runJustT $ updateUser modifiedUser
let responseView = userSettingsResponseSubView moddedRole moddedPass moddedPubEmail moddedEmail mbMailChangeInfo
userSettingsControllerWithResponse responseView (userName userToEdit)
--- Generates the common components of a new mail token for the user, specifically,
--- the expiration time (Int seconds from epoch), the plain token with user ID prepended,
--- and the hashed token for database storage.
getNewMailToken :: User -> IO (Int, String, String)
getNewMailToken user = do
userToken <- randomPassword 32
userTokenHash <- getUserHash (fst $ splitPassField (userPassword user)) userToken
expiryTime <- liftIO (clockTimeToInt . (addMinutes confirmCodeDuration)) getClockTime
return (expiryTime, (show $ userKeyToInt $ userKey user) ++ "-" ++ userToken, userTokenHash)
--- Form input checks for user Settings
settingsChecks :: String -> String -> String -> String -> String -> URole -> URole -> [(IO InputValResult, [Int])]
settingsChecks oldEmail email pass1 pass2 pubEmail role oldRole =
( oldEmail ~= email =? [] ##
[ (validateEmail email True, [])] ) ++
[ (validatePasswords pass1 pass2 False, [])
[ (validateRole role oldRole, [])
, (validatePasswords pass1 pass2 False, [])
, (validatePublicEmail pubEmail, []) ]
---------------------------------------------------------------------------------
......@@ -544,7 +609,7 @@ confirmCodeDuration = 60
-- Email tokens
data MailToken = UserT { tExpiry :: Int, tCode :: String } -- the token is used to initially confim a user account
| PassT { tExpiry :: Int, tCode :: String } -- the token is used to confirm a password reset
| MailT { tExpiry :: Int, tCode :: String, mtEmail :: String } -- the token is used to confirm a changed mail address
| MailT { tExpiry :: Int, tCode :: String, tEmail :: String } -- the token is used to confirm a changed mail address
deriving (Eq,Show,Read)
--- Searches the database for a user who has a specified email token.
......
......@@ -30,8 +30,6 @@ userProfileEditAllowed userToEdit sinfo = return $
where
loggedInUserMayEdit login
| userName userToEdit == ldName login = AccessGranted -- authenticated users can always edit their own account
| readUserRole (userRole userToEdit) < NONE =
AccessDenied "This user account cannot be edited." -- DELETED accounts cannot be edited. Use the CRUD user editor for that.
| ldRole login >= ADMIN = AccessGranted -- in any other case, at least admins can edit the profile
| otherwise = AccessDenied genericDenied -- otherwise, access is denied
......
......@@ -22,11 +22,10 @@ import Maybe
--- The role / permission level of a user
--- It allows to compare permission level easily, e.g. USER < ADMIN evals to TRUE
data URole = GUEST -- non-persistent, assumed when no user is logged in
| DELETED -- 'deleted', disfunct user entry with blanked fields
| NONE -- registered but not activated user account
| NONE -- registered but not yet activated user account
| USER -- standard user with no special rights
| TRUSTED -- user who has been marked trusted by an admin, can ul to public pkgindex
| ADMIN -- has complete access to all functionality in the system
| TRUSTED -- user who has been marked trusted by an admin, uploaded version are publicly visible
| ADMIN -- has complete access to all functionality in the system, including DB maintenenance
deriving (Ord, Eq, Show, Read)
--- Read a user role string (from the DB) to URole form.
......
......@@ -3,8 +3,8 @@
--------------------------------------------------------------------------
module View.Shared
( setAttrs, alert, redirectHandler, passwordR, textfieldR, emailfield,
emailfieldR, userNameField, yesNoForm, dlisth, headedTable4)
( setAttrs, alert, prependAlert, redirectHandler, passwordR, textfieldR, emailfield,
emailfieldR, userNameField, yesNoForm, dlisth, headedTable4, confirmCodeForm)
where
import HTML.Styles.Bootstrap3
......@@ -25,11 +25,22 @@ setAttrs (HtmlEvent hexp handler) attrs =
setAttrs (HtmlCRef hexp cref) attrs =
HtmlCRef (setAttrs hexp attrs) cref
-- Displays a bootstrap alert
--- Displays a bootstrap alert
--- @param alertclass - a string of css class(es) to use on the alert. See Bootstrap4 docs.
--- @param contents - a list of HtmlExp to display inside of the alert element.
alert :: String -> [HtmlExp] -> HtmlExp
alert alertclass contents =
blockstyle ("alert "++alertclass) contents `addAttr` ("role","alert")
--- Prepend an alert to a controller (i.e. to the top of the page).
--- Usage e.g. defaultController >>= prependAlert "alert-success" [htxt "Success"] >>= getForm
--- @param alertclass - a string of css class(es) to use on the alert. See Bootstrap4 docs.
--- @param alertcontents - a list of HtmlExp to display inside of the alert element.
--- @param controllercontents - a ViewBlock supplied by a controller
prependAlert :: String -> [HtmlExp] -> [HtmlExp] -> IO [HtmlExp]
prependAlert alertclass alertcontents controllercontents =
return (alert alertclass alertcontents : controllercontents)
--- A simple HtmlHandler that redirects the user to another URL
--- TODO: implement this using HTTP 302, it might get around the blank page that is intermittently displayed
redirectHandler :: String -> HtmlHandler
......@@ -81,8 +92,21 @@ headedTable4 tclasses headclasses headColSpecs rows =
headerRow spec = HtmlStruct "tr" [] (map (\(attrs,exps) -> HtmlStruct "th" attrs exps) spec)
bodyRows = map (\row->HtmlStruct "tr" [] (map (\item -> HtmlStruct "td" [] item) row))
--- Form component for inputting a confirmation code. Only use one instance per page.
confirmCodeForm :: CgiRef -> HtmlHandler -> String -> HtmlExp
confirmCodeForm inputRef submitHandler text =
blockstyle "form-group text-left mx-auto" [
HtmlStruct "label" [("class","my-1"), ("for","cCodeInput")] [htxt "Confirmation Code:"],
blockstyle "input-group" [
textfield inputRef text `addAttrs` [("id","cCodeInput"), ("class", "form-control")],
blockstyle "input-group-append" [
primButton "Submit" submitHandler `setAttrs` [("class","btn btn-primary ml-2")]
]
]
] `addAttr` ("style","max-width:410px")
------------------------------------------------------------------------------
-- Forms:
-- Forms:
--- Show a form for a user choice between Yes or No (a button for each).
--- Yes is the default, highlighted choice.
......
......@@ -2,7 +2,8 @@ module View.User
( wUser, tuple2User, user2Tuple, wUserType, blankUserView, createUserView
, editUserView, showUserView, listUserView, signupForm, signupSuccessForm
, activatedAccountForm, yesNoForm, passResetRequestView, passResetRequestSuccessView
, passResetView, userProfileView, userSettingsView, publicUserListView) where
, passResetView, userProfileView, userSettingsView, userSettingsResponseSubView
, publicUserListView) where
import WUI
import HTML.Base
......@@ -66,9 +67,8 @@ signupSuccessForm uname email validMins leakedConfirmCode submitHandler =
htxt "In order to use your account, click the link in the confirmation email that has been sent to ", strong [htxt email], htxt ",", breakline,
htxt "or copy the code to the field below and click Submit. ", breakline,
htxt "The confirmation code is valid for ", htxt (show validMins), htxt " minutes. "],
spTable [[[htxt "Confirmation code:"], [textfield cCodeRef leakedConfirmCode `addAttr` ("size", "40")]]],
hrule,
primButton "Submit" (submitHandler cCodeRef)]
hrule `addAttr` ("class","my-2"),
confirmCodeForm cCodeRef (submitHandler cCodeRef) leakedConfirmCode]
where
cCodeRef free
......@@ -108,9 +108,8 @@ passResetRequestSuccessView validMins email leakedConfirmCode submitHandler =
strong [htxt email], htxt ",", breakline,
htxt "or copy the code to the field below and click Submit. ", breakline,
htxt "The confirmation code is valid for ", htxt (show validMins), htxt " minutes. "],
spTable [[[htxt "Confirmation code:"], [textfield cCodeRef leakedConfirmCode `addAttr` ("size", "40")]]],
hrule,
primButton "Submit" (submitHandler cCodeRef)]
hrule `addAttr` ("class","my-2"),
confirmCodeForm cCodeRef (submitHandler cCodeRef) leakedConfirmCode]
where
cCodeRef free
......@@ -128,12 +127,17 @@ passResetView uname submitHandler =
where
pfPass1, pfPass2 free
userProfileView :: User -> [(String, String, String, [String])] -> [HtmlExp]
userProfileView u pkginfos = [
userProfileView :: UserSessionInfo -> User -> [(String, String, String, [String])] -> [HtmlExp]
userProfileView sinfo u pkginfos = [
blockstyle "container" [
h4 [center [htxt ("User: " ++ userName u)]],
blockstyle "card card-light shadow" [
blockstyle "card-header text-center" [htxt "General information"],
blockstyle "card-header d-flex p-1 align-items-center justify-content-between" (
(isAdmin sinfo =? [href "#" [htxt "Edit user"] `addClass` "btn invisible"] ## []) ++
[textstyle "text-center flex-fill my-2" "General information"] ++
(isAdmin sinfo =? [href ("?User/" ++ string2urlencoded (userName u) ++ "/settings")
[htxt "Edit user"] `addClass` "btn btn-primary"] ## [])
),
blockstyle "card-body row justify-content-center" [
blockstyle "col-xs-12 col-md-8 col-lg-6" [
dlist ([([htxt "User name:"],[htxt (userName u)]),
......@@ -167,18 +171,25 @@ userProfileView u pkginfos = [
userSettingsView :: UserSessionInfo -> User ->
(CgiRef -> CgiRef -> CgiRef -> CgiRef -> Maybe CgiRef -> HtmlHandler) -> [HtmlExp]
userSettingsView sinfo userToEdit submitHandler = [
(CgiRef -> CgiRef -> CgiRef -> CgiRef -> Maybe CgiRef -> HtmlHandler) -> [HtmlExp] -> [HtmlExp]
userSettingsView sinfo userToEdit submitHandler responseSubView =
let
editingUserID = maybe (-1) ldKey (userLoginOfSession sinfo)
-- is this an admin editing someone else's account?
adminEdit = isAdmin sinfo && editingUserID /= (userKeyToInt $ userKey userToEdit)
in [
blockstyle "container" [
h4 [center [htxt ("Edit profile: " ++ userName userToEdit)]],
blockstyle "card card-light shadow" [
blockstyle "card-header text-center" [htxt "Login credentials and User information"],
blockstyle "card-body" (
responseSubView ++
inputGrid [
([htxt "User name:"], [htxt (userName userToEdit)], isAdmin sinfo =? [roleDropDown] ## []),
([label "emailfield" [htxt "Email address:"]]
,[emailfieldR tfMail (userEmail userToEdit) `addAttrs` [("class","form-control"), ("id","emailfield")]]
,[par [htxt "If you change your email address, a confirmation code will be sent to the new address."]
,[par (adminEdit =? [htxt "The email address will be changed immediately (no verification)."] ##
[htxt "If you change your email address, a confirmation code will be sent to the new address."])
`addClass` infoBoxClass]),
([label "passfield1" [htxt "New password:"]]
,[password pfPass1 `addAttrs` [("class","form-control"), ("id","passfield1")]]
......@@ -190,10 +201,11 @@ userSettingsView sinfo userToEdit submitHandler = [
([label "pubemailfield" [htxt "Public email address:"]]
,[emailfield tfMail2 displayPubEmail `addAttrs` [("class","form-control"), ("id","pubemailfield")]]
,[par [htxt "Public contact email (optional)."] `addClass` infoBoxClass])
] ++
[
] ++ [
hrule,
primButton "Submit" (submitHandler tfMail pfPass1 pfPass2 tfMail2 (isAdmin sinfo =? Just selRole ## Nothing))
blockstyle "d-flex justify-content-center" [
primButton "Submit" (submitHandler tfMail pfPass1 pfPass2 tfMail2 (isAdmin sinfo =? Just selRole ## Nothing))
]
]
)
]
......@@ -220,10 +232,36 @@ userSettingsView sinfo userToEdit submitHandler = [
],
blockstyle "col-5 col-md-3 px-0" [
selectionInitial selRole roleList roleIdx
`addAttrs` [("class","form-control"), ("id","roleselect")]
`addAttrs` [("class","custom-select"), ("id","roleselect")]
]]
tfMail, pfPass1, pfPass2, tfMail2, selRole free
--- The upper section of the user profile settings page after changes have been submitted
userSettingsResponseSubView :: Bool -> Bool -> Bool -> Bool ->
Maybe (String, String, Int, String, (CgiRef -> HtmlHandler)) -> [HtmlExp]
userSettingsResponseSubView roleChanged passChanged pubMailChanged mailByAdminChanged mbMailChanged =
null alerts =? [] ##
[
blockstyle "row align-items-center" (map makeCol alerts)
]
where
alerts = (roleChanged =? [roleAlert] ## []) ++ (mailByAdminChanged =? [mailAdminAlert] ## []) ++ mailAlert ++
(passChanged =? [pwAlert] ## []) ++ (pubMailChanged =? [pubMailAlert] ## [])
makeCol exps = blockstyle "col-12" [alert "alert-success text-center p-2 mb-2 border border-dark" exps]
mailAlert = maybe [] (\(oldmail, newmail, validMins, leakedCode, ccHandler) ->
let cCodeRef free in [[
par [
htxt "Your email address will be changed to ", strong [htxt newmail], htxt " after verification.", breakline,
htxt "To verify the address, click the link in the email that has been sent to ", strong [htxt oldmail], htxt ", or copy the confirmation code to the field below and click Submit.", breakline, breakline,
htxt "The confirmation code is valid for ", htxt (show validMins), htxt " minutes."
],
hrule `addAttr` ("class","my-2"),
confirmCodeForm cCodeRef (ccHandler cCodeRef) leakedCode ]]
) mbMailChanged
mailAdminAlert = [htxt "The account's email has been changed."]
pwAlert = [htxt "Your password has been changed."]
roleAlert = [htxt "Account level has been changed."]
pubMailAlert = [htxt "Your public email address has been changed."]
--- Supplies a list view for a given list of User entities.
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment