From 5c4f742745546d50e0fc706b96d47f703af638a8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 13 Dec 2023 16:36:52 +0000 Subject: [PATCH 01/12] chore(admin): add basic admin route stub and navigation for response inspection --- .../utils/navigation/menu/de-de-formal.msg | 3 +- .../uniworx/utils/navigation/menu/en-eu.msg | 3 +- routes | 3 +- src/Foundation/Navigation.hs | 9 ++++ src/Foundation/Routes.hs | 2 +- src/Handler/Admin.hs | 3 +- src/Handler/Admin/OAuth2.hs | 48 +++++++++++++++++++ 7 files changed, 66 insertions(+), 5 deletions(-) create mode 100644 src/Handler/Admin/OAuth2.hs diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 502f3d09f..78e095b6d 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -141,7 +141,8 @@ MenuSap: SAP Schnittstelle MenuAvs: AVS Schnittstelle MenuAvsSynchError: AVS Problemübersicht -MenuLdap: LDAP Schnittstelle +MenuLdap !ident-ok: LDAP +MenuOAuth2 !ident-ok: OAuth2 MenuApc: Druckerei MenuPrintSend: Manueller Briefversand MenuPrintDownload: Brief herunterladen diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 9fcb4b2a6..bb085c38e 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -141,7 +141,8 @@ MenuSap: SAP Interface MenuAvs: AVS Interface MenuAvsSynchError: AVS Problem Overview -MenuLdap: LDAP Interface +MenuLdap: LDAP +MenuOAuth2: OAuth2 MenuApc: Printing MenuPrintSend: Send Letter MenuPrintDownload: Download Letter diff --git a/routes b/routes index 3f30c960a..2376c33af 100644 --- a/routes +++ b/routes @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,Wolfgang Witt +-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel , Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,Wolfgang Witt -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -70,6 +70,7 @@ /admin/avs AdminAvsR GET POST /admin/avs/#CryptoUUIDUser AdminAvsUserR GET /admin/ldap AdminLdapR GET POST +/admin/oauth2 AdminOAuth2R GET POST /admin/problems AdminProblemsR GET /admin/problems/no-contact ProblemUnreachableR GET /admin/problems/no-avs-id ProblemWithoutAvsId GET diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index ce7d466f4..bf486ed22 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -116,6 +116,7 @@ breadcrumb AdminJobsR = i18nCrumb MsgBreadcrumbAdminJobs $ Just breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR breadcrumb AdminAvsUserR{} = i18nCrumb MsgAvsPersonInfo $ Just AdminAvsR breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR +breadcrumb AdminOAuth2R = i18nCrumb MsgMenuOAuth2 $ Just AdminR breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR breadcrumb ProblemWithoutAvsId = i18nCrumb MsgProblemsNoAvsIdHeading $ Just AdminProblemsR @@ -861,6 +862,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the , navQuick' = mempty , navForceActive = False } + , NavLink + { navLabel = MsgMenuOAuth2 + , navRoute = AdminOAuth2R + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } ] } , return NavHeaderContainer diff --git a/src/Foundation/Routes.hs b/src/Foundation/Routes.hs index 454be37a6..e7f7ba32b 100644 --- a/src/Foundation/Routes.hs +++ b/src/Foundation/Routes.hs @@ -9,7 +9,7 @@ module Foundation.Routes ( module Foundation.Routes.Definitions , module Foundation.Routes ) where - + import Import.NoFoundation import Foundation.Type diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 2b9f17857..a64620899 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel , Gregor Kleen , Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -31,6 +31,7 @@ import Handler.Admin.Tokens as Handler.Admin import Handler.Admin.Crontab as Handler.Admin import Handler.Admin.Avs as Handler.Admin import Handler.Admin.Ldap as Handler.Admin +import Handler.Admin.OAuth2 as Handler.Admin getAdminR :: Handler Html diff --git a/src/Handler/Admin/OAuth2.hs b/src/Handler/Admin/OAuth2.hs new file mode 100644 index 000000000..27a29b461 --- /dev/null +++ b/src/Handler/Admin/OAuth2.hs @@ -0,0 +1,48 @@ +-- SPDX-FileCopyrightText: 2023 Sarah Vaupel +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Handler.Admin.OAuth2 + ( getAdminOAuth2R + , postAdminOAuth2R + ) where + +import Import +-- import qualified Data.CaseInsensitive as CI +-- import qualified Data.Text as Text +-- import Handler.Utils + + +getAdminOAuth2R, postAdminOAuth2R :: Handler Html +getAdminOAuth2R = postAdminOAuth2R +postAdminOAuth2R = error "postAdminOAuth2R not yet implemented" +-- ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminLdapLookup"::Text) $ \html -> +-- flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing +-- +-- let procFormPerson :: Text -> Handler (Maybe ()) +-- procFormPerson lid = error "TODO" +-- +-- +-- ((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminLdapUpsert"::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 AdminLdapR <$> getCurrentRoute +-- siteLayoutMsg MsgMenuLdap $ do +-- setTitleI MsgMenuLdap +-- 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 "ldap") From ce8aa849f8548712a0d4a8586a825d48ad23134e Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Mon, 18 Dec 2023 00:56:50 +0000 Subject: [PATCH 02/12] chore(admin): oauth2 admin form identifiers --- src/Handler/Admin/OAuth2.hs | 61 ++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/src/Handler/Admin/OAuth2.hs b/src/Handler/Admin/OAuth2.hs index 27a29b461..cf99ab5cf 100644 --- a/src/Handler/Admin/OAuth2.hs +++ b/src/Handler/Admin/OAuth2.hs @@ -15,34 +15,33 @@ import Import getAdminOAuth2R, postAdminOAuth2R :: Handler Html getAdminOAuth2R = postAdminOAuth2R -postAdminOAuth2R = error "postAdminOAuth2R not yet implemented" --- ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminLdapLookup"::Text) $ \html -> --- flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing --- --- let procFormPerson :: Text -> Handler (Maybe ()) --- procFormPerson lid = error "TODO" --- --- --- ((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminLdapUpsert"::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 AdminLdapR <$> getCurrentRoute --- siteLayoutMsg MsgMenuLdap $ do --- setTitleI MsgMenuLdap --- 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 "ldap") +postAdminOAuth2R = + ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminOAuth2Lookup"::Text) $ \html -> + flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing + + let procFormPerson :: Text -> Handler (Maybe ()) + procFormPerson lid = error "TODO" + + ((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 AdminLdapR <$> getCurrentRoute + siteLayoutMsg MsgMenuLdap $ do + setTitleI MsgMenuLdap + 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") From a67697d159358d276aefb1cfb24fce70e32ce3e6 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Mon, 18 Dec 2023 02:58:14 +0000 Subject: [PATCH 03/12] chore(admin): added oauth2 handling widget --- src/Handler/Admin/OAuth2.hs | 46 +++++++++++++++++++++---------------- templates/oauth2.hamlet | 18 +++++++++++++++ 2 files changed, 44 insertions(+), 20 deletions(-) create mode 100644 templates/oauth2.hamlet diff --git a/src/Handler/Admin/OAuth2.hs b/src/Handler/Admin/OAuth2.hs index cf99ab5cf..fdd8b8f63 100644 --- a/src/Handler/Admin/OAuth2.hs +++ b/src/Handler/Admin/OAuth2.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2023 Sarah Vaupel +-- SPDX-FileCopyrightText: 2023 Sarah Vaupel ,David Mosbach -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -9,39 +9,45 @@ module Handler.Admin.OAuth2 import Import -- import qualified Data.CaseInsensitive as CI --- import qualified Data.Text as Text --- import Handler.Utils +import Data.Text() +--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 -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 ()) - procFormPerson lid = error "TODO" + let procFormPerson :: Text -> Handler (Maybe Text) + 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 -> - 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 + --((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 AdminLdapR <$> getCurrentRoute - siteLayoutMsg MsgMenuLdap $ do - setTitleI MsgMenuLdap + 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) + --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") diff --git a/templates/oauth2.hamlet b/templates/oauth2.hamlet new file mode 100644 index 000000000..23030ebd6 --- /dev/null +++ b/templates/oauth2.hamlet @@ -0,0 +1,18 @@ +$newline never + +$# SPDX-FileCopyrightText: 2023 David Mosbach +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +
+

+ OAuth2 User Search: + ^{personForm} + $maybe answers <- mOAuth2Data +

+ Antwort: # +
+
+ #{show answers} +
+ From 8acfc1d10c740766b55d5315fa6b413dcad50df5 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Sun, 28 Jan 2024 12:53:00 +0000 Subject: [PATCH 04/12] feat(auth): integrated oauth2 mock server --- shell.nix | 30 ++++++++++++++++++++++++++++-- src/Auth/OAuth2.hs | 12 ++++++------ src/Foundation/Instances.hs | 2 +- templates/login.hamlet | 4 ++-- 4 files changed, 37 insertions(+), 11 deletions(-) diff --git a/shell.nix b/shell.nix index 42c65ae1f..329dd7549 100644 --- a/shell.nix +++ b/shell.nix @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022-2023 Gregor Kleen , Sarah Vaupel , Steffen Jost +# SPDX-FileCopyrightText: 2022-2024 Gregor Kleen , Sarah Vaupel , Steffen Jost , David Mosbach # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -9,6 +9,12 @@ let haskellPackages = pkgs.haskellPackages; + oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=11548e5aacca29c6ba389a62bca3d7a80d54eb6f&ref=refresh-tokens").packages.x86_64-linux; + + oauth2MockServer = oauth2Flake.default; + mkOauth2DB = oauth2Flake.mkOauth2DB; + killOauth2DB = oauth2Flake.killOauth2DB; + postgresSchema = pkgs.writeText "schema.sql" '' CREATE USER uniworx WITH SUPERUSER; CREATE DATABASE uniworx_test; @@ -21,6 +27,17 @@ let local all all trust ''; + oauth2Schema = pkgs.writeText "oauth2_schema.sql" '' + CREATE USER oauth2mock WITH SUPERUSER; + CREATE DATABASE test_users; + GRANT ALL ON DATABASE test_users TO oauth2mock; + ''; + + oauth2Hba = pkgs.writeText "oauth2_hba_file" '' + local all all trust + ''; + + develop = pkgs.writeScriptBin "develop" '' #!${pkgs.zsh}/bin/zsh -e @@ -44,6 +61,7 @@ let type cleanup_cache_memcached &>/dev/null && cleanup_cache_memcached type cleanup_minio &>/dev/null && cleanup_minio type cleanup_maildev &>/dev/null && cleanup_maildev + [[ -z "$OAUTH2_PGDIR" ]] || source ${killOauth2DB}/bin/killOauth2DB [ -f "''${basePath}/.develop.env" ] && rm -vf "''${basePath}/.develop.env" set +x @@ -53,6 +71,12 @@ let export PORT_OFFSET=$(((16#$(sha256sum <<<"$(hostname -f):''${basePath}" | head -c 16)) % 1000)) + if [[ -z "$OAUTH2_PGHOST" ]]; then + set -xe + source ${mkOauth2DB}/bin/mkOauth2DB + set +xe + fi + if [[ -z "$PGHOST" ]]; then set -xe @@ -271,7 +295,9 @@ in pkgs.mkShell { export CHROME_BIN=${pkgs.chromium}/bin/chromium ''; - nativeBuildInputs = [develop inDevelop killallUni2work diffRunning] + OAUTH2_HBA = oauth2Hba; + OAUTH2_DB_SCHEMA = oauth2Schema; + nativeBuildInputs = [develop inDevelop killallUni2work diffRunning oauth2MockServer] ++ (with pkgs; [ stack nodejs-14_x postgresql_12 openldap exiftool memcached minio minio-client gup reuse pre-commit diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index 9b4efdd5d..c3637c0f0 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -30,7 +30,7 @@ instance Exception AzureUserException ---------------------------------------- mockPluginName :: Text -mockPluginName = "uniworx_dev" +mockPluginName = "dev-oauth2-mock" newtype UserID = UserID Text instance FromJSON UserID where @@ -40,14 +40,14 @@ instance FromJSON UserID where oauth2MockServer :: YesodAuth m => AuthPlugin m oauth2MockServer = let oa = OAuth2 - { oauth2ClientId = "uniworx" - , oauth2ClientSecret = Just "shh" - , oauth2AuthorizeEndpoint = fromString $ mockServerURL <> "/authorize" + { oauth2ClientId = "42" + , oauth2ClientSecret = Just "shhh" + , oauth2AuthorizeEndpoint = (fromString $ mockServerURL <> "/auth") `withQuery` [scopeParam " " ["ID", "Profile"]] , oauth2TokenEndpoint = fromString $ mockServerURL <> "/token" , oauth2RedirectUri = Nothing } - mockServerURL = "0.0.0.0/" - profileSrc = fromString $ mockServerURL <> "/foo" + mockServerURL = "http://localhost:9443" + profileSrc = fromString $ mockServerURL <> "/users/me" in authOAuth2 mockPluginName oa $ \manager token -> do (UserID userID, userResponse) <- authGetProfile mockPluginName manager token profileSrc return Creds diff --git a/src/Foundation/Instances.hs b/src/Foundation/Instances.hs index 79fefdccf..20d10b2de 100644 --- a/src/Foundation/Instances.hs +++ b/src/Foundation/Instances.hs @@ -140,7 +140,7 @@ instance YesodAuth UniWorX where $(widgetFile "login") authenticate c@Creds{..} - | credsPlugin `elem` ["azureadv2", "uniworx_dev"] = UniWorX.oAuthenticate c + | credsPlugin `elem` ["azureadv2", "dev-oauth2-mock"] = UniWorX.oAuthenticate c | otherwise = UniWorX.authenticate c authPlugins UniWorX{ appSettings' = AppSettings{..}, appLdapPool, appAuthPlugins } = appAuthPlugins ++ catMaybes diff --git a/templates/login.hamlet b/templates/login.hamlet index 7c1483d65..bb3ee704e 100644 --- a/templates/login.hamlet +++ b/templates/login.hamlet @@ -1,6 +1,6 @@ $newline never -$# SPDX-FileCopyrightText: 2022 Gregor Kleen +$# SPDX-FileCopyrightText: 2022-2024 Gregor Kleen ,David Mosbach $# $# SPDX-License-Identifier: AGPL-3.0-or-later @@ -9,7 +9,7 @@ $forall AuthPlugin{apName, apLogin} <- plugins

Azure ^{apLogin toParent} - $elseif apName == "uniworx_dev" + $elseif apName == "dev-oauth2-mock"

_{MsgDummyLoginTitle} ^{apLogin toParent} From 2763d2012a85fa3d72bb8292675b55689abc6bee Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Mon, 29 Jan 2024 00:45:43 +0000 Subject: [PATCH 05/12] chore(auth): provide oauth2 test users yaml --- shell.nix | 5 +- test/Database/test-users.yaml | 231 ++++++++++++++++++++++++++++++++++ 2 files changed, 235 insertions(+), 1 deletion(-) create mode 100644 test/Database/test-users.yaml diff --git a/shell.nix b/shell.nix index 329dd7549..9c43c44cf 100644 --- a/shell.nix +++ b/shell.nix @@ -9,7 +9,7 @@ let haskellPackages = pkgs.haskellPackages; - oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=11548e5aacca29c6ba389a62bca3d7a80d54eb6f&ref=refresh-tokens").packages.x86_64-linux; + oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=02510301ff4536f63182b798ca3551406c7e1aab&ref=refresh-tokens").packages.x86_64-linux; oauth2MockServer = oauth2Flake.default; mkOauth2DB = oauth2Flake.mkOauth2DB; @@ -297,6 +297,9 @@ in pkgs.mkShell { ''; OAUTH2_HBA = oauth2Hba; OAUTH2_DB_SCHEMA = oauth2Schema; + OAUTH2_TEST_USERS = ./test/Database/test-users.yaml; + OAUTH2_SERVER_PORT = 9443; + OAUTH2_DB_PORT = 9444; nativeBuildInputs = [develop inDevelop killallUni2work diffRunning oauth2MockServer] ++ (with pkgs; [ stack nodejs-14_x postgresql_12 openldap exiftool memcached minio minio-client diff --git a/test/Database/test-users.yaml b/test/Database/test-users.yaml new file mode 100644 index 000000000..17ea6d1ba --- /dev/null +++ b/test/Database/test-users.yaml @@ -0,0 +1,231 @@ +# SPDX-FileCopyrightText: 2024 David Mosbach +# +# SPDX-License-Identifier: AGPL-3.0-or-later + +special-users: + + - default: &default-user + userIdent: null + userAuthentication: AuthLDAP + userLastAuthentication: null + userTokensIssuedAfter: null + userMatrikelnummer: null + userEmail: "" + userDisplayEmail: null + userDisplayName: null + userSurname: "" + userFirstName: "" + userTitle: null + userMaxFavourites: userDefaultMaxFavourites + userMaxFavouriteTerms: userDefaultMaxFavouriteTerms + userTheme: ThemeDefault + userDateTimeFormat: userDefaultDateTimeFormat + userDateFormat: userDefaultDateFormat + userTimeFormat: userDefaultTimeFormat + userDownloadFiles: userDefaultDownloadFiles + userWarningDays: userDefaultWarningDays + userLanguages: null + userCreated: now + userNotificationSettings: def + userLastLdapSynchronisation: null + userLdapPrimaryKey: null + userCsvOptions: def + userSex: null + userBirthday: null + userShowSex: userDefaultShowSex + userTelephone: null + userMobile: null + userCompanyPersonalNumber: null + userCompanyDepartment: null + userPinPassword: null + userPostAddress: null + userPostLastUpdate: null + userPrefersPostal: true + userExamOfficeGetSynced: userDefaultExamOfficeGetSynced + userExamOfficeGetLabels: userDefaultExamOfficeGetLabels + + - gkleen: + <<: *default-user + userIdent: "G.Kleen@campus.lmu.de" + userLastAuthentication: now + userTokensIssuedAfter: now + userEmail: "G.Kleen@campus.lmu.de" + userDisplayEmail: "gregor.kleen@ifi.lmu.de" + userDisplayName: "Gregor Kleen" + userSurname: "Kleen" + userFirstName: "Gregor Julius Arthur" + userMaxFavourites: 6 + userMaxFavouriteTerms: 1 + userLanguages: ["en"] + # userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC } + userSex: SexMale + userCompanyPersonalNumber: "00000" + userPostAddress: "Büro 127 \nMathematisches Institut der Ludwig-Maximilians-Universität München \nTheresienstr. 39 \nD-80333 München" + + - fhamann: + <<: *default-user + userIdent: "felix.hamann@campus.lmu.de" + userEmail: "noEmailKnown" + userDisplayEmail: "felix.hamann@campus.lmu.de" + userDisplayName: "Felix Hamann" + userSurname: "Hamann" + userFirstName: "Felix" + # userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel } + userSex: SexMale + userPinPassword: "tomatenmarmelade" + userPostAddress: "Erdbeerweg 24 \n12345 Schlumpfhausen \nTraumland" + + - jost: + <<: *default-user + userIdent: "jost@tcs.ifi.lmu.de" + userAuthentication: pwSimple + userMatrikelnummer: "12345678" + userEmail: "S.Jost@Fraport.de" + userDisplayEmail: "jost@tcs.ifi.lmu.de" + userDisplayName: "Steffen Jost" + userSurname: "Jost" + userFirstName: "Steffen" + userTitle: "Dr." + userMaxFavourites: 14 + userMaxFavouriteTerms: 4 + userTheme: ThemeMossGreen + userSex: SexMale + # userBirthday = Just $ n_day $ 35 * (-365) + userTelephone: "+49 69 690-71706" + userMobile: "0173 69 99 646" + userCompanyPersonalNumber: "57138" + userCompanyDepartment: "AVN-AR2" + + - maxMuster: + <<: *default-user + userIdent: "max@campus.lmu.de" + userLastAuthentication: now + userMatrikelnummer: "1299" + userEmail: "max@campus.lmu.de" + userDisplayEmail: "max@max.com" + userDisplayName: "Max Musterstudent" + userSurname: "Musterstudent" + userFirstName: "Max" + userMaxFavourites: 7 + userTheme: ThemeAberdeenReds + userLanguages: ["de"] + userSex: SexMale + # userBirthday = Just $ n_day $ 27 * (-365) + userPrefersPostal: false + + - tinaTester: + <<: *default-user + userIdent: "tester@campus.lmu.de" + userAuthentication: null + userMatrikelnummer: "999" + userEmail: "tester@campus.lmu.de" + userDisplayEmail: "tina@tester.example" + userDisplayName: "Tina Tester" + userSurname: "vön Tërrör¿" + userFirstName: "Sabrina" + userTitle: "Magister" + userMaxFavourites: 5 + userTheme: ThemeAberdeenReds + userLanguages: ["sn"] + userSex: SexNotApplicable + # userBirthday = Just $ n_day 3 + userCompanyPersonalNumber: "12345" + userPrefersPostal: false + + - svaupel: + <<: *default-user + userIdent: "vaupel.sarah@campus.lmu.de" + userEmail: "vaupel.sarah@campus.lmu.de" + userDisplayEmail: "vaupel.sarah@campus.lmu.de" + userDisplayName: "Sarah Vaupel" + userSurname: "Vaupel" + userFirstName: "Sarah" + userMaxFavourites: 14 + userMaxFavouriteTerms: 4 + userTheme: ThemeMossGreen + userLanguages: null + userSex: SexFemale + userPrefersPostal: false + + - sbarth: + <<: *default-user + userIdent: "Stephan.Barth@campus.lmu.de" + userEmail: "Stephan.Barth@lmu.de" + userDisplayEmail: "stephan.barth@ifi.lmu.de" + userDisplayName: "Stephan Barth" + userSurname: "Barth" + userFirstName: "Stephan" + userTheme: ThemeMossGreen + userSex: SexMale + userPrefersPostal: false + userExamOfficeGetSynced: false + userExamOfficeGetLabels: true + + - _stranger1: + userIdent: "AVSID:996699" + userEmail: "E996699@fraport.de" + userDisplayEmail: "" + userDisplayName: "Stranger One" + userSurname: "One" + userFirstName: "Stranger" + userTheme: ThemeMossGreen + userSex: SexMale + userCompanyPersonalNumber: "E996699" + userCompanyDepartment: "AVN-Strange" + userPrefersPostal: false + userExamOfficeGetSynced: false + userExamOfficeGetLabels: true + + - _stranger2: + userIdent: "AVSID:669966" + userEmail: "E669966@fraport.de" + userDisplayEmail: "" + userDisplayName: "Stranger Two" + userSurname: "Stranger" + userFirstName: "Two" + userTheme: ThemeMossGreen + userSex: SexMale + userCompanyPersonalNumber: "669966" + userCompanyDepartment: "AVN-Strange" + userPrefersPostal: false + userExamOfficeGetSynced: false + userExamOfficeGetLabels: true + + - _stranger3: + userIdent: "AVSID:6969" + userEmail: "E6969@fraport.de" + userDisplayEmail: "" + userDisplayName: "Stranger 3 Three" + userSurname: "Three" + userFirstName: "Stranger" + userTheme: ThemeMossGreen + userSex: SexMale + userCompanyPersonalNumber: "E996699" + userCompanyDepartment: "AVN-Strange" + userPostAddress: "Kartoffelweg 12 \n666 Höllensumpf \nFreiland" + userPrefersPostal: false + userExamOfficeGetSynced: false + userExamOfficeGetLabels: true + + +random-users: + firstNames: [ "James", "John", "Robert", "Michael" + , "William", "David", "Mary", "Richard" + , "Joseph", "Thomas", "Charles", "Daniel" + , "Matthew", "Patricia", "Jennifer", "Linda" + , "Elizabeth", "Barbara", "Anthony", "Donald" + , "Mark", "Paul", "Steven", "Andrew" + , "Kenneth", "Joshua", "George", "Kevin" + , "Brian", "Edward", "Susan", "Ronald" + ] + surnames: [ "Smith", "Johnson", "Williams", "Brown" + , "Jones", "Miller", "Davis", "Garcia" + , "Rodriguez", "Wilson", "Martinez", "Anderson" + , "Taylor", "Thomas", "Hernandez", "Moore" + , "Martin", "Jackson", "Thompson", "White" + , "Lopez", "Lee", "Gonzalez", "Harris" + , "Clark", "Lewis", "Robinson", "Walker" + , "Perez", "Hall", "Young", "Allen" + ] + middlenames: [ null, "Jamesson" ] + From 5a023a9e32d5493871e1ac36c49330446bf29bc1 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Mon, 29 Jan 2024 21:34:39 +0000 Subject: [PATCH 06/12] chore(auth): added function for user queries to auth servers --- src/Application.hs | 2 +- src/Auth/OAuth2.hs | 42 ++++++++++++++++++++++++++++++++++++++---- 2 files changed, 39 insertions(+), 5 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 8b9a21739..e4c75668b 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -337,7 +337,7 @@ makeFoundation appSettings''@AppSettings{..} = do return . uncurry p $ fromJust mArgs appAuthPlugins <- liftIO $ sequence [ - return oauth2MockServer + (oauth2MockServer . fromJust) <$> lookupEnv "OAUTH2_SERVER_PORT" , loadPlugin (oauth2AzureADv2 tenantID) "AZURE_ADV2" ] diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index c3637c0f0..8be0e5111 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -6,13 +6,19 @@ module Auth.OAuth2 ( AzureUserException(..) +, azurePluginName , oauth2MockServer , mockPluginName +, queryOauth2User ) where import Data.Text -import Import.NoFoundation +import Import.NoFoundation hiding (unpack) + +import Network.HTTP.Simple (httpJSONEither, getResponseBody, JSONException) + +import System.Environment (lookupEnv) import Yesod.Auth.OAuth2 import Yesod.Auth.OAuth2.Prelude @@ -25,6 +31,9 @@ data AzureUserException = AzureUserError instance Exception AzureUserException +azurePluginName :: Text +azurePluginName = "azureadv2" + ---------------------------------------- ---- OAuth2 development auth plugin ---- ---------------------------------------- @@ -37,8 +46,8 @@ instance FromJSON UserID where parseJSON = withObject "UserID" $ \o -> UserID <$> o .: "id" -oauth2MockServer :: YesodAuth m => AuthPlugin m -oauth2MockServer = +oauth2MockServer :: YesodAuth m => String -> AuthPlugin m +oauth2MockServer port = let oa = OAuth2 { oauth2ClientId = "42" , oauth2ClientSecret = Just "shhh" @@ -46,7 +55,7 @@ oauth2MockServer = , oauth2TokenEndpoint = fromString $ mockServerURL <> "/token" , oauth2RedirectUri = Nothing } - mockServerURL = "http://localhost:9443" + mockServerURL = "http://localhost:" <> fromString port profileSrc = fromString $ mockServerURL <> "/users/me" in authOAuth2 mockPluginName oa $ \manager token -> do (UserID userID, userResponse) <- authGetProfile mockPluginName manager token profileSrc @@ -56,4 +65,29 @@ oauth2MockServer = , credsExtra = setExtra token userResponse } +---------------------- +---- User Queries ---- +---------------------- + +data UserData = UD +instance FromJSON UserData where + parseJSON _ = pure UD + +queryOauth2User :: forall m . (MonadIO m, MonadThrow m) + => Text + -> Text + -> m (Either JSONException UserData) +queryOauth2User authPlugin userID = do + baseUrl <- liftIO mkBaseUrl + req <- parseRequest $ "GET " ++ baseUrl ++ unpack userID + -- TODO get new token & put token in auth header + getResponseBody <$> httpJSONEither @m @UserData req + where + mkBaseUrl :: IO String + mkBaseUrl + | authPlugin == azurePluginName = return "https://graph.microsoft.com/v1.0/users/" + | authPlugin == mockPluginName = do + Just port <- lookupEnv "OAUTH2_SERVER_PORT" + return $ "http://localhost:" ++ port ++ "/users/query?id=" + | otherwise = fail $ unpack authPlugin From c8fa509ace7cc0746ac1df5678b49e393f39d397 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Tue, 30 Jan 2024 05:06:06 +0000 Subject: [PATCH 07/12] feat(auth): tokens can be stored & refreshed --- src/Application.hs | 4 +-- src/Auth/OAuth2.hs | 70 ++++++++++++++++++++++++++++++++++---------- src/Utils/Session.hs | 3 +- 3 files changed, 58 insertions(+), 19 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index e4c75668b..08fef42ee 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -62,7 +62,7 @@ import Jobs import qualified Data.Text.Encoding as Text import qualified Data.Text as Text -import Yesod.Auth.OAuth2.AzureADv2 (oauth2AzureADv2) +import Yesod.Auth.OAuth2.AzureADv2 (oauth2AzureADv2Scoped) import Yesod.Auth.Util.PasswordStore import qualified Data.ByteString.Lazy as LBS @@ -338,7 +338,7 @@ makeFoundation appSettings''@AppSettings{..} = do appAuthPlugins <- liftIO $ sequence [ (oauth2MockServer . fromJust) <$> lookupEnv "OAUTH2_SERVER_PORT" - , loadPlugin (oauth2AzureADv2 tenantID) "AZURE_ADV2" + , loadPlugin (oauth2AzureADv2Scoped ["openid", "profile", "offline_access"] tenantID) "AZURE_ADV2" ] diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index 8be0e5111..e4dc20433 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -9,9 +9,10 @@ module Auth.OAuth2 , azurePluginName , oauth2MockServer , mockPluginName -, queryOauth2User +, queryOAuth2User ) where +import Data.Maybe (fromJust) import Data.Text import Import.NoFoundation hiding (unpack) @@ -21,7 +22,7 @@ import Network.HTTP.Simple (httpJSONEither, getResponseBody, JSONException) import System.Environment (lookupEnv) import Yesod.Auth.OAuth2 -import Yesod.Auth.OAuth2.Prelude +import Yesod.Auth.OAuth2.Prelude hiding (encodeUtf8) data AzureUserException = AzureUserError @@ -73,21 +74,58 @@ data UserData = UD instance FromJSON UserData where parseJSON _ = pure UD -queryOauth2User :: forall m . (MonadIO m, MonadThrow m) +queryOAuth2User :: forall m . (MonadIO m, MonadThrow m, MonadHandler m, MonadFail m) => Text -> Text -> m (Either JSONException UserData) -queryOauth2User authPlugin userID = do - baseUrl <- liftIO mkBaseUrl - req <- parseRequest $ "GET " ++ baseUrl ++ unpack userID - -- TODO get new token & put token in auth header - getResponseBody <$> httpJSONEither @m @UserData req - where - mkBaseUrl :: IO String - mkBaseUrl - | authPlugin == azurePluginName = return "https://graph.microsoft.com/v1.0/users/" - | authPlugin == mockPluginName = do - Just port <- lookupEnv "OAUTH2_SERVER_PORT" - return $ "http://localhost:" ++ port ++ "/users/query?id=" - | otherwise = fail $ unpack authPlugin +queryOAuth2User authPlugin userID = do + (queryUrl, tokenUrl) <- liftIO $ mkBaseUrls authPlugin + req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID + mTokens <- lookupSessionJson SessionOAuth2Token + unless (isJust mTokens) . fail $ "Tried to load sesion Oauth2 tokens, but there are none" + eNewToken <- refreshOAuth2Token @m (fromJust mTokens) tokenUrl (authPlugin == azurePluginName) + case eNewToken of + Left e -> return $ Left e + Right newTokens -> do + setSessionJson SessionOAuth2Token newTokens + getResponseBody <$> httpJSONEither @m @UserData (req + { secure = authPlugin == azurePluginName + , requestHeaders = [("Authorization", encodeUtf8 . atoken . fromJust $ fst newTokens)] }) + +mkBaseUrls :: Text -> IO (String, String) +mkBaseUrls authPlugin + | authPlugin == azurePluginName = do + Just tenantID <- lookupEnv "AZURE_TENANT_ID" + return ( "https://graph.microsoft.com/v1.0/users/" + , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" ) + | authPlugin == mockPluginName = do + Just port <- lookupEnv "OAUTH2_SERVER_PORT" + let base = "http://localhost:" ++ port + return ( base ++ "/users/query?id=" + , base ++ "/token" ) + | otherwise = fail $ "Unsupported auth plugin: " ++ unpack authPlugin + + +refreshOAuth2Token :: forall m x. (MonadIO m, MonadThrow m, MonadHandler m, MonadFail m, x ~ (Maybe AccessToken, Maybe RefreshToken)) + => x + -> String + -> Bool + -> m (Either JSONException x) +refreshOAuth2Token (_, refreshToken) url secure + | isJust refreshToken = do + req <- parseRequest $ "POST " ++ url + let + body = + [ ("grant_type", "refresh_token") + , ("refresh_token", encodeUtf8 . rtoken $ fromJust refreshToken) + , ("scope", "") -- TODO must be subset of previously requested scopes. space separated list + ] + body' <- if secure then do + Just clientID <- liftIO $ lookupEnv "CLIENT_ID" + Just clientSecret <- liftIO $ lookupEnv "CLIENT_SECRET" + return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret)] + else return body + getResponseBody <$> httpJSONEither @m @x (urlEncodedBody body' req{ secure = secure }) + | otherwise = fail "Could not refresh access token. Refresh token is missing." + diff --git a/src/Utils/Session.hs b/src/Utils/Session.hs index ef104b29c..4b5e5c378 100644 --- a/src/Utils/Session.hs +++ b/src/Utils/Session.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen +-- SPDX-FileCopyrightText: 2022-2024 Gregor Kleen , David Mosbach -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -20,6 +20,7 @@ data SessionKey = SessionActiveAuthTags | SessionInactiveAuthTags | SessionLang | SessionError | SessionFiles + | SessionOAuth2Token deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) deriving anyclass (Universe, Finite) From 453034100b38540a884ebfa4d46fdba04cf90b77 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Wed, 31 Jan 2024 14:32:49 +0000 Subject: [PATCH 08/12] feat(auth): admin handler can query user data --- shell.nix | 2 +- src/Auth/OAuth2.hs | 44 +++++++++++++++++++------------------ src/Handler/Admin/OAuth2.hs | 20 +++++++++++++---- 3 files changed, 40 insertions(+), 26 deletions(-) diff --git a/shell.nix b/shell.nix index 9c43c44cf..4b114f966 100644 --- a/shell.nix +++ b/shell.nix @@ -9,7 +9,7 @@ let haskellPackages = pkgs.haskellPackages; - oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=02510301ff4536f63182b798ca3551406c7e1aab&ref=refresh-tokens").packages.x86_64-linux; + oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=6fc2d621573e048b7ce2dabfc4887c7876055f8d&ref=user-queries").packages.x86_64-linux; oauth2MockServer = oauth2Flake.default; mkOauth2DB = oauth2Flake.mkOauth2DB; diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index e4dc20433..a184d7ddd 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -70,27 +70,27 @@ oauth2MockServer port = ---- User Queries ---- ---------------------- -data UserData = UD +data UserData = UD deriving (Show) instance FromJSON UserData where parseJSON _ = pure UD -queryOAuth2User :: forall m . (MonadIO m, MonadThrow m, MonadHandler m, MonadFail m) +queryOAuth2User :: forall m . (MonadIO m, MonadThrow m, MonadHandler m) => Text -> Text - -> m (Either JSONException UserData) + -> m (Either JSONException Value) queryOAuth2User authPlugin userID = do (queryUrl, tokenUrl) <- liftIO $ mkBaseUrls authPlugin req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID mTokens <- lookupSessionJson SessionOAuth2Token - unless (isJust mTokens) . fail $ "Tried to load sesion Oauth2 tokens, but there are none" + unless (isJust mTokens) . liftIO . fail $ "Tried to load sesion Oauth2 tokens, but there are none" eNewToken <- refreshOAuth2Token @m (fromJust mTokens) tokenUrl (authPlugin == azurePluginName) case eNewToken of Left e -> return $ Left e Right newTokens -> do - setSessionJson SessionOAuth2Token newTokens - getResponseBody <$> httpJSONEither @m @UserData (req + setSessionJson SessionOAuth2Token (Just $ accessToken newTokens, refreshToken newTokens) + getResponseBody <$> httpJSONEither @m @Value (req { secure = authPlugin == azurePluginName - , requestHeaders = [("Authorization", encodeUtf8 . atoken . fromJust $ fst newTokens)] }) + , requestHeaders = [("Authorization", encodeUtf8 . ("Bearer " <>) . atoken $ accessToken newTokens)] }) mkBaseUrls :: Text -> IO (String, String) mkBaseUrls authPlugin @@ -106,26 +106,28 @@ mkBaseUrls authPlugin | otherwise = fail $ "Unsupported auth plugin: " ++ unpack authPlugin -refreshOAuth2Token :: forall m x. (MonadIO m, MonadThrow m, MonadHandler m, MonadFail m, x ~ (Maybe AccessToken, Maybe RefreshToken)) - => x +refreshOAuth2Token :: forall m. (MonadIO m, MonadThrow m, MonadHandler m) + => (Maybe AccessToken, Maybe RefreshToken) -> String -> Bool - -> m (Either JSONException x) -refreshOAuth2Token (_, refreshToken) url secure - | isJust refreshToken = do + -> m (Either JSONException OAuth2Token) +refreshOAuth2Token (_, rToken) url secure + | isJust rToken = do req <- parseRequest $ "POST " ++ url let body = [ ("grant_type", "refresh_token") - , ("refresh_token", encodeUtf8 . rtoken $ fromJust refreshToken) - , ("scope", "") -- TODO must be subset of previously requested scopes. space separated list + , ("refresh_token", encodeUtf8 . rtoken $ fromJust rToken) ] body' <- if secure then do - Just clientID <- liftIO $ lookupEnv "CLIENT_ID" - Just clientSecret <- liftIO $ lookupEnv "CLIENT_SECRET" - return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret)] - else return body - getResponseBody <$> httpJSONEither @m @x (urlEncodedBody body' req{ secure = secure }) - | otherwise = fail "Could not refresh access token. Refresh token is missing." - + clientID <- liftIO $ fromJust <$> lookupEnv "CLIENT_ID" + clientSecret <- liftIO $ fromJust <$> lookupEnv "CLIENT_SECRET" + return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret), ("scope", "openid profile")] + else return $ ("scope", "ID Profile") : body + $logErrorS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure }) + getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure }) + | otherwise = liftIO $ fail "Could not refresh access token. Refresh token is missing." +instance Show RequestBody where + show (RequestBodyLBS x) = show x + show _ = error ":(" diff --git a/src/Handler/Admin/OAuth2.hs b/src/Handler/Admin/OAuth2.hs index fdd8b8f63..997a61756 100644 --- a/src/Handler/Admin/OAuth2.hs +++ b/src/Handler/Admin/OAuth2.hs @@ -1,9 +1,9 @@ --- SPDX-FileCopyrightText: 2023 Sarah Vaupel ,David Mosbach +-- SPDX-FileCopyrightText: 2023-2024 Sarah Vaupel ,David Mosbach -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Handler.Admin.OAuth2 - ( getAdminOAuth2R + ( getAdminOAuth2R , postAdminOAuth2R ) where @@ -15,6 +15,12 @@ import Data.Text() --import Foundation.Yesod.Auth (CampusUserConversionException()) import Handler.Utils +# ifdef DEVELOPMENT +import Auth.OAuth2 (queryOAuth2User, mockPluginName) +# else +import Auth.OAuth2 (queryOAuth2User, azurePluginName) +# endif + getAdminOAuth2R, postAdminOAuth2R :: Handler Html getAdminOAuth2R = postAdminOAuth2R @@ -23,8 +29,14 @@ postAdminOAuth2R = do flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing let procFormPerson :: Text -> Handler (Maybe Text) - procFormPerson lid = return . Just $ "Mock reply for id " <> lid - -- TODO implement oauth query + procFormPerson lid = do --return . Just $ "Mock reply for id " <> lid +# ifdef DEVELOPMENT + let authPlugin = mockPluginName +# else + let authPlugin = azurePluginName +# endif + eUserData <- queryOAuth2User authPlugin lid + return . Just $ tshow eUserData mOAuth2Data <- formResultMaybe presult procFormPerson --((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminOAuth2Upsert"::Text) $ \html -> From d4cfce317d00714404ea3640cae8ad25182594b0 Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Sat, 3 Feb 2024 20:48:32 +0000 Subject: [PATCH 09/12] feat(auth): formatted output of user queries --- src/Auth/OAuth2.hs | 75 +++++++++++++++++++++--------------- src/Foundation/Yesod/Auth.hs | 4 ++ src/Handler/Admin/OAuth2.hs | 24 +++++------- templates/oauth2.hamlet | 3 +- 4 files changed, 58 insertions(+), 48 deletions(-) diff --git a/src/Auth/OAuth2.hs b/src/Auth/OAuth2.hs index a184d7ddd..fab04ca16 100644 --- a/src/Auth/OAuth2.hs +++ b/src/Auth/OAuth2.hs @@ -10,6 +10,7 @@ module Auth.OAuth2 , oauth2MockServer , mockPluginName , queryOAuth2User +, UserDataException ) where import Data.Maybe (fromJust) @@ -70,47 +71,54 @@ oauth2MockServer port = ---- User Queries ---- ---------------------- -data UserData = UD deriving (Show) -instance FromJSON UserData where - parseJSON _ = pure UD +data UserDataException = UserDataJSONException JSONException + | UserDataInternalException Text + deriving Show -queryOAuth2User :: forall m . (MonadIO m, MonadThrow m, MonadHandler m) +instance Exception UserDataException + +queryOAuth2User :: forall j m . (FromJSON j, MonadIO m, MonadThrow m, MonadHandler m) => Text - -> Text - -> m (Either JSONException Value) -queryOAuth2User authPlugin userID = do - (queryUrl, tokenUrl) <- liftIO $ mkBaseUrls authPlugin + -> m (Either UserDataException j) +queryOAuth2User userID = runExceptT $ do + (queryUrl, tokenUrl) <- liftIO mkBaseUrls req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID mTokens <- lookupSessionJson SessionOAuth2Token - unless (isJust mTokens) . liftIO . fail $ "Tried to load sesion Oauth2 tokens, but there are none" - eNewToken <- refreshOAuth2Token @m (fromJust mTokens) tokenUrl (authPlugin == azurePluginName) - case eNewToken of - Left e -> return $ Left e - Right newTokens -> do - setSessionJson SessionOAuth2Token (Just $ accessToken newTokens, refreshToken newTokens) - getResponseBody <$> httpJSONEither @m @Value (req - { secure = authPlugin == azurePluginName - , requestHeaders = [("Authorization", encodeUtf8 . ("Bearer " <>) . atoken $ accessToken newTokens)] }) + unless (isJust mTokens) . throwE $ UserDataInternalException "Tried to load session Oauth2 tokens, but there are none" +# ifdef DEVELOPMENT + let secure = False +# else + let secure = True +# endif + newTokens <- refreshOAuth2Token @m (fromJust mTokens) tokenUrl secure + setSessionJson SessionOAuth2Token (Just $ accessToken newTokens, refreshToken newTokens) + eResult <- lift $ getResponseBody <$> httpJSONEither @m @j (req + { secure = secure + , requestHeaders = [("Authorization", encodeUtf8 . ("Bearer " <>) . atoken $ accessToken newTokens)] }) + case eResult of + Left x -> throwE $ UserDataJSONException x + Right x -> return x -mkBaseUrls :: Text -> IO (String, String) -mkBaseUrls authPlugin - | authPlugin == azurePluginName = do - Just tenantID <- lookupEnv "AZURE_TENANT_ID" - return ( "https://graph.microsoft.com/v1.0/users/" - , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" ) - | authPlugin == mockPluginName = do - Just port <- lookupEnv "OAUTH2_SERVER_PORT" - let base = "http://localhost:" ++ port - return ( base ++ "/users/query?id=" - , base ++ "/token" ) - | otherwise = fail $ "Unsupported auth plugin: " ++ unpack authPlugin + +mkBaseUrls :: IO (String, String) +mkBaseUrls = do +# ifndef DEVELOPMENT + Just tenantID <- lookupEnv "AZURE_TENANT_ID" + return ( "https://graph.microsoft.com/v1.0/users/" + , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" ) +# else + Just port <- lookupEnv "OAUTH2_SERVER_PORT" + let base = "http://localhost:" ++ port + return ( base ++ "/users/query?id=" + , base ++ "/token" ) +# endif refreshOAuth2Token :: forall m. (MonadIO m, MonadThrow m, MonadHandler m) => (Maybe AccessToken, Maybe RefreshToken) -> String -> Bool - -> m (Either JSONException OAuth2Token) + -> ExceptT UserDataException m OAuth2Token refreshOAuth2Token (_, rToken) url secure | isJust rToken = do req <- parseRequest $ "POST " ++ url @@ -125,8 +133,11 @@ refreshOAuth2Token (_, rToken) url secure return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret), ("scope", "openid profile")] else return $ ("scope", "ID Profile") : body $logErrorS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure }) - getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure }) - | otherwise = liftIO $ fail "Could not refresh access token. Refresh token is missing." + eResult <- lift $ getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure }) + case eResult of + Left x -> throwE $ UserDataJSONException x + Right x -> return x + | otherwise = throwE $ UserDataInternalException "Could not refresh access token. Refresh token is missing." instance Show RequestBody where show (RequestBodyLBS x) = show x diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 2bd046479..7c3594a53 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -24,6 +24,7 @@ import Handler.Utils.Memcached import Foundation.Authorization (AuthorizationCacheKey(..)) import Yesod.Auth.Message +import Yesod.Auth.OAuth2 (getAccessToken, getRefreshToken) import Auth.LDAP import Auth.OAuth2 import Auth.PWHash (apHash) @@ -131,6 +132,9 @@ oAuthenticate :: ( MonadHandler m, HandlerSite m ~ UniWorX => Creds UniWorX -> m (AuthenticationResult UniWorX) oAuthenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend $ do $logErrorS "OAuth" $ "\a\27[31m" <> tshow creds <> "\27[0m" + setSessionJson SessionOAuth2Token $ (getAccessToken creds, getRefreshToken creds) + sess <- getSession + $logErrorS "OAuth" $ "\27[34m" <> tshow sess <> "\27[0m" now <- liftIO getCurrentTime let diff --git a/src/Handler/Admin/OAuth2.hs b/src/Handler/Admin/OAuth2.hs index 997a61756..1face989f 100644 --- a/src/Handler/Admin/OAuth2.hs +++ b/src/Handler/Admin/OAuth2.hs @@ -9,17 +9,14 @@ module Handler.Admin.OAuth2 import Import -- import qualified Data.CaseInsensitive as CI -import Data.Text() ---import qualified Data.Text as Text +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 -# ifdef DEVELOPMENT -import Auth.OAuth2 (queryOAuth2User, mockPluginName) -# else -import Auth.OAuth2 (queryOAuth2User, azurePluginName) -# endif +import Auth.OAuth2 (queryOAuth2User) getAdminOAuth2R, postAdminOAuth2R :: Handler Html @@ -28,15 +25,12 @@ postAdminOAuth2R = do ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminOAuth2Lookup"::Text) $ \html -> flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing - let procFormPerson :: Text -> Handler (Maybe Text) + let procFormPerson :: Text -> Handler (Maybe T.Text) procFormPerson lid = do --return . Just $ "Mock reply for id " <> lid -# ifdef DEVELOPMENT - let authPlugin = mockPluginName -# else - let authPlugin = azurePluginName -# endif - eUserData <- queryOAuth2User authPlugin lid - return . Just $ tshow eUserData + 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 -> diff --git a/templates/oauth2.hamlet b/templates/oauth2.hamlet index 23030ebd6..90711a799 100644 --- a/templates/oauth2.hamlet +++ b/templates/oauth2.hamlet @@ -13,6 +13,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later Antwort: #
- #{show answers} + 
+              #{answers}
           

             

From fafa25a7b51b734e5172fc3b80295b418e663535 Mon Sep 17 00:00:00 2001
From: David Mosbach 
Date: Sat, 3 Feb 2024 21:10:24 +0000
Subject: [PATCH 10/12] chore(auth): auto start oauth2 mock server in develop

---
 shell.nix | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/shell.nix b/shell.nix
index 4b114f966..c02c51c19 100644
--- a/shell.nix
+++ b/shell.nix
@@ -62,6 +62,7 @@ let
       type cleanup_minio &>/dev/null && cleanup_minio
       type cleanup_maildev &>/dev/null && cleanup_maildev
       [[ -z "$OAUTH2_PGDIR" ]] || source ${killOauth2DB}/bin/killOauth2DB
+      [[ -z "$OAUTH2_PGHOST" ]] || pkill oauth2-mock-ser
 
       [ -f "''${basePath}/.develop.env" ] && rm -vf "''${basePath}/.develop.env"
       set +x
@@ -74,6 +75,7 @@ let
     if [[ -z "$OAUTH2_PGHOST" ]]; then
       set -xe
       source ${mkOauth2DB}/bin/mkOauth2DB
+      ${oauth2MockServer}/bin/oauth2-mock-server&
       set +xe
     fi
 
@@ -300,7 +302,7 @@ in pkgs.mkShell {
   OAUTH2_TEST_USERS = ./test/Database/test-users.yaml;
   OAUTH2_SERVER_PORT = 9443;
   OAUTH2_DB_PORT = 9444;
-  nativeBuildInputs = [develop inDevelop killallUni2work diffRunning oauth2MockServer]
+  nativeBuildInputs = [develop inDevelop killallUni2work diffRunning]
   ++ (with pkgs;
     [ stack nodejs-14_x postgresql_12 openldap exiftool memcached minio minio-client
       gup reuse pre-commit

From 3f5a22c85d6db947d6a77b34bff15d75f25d30f3 Mon Sep 17 00:00:00 2001
From: David Mosbach 
Date: Fri, 9 Feb 2024 17:38:35 +0000
Subject: [PATCH 11/12] chore(auth): update oauth2 mock server

---
 shell.nix | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/shell.nix b/shell.nix
index c02c51c19..58494040a 100644
--- a/shell.nix
+++ b/shell.nix
@@ -9,7 +9,7 @@ let
 
   haskellPackages = pkgs.haskellPackages;
 
-  oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=6fc2d621573e048b7ce2dabfc4887c7876055f8d&ref=user-queries").packages.x86_64-linux;
+  oauth2Flake = (builtins.getFlake "git+https://gitlab.uniworx.de/mosbach/oauth2-mock-server/?rev=d47908b4f7883b4b485abf1ee06645495ccdc7b3&ref=user-queries").packages.x86_64-linux;
 
   oauth2MockServer = oauth2Flake.default;
   mkOauth2DB = oauth2Flake.mkOauth2DB;

From bbeebc641ee89a98f70616b1e722ac6b461e302a Mon Sep 17 00:00:00 2001
From: David Mosbach 
Date: Mon, 12 Feb 2024 15:06:30 +0000
Subject: [PATCH 12/12] chore(auth): new port offset calculation

---
 .ports/assign.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++
 .ports/offsets   | 24 ++++++++++++++++++
 shell.nix        |  8 +++---
 3 files changed, 93 insertions(+), 3 deletions(-)
 create mode 100644 .ports/assign.hs
 create mode 100644 .ports/offsets

diff --git a/.ports/assign.hs b/.ports/assign.hs
new file mode 100644
index 000000000..000881729
--- /dev/null
+++ b/.ports/assign.hs
@@ -0,0 +1,64 @@
+-- SPDX-FileCopyrightText: 2024 David Mosbach 
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+{-# Language OverloadedStrings, LambdaCase, TypeApplications #-}
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import System.Directory
+import System.Environment
+import System.IO
+
+main :: IO ()
+main = getArgs >>= \case
+  ["--assign", offsetFile] -> parseOffsets offsetFile >>= uncurry nextOffset
+  ["--remove", offset] -> removeOffset offset
+  _ -> fail "unsupported args"
+
+parseOffsets :: FilePath -> IO (Int,Int)
+parseOffsets offsetFile = do
+  user <- T.pack <$> getEnv "USER"
+  let pred x = "//" `T.isPrefixOf` x || T.null (T.strip x)
+      tokenise = map (filter (not . pred) . T.lines) . T.split (=='#')
+      extract = map tail . filter (\u -> not (null u) && user == (T.strip $ head u))
+  ((extract . tokenise . T.pack) <$> readFile offsetFile) >>= \case
+    [[min,max]] -> return (read $ T.unpack min, read $ T.unpack max)
+    x -> print x >> fail "malformed offset file"
+
+nextOffset :: Int -> Int -> IO ()
+nextOffset min max
+  | min > max = nextOffset max min
+  | otherwise = do
+      home <- getEnv "HOME"
+      offset <- findFile [home] ".port-offsets" >>= \case
+        Nothing   -> writeFile (home ++ "/.port-offsets") (show min) >> return min
+        Just path -> do
+          used <- (map (read @Int) . filter (not . null) . lines) <$> readFile path
+          o <- next min max used
+          appendFile path ('\n' : show o)
+          return o
+      print offset
+        where
+          next :: Int -> Int -> [Int] -> IO Int
+          next min max used
+            | min > max = fail "all offsets currently in use"
+            | min `elem` used = next (min+1) max used
+            | otherwise = return min
+
+removeOffset :: String -> IO ()
+removeOffset offset = do
+  home <- getEnv "HOME"
+  findFile [home] ".port-offsets" >>= \case
+    Nothing   -> fail "offset file does not exist"
+    Just path -> do
+      remaining <- (filter (/= offset) . lines) <$> readFile path
+      run <- getEnv "XDG_RUNTIME_DIR"
+      (tempPath, fh) <- openTempFile run ".port-offsets"
+      let out = unlines remaining
+      hPutStr fh $ out
+      case T.null (T.strip $ T.pack out) of
+        True -> removeFile path
+        False -> writeFile path $ out
+      removeFile tempPath
+
diff --git a/.ports/offsets b/.ports/offsets
new file mode 100644
index 000000000..7a4e5e7d6
--- /dev/null
+++ b/.ports/offsets
@@ -0,0 +1,24 @@
+// SPDX-FileCopyrightText: 2024 David Mosbach 
+//
+// SPDX-License-Identifier: AGPL-3.0-or-later
+
+# gkleen
+  -1000
+  -950
+
+# ishka
+  -949
+  -899
+
+# jost
+  -898
+  -848
+
+# mosbach
+  -847
+  -797
+
+# savau
+  -796
+  -746
+
diff --git a/shell.nix b/shell.nix
index 58494040a..8c3f8b97e 100644
--- a/shell.nix
+++ b/shell.nix
@@ -63,6 +63,7 @@ let
       type cleanup_maildev &>/dev/null && cleanup_maildev
       [[ -z "$OAUTH2_PGDIR" ]] || source ${killOauth2DB}/bin/killOauth2DB
       [[ -z "$OAUTH2_PGHOST" ]] || pkill oauth2-mock-ser
+      [[ -z "$PORT_OFFSET" ]] || runghc .ports/assign.hs --remove $PORT_OFFSET
 
       [ -f "''${basePath}/.develop.env" ] && rm -vf "''${basePath}/.develop.env"
       set +x
@@ -70,10 +71,13 @@ let
 
     trap cleanup EXIT
 
-    export PORT_OFFSET=$(((16#$(sha256sum <<<"$(hostname -f):''${basePath}" | head -c 16)) % 1000))
+    export PORT_OFFSET=$(runghc .ports/assign.hs --assign .ports/offsets)
+    # export PORT_OFFSET=$(((16#$(sha256sum <<<"$(hostname -f):''${basePath}" | head -c 16)) % 1000))
 
     if [[ -z "$OAUTH2_PGHOST" ]]; then
       set -xe
+      export OAUTH2_SERVER_PORT=$((9443 + $PORT_OFFSET))
+      export OAUTH2_DB_PORT=$((9444 + $PORT_OFFSET))
       source ${mkOauth2DB}/bin/mkOauth2DB
       ${oauth2MockServer}/bin/oauth2-mock-server&
       set +xe
@@ -300,8 +304,6 @@ in pkgs.mkShell {
   OAUTH2_HBA = oauth2Hba;
   OAUTH2_DB_SCHEMA = oauth2Schema;
   OAUTH2_TEST_USERS = ./test/Database/test-users.yaml;
-  OAUTH2_SERVER_PORT = 9443;
-  OAUTH2_DB_PORT = 9444;
   nativeBuildInputs = [develop inDevelop killallUni2work diffRunning]
   ++ (with pkgs;
     [ stack nodejs-14_x postgresql_12 openldap exiftool memcached minio minio-client