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

fix(avs): synch job deletes used row instead of truncation

Browse Source 
Database.Esquelet.Utils.truncate is suspected to crash in conjunction with the incomplete argument containing an error value due to strictness
This commit is contained in:
Steffen Jost 2024-06-21 13:09:16 +02:00
parent 822c43c8a7
commit d7acc7a2d0
2 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Database/Esqueleto/Utils.hs
View File

@ -52,7 +52,7 @@ module Database.Esqueleto.Utils
, day, day', dayMaybe, interval, diffDays, diffTimes
, exprLift
, explicitUnsafeCoerceSqlExprValue
, truncateTable
-- , truncateTable
, module Database.Esqueleto.Utils.TH
) where
@ -69,7 +69,7 @@ import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH
import qualified Database.Persist.Postgresql as P
-- import qualified Database.Persist.Postgresql as P
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
@ -772,6 +772,7 @@ instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2
(E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))
truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record)
=> record -> ReaderT backend m ()
truncateTable tbl = E.rawExecute ("TRUNCATE TABLE " <> P.tableName tbl <> " RESTART IDENTITY") []
-- Suspected to cause trouble. Needs more testing!
-- truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record)
-- => record -> ReaderT backend m ()
-- truncateTable tbl = E.rawExecute ("TRUNCATE TABLE " <> P.tableName tbl <> " RESTART IDENTITY") []

24
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -102,27 +102,29 @@ dispatchJobSynchroniseAvs numIterations epoch iteration pause
dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
jobs <- runDB $ do
jobs <- E.select (do
E.select (do
(avsSync :& usrAvs) <- E.from $ E.table @AvsSync
`E.leftJoin` E.table @UserAvs
`E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
let pause = avsSync E.^. AvsSyncPause
lastSync = usrAvs E.?. UserAvsLastSynch
E.where_ $ E.isNothing pause
E.||. E.isNothing lastSync
E.||. pause E.>. E.dayMaybe lastSync
return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId)
proceed = E.isNothing pause
E.||. E.isNothing lastSync
E.||. pause E.>. E.dayMaybe lastSync
-- E.where_ proceed -- we still want to delete all paused jobs, rather than to delay them only
return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId, proceed)
)
now <- liftIO getCurrentTime
E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
return jobs
-- now <- liftIO getCurrentTime
-- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
-- return jobs
let (unlinked, linked) = foldl' discernJob mempty jobs
$logInfoS "SynchronisAvs" [st|AVS synch performing for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
void $ updateAvsUserByIds linked
void $ linktoAvsUserByUIDs unlinked
runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)]
$logInfoS "SynchronisAvs" [st|AVS synch performed for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
-- we do not reschedule failed synchs here in order to avoid a loop
where
discernJob (accUid, accApi) ( _ , E.Value (Just api)) = ( accUid, Set.insert api accApi)
discernJob (accUid, accApi) (E.Value uid, E.Value Nothing ) = (Set.insert uid accUid, accApi)
discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api)
discernJob accs (E.Value uid, E.Value Nothing , E.Value True ) = accs & over _1 (Set.insert uid)
discernJob accs ( _ , _ , E.Value False ) = accs