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

chore(admin): added oauth2 handling widget

Browse Source
This commit is contained in:
David Mosbach 2023-12-18 02:58:14 +00:00
parent ce8aa849f8
commit a67697d159
2 changed files with 44 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/Handler/Admin/OAuth2.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2023 Sarah Vaupel <sarah.vaupel@uniworx.de> -- SPDX-FileCopyrightText: 2023 Sarah Vaupel <sarah.vaupel@uniworx.de>,David Mosbach <david.mosbach@uniworx.de>
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
@ -9,39 +9,45 @@ module Handler.Admin.OAuth2
import Import import Import
-- import qualified Data.CaseInsensitive as CI -- import qualified Data.CaseInsensitive as CI
-- import qualified Data.Text as Text import Data.Text()
-- import Handler.Utils --import qualified Data.Text as Text
--import qualified Data.Text.Encoding as Text
--import Foundation.Yesod.Auth (CampusUserConversionException())
import Handler.Utils
getAdminOAuth2R, postAdminOAuth2R :: Handler Html getAdminOAuth2R, postAdminOAuth2R :: Handler Html
getAdminOAuth2R = postAdminOAuth2R getAdminOAuth2R = postAdminOAuth2R
postAdminOAuth2R = postAdminOAuth2R = do
((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminOAuth2Lookup"::Text) $ \html -> ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminOAuth2Lookup"::Text) $ \html ->
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
let procFormPerson :: Text -> Handler (Maybe ()) let procFormPerson :: Text -> Handler (Maybe Text)
procFormPerson lid = error "TODO" procFormPerson lid = return . Just $ "Mock reply for id " <> lid
-- TODO implement oauth query
mOAuth2Data <- formResultMaybe presult procFormPerson
((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminOAuth2Upsert"::Text) $ \html -> --((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminOAuth2Upsert"::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 (Either CampusUserConversionException (Entity User)))
procFormUpsert lid = pure <$> runDB (try $ ldapLookupAndUpsert lid) --let procFormUpsert :: Text -> Handler (Maybe (Either CampusUserConversionException (Entity User)))
mbLdapUpsert <- formResultMaybe uresult procFormUpsert -- procFormUpsert lid = pure <$> runDB (try $ ldapLookupAndUpsert lid)
--mbLdapUpsert <- formResultMaybe uresult procFormUpsert
actionUrl <- fromMaybe AdminLdapR <$> getCurrentRoute actionUrl <- fromMaybe AdminOAuth2R <$> getCurrentRoute
siteLayoutMsg MsgMenuLdap $ do siteLayoutMsg MsgMenuOAuth2 $ do
setTitleI MsgMenuLdap setTitleI MsgMenuOAuth2
let personForm = wrapForm pwidget def let personForm = wrapForm pwidget def
{ formAction = Just $ SomeRoute actionUrl { formAction = Just $ SomeRoute actionUrl
, formEncoding = penctype , formEncoding = penctype
} }
upsertForm = wrapForm uwidget def --upsertForm = wrapForm uwidget def
{ formAction = Just $ SomeRoute actionUrl -- { formAction = Just $ SomeRoute actionUrl
, formEncoding = uenctype -- , formEncoding = uenctype
} -- }
presentUtf8 lv = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> lv) --presentUtf8 lv = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> lv)
presentLatin1 lv = Text.intercalate ", " ( Text.decodeLatin1 <$> lv) --presentLatin1 lv = Text.intercalate ", " ( Text.decodeLatin1 <$> lv)
-- TODO: use i18nWidgetFile instead if this is to become permanent -- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "oauth2") $(widgetFile "oauth2")

18
templates/oauth2.hamlet Normal file
View File

@ -0,0 +1,18 @@
$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>
#{show answers}
<dd>