chore(avs): work on new avs upsert user (WIP)

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

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 Auth.LDAP (ldapUserPrincipalName)
-import Foundation.Yesod.Auth (upsertCampusUser,CampusUserConversionException())
+import Foundation.Yesod.Auth (upsertCampusUserByCn,CampusUserConversionException())
 
 import Handler.Users.Add
 
@@ -115,16 +114,17 @@ checkLicences = do
 
 
 {-
-upsertAvsUser :: AvsStatusPerson ->
+upsertAvsUser :: Text -> Handler (Maybe UserId)
-
+upsertAvsUser someid 
-or
+  | 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)
+upsertAvsUserById :: AvsPersonId -> Handler (Maybe UserId)
-upsertAvsUser api = do  
+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
 
 
 

src/Utils/Avs.hs

@@ -98,9 +98,9 @@ guessLicenceAddress cards
   | otherwise = Nothing
 
 -- | Helper for guessLicenceAddress
-mergeFirmAddress :: (Maybe Text, Text, a) -> Text
+mergeCompanyAddress :: (Maybe Text, Text, a) -> Text
-mergeFirmAddress (Nothing  , addr, _) = addr
+mergeCompanyAddress (Nothing  , addr, _) = addr
-mergeFirmAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr
+mergeCompanyAddress (Just firm, addr, _) = firm <> Text.cons '\n' addr
 
 hasAddress :: AvsDataPersonCard -> Bool
 hasAddress AvsDataPersonCard{..} = isJust avsDataStreet && isJust avsDataCity && isJust avsDataPostalCode