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

chore(ldap): admin interface allows search by personal number

Browse Source
This commit is contained in:
Steffen Jost 2022-10-06 10:25:09 +02:00
parent 86b5f0f175
commit ef97e19522
2 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/Admin/Ldap.hs
View File

@ -6,7 +6,7 @@ module Handler.Admin.Ldap
) where ) where
import Import import Import
-- import qualified Control.Monad.State.Class as State import qualified Control.Monad.State.Class as State
-- import Data.Aeson (encode) -- import Data.Aeson (encode)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import qualified Data.Text as Text import qualified Data.Text as Text
@ -19,27 +19,27 @@ import Handler.Utils
import qualified Ldap.Client as Ldap import qualified Ldap.Client as Ldap
import Auth.LDAP import Auth.LDAP
newtype LdapQueryPerson = LdapQueryPerson data LdapQueryPerson = LdapQueryPerson
{ ldapQueryIdent :: Text { ldapQueryIdent :: Maybe Text
-- , ldapQueryName :: Maybe Text -- , ldapQueryName :: Maybe Text
-- , ldapQueryPNum :: Maybe Text , ldapQueryPNum :: Maybe Text
} }
deriving (Eq, Ord, Read, Show, Generic, Typeable) deriving (Eq, Ord, Read, Show, Generic, Typeable)
makeLdapPersonForm :: Maybe LdapQueryPerson -> Form LdapQueryPerson makeLdapPersonForm :: Maybe LdapQueryPerson -> Form LdapQueryPerson
makeLdapPersonForm tmpl = validateForm validateLdapQueryPerson $ \html -> makeLdapPersonForm tmpl = validateForm validateLdapQueryPerson $ \html ->
flip (renderAForm FormStandard) html $ LdapQueryPerson flip (renderAForm FormStandard) html $ LdapQueryPerson
<$> areq textField (fslI MsgAdminUserIdent) (ldapQueryIdent <$> tmpl) <$> aopt textField (fslI MsgAdminUserIdent) (ldapQueryIdent <$> tmpl)
-- <*> aopt textField (fslI MsgAdminUserSurname) (ldapQueryName <$> tmpl) -- <*> aopt textField (fslI MsgAdminUserSurname) (ldapQueryName <$> tmpl)
-- <*> aopt textField (fslI MsgAdminUserFPersonalNumber) (ldapQueryPNum <$> tmpl) <*> aopt textField (fslI MsgAdminUserFPersonalNumber) (ldapQueryPNum <$> tmpl)
validateLdapQueryPerson :: FormValidator LdapQueryPerson Handler () validateLdapQueryPerson :: FormValidator LdapQueryPerson Handler ()
validateLdapQueryPerson = return () -- currently no tests needed validateLdapQueryPerson = do
--LdapQueryPerson{..} <- State.get LdapQueryPerson{..} <- State.get
--guardValidation MsgAvsQueryEmpty guardValidation MsgAvsQueryEmpty $
--is _Just ldapQueryIdent || is _Just ldapQueryIdent ||
--is _Just ldapQueryName || -- is _Just ldapQueryName ||
--is _Just ldapQueryPNum is _Just ldapQueryPNum
@ -56,8 +56,10 @@ postAdminLdapR = do
then addMessage Warning $ text2Html "LDAP Configuration missing." then addMessage Warning $ text2Html "LDAP Configuration missing."
else addMessage Info $ text2Html "Input for LDAP test received." else addMessage Info $ text2Html "Input for LDAP test received."
fmap join . for ldapPool' $ \ldapPool -> do fmap join . for ldapPool' $ \ldapPool -> do
ldapData <- campusUser'' ldapPool FailoverUnlimited ldapQueryIdent ldapData <- if | Just lqi <- ldapQueryIdent -> campusUser'' ldapPool FailoverUnlimited lqi
decodedErr <- decodeUserTest (Just $ CI.mk ldapQueryIdent) $ concat ldapData | Just lqn <- ldapQueryPNum -> campusUserMatr' ldapPool FailoverUnlimited lqn
| otherwise -> addMessageI Error MsgAvsQueryEmpty >> pure Nothing
decodedErr <- decodeUserTest (CI.mk <$> ldapQueryIdent) $ concat ldapData
whenIsLeft decodedErr $ addMessageI Error whenIsLeft decodedErr $ addMessageI Error
return ldapData return ldapData