Merge pull request #1062 from IntersectMBO/remove-semaphores-and-para…

…llelism

Remove semaphores and disable parallel test execution for GHA

.github/workflows/haskell.yml

@@ -77,7 +77,7 @@ jobs:
     - name: Cabal update
       run: cabal update
 
-    # A dry run `build all` operation does *NOT* downlaod anything, it just looks at the package
+    # A dry run `build all` operation does *NOT* download anything, it just looks at the package
     # indices to generate an install plan.
     - name: Build dry run
       run: cabal build all --enable-tests --dry-run --minimize-conflict-set
@@ -142,7 +142,9 @@ jobs:
         TMP: ${{ runner.temp }}
         KEEP_WORKSPACE: 1
         CREATE_GOLDEN_FILES: 1
-      run: cabal test all --enable-tests --test-show-details=direct
+      # We disable parallel execution of tests because there is a race condition
+      # that appears only in CI when the golden files are removed and then recreated
+      run: cabal test all --enable-tests --test-show-details=direct --ghc-options="-threaded -rtsopts \"-with-rtsopts=-N1 -T\""
 
     # We want this check to run first because $(git ls-files -m) (see below) returns both
     # modified files *and* deleted files. So we want to fail on deleted files first.

cardano-cli/cardano-cli.cabal

@@ -309,7 +309,6 @@ library cardano-cli-test-lib
     process,
     resourcet,
     text,
-    transformers-base,
     utf8-string,
     vector,
     wai,

cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs

@@ -19,7 +19,7 @@ import           System.Directory.Extra (listDirectories)
 import           System.FilePath
 
 import           Test.Cardano.CLI.Aeson
-import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, newFileSem)
+import           Test.Cardano.CLI.Util (execCardanoCLI)
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H
@@ -96,10 +96,8 @@ hprop_golden_create_testnet_data_with_template =
   golden_create_testnet_data $
     Just "test/cardano-cli-golden/files/input/shelley/genesis/genesis.spec.json"
 
--- | Semaphore protecting against locked file error, when running properties concurrently.
-createTestnetDataOutSem :: FileSem
-createTestnetDataOutSem = newFileSem "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
-{-# NOINLINE createTestnetDataOutSem #-}
+createTestnetDataOutGoldenFile :: FilePath
+createTestnetDataOutGoldenFile = "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
 
 -- | This test tests the non-transient case, i.e. it maximizes the files
 -- that can be written to disk.
@@ -130,8 +128,7 @@ golden_create_testnet_data mShelleyTemplate =
         generated'' = map (\c -> if c == '\\' then '/' else c) generated'
     void $ H.note generated''
 
-    bracketSem createTestnetDataOutSem $
-      H.diffVsGoldenFile generated''
+    H.diffVsGoldenFile generated'' createTestnetDataOutGoldenFile
 
     shelleyGenesis :: ShelleyGenesis StandardCrypto <-
       H.readJsonFileOk $ outputDir </> "shelley-genesis.json"

cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs

@@ -20,25 +20,20 @@ import           System.Posix.Files (fileMode, getFileStatus)
 import           GHC.IO.Exception (ExitCode (ExitFailure))
 import           Test.Cardano.CLI.Hash (exampleAnchorDataHash, exampleAnchorDataIpfsHash,
                    exampleAnchorDataPathGolden, serveFilesWhile, tamperBase16Hash)
-import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, execDetailCardanoCLI,
-                   newFileSem, noteInputFile, noteTempFile, propertyOnce)
+import           Test.Cardano.CLI.Util (execCardanoCLI, execDetailCardanoCLI,
+                   noteInputFile, noteTempFile, propertyOnce)
 
 import           Hedgehog
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Golden as H
 
--- | Semaphore protecting against locked file error, when running properties concurrently.
-drepRetirementCertSem :: FileSem
-drepRetirementCertSem = newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
-{-# NOINLINE drepRetirementCertSem #-}
+drepRetirementCertFile :: FilePath
+drepRetirementCertFile = "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
 
--- | Semaphore protecting against locked file error, when running properties concurrently.
-drepRegistrationCertSem :: FileSem
-drepRegistrationCertSem =
-  newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
-{-# NOINLINE drepRegistrationCertSem #-}
+drepRegistrationCertFile :: FilePath
+drepRegistrationCertFile = "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
 
 hprop_golden_governanceDRepKeyGen :: Property
 hprop_golden_governanceDRepKeyGen =
@@ -174,7 +169,7 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey"
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    H.noteShow_ drepRetirementCertSem
+    H.noteShow_ drepRetirementCertFile
 
     void $
       execCardanoCLI
@@ -190,14 +185,13 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file =
         , certFile
         ]
 
-    bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile
+    H.diffFileVsGoldenFile certFile drepRetirementCertFile
 
 hprop_golden_governance_drep_retirement_certificate_id_hex :: Property
 hprop_golden_governance_drep_retirement_certificate_id_hex =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    H.noteShow_ drepRetirementCertSem
+    H.noteShow_ drepRetirementCertFile
 
     idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex"
 
@@ -215,14 +209,13 @@ hprop_golden_governance_drep_retirement_certificate_id_hex =
         , certFile
         ]
 
-    bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile
+    H.diffFileVsGoldenFile certFile drepRetirementCertFile
 
 hprop_golden_governance_drep_retirement_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_retirement_certificate_id_bech32 =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    H.noteShow_ drepRetirementCertSem
+    H.noteShow_ drepRetirementCertFile
 
     idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32"
 
@@ -240,8 +233,7 @@ hprop_golden_governance_drep_retirement_certificate_id_bech32 =
         , certFile
         ]
 
-    bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile
+    H.diffFileVsGoldenFile certFile drepRetirementCertFile
 
 hprop_golden_governance_drep_metadata_hash :: Property
 hprop_golden_governance_drep_metadata_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
@@ -297,7 +289,7 @@ hprop_golden_governance_drep_metadata_hash_cip119 = propertyOnce . H.moduleWorks
 hprop_golden_governance_drep_registration_certificate_vkey_file :: Property
 hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey"
-  H.noteShow_ drepRegistrationCertSem
+  H.noteShow_ drepRegistrationCertFile
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -319,13 +311,12 @@ hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce .
       , outFile
       ]
 
-  bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile
+  H.diffFileVsGoldenFile outFile drepRegistrationCertFile
 
 hprop_golden_governance_drep_registration_certificate_id_hex :: Property
 hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex"
-  H.noteShow_ drepRegistrationCertSem
+  H.noteShow_ drepRegistrationCertFile
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -347,13 +338,12 @@ hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.
       , outFile
       ]
 
-  bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile
+  H.diffFileVsGoldenFile outFile drepRegistrationCertFile
 
 hprop_golden_governance_drep_registration_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32"
-  H.noteShow_ drepRegistrationCertSem
+  H.noteShow_ drepRegistrationCertFile
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -375,8 +365,7 @@ hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce .
       , outFile
       ]
 
-  bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile
+  H.diffFileVsGoldenFile outFile drepRegistrationCertFile
 
 hprop_golden_governance_drep_registration_certificate_script_hash :: Property
 hprop_golden_governance_drep_registration_certificate_script_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do

cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Vote.hs

@@ -9,8 +9,8 @@ import qualified System.Environment as IO
 
 import           Test.Cardano.CLI.Hash (exampleAnchorDataHash, exampleAnchorDataIpfsHash,
                    exampleAnchorDataPathGolden, serveFilesWhile, tamperBase16Hash)
-import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI,
-                   execDetailConfigCardanoCLI, newFileSem, noteInputFile, propertyOnce)
+import           Test.Cardano.CLI.Util (execCardanoCLI, execDetailConfigCardanoCLI, noteInputFile,
+                   propertyOnce)
 
 import           Hedgehog (Property, (===))
 import qualified Hedgehog as H
@@ -47,15 +47,14 @@ hprop_golden_governance_governance_vote_create =
 
     H.diffFileVsGoldenFile voteFile voteGold
 
-voteViewJsonSem :: FileSem
-voteViewJsonSem = newFileSem "test/cardano-cli-golden/files/golden/governance/vote/voteViewJSON"
-{-# NOINLINE voteViewJsonSem #-}
+voteViewJsonFile :: FilePath
+voteViewJsonFile = "test/cardano-cli-golden/files/golden/governance/vote/voteViewJSON"
 
 hprop_golden_governance_governance_vote_view_json_stdout :: Property
 hprop_golden_governance_governance_vote_view_json_stdout =
   propertyOnce $ do
     voteFile <- noteInputFile "test/cardano-cli-golden/files/input/governance/vote/vote"
-    H.noteShow_ voteViewJsonSem
+    H.noteShow_ voteViewJsonFile
     voteView <-
       execCardanoCLI
         [ "conway"
@@ -66,15 +65,14 @@ hprop_golden_governance_governance_vote_view_json_stdout =
         , voteFile
         ]
 
-    bracketSem voteViewJsonSem $
-      H.diffVsGoldenFile voteView
+    H.diffVsGoldenFile voteView voteViewJsonFile
 
 hprop_golden_governance_governance_vote_view_json_outfile :: Property
 hprop_golden_governance_governance_vote_view_json_outfile =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     voteFile <- noteInputFile "test/cardano-cli-golden/files/input/governance/vote/vote"
     voteViewFile <- H.noteTempFile tempDir "voteView"
-    H.noteShow_ voteViewJsonSem
+    H.noteShow_ voteViewJsonFile
     void $
       execCardanoCLI
         [ "conway"
@@ -87,8 +85,7 @@ hprop_golden_governance_governance_vote_view_json_outfile =
         , voteViewFile
         ]
 
-    bracketSem voteViewJsonSem $
-      H.diffFileVsGoldenFile voteViewFile
+    H.diffFileVsGoldenFile voteViewFile voteViewJsonFile
 
 hprop_golden_governance_governance_vote_view_yaml :: Property
 hprop_golden_governance_governance_vote_view_yaml =

cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs

@@ -20,9 +20,6 @@ module Test.Cardano.CLI.Util
   , noteInputFile
   , noteTempFile
   , redactJsonField
-  , bracketSem
-  , FileSem
-  , newFileSem
   , expectFailure
   )
 where
@@ -31,13 +28,9 @@ import           Cardano.Api
 
 import           Cardano.CLI.Read
 
-import           Control.Concurrent (QSem, newQSem, signalQSem, waitQSem)
-import           Control.Exception.Lifted (bracket_)
 import           Control.Monad (when)
-import           Control.Monad.Base
 import           Control.Monad.Catch hiding (bracket_)
 import           Control.Monad.Morph (hoist)
-import           Control.Monad.Trans.Control (MonadBaseControl)
 import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
@@ -56,7 +49,6 @@ import qualified System.Environment as IO
 import qualified System.Exit as IO
 import           System.FilePath (takeDirectory)
 import qualified System.IO.Unsafe as IO
-import           System.IO.Unsafe (unsafePerformIO)
 import qualified System.Process as IO
 import           System.Process (CreateProcess)
 
@@ -356,40 +348,6 @@ redactJsonField fieldName replacement sourceFilePath targetFilePath = GHC.withFr
         v -> pure v
       H.evalIO $ LBS.writeFile targetFilePath (Aeson.encodePretty redactedJson)
 
--- | A file semaphore protecting against a concurrent path access
-data FileSem = FileSem !FilePath !QSem
-
-instance Show FileSem where
-  show (FileSem path _) = "FileSem " ++ path
-
-deriving via (ShowOf FileSem) instance Pretty FileSem
-
--- | Create new file semaphore. Always use with @NOINLINE@ pragma! Example:
--- @
--- createTestnetDataOutSem :: FileSem
--- createTestnetDataOutSem = newFileSem "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
--- {-# NOINLINE createTestnetDataOutSem  #-}
--- @
-newFileSem
-  :: FilePath
-  -- ^ path to be guarded by a semaphore allowing only one concurrent to access it
-  -> FileSem
-newFileSem fp = unsafePerformIO $ FileSem fp <$> newQSem 1
-{-# INLINE newFileSem #-}
-
--- | Run action acquiring a semaphore, and releasing afterwards. Guards against concurrent access to
--- a block of code.
-bracketSem
-  :: MonadBaseControl IO m
-  => FileSem
-  -- ^ a file semaphore
-  -> (FilePath -> m c)
-  -- ^ an action, a file path will be extracted from the semaphore
-  -> m c
-bracketSem (FileSem path semaphore) act =
-  bracket_ (liftBase $ waitQSem semaphore) (liftBase $ signalQSem semaphore) $
-    act path
-
 -- | Invert the behavior of a MonadTest: success becomes failure and vice versa.
 expectFailure
   :: (MonadTrans t, MonadTest (t m), MonadCatch (t m), MonadIO m, HasCallStack) => H.TestT m a -> t m ()