chore(admin): merge external-user handlers (ldap, oauth2)
This commit is contained in:
parent
a2903da109
commit
96e3eb613d
@ -1,4 +1,4 @@
|
|||||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
# SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||||
#
|
#
|
||||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -141,8 +141,7 @@ MenuSap: SAP Schnittstelle
|
|||||||
|
|
||||||
MenuAvs: AVS Schnittstelle
|
MenuAvs: AVS Schnittstelle
|
||||||
MenuAvsSynchError: AVS Problemübersicht
|
MenuAvsSynchError: AVS Problemübersicht
|
||||||
MenuLdap !ident-ok: LDAP
|
MenuExternalUser: Externe Benutzer
|
||||||
MenuOAuth2 !ident-ok: OAuth2
|
|
||||||
MenuApc: Druckerei
|
MenuApc: Druckerei
|
||||||
MenuPrintSend: Manueller Briefversand
|
MenuPrintSend: Manueller Briefversand
|
||||||
MenuPrintDownload: Brief herunterladen
|
MenuPrintDownload: Brief herunterladen
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
# SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||||
#
|
#
|
||||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -141,8 +141,7 @@ MenuSap: SAP Interface
|
|||||||
|
|
||||||
MenuAvs: AVS Interface
|
MenuAvs: AVS Interface
|
||||||
MenuAvsSynchError: AVS Problem Overview
|
MenuAvsSynchError: AVS Problem Overview
|
||||||
MenuLdap: LDAP
|
MenuExternalUser: External users
|
||||||
MenuOAuth2: OAuth2
|
|
||||||
MenuApc: Printing
|
MenuApc: Printing
|
||||||
MenuPrintSend: Send Letter
|
MenuPrintSend: Send Letter
|
||||||
MenuPrintDownload: Download Letter
|
MenuPrintDownload: Download Letter
|
||||||
|
|||||||
35
routes
35
routes
@ -1,4 +1,4 @@
|
|||||||
-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -30,8 +30,8 @@
|
|||||||
-- !capacity -- course this route is associated with has at least one unit of participant capacity
|
-- !capacity -- course this route is associated with has at least one unit of participant capacity
|
||||||
-- !empty -- course this route is associated with has no participants whatsoever
|
-- !empty -- course this route is associated with has no participants whatsoever
|
||||||
--
|
--
|
||||||
-- !is-ldap -- user has authentication mode set to LDAP
|
-- !is-external -- user can login using external sources
|
||||||
-- !is-pw-hash -- user has authentication mode set to PWHash
|
-- !is-internal -- user can login using internal credentials
|
||||||
--
|
--
|
||||||
-- !materials -- only if course allows all materials to be free (no meaning outside of courses)
|
-- !materials -- only if course allows all materials to be free (no meaning outside of courses)
|
||||||
-- !time -- access depends on time somehow
|
-- !time -- access depends on time somehow
|
||||||
@ -59,24 +59,23 @@
|
|||||||
/users/#CryptoUUIDUser/password UserPasswordR GET POST !selfANDis-pw-hash
|
/users/#CryptoUUIDUser/password UserPasswordR GET POST !selfANDis-pw-hash
|
||||||
!/users/functionary-invite/new AdminNewFunctionaryInviteR GET POST
|
!/users/functionary-invite/new AdminNewFunctionaryInviteR GET POST
|
||||||
!/users/functionary-invite AdminFunctionaryInviteR GET POST
|
!/users/functionary-invite AdminFunctionaryInviteR GET POST
|
||||||
!/users/add AdminUserAddR GET POST
|
!/users/add AdminUserAddR GET POST
|
||||||
/admin AdminR GET
|
/admin AdminR GET
|
||||||
/admin/test AdminTestR GET POST
|
/admin/test AdminTestR GET POST
|
||||||
/admin/test/pdf AdminTestPdfR GET
|
/admin/test/pdf AdminTestPdfR GET
|
||||||
/admin/errMsg AdminErrMsgR GET POST
|
/admin/errMsg AdminErrMsgR GET POST
|
||||||
/admin/tokens AdminTokensR GET POST
|
/admin/tokens AdminTokensR GET POST
|
||||||
/admin/crontab AdminCrontabR GET
|
/admin/crontab AdminCrontabR GET
|
||||||
/admin/crontab/jobs AdminJobsR GET POST
|
/admin/crontab/jobs AdminJobsR GET POST
|
||||||
/admin/avs AdminAvsR GET POST
|
/admin/avs AdminAvsR GET POST
|
||||||
/admin/avs/#CryptoUUIDUser AdminAvsUserR GET
|
/admin/avs/#CryptoUUIDUser AdminAvsUserR GET
|
||||||
/admin/ldap AdminLdapR GET POST
|
/admin/external-user AdminExternalUserR GET POST
|
||||||
/admin/oauth2 AdminOAuth2R GET POST
|
/admin/problems AdminProblemsR GET
|
||||||
/admin/problems AdminProblemsR GET
|
|
||||||
/admin/problems/no-contact ProblemUnreachableR GET
|
/admin/problems/no-contact ProblemUnreachableR GET
|
||||||
/admin/problems/no-avs-id ProblemWithoutAvsId GET
|
/admin/problems/no-avs-id ProblemWithoutAvsId GET
|
||||||
/admin/problems/r-without-f ProblemFbutNoR GET
|
/admin/problems/r-without-f ProblemFbutNoR GET
|
||||||
/admin/problems/avs ProblemAvsSynchR GET POST
|
/admin/problems/avs ProblemAvsSynchR GET POST
|
||||||
/admin/problems/avs/errors ProblemAvsErrorR GET
|
/admin/problems/avs/errors ProblemAvsErrorR GET
|
||||||
|
|
||||||
/print PrintCenterR GET POST !system-printer
|
/print PrintCenterR GET POST !system-printer
|
||||||
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer
|
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer
|
||||||
|
|||||||
@ -115,8 +115,7 @@ breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just
|
|||||||
breadcrumb AdminJobsR = i18nCrumb MsgBreadcrumbAdminJobs $ Just AdminCrontabR
|
breadcrumb AdminJobsR = i18nCrumb MsgBreadcrumbAdminJobs $ Just AdminCrontabR
|
||||||
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
|
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
|
||||||
breadcrumb AdminAvsUserR{} = i18nCrumb MsgAvsPersonInfo $ Just AdminAvsR
|
breadcrumb AdminAvsUserR{} = i18nCrumb MsgAvsPersonInfo $ Just AdminAvsR
|
||||||
breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR
|
breadcrumb AdminExternalUserR = i18nCrumb MsgMenuExternalUser $ Just AdminR
|
||||||
breadcrumb AdminOAuth2R = i18nCrumb MsgMenuOAuth2 $ Just AdminR
|
|
||||||
breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR
|
breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR
|
||||||
breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR
|
breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR
|
||||||
breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminProblemsR
|
breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminProblemsR
|
||||||
@ -855,16 +854,8 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
|
|||||||
, navForceActive = False
|
, navForceActive = False
|
||||||
}
|
}
|
||||||
, NavLink
|
, NavLink
|
||||||
{ navLabel = MsgMenuLdap
|
{ navLabel = MsgMenuExternalUser
|
||||||
, navRoute = AdminLdapR
|
, navRoute = AdminExternalUserR
|
||||||
, navAccess' = NavAccessTrue
|
|
||||||
, navType = NavTypeLink { navModal = False }
|
|
||||||
, navQuick' = mempty
|
|
||||||
, navForceActive = False
|
|
||||||
}
|
|
||||||
, NavLink
|
|
||||||
{ navLabel = MsgMenuOAuth2
|
|
||||||
, navRoute = AdminOAuth2R
|
|
||||||
, navAccess' = NavAccessTrue
|
, navAccess' = NavAccessTrue
|
||||||
, navType = NavTypeLink { navModal = False }
|
, navType = NavTypeLink { navModal = False }
|
||||||
, navQuick' = mempty
|
, navQuick' = mempty
|
||||||
|
|||||||
@ -1,4 +1,4 @@
|
|||||||
-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
|
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
@ -30,8 +30,7 @@ import Handler.Admin.ErrorMessage as Handler.Admin
|
|||||||
import Handler.Admin.Tokens as Handler.Admin
|
import Handler.Admin.Tokens as Handler.Admin
|
||||||
import Handler.Admin.Crontab as Handler.Admin
|
import Handler.Admin.Crontab as Handler.Admin
|
||||||
import Handler.Admin.Avs as Handler.Admin
|
import Handler.Admin.Avs as Handler.Admin
|
||||||
import Handler.Admin.Ldap as Handler.Admin
|
import Handler.Admin.ExternalUser as Handler.Admin
|
||||||
import Handler.Admin.OAuth2 as Handler.Admin
|
|
||||||
|
|
||||||
|
|
||||||
getAdminR :: Handler Html
|
getAdminR :: Handler Html
|
||||||
|
|||||||
@ -1,10 +1,10 @@
|
|||||||
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
|
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, David Mosbach <david.mosbach@uniworx.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
module Handler.Admin.Ldap
|
module Handler.Admin.ExternalUser
|
||||||
( getAdminLdapR
|
( getAdminExternalUserR
|
||||||
, postAdminLdapR
|
, postAdminExternalUserR
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -21,11 +21,10 @@ import qualified Data.Text.Encoding as Text
|
|||||||
import qualified Ldap.Client as Ldap
|
import qualified Ldap.Client as Ldap
|
||||||
|
|
||||||
|
|
||||||
-- TODO: used for every external source type => rename!
|
getAdminExternalUserR, postAdminExternalUserR :: Handler Html
|
||||||
getAdminLdapR, postAdminLdapR :: Handler Html
|
getAdminExternalUserR = postAdminExternalUserR
|
||||||
getAdminLdapR = postAdminLdapR
|
postAdminExternalUserR = do
|
||||||
postAdminLdapR = do
|
((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminExternalUserLookup"::Text) $ \html ->
|
||||||
((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminLdapLookup"::Text) $ \html ->
|
|
||||||
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
||||||
|
|
||||||
let
|
let
|
||||||
@ -52,7 +51,7 @@ postAdminLdapR = do
|
|||||||
mbData <- formResultMaybe presult procFormPerson
|
mbData <- formResultMaybe presult procFormPerson
|
||||||
|
|
||||||
|
|
||||||
((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminLdapUpsert"::Text) $ \html ->
|
((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminExternalUserUpsert"::Text) $ \html ->
|
||||||
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
||||||
let procFormUpsert :: Text -> Handler (Maybe (Entity User))
|
let procFormUpsert :: Text -> Handler (Maybe (Entity User))
|
||||||
procFormUpsert lid = pure <$> runDB (userLookupAndUpsert lid UpsertUserGuessUser)
|
procFormUpsert lid = pure <$> runDB (userLookupAndUpsert lid UpsertUserGuessUser)
|
||||||
@ -60,9 +59,9 @@ postAdminLdapR = do
|
|||||||
mbUpsert <- formResultMaybe uresult procFormUpsert
|
mbUpsert <- formResultMaybe uresult procFormUpsert
|
||||||
|
|
||||||
|
|
||||||
actionUrl <- fromMaybe AdminLdapR <$> getCurrentRoute
|
actionUrl <- fromMaybe AdminExternalUserR <$> getCurrentRoute
|
||||||
siteLayoutMsg MsgMenuLdap $ do
|
siteLayoutMsg MsgMenuExternalUser $ do
|
||||||
setTitleI MsgMenuLdap
|
setTitleI MsgMenuExternalUser
|
||||||
let personForm = wrapForm pwidget def
|
let personForm = wrapForm pwidget def
|
||||||
{ formAction = Just $ SomeRoute actionUrl
|
{ formAction = Just $ SomeRoute actionUrl
|
||||||
, formEncoding = penctype
|
, formEncoding = penctype
|
||||||
@ -71,6 +70,4 @@ postAdminLdapR = do
|
|||||||
{ formAction = Just $ SomeRoute actionUrl
|
{ formAction = Just $ SomeRoute actionUrl
|
||||||
, formEncoding = uenctype
|
, formEncoding = uenctype
|
||||||
}
|
}
|
||||||
-- TODO: use i18nWidgetFile instead if this is to become permanent
|
$(widgetFile "admin/external-user")
|
||||||
$(widgetFile "ldap")
|
|
||||||
|
|
||||||
@ -1,59 +0,0 @@
|
|||||||
-- SPDX-FileCopyrightText: 2023-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>,David Mosbach <david.mosbach@uniworx.de>
|
|
||||||
--
|
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
||||||
|
|
||||||
module Handler.Admin.OAuth2
|
|
||||||
( getAdminOAuth2R
|
|
||||||
, postAdminOAuth2R
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Import
|
|
||||||
-- import qualified Data.CaseInsensitive as CI
|
|
||||||
import Data.Aeson.Encode.Pretty (encodePretty)
|
|
||||||
import qualified Data.Text.Lazy as T
|
|
||||||
import qualified Data.Text.Lazy.Encoding as T
|
|
||||||
--import qualified Data.Text.Encoding as Text
|
|
||||||
--import Foundation.Yesod.Auth (CampusUserConversionException())
|
|
||||||
import Handler.Utils
|
|
||||||
|
|
||||||
import Auth.OAuth2 (queryOAuth2User)
|
|
||||||
|
|
||||||
|
|
||||||
getAdminOAuth2R, postAdminOAuth2R :: Handler Html
|
|
||||||
getAdminOAuth2R = postAdminOAuth2R
|
|
||||||
postAdminOAuth2R = do
|
|
||||||
((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminOAuth2Lookup"::Text) $ \html ->
|
|
||||||
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
|
||||||
|
|
||||||
let procFormPerson :: Text -> Handler (Maybe T.Text)
|
|
||||||
procFormPerson lid = do --return . Just $ "Mock reply for id " <> lid
|
|
||||||
eUserData <- queryOAuth2User @Value lid
|
|
||||||
case eUserData of
|
|
||||||
Left e -> throwM e
|
|
||||||
Right userData -> return . Just . T.decodeUtf8 $ encodePretty userData
|
|
||||||
mOAuth2Data <- formResultMaybe presult procFormPerson
|
|
||||||
|
|
||||||
--((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminOAuth2Upsert"::Text) $ \html ->
|
|
||||||
-- flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
|
|
||||||
|
|
||||||
--let procFormUpsert :: Text -> Handler (Maybe (Either CampusUserConversionException (Entity User)))
|
|
||||||
-- procFormUpsert lid = pure <$> runDB (try $ ldapLookupAndUpsert lid)
|
|
||||||
--mbLdapUpsert <- formResultMaybe uresult procFormUpsert
|
|
||||||
|
|
||||||
|
|
||||||
actionUrl <- fromMaybe AdminOAuth2R <$> getCurrentRoute
|
|
||||||
siteLayoutMsg MsgMenuOAuth2 $ do
|
|
||||||
setTitleI MsgMenuOAuth2
|
|
||||||
let personForm = wrapForm pwidget def
|
|
||||||
{ formAction = Just $ SomeRoute actionUrl
|
|
||||||
, formEncoding = penctype
|
|
||||||
}
|
|
||||||
--upsertForm = wrapForm uwidget def
|
|
||||||
-- { formAction = Just $ SomeRoute actionUrl
|
|
||||||
-- , formEncoding = uenctype
|
|
||||||
-- }
|
|
||||||
--presentUtf8 lv = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> lv)
|
|
||||||
--presentLatin1 lv = Text.intercalate ", " ( Text.decodeLatin1 <$> lv)
|
|
||||||
|
|
||||||
-- TODO: use i18nWidgetFile instead if this is to become permanent
|
|
||||||
$(widgetFile "oauth2")
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
$newline never
|
|
||||||
|
|
||||||
$# SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@uniworx.de>
|
|
||||||
$#
|
|
||||||
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
|
||||||
|
|
||||||
<section>
|
|
||||||
<p>
|
|
||||||
OAuth2 User Search:
|
|
||||||
^{personForm}
|
|
||||||
$maybe answers <- mOAuth2Data
|
|
||||||
<h1>
|
|
||||||
Antwort: #
|
|
||||||
<dl .deflist>
|
|
||||||
<dt>
|
|
||||||
<pre>
|
|
||||||
#{answers}
|
|
||||||
<dd>
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user