fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(users): fix #112 working now

Browse Source
This commit is contained in:
Steffen Jost 2023-07-26 08:55:12 +00:00
parent 35096ace01
commit 88bf21c9c5
2 changed files with 29 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Foundation/Navigation.hs
View File

@ -442,6 +442,14 @@ defNavLink navLabel navRoute = NavLink {..}
navQuick' = mempty navQuick' = mempty
navForceActive = False navForceActive = False
defNavLinkModal :: (RenderMessage UniWorX msg, HasRoute UniWorX route) => msg -> route -> NavLink
defNavLinkModal navLabel navRoute = NavLink {..}
where
navAccess' = NavAccessTrue
navType = NavTypeLink { navModal = True}
navQuick' = mempty
navForceActive = False
navBaseRoute :: NavLink -> Route UniWorX navBaseRoute :: NavLink -> Route UniWorX
navBaseRoute NavLink{navRoute} = urlRoute navRoute navBaseRoute NavLink{navRoute} = urlRoute navRoute
@ -1196,8 +1204,9 @@ pageActions (AdminUserR cID) = return
{ navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID { navLink = defNavLink MsgMenuUserEdit $ ForProfileR cID
, navChildren = [] , navChildren = []
} }
, NavPageActionSecondary , NavPageActionPrimary
{ navLink = (defNavLink MsgUserHijack $ AdminHijackUserR cID){ navType = NavTypeLink { navModal = True }} { navLink = defNavLinkModal MsgUserHijack $ AdminHijackUserR cID
, navChildren = []
} }
] ]
pageActions InfoR = return pageActions InfoR = return

31
src/Handler/Users.hs
View File

@ -413,22 +413,27 @@ hijackUser uid = do
User{userIdent} <- runDB $ get404 uid User{userIdent} <- runDB $ get404 uid
setCredsRedirect $ Creds apDummy (CI.original userIdent) [] setCredsRedirect $ Creds apDummy (CI.original userIdent) []
getAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent getAdminHijackUserR :: CryptoUUIDUser -> Handler Html
getAdminHijackUserR = postAdminHijackUserR getAdminHijackUserR cID = do
(hijackWgt, hijackEnctype) <- generateFormPost hijackUserForm
let hjForm = wrapForm hijackWgt def{ formSubmit = FormNoSubmit, formEncoding = hijackEnctype, formAction = Just . SomeRoute $ AdminHijackUserR cID }
uid :: UserId <- decrypt cID
usr <- runDB $ get404 uid
siteLayoutMsg MsgUserHijack $ do
setTitleI MsgUserHijack
[whamlet|
^{userWidget usr}
^{hjForm}
|]
postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent postAdminHijackUserR :: CryptoUUIDUser -> Handler TypedContent
postAdminHijackUserR cID = do postAdminHijackUserR cID = do
((hijackRes, _), _) <- runFormPost hijackUserForm
$logWarnS "HIJACK" $ "Form Result is: " <> tshow hijackRes
uid <- decrypt cID uid <- decrypt cID
((hijackRes, hijackWgt), hijackEnctype) <- runFormPost hijackUserForm ret <- formResultMaybe hijackRes $ \() -> Just <$> hijackUser uid
case hijackRes of maybe (redirect UsersR) return ret
(FormSuccess ()) -> hijackUser uid
_ -> selectRep $ do
provideRep . siteLayoutMsg MsgUserHijack $ do
setTitleI MsgUserHijack
let hjForm = wrapForm hijackWgt def{ formEncoding = hijackEnctype }
[whamlet|
^{hjForm}
|]
data ButtonAuthMode = BtnAuthLDAP | BtnAuthPWHash | BtnPasswordReset data ButtonAuthMode = BtnAuthLDAP | BtnAuthPWHash | BtnPasswordReset
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)