Commit b9f4f6cc authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

user data. change info

parent 8240a4fe
......@@ -130,7 +130,11 @@ ordering b user Username = orderBy [(chooseAscension b) (user ^. UsersUsername
ordering b user Registered = orderBy [(chooseAscension b) (user ^. UsersJoinTime)]
ordering b user PostCount = orderBy [(chooseAscension b) (user ^. UsersRepliesPosted)]
chooseAscension :: (Esqueleto query expr backend, PersistField a) => Bool -> expr (Value a) -> expr OrderBy
chooseAscension ::
(Esqueleto query expr backend, PersistField a)
=> Bool
-> expr (Value a)
-> expr OrderBy
chooseAscension True e = asc e
chooseAscension False e = desc e
......@@ -152,3 +156,17 @@ selectAllUsers ascending = do
where_ (user ^. UsersGroupId ==. group ^. GroupsId)
orderBy [op (user ^. UsersUsername)]
return (group ^. GroupsGrouping, user)
updateUserEmail ::
MonadIO m => Key Users -> Text -> ReaderT SqlBackend m ()
updateUserEmail uid email = do
update $ \user -> do
set user [UsersEmail =. val email]
where_ (user ^. UsersId ==. val uid)
updateUserPassword ::
MonadIO m => Key Users -> Maybe Text -> ReaderT SqlBackend m ()
updateUserPassword uid password = do
update $ \user -> do
set user [UsersPassword =. val password]
where_ (user ^. UsersId ==. val uid)
......@@ -94,8 +94,59 @@ getAllUsers ascending = do
groupandusers <- liftHandler $ runDB $ selectAllUsers ascending
return $ map (\(Value a, x) -> (a, x)) groupandusers
searchUserByConditions ::
( BackendCompatible SqlBackend (YesodPersistBackend (HandlerSite m))
, PersistQueryRead (YesodPersistBackend (HandlerSite m))
, PersistUniqueRead (YesodPersistBackend (HandlerSite m))
, YesodPersist (HandlerSite m)
, MonadHandler m
)
=> Maybe Text
-> Maybe (Key Groups)
-> SortBy
-> Bool
-> m [(Grouping, Entity Users)]
searchUserByConditions username groupid orderby ascending = do
groupandusers <-
liftHandler $
runDB $ selectUsersBySearchConditions username groupid orderby ascending
return $ map (\(Value a, x) -> (a, x)) groupandusers
selfUpdateInfoByUser ::
( YesodPersistBackend (HandlerSite m) ~ SqlBackend
, MonadHandler m
, YesodPersist (HandlerSite m)
)
=> Key Users
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> m ()
selfUpdateInfoByUser userid userpass oldpass newpass email = do
case (userpass, oldpass, newpass) of
(Nothing, _, _) -> error "Your profile is broken. Ask admin to fix this."
(Just _, Nothing, Nothing) ->
liftHandler $ runDB $ updateUserEmail userid email
(Just _, Nothing, Just _) ->
invalidArgs
["You cannot update your password without providing your old password."]
(Just _, Just _, Nothing) ->
invalidArgs ["You cannot use an empty password."]
(Just up, Just op, Just np) -> do
if verifyPassword (encodeUtf8 op) (encodeUtf8 up)
then do
newpassword <- liftIO $ makePassword (encodeUtf8 np) 17
liftHandler $
runDB $ do
updateUserEmail userid email
updateUserPassword userid (Just $ decodeUtf8 newpassword)
else invalidArgs ["Your password don't match with the old one."]
updateInfoByAdmin userid Nothing email = liftHandler $ runDB $ updateUserEmail userid email
updateInfoByAdmin userid (Just np) email =
liftHandler $
runDB $ do
newpassword <- liftIO $ makePassword (encodeUtf8 np) 17
updateUserEmail userid email
updateUserPassword userid (Just $ decodeUtf8 newpassword)
......@@ -39,6 +39,7 @@ mkYesodData
/register RegisterR GET POST
/profile ProfileR GET
/user/#Int64 UserR GET
/user/#Int64/edit UserEditR GET POST
/admin AdmR GET
/admin/category AdmCategoryR GET POST
/admin/forum AdmForumR GET POST
......@@ -213,12 +214,13 @@ profileLayout uid name group user widget = do
withUrlRenderer $(hamletFile "templates/wrapper.hamlet")
allowedToEditProfile uid group profileid =
profileid == uid || group == Administrator || group == Moderator
profileid == uid || group == Administrator
profileRouteToText :: Route App -> Text
profileRouteToText ProfileR = "Common Information"
profileRouteToText (UserR _) = "Common Information of user"
profileRouteToText _ = "Not Needed"
profileRouteToText ProfileR = "Common Information"
profileRouteToText (UserR _) = "Common Information"
profileRouteToText (UserEditR _) = "Edit Common Information"
profileRouteToText _ = "Not Needed"
data SortBy
= Username
......
......@@ -52,6 +52,30 @@ searchUserForm groups = renderDivs $
alist :: [(Text, Bool)]
alist = [("Ascending", True), ("Descending", False)]
data EditByUserForm = EditByUserForm
{ editByUserFormOldPass :: Maybe Text
, editByUserFormNewPass :: Maybe Text
, editByUserFormEmail :: Text
}
editByUserForm :: Text -> Form EditByUserForm
editByUserForm email = renderDivs $
EditByUserForm
<$> aopt passwordField "Old Password" Nothing
<*> aopt passwordField "New Password" Nothing
<*> areq emailField "Email" (Just email)
data EditByAdminForm = EditByAdminForm
{ editByAdminFormNewPass :: Maybe Text
, editByAdminFormEmail :: Text
}
editByAdminForm :: Text -> Form EditByAdminForm
editByAdminForm email = renderDivs $
EditByAdminForm
<$> aopt passwordField "New Password" Nothing
<*> areq emailField "Email" (Just email)
getRegisterR :: Handler Html
getRegisterR = do
isNotLoggedIn
......@@ -118,3 +142,51 @@ postUserListR = do
setTitle "User List"
$(widgetFile "user-list")
_ -> error ""
allowedToActuallyEdit :: Int64 -> HandlerFor App (Key Users, Text, Grouping)
allowedToActuallyEdit pid = do
(uid, name, group) <- allowedToPost
if uid == toSqlKey pid || group == Administrator
then return (uid, name, group)
else permissionDenied "You're not allowed to edit user's information."
generateFormEdit :: Grouping -> Text -> Handler (Widget, Enctype)
generateFormEdit Administrator = generateFormPost . editByAdminForm
generateFormEdit _ = generateFormPost . editByUserForm
getUserEditR :: Int64 -> Handler Html
getUserEditR userid = do
(uid, name, group) <- allowedToActuallyEdit userid
user'@(Entity uid' user) <- getUserById $ toSqlKey userid
(wid, enct) <- generateFormEdit group (usersEmail user)
profileLayout uid name group user' $(widgetFile "profile-info-edit")
postUserEditR :: Int64 -> Handler Html
postUserEditR userid = do
(uid, name, group) <- allowedToActuallyEdit userid
user'@(Entity uid' user) <- getUserById $ toSqlKey userid
case group of
Administrator -> do
((res, wid), enct) <- runFormPost $ editByAdminForm (usersEmail user)
case res of
FormSuccess r -> do
let (newpass, email) =
(editByAdminFormNewPass r, editByAdminFormEmail r)
updateInfoByAdmin uid' newpass email
redirect $ UserR userid
_ -> do
profileLayout uid name group user' $ do
[whamlet|Please fill the input correctly|]
_ -> do
((res, wid), enct) <- runFormPost $ editByUserForm (usersEmail user)
case res of
FormSuccess r -> do
let (oldpass, newpass, email) =
( editByUserFormOldPass r
, editByUserFormNewPass r
, editByUserFormEmail r)
selfUpdateInfoByUser uid (usersPassword user) oldpass newpass email
redirect $ UserR userid
_ -> do
profileLayout uid name group user' $ do
[whamlet|Please fill the input correctly|]
......@@ -4,7 +4,7 @@
<li .navigation-item>
<a .navigation-link [email protected]{HomeR}> Home
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<a .navigation-link [email protected]{AdmR} title="Administration"> Administration
<li .navigation-item>
<a .navigation-link [email protected]{UserListR} title="Users"> Users
<ul .navigation-list.float-right>
......@@ -16,7 +16,7 @@
<h4>
<a [email protected]{HomeR}> Index
<span> »
<a [email protected]{AdmR}> Management
<a [email protected]{AdmR}> Administration
$maybe route <- mcurrentroute
<span> »
<a [email protected]{route}> #{adminRouteToText route}
......
<h4> Update Information
<form [email protected]{UserEditR userid} method=post enctype=#{enct}>
^{wid}
<input .button-primary name=update value=update type=submit>
......@@ -6,12 +6,12 @@
$case group
$of Administrator
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<a .navigation-link [email protected]{AdmR} title="Administration"> Administration
<li .navigation-item>
<a .navigation-link [email protected]{UserListR} title="Users"> Users
$of Moderator
<li .navigation-item>
<a .navigation-link [email protected]{AdmR} title="Management"> Management
<a .navigation-link [email protected]{AdmR} title="Administration"> Administration
<li .navigation-item>
<a .navigation-link [email protected]{UserListR} title="Users"> Users
$of Member
......@@ -43,15 +43,12 @@
<tr>
<thead> <h5> Profile Menu
<tr>
<td> <a href="#"> Edit Essentials
$case group
$of Administrator
<tr>
<td> <a href="#"> Administration
$of Moderator
<tr>
<td> <a href="#"> Administration
$of _
<td> <a [email protected]{UserEditR $ fromSqlKey $ entityKey user}> Edit Essentials
$case group
$of Administrator
<tr>
<td> <a href="#"> Administration
$of _
<.column.column-75.column-offset-5>
$maybe message <- mmessage
#{message}
......
Markdown is supported
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