diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 0bebc13b9..9d4bbb1f2 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -4,7 +4,7 @@ module Foundation.Yesod.Auth ( authenticate - , upsertCampusUser + , upsertCampusUser, upsertCampusUserByCn , decodeUserTest , CampusUserConversionException(..) , campusUserFailoverMode, updateUserLanguage @@ -152,6 +152,14 @@ _upsertCampusUserMode mMode cs@Creds{..} defaultOther = apHash +upsertCampusUserByCn :: forall m. + ( MonadHandler m, HandlerSite m ~ UniWorX + , MonadThrow m + ) + => Text -> SqlPersistT m (Entity User) +upsertCampusUserByCn persNo = upsertCampusUser UpsertCampusUserGuessUser [(ldapPrimaryKey,[Text.encodeUtf8 persNo])] + + upsertCampusUser :: forall m. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 0a371b7e7..a85d185cc 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -9,7 +9,7 @@ module Handler.Utils.Avs , setLicence, setLicenceAvs, setLicencesAvs , checkLicences , lookupAvsUser, lookupAvsUsers - , upsertAvsUser, upsertAvsUserByCard + , upsertAvsUserById, upsertAvsUserByCard ) where import Import @@ -21,11 +21,10 @@ import Utils.Avs import qualified Data.Set as Set import qualified Data.Map as Map -import qualified Data.Text.Encoding as Text import qualified Data.CaseInsensitive as CI -import Auth.LDAP (ldapUserPrincipalName) -import Foundation.Yesod.Auth (upsertCampusUser,CampusUserConversionException()) +-- import Auth.LDAP (ldapUserPrincipalName) +import Foundation.Yesod.Auth (upsertCampusUserByCn,CampusUserConversionException()) import Handler.Users.Add @@ -115,16 +114,17 @@ checkLicences = do {- -upsertAvsUser :: AvsStatusPerson -> - -or - +upsertAvsUser :: Text -> Handler (Maybe UserId) +upsertAvsUser someid + | isAvsId someid = error "TODO" + | isEmail someid = error "TODO" + | isNumber someid = error "TODO" -} -- | Retrieve and _always_ update user by AvsPersonId. Non-existing users are created. -- Throws errors if the avsInterface in unavailable or the user is non-unique within external AVS DB (should never happen). -upsertAvsUser :: AvsPersonId -> Handler (Maybe UserId) -upsertAvsUser api = do +upsertAvsUserById :: AvsPersonId -> Handler (Maybe UserId) +upsertAvsUserById api = do mbapd <- lookupAvsUser api mbuid <- runDB $ do mbuid <- getBy (UniqueUserAvsId api) @@ -136,7 +136,8 @@ upsertAvsUser api = do [uid] -> insertUniqueEntity $ UserAvs api uid (_:_) -> throwM AvsUserAmbiguous [] -> do - upsRes :: Either CampusUserConversionException (Entity User) <- try $ upsertCampusUser UpsertCampusUserGuessUser [(ldapUserPrincipalName,[Text.encodeUtf8 persNo])] + upsRes :: Either CampusUserConversionException (Entity User) + <- try $ upsertCampusUserByCn persNo case upsRes of Right Entity{entityKey=uid} -> insertUniqueEntity $ UserAvs api uid _other -> return mbuid -- ==Nothing -- user could not be created somehow @@ -144,7 +145,7 @@ upsertAvsUser api = do case (mbuid, mbapd) of ( _ , Nothing ) -> throwM $ AvsUserUnknownByAvs api -- User not found in AVS at all, i.e. no valid card exists yet (Nothing, Just AvsDataPerson{..}) -> do -- No LDAP User, but found in AVS; create user - let firmAddress = mergeFirmAddress <$> guessLicenceAddress avsPersonPersonCards + let firmAddress = mergeCompanyAddress <$> guessLicenceAddress avsPersonPersonCards bestCard = Set.lookupMax avsPersonPersonCards fakeIdent = CI.mk $ tshow api newUsr = AdminUserForm @@ -166,7 +167,7 @@ upsertAvsUser api = do , aufIdent = fakeIdent -- use AvsPersonId instead , aufAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known } - _ <- addNewUser newUsr + _ <- addNewUser newUsr -- trigger JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe -- _newAvs = UserAvs avsPersonPersonID uid -- _newAvsCards = UserAvsCard error "TODO" -- CONTINUE HERE @@ -193,7 +194,7 @@ upsertAvsUserByCard persNo = do mbuid <- runDB $ getBy $ UniqueUserAvsId appi case mbuid of (Just (Entity _ UserAvs{userAvsUser=uau})) -> return $ Just uau - Nothing -> upsertAvsUser appi + Nothing -> upsertAvsUserById appi diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index 00251aa95..df3b35c40 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -98,9 +98,9 @@ guessLicenceAddress cards | otherwise = Nothing -- | Helper for guessLicenceAddress -mergeFirmAddress :: (Maybe Text, Text, a) -> Text -mergeFirmAddress (Nothing , addr, _) = addr -mergeFirmAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr +mergeCompanyAddress :: (Maybe Text, Text, a) -> Text +mergeCompanyAddress (Nothing , addr, _) = addr +mergeCompanyAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr hasAddress :: AvsDataPersonCard -> Bool hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode