-- SPDX-FileCopyrightText: 2022 Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Handler.Admin.Ldap ( getAdminLdapR , postAdminLdapR ) where import Import -- import qualified Control.Monad.State.Class as State -- import Data.Aeson (encode) import qualified Data.CaseInsensitive as CI import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -- import qualified Data.Set as Set import Foundation.Yesod.Auth (decodeUserTest,ldapLookupAndUpsert,campusUserFailoverMode,CampusUserConversionException()) import Handler.Utils import qualified Ldap.Client as Ldap import Auth.LDAP getAdminLdapR, postAdminLdapR :: Handler Html getAdminLdapR = postAdminLdapR postAdminLdapR = do ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminLdapLookup"::Text) $ \html -> flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing let procFormPerson :: Text -> Handler (Maybe (Ldap.AttrList [])) procFormPerson lid = do ldapPool' <- getsYesod $ view _appLdapPool case ldapPool' of Nothing -> addMessage Error (text2Html "LDAP Configuration missing.") >> return Nothing Just ldapPool -> do addMessage Info $ text2Html "Input for LDAP test received." ldapData <- campusUser'' ldapPool campusUserFailoverMode lid decodedErr <- decodeUserTest (pure $ CI.mk lid) $ concat ldapData whenIsLeft decodedErr $ addMessageI Error return ldapData mbLdapData <- formResultMaybe presult procFormPerson ((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")