summaryrefslogtreecommitdiff
path: root/Omni/Task/RaceTest.hs
blob: 8ab797a5e57bb19a2a9945806969f92117a97e27 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Omni.Task.RaceTest where

import Alpha
import Control.Concurrent.Async (mapConcurrently)
import Data.List (nub)
import qualified Data.Text as T
import Omni.Task.Core
import qualified Omni.Test as Test
import System.Directory (doesFileExist, removeFile)
import System.Environment (setEnv)

test :: Test.Tree
test = Test.group "Omni.Task.Race" [raceTest]

raceTest :: Test.Tree
raceTest =
  Test.unit "concurrent child creation (race condition)" <| do
    -- Set up test mode (uses _/tmp/tasks-test.db)
    setEnv "TASK_TEST_MODE" "1"

    -- Clean up test database
    let testFile = "_/tmp/tasks-test.db"
    exists <- doesFileExist testFile
    when exists <| removeFile testFile
    initTaskDb

    -- Create a parent epic
    parent <- createTask "Parent Epic" Epic Nothing Nothing P2 Nothing [] "Parent Epic description"
    let parentId = taskId parent

    -- Create multiple children concurrently
    -- We'll create 10 children in parallel
    let childCount = 10
        indices = [1 .. childCount]

    -- Run concurrent creations
    children <-
      mapConcurrently
        (\i -> createTask ("Child " <> tshow i) WorkTask (Just parentId) Nothing P2 Nothing [] ("Child " <> tshow i <> " description"))
        indices

    -- Check for duplicates in generated IDs
    let ids = map taskId children
        uniqueIds = nub ids

    -- If there was a race condition, we'd have fewer unique IDs than children
    length uniqueIds Test.@?= length children
    length uniqueIds Test.@?= childCount

    -- Verify IDs follow the pattern parentId.N
    for_ ids <| \tid -> do
      (parentId `T.isPrefixOf` tid) Test.@?= True

    -- Cleanup
    removeFile testFile