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