refactor(avs): rewrite AVS synch (WIP)

src/Handler/Admin/Avs.hs

@@ -382,7 +382,7 @@ getProblemAvsSynchR = do
       numUnknownLicenceOwners = length unknownLicenceOwners
 
   (btnImportUnknownWgt, btnImportUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDBtnAvsImportUnknown
-  ifMaybeM btnImportUnknownRes () $ \BtnAvsImportUnknown -> do
+  ifNothingM btnImportUnknownRes () $ \BtnAvsImportUnknown -> do
     res <- catchAllAvs $ forM (take 500 unknownLicenceOwners) $ try . upsertAvsUserById -- TODO: turn this into a background job
     let procRes (Right _)                           = (Sum 1, mempty :: Set.Set AvsPersonId, mempty :: Set.Set AvsPersonId, mempty)
         --TODO: continue here!
@@ -413,7 +413,7 @@ getProblemAvsSynchR = do
             ^{revokeUnknownExecWgt}
         |]
 
-  ifMaybeM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> do
+  ifNothingM btnRevokeUnknownRes () $ \BtnAvsRevokeUnknown -> do
     let revokes = Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners
         no_revokes = Set.size revokes
     oks <- catchAllAvs $ setLicencesAvs revokes

src/Handler/Course/Edit.hs

@@ -291,9 +291,9 @@ getCourseNewR = do
                 }
         [] -> do
             (tidOk,sshOk,cshOk) <- runDB $ (,,)
-                <$> ifMaybeM mbTid True existsKey
+                <$> ifNothingM mbTid True existsKey
-                <*> ifMaybeM mbSsh True existsKey
+                <*> ifNothingM mbSsh True existsKey
-                <*> ifMaybeM mbCsh True (\csh -> not . null <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
+                <*> ifNothingM mbCsh True (\csh -> not . null <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
             unless tidOk $ addMessageI Warning $ MsgNoSuchTerm   $ fromJust mbTid -- safe, since tidOk==True otherwise
             unless sshOk $ addMessageI Warning $ MsgNoSuchSchool $ fromJust mbSsh -- safe, since sshOk==True otherwise
             unless cshOk $ addMessageI Warning $ MsgNoSuchCourseShorthand $ fromJust mbCsh

src/Jobs/Handler/Invitation.hs

@@ -21,7 +21,7 @@ dispatchJobInvitation :: Maybe UserId
                       -> Html
                       -> JobHandler UniWorX
 dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvitationExplanation = JobHandlerException $ do
-  (mInviter, mInviterAddress) <- ifMaybeM jInviter (Nothing,Nothing) $ \uid -> runDB $ do 
+  (mInviter, mInviterAddress) <- ifNothingM jInviter (Nothing,Nothing) $ \uid -> runDB $ do 
     usrEnt <- getEntity uid
     usrAdr <- join <$> traverse getEmailAddress usrEnt
     return (usrEnt ^? _Just . _entityVal, usrAdr)

src/Jobs/Handler/LMS.hs

@@ -92,7 +92,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
                           }
                   _ -> return ()
           -- send second reminders first, before enqueing even more
-          ifMaybeM (qualificationRefreshReminder quali) () sendReminders
+          ifNothingM (qualificationRefreshReminder quali) () sendReminders
 
           renewalUsers <- E.select $ do
             quser <- E.from $ E.table @QualificationUser

src/Jobs/Handler/SynchroniseAvs.hs

@@ -6,9 +6,7 @@ module Jobs.Handler.SynchroniseAvs
   ( dispatchJobSynchroniseAvs  
   , dispatchJobSynchroniseAvsId
   , dispatchJobSynchroniseAvsUser  
-  , dispatchJobSynchroniseAvsNext   -- internal only
   , dispatchJobSynchroniseAvsQueue  -- internal only  
-  , dispatchJobSynchroniseAvsQueue' -- internal only TODO replace unprimed
   ) where
 
 import Import
@@ -48,26 +46,18 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
       guard $ userIteration == currentIteration      
       return $ AvsSync userId now pause      
 
--- dispatchJobSynchroniseAvs' :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
--- dispatchJobSynchroniseAvs' numIterations epoch iteration pause = JobHandlerAtomic $ do 
-
-
 dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> JobHandler UniWorX
 dispatchJobSynchroniseAvsId apid pause = JobHandlerException $ do 
-  ok <- runDB $ getBy (UniqueUserAvsId apid) >>= 
+    usrAvs <- runDB $ getBy (UniqueUserAvsId apid)
-    \case
+    ifNothingM usrAvs insertUnknown processKnown  
-      (Just Entity{entityVal=UserAvs{userAvsUser=uid}}) -> do -- known user 
+  where 
-        workJobSychronizeAvs uid pause
+    processKnown Entity{entityVal=UserAvs{userAvsUser=uid}} = workJobSychronizeAvs uid pause
-        return True
+    insertUnknown = void $ maybeCatchAll $ Just <$> upsertAvsUserById apid
-      _ -> -- unknown avsPersonId, attempt to create user
-        return False
-  unless ok $ void $ maybeCatchAll $ Just <$> upsertAvsUserById apid -- TOOD: needs thorough refactoring
-
 
 dispatchJobSynchroniseAvsUser :: UserId -> Maybe Day -> JobHandler UniWorX
-dispatchJobSynchroniseAvsUser uid pause = JobHandlerException $ runDB $ workJobSychronizeAvs uid pause
+dispatchJobSynchroniseAvsUser uid pause = JobHandlerException $ workJobSychronizeAvs uid pause
 
-workJobSychronizeAvs :: UserId -> Maybe Day -> DB ()
+workJobSychronizeAvs :: UserId -> Maybe Day -> Handler ()
 workJobSychronizeAvs uid pause = do
     now <- liftIO getCurrentTime
     -- void $ E.upsert
@@ -76,45 +66,16 @@ workJobSychronizeAvs uid pause = do
     --           , avsSyncPause        = pause
     --           }
     --   [ \oldSync -> (AvsSyncPause E.=. E.greatest (E.val pause) (oldSync E.^. AvsSyncPause)) oldSync ] -- causes Esqueleto to call undefined at Database.Esqueleto.Internal.Internal.renderUpdates:1308
-    maybeM 
+    runDB $ maybeM 
       (insert_ AvsSync{avsSyncUser=uid, avsSyncCreationTime=now, avsSyncPause=pause})
       (\Entity{entityKey=asid, entityVal=AvsSync{avsSyncPause=oldPause}} ->
         update asid [AvsSyncPause =. max pause oldPause, AvsSyncCreationTime =. now])
       (getBy $ UniqueAvsSyncUser uid)
-    queueJob' JobSynchroniseAvsQueue
+    queueJob JobSynchroniseAvsQueue
+
 
 dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
 dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
-  syncJob <- runDB $ 
-    selectFirst [] [Asc AvsSyncCreationTime] >>= \case
-      Nothing -> return Nothing -- nothing more to do
-      Just Entity{entityKey=asid, entityVal=AvsSync{..}} -> do
-        delete asid        
-        getBy (UniqueUserAvsUser avsSyncUser) >>= \case
-          Just uae@Entity{entityVal=UserAvs{userAvsLastSynch=_} }
-            -- | maybe True (utctDay userAvsLastSynch <) avsSyncPause   -- TODO: we ignore pauses for now
-            -> return $ Just uae
-          _other -> return Nothing -- we just updated this one within the given limit or the entity does not exist
-        
-  ifMaybeM syncJob () $ \Entity{entityKey=avsKey, entityVal=UserAvs{userAvsPersonId=apid}} -> do
-    void $ queueJob JobSynchroniseAvsNext
-    catch (void $ upsertAvsUserById apid) -- already updates UserAvsLastSynch
-            (\exc -> do 
-              now <- liftIO getCurrentTime              
-              runDB (update avsKey [UserAvsLastSynchError =. Just (tshow exc), UserAvsLastSynch =. now])
-              case exc of
-                AvsInterfaceUnavailable -> return ()  -- ignore and retry later -- TODO won't be retried, since individual job had been deleted
-                AvsUserUnknownByAvs _   -> return ()  -- ignore for users no longer listed in AVS
-                otherExc                -> throwM otherExc
-            )            
-
--- needed, since JobSynchroniseAvsQueue cannot requeue itself due to JobNoQueueSame (and having no parameters)
-dispatchJobSynchroniseAvsNext :: JobHandler UniWorX
-dispatchJobSynchroniseAvsNext = JobHandlerException $ void $ queueJob JobSynchroniseAvsQueue
-
-
-dispatchJobSynchroniseAvsQueue' :: JobHandler UniWorX
-dispatchJobSynchroniseAvsQueue' = JobHandlerException $ do
     (unlinked,linked) <- runDB $ do
       jobs <- E.select (do
           (avsSync :& usrAvs) <- E.from $  E.table @AvsSync 

src/Jobs/Types.hs

@@ -109,7 +109,6 @@ data Job
                               , jSynchAfter :: Maybe Day
                               }                              
   | JobSynchroniseAvsQueue  
-  | JobSynchroniseAvsNext
   | JobChangeUserDisplayEmail { jUser :: UserId
                               , jDisplayEmail :: UserEmail
                               }
@@ -354,7 +353,6 @@ jobNoQueueSame = \case
   JobSynchroniseAvsUser{}             -> Just JobNoQueueSame
   JobSynchroniseAvsId{}               -> Just JobNoQueueSame
   JobSynchroniseAvsQueue{}            -> Just JobNoQueueSame  
-  JobSynchroniseAvsNext{}             -> Just JobNoQueueSame  
   JobChangeUserDisplayEmail{}         -> Just JobNoQueueSame
   JobPruneSessionFiles{}              -> Just JobNoQueueSameTag
   JobPruneUnreferencedFiles{}         -> Just JobNoQueueSameTag

src/Utils.hs

@@ -935,10 +935,10 @@ whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
 whenIsJust Nothing  _ = return ()
 
--- ifMaybeM m d a = maybe (return d) a m
+-- ifNothingM m d a = maybe (return d) a m
-ifMaybeM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argument order as compared to maybeM
+ifNothingM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argument order as compared to maybeM
-ifMaybeM Nothing dft _  = return dft
+ifNothingM Nothing dft _  = return dft
-ifMaybeM (Just x) _ act = act x
+ifNothingM (Just x) _ act = act x
 
 maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespeare: one $maybe instead of $with & $if
 maybePositive a | a > 0     = Just a

src/Utils/Print.hs

@@ -261,7 +261,7 @@ printLetter' pji pdf = do
       -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf   -- for PrintJobFile :: FileContentReference use this code
       printJobFile = LBS.toStrict pdf
       printJobAcknowledged = Nothing
-  qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get
+  qshort <- ifNothingM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get
   let logInter = flip (logInterface "Printer" qshort) (Just 1)
   lprPDF printJobFilename pdf >>= \case
     Left err -> do
@@ -279,7 +279,7 @@ reprintPDF ignoreReroute pjid = maybeM (return $ Left "Print job id is unknown."
   where 
     reprint :: PrintJob -> DB (Either Text Text)
     reprint pj@PrintJob{..} = do 
-      qshort <- ifMaybeM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get  
+      qshort <- ifNothingM printJobQualification "-" $ fmap (maybe "_" $ CI.original . qualificationShorthand ) . get  
       let logInter = flip (logInterface "Printer" qshort) (Just 1)
       result <- lprPDF' ignoreReroute printJobFilename $ LBS.fromStrict printJobFile
       case result of