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 , day, day', dayMaybe, interval, diffDays, diffTimes
, exprLift , exprLift
, explicitUnsafeCoerceSqlExprValue , explicitUnsafeCoerceSqlExprValue
, truncateTable -- , truncateTable
, module Database.Esqueleto.Utils.TH , module Database.Esqueleto.Utils.TH
) where ) where
@ -69,7 +69,7 @@ import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Internal.Internal as E import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH 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 as Text
import qualified Data.Text.Lazy as Lazy (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 ())))) (E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ()))))
truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record) -- Suspected to cause trouble. Needs more testing!
=> record -> ReaderT backend m () -- truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record)
truncateTable tbl = E.rawExecute ("TRUNCATE TABLE " <> P.tableName tbl <> " RESTART IDENTITY") [] -- => 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 :: JobHandler UniWorX
dispatchJobSynchroniseAvsQueue = JobHandlerException $ do dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
jobs <- runDB $ do jobs <- runDB $ do
jobs <- E.select (do E.select (do
(avsSync :& usrAvs) <- E.from $ E.table @AvsSync (avsSync :& usrAvs) <- E.from $ E.table @AvsSync
`E.leftJoin` E.table @UserAvs `E.leftJoin` E.table @UserAvs
`E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser) `E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
let pause = avsSync E.^. AvsSyncPause let pause = avsSync E.^. AvsSyncPause
lastSync = usrAvs E.?. UserAvsLastSynch lastSync = usrAvs E.?. UserAvsLastSynch
E.where_ $ E.isNothing pause proceed = E.isNothing pause
E.||. E.isNothing lastSync E.||. E.isNothing lastSync
E.||. pause E.>. E.dayMaybe lastSync E.||. pause E.>. E.dayMaybe lastSync
return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId) -- 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 -- now <- liftIO getCurrentTime
E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing -- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
return jobs -- return jobs
let (unlinked, linked) = foldl' discernJob mempty 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|] $logInfoS "SynchronisAvs" [st|AVS synch performing for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
void $ updateAvsUserByIds linked void $ updateAvsUserByIds linked
void $ linktoAvsUserByUIDs unlinked 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|] $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 -- we do not reschedule failed synchs here in order to avoid a loop
where where
discernJob (accUid, accApi) ( _ , E.Value (Just api)) = ( accUid, Set.insert api accApi) discernJob accs ( _ , E.Value (Just api), E.Value True ) = accs & over _2 (Set.insert api)
discernJob (accUid, accApi) (E.Value uid, E.Value Nothing ) = (Set.insert uid accUid, accApi) discernJob accs (E.Value uid, E.Value Nothing , E.Value True ) = accs & over _1 (Set.insert uid)
discernJob accs ( _ , _ , E.Value False ) = accs