@@ -13,11 +13,7 @@ import Control.Exception.Lifted (finally, catch)
1313import Control.Monad.Logger
1414import Control.Monad.Reader
1515import Data.Aeson as Aeson
16−-- import UnliftIO.Async
17−-- import UnliftIO.Concurrent
18−-- import UnliftIO.Exception
1916import Control.Concurrent.Lifted
20−import Control.Concurrent.Async (AsyncCancelled(..))
2117import Control.Concurrent.Async.Lifted
2218import Job (Job(..), JobId)
2319import System.Log.FastLogger (fromLogStr, withFastLogger, LogType(..), defaultBufSize, FastLogger, FileLogSpec(..))
@@ -36,14 +32,6 @@ import Control.Monad.Trans.Control (liftWith, restoreT)
3632import Control.Monad.Morph (hoist)
3733import Data.List as DL
3834
39−
40−
41−setupDatabase :: ConnectInfo -> IO ()
42−setupDatabase cinfo = pure ()
43− -- do
44− -- conn1 <- connect cinfo{connectDatabase="postgres"}
45− -- finally (void $ PGS.execute_ conn1 "drop database if exists jobs_test; create database jobs_test") (close conn1)
46−
4735main :: IO ()
4836main = do
4937 let connInfo = ConnectInfo
@@ -53,7 +41,6 @@ main = do
5341 , connectPassword = "jobs_test"
5442 , connectDatabase = "jobs_test"
5543 }
56− setupDatabase connInfo
5744 appPool <- createPool
5845 (PGS.connect connInfo) -- cretea a new resource
5946 (PGS.close) -- destroy resource
@@ -68,34 +55,11 @@ main = do
6855 (fromRational 10) -- number of seconds unused resources are kept around
6956 45 -- maximum open connections
7057
71− -- let foo i conn = do
72− -- traceM $ " === executing query in thread " <> show i <> "\n\n"
73− -- void $ PGS.execute_ conn "update jobs set id=id+1 where id < 0"
74− -- threadDelay (oneSec * 5)
75−
76− -- void $ forConcurrently [1..50] (\i -> Pool.withResource dbpool (foo i))
77−
78− -- defaults <- (Job.defaultJobMonitor jobPool)
79− -- let jobMonitorSettings = defaults{ Job.monitorJobRunner = jobRunner }
80−
81− -- withFastLogger (LogFile FileLogSpec{log_file="test.log", log_file_size=1024*1024*10, log_backup_number=5} defaultBufSize) $ \ flogger -> do
82− -- let env = Env { envDbPool = jobPool, envLogger = flogger }
83− -- finally
84− -- (withAsync (Job.runJobMonitor jobMonitorSettings) (const $ defaultMain $ tests appPool jobPool))
85− -- ((Pool.destroyAllResources appPool) >> (Pool.destroyAllResources jobPool))
86−
8758 defaultMain $ tests appPool jobPool
8859
89−-- tests dbpool = testGroup "All tests" $ (\t -> t dbpool) <$> [simpleJobCreation]
90−-- tests appPool jobPool = testGroup "All tests"
91−-- [ testGroup "simple tests" $ (\t -> t appPool) <$> [testJobFailure, testJobCreation, testJobScheduling]
92−-- , testGroup "property tests" [testPayloadGenerator appPool jobPool] -- [testEverything appPool jobPool]
93−-- ]
94−
9560tests appPool jobPool = testGroup "All tests"
9661 [
9762 testGroup "simple tests" [testJobCreation appPool jobPool, testJobScheduling appPool jobPool, testJobFailure appPool jobPool, testEnsureShutdown appPool jobPool]
98− -- testGroup "simple tests" [testEnsureShutdown appPool jobPool]
9963 , testGroup "property tests" [testEverything appPool jobPool]
10064 ]
10165
@@ -129,7 +93,6 @@ instance {-# OVERLAPPING #-} MonadLogger TestM where
12993 monadLoggerLog _ _ _ msg = do
13094 flogger <- envLogger <$> ask
13195 liftIO $ flogger $ toLogStr msg <> toLogStr ("\n" :: String)
132− -- monadLoggerLog _ _ _ _ = pure ()
13396
13497testPayload :: Value
13598testPayload = toJSON (10 :: Int)
@@ -171,11 +134,6 @@ ensureJobId conn tname jid = Job.findJobById conn tname jid >>= \case
171134 Nothing -> error $ "Not expecting job to be deleted. JobId=" <> show jid
172135 Just j -> pure j
173136
174−-- simpleJobCreation appPool jobPool = testCase "simple job creation" $ do
175−-- jobs <- (forConcurrently [1..10000] (const $ Pool.withResource appPool $ \conn -> Job.createJob conn testPayload))
176−-- threadDelay (oneSec * 280)
177−-- forConcurrently_ jobs $ \Job{jobId} -> Pool.withResource appPool $ \conn -> assertJobIdStatus conn "Expecting job to be completed by now" Job.Success jid
178−
179137-- withRandomTable :: (MonadIO m) => Pool Connection -> (Job.TableName -> m a) -> m a
180138withRandomTable jobPool action = do
181139 (tname :: Job.TableName) <- liftIO ((("jobs_" <>) . fromString) <$> (replicateM 10 (R.randomRIO ('a', 'z'))))
@@ -240,8 +198,6 @@ testJobFailure appPool jobPool = testCase "job retry" $ withNewJobMonitor jobPoo
240198 assertEqual "Exepcting job to be in Failed status" Job.Failed jobStatus
241199 assertEqual ("Expecting job attempts to be 3. Found " <> show jobAttempts) 3 jobAttempts
242200
243−-- withRandomTableLifted jobPool action = liftWith (\run -> withRandomTable jobPool (run . action)) >>= restoreT . return
244−
245201data JobEvent = JobStart
246202 | JobRetry
247203 | JobSuccess
@@ -337,6 +293,3 @@ payloadDelay jobPollingInterval pload = payloadDelay_ 0 pload
337293 PayloadSucceed x -> total + x + jobPollingInterval
338294 PayloadFail x ip -> payloadDelay_ (total + x + jobPollingInterval) ip
339295
340− -- xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha
341− -- reverse (reverse xs) === xs
342−