diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index e6627ebc23..5c359db8c8 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -268,8 +268,11 @@ library cardano-cli-test-lib , filepath , hedgehog , hedgehog-extras ^>= 0.6.1.0 + , lifted-base + , monad-control , process , text + , transformers-base test-suite cardano-cli-test import: project-config @@ -313,7 +316,7 @@ test-suite cardano-cli-test Test.Cli.Pipes Test.Cli.Shelley.Run.Query - ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T + ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" test-suite cardano-cli-golden import: project-config @@ -420,4 +423,4 @@ test-suite cardano-cli-golden Test.Golden.TxView Test.Golden.Version - ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T + ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs index c8a177ec54..a04794e948 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs @@ -6,7 +6,9 @@ import Cardano.Api.Shelley (ShelleyGenesis (..)) import qualified Cardano.Ledger.Shelley.API as L -import Control.Monad (filterM, forM_, void) +import Control.Concurrent (newQSem) +import Control.Concurrent.QSem (QSem) +import Control.Monad import Control.Monad.IO.Class import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as LBS @@ -16,8 +18,9 @@ import Data.Word (Word32) import System.Directory import System.Directory.Extra (listDirectories) import System.FilePath +import System.IO.Unsafe (unsafePerformIO) -import Test.Cardano.CLI.Util (execCardanoCLI) +import Test.Cardano.CLI.Util (bracketSem, execCardanoCLI) import Hedgehog (Property) import qualified Hedgehog as H @@ -25,7 +28,6 @@ import Hedgehog.Extras (moduleWorkspace, propertyOnce) import qualified Hedgehog.Extras as H import qualified Hedgehog.Extras.Test.Golden as H -{- HLINT ignore "Move brackets to avoid $" -} {- HLINT ignore "Use camelCase" -} networkMagic :: Word32 @@ -78,6 +80,12 @@ hprop_golden_create_testnet_data_with_template :: Property 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. +-- This semaphore protects @"test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"@. +createTestnetDataOutSem :: QSem +createTestnetDataOutSem = unsafePerformIO $ newQSem 1 +{-# NOINLINE createTestnetDataOutSem #-} + -- | This test tests the non-transient case, i.e. it maximizes the files -- that can be written to disk. golden_create_testnet_data :: () @@ -103,16 +111,17 @@ golden_create_testnet_data mShelleyTemplate = generated'' = map (\c -> if c == '\\' then '/' else c) generated' void $ H.note generated'' - H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out" + bracketSem createTestnetDataOutSem $ + H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out" bs <- liftIO $ LBS.readFile $ outputDir "genesis.json" genesis :: ShelleyGenesis StandardCrypto <- Aeson.throwDecode bs sgNetworkMagic genesis H.=== networkMagic - (length $ L.sgsPools $ sgStaking genesis) H.=== numPools + length (L.sgsPools $ sgStaking genesis) H.=== numPools forM_ (L.sgsPools $ sgStaking genesis) $ \pool -> - (Seq.length $ L.ppRelays pool) H.=== 1 + Seq.length (L.ppRelays pool) H.=== 1 actualNumDReps <- liftIO $ listDirectories $ outputDir "drep-keys" length actualNumDReps H.=== numDReps diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs index ba579f1d2d..c74ec39e89 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs @@ -7,7 +7,10 @@ module Test.Golden.Governance.DRep where #define UNIX #endif +import Control.Concurrent (newQSem) +import Control.Concurrent.QSem (QSem) import Control.Monad +import System.IO.Unsafe (unsafePerformIO) #ifdef UNIX import Data.Bits ((.&.)) @@ -16,7 +19,7 @@ import Numeric (showOct) import System.Posix.Files (fileMode, getFileStatus) #endif -import Test.Cardano.CLI.Util (execCardanoCLI, noteInputFile, noteTempFile, propertyOnce) +import Test.Cardano.CLI.Util (execCardanoCLI, noteInputFile, noteTempFile, propertyOnce, bracketSem) import Hedgehog import qualified Hedgehog as H @@ -24,6 +27,18 @@ 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. +-- This semaphore protects @"test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"@. +drepRetirementCertSem :: QSem +drepRetirementCertSem = unsafePerformIO $ newQSem 1 +{-# NOINLINE drepRetirementCertSem #-} + +-- | Semaphore protecting against locked file error, when running properties concurrently. +-- This semaphore protects @"test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"@. +drepRegistrationCertSem :: QSem +drepRegistrationCertSem = unsafePerformIO $ newQSem 1 +{-# NOINLINE drepRegistrationCertSem #-} + hprop_golden_governanceDRepKeyGen :: Property hprop_golden_governanceDRepKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do @@ -92,8 +107,8 @@ hprop_golden_governance_drep_extended_key_signing = skeyFile <- noteInputFile "test/cardano-cli-golden/files/input/governance/drep/extended-key-signing/drep.skey" txBody <- noteInputFile "test/cardano-cli-golden/files/input/governance/drep/extended-key-signing/tx.body" - outGold <- H.note "test/cardano-cli-golden/files/golden/governance/drep/extended-key-signing/tx.signed" outFile <- H.noteTempFile tempDir "outFile" + outGold <- H.note "test/cardano-cli-golden/files/golden/governance/drep/extended-key-signing/tx.signed" void $ execCardanoCLI [ "conway", "transaction", "sign" @@ -118,7 +133,8 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file = , "--out-file", certFile ] - H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile + bracketSem drepRetirementCertSem $ + H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile hprop_golden_governance_drep_retirement_certificate_id_hex :: Property hprop_golden_governance_drep_retirement_certificate_id_hex = @@ -135,7 +151,8 @@ hprop_golden_governance_drep_retirement_certificate_id_hex = , "--out-file", certFile ] - H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile + bracketSem drepRetirementCertSem $ + H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile hprop_golden_governance_drep_retirement_certificate_id_bech32 :: Property hprop_golden_governance_drep_retirement_certificate_id_bech32 = @@ -152,7 +169,8 @@ hprop_golden_governance_drep_retirement_certificate_id_bech32 = , "--out-file", certFile ] - H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile + bracketSem drepRetirementCertSem $ + H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile hprop_golden_governance_drep_metadata_hash :: Property hprop_golden_governance_drep_metadata_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do @@ -187,12 +205,13 @@ hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce . , "--out-file", outFile ] - H.diffFileVsGoldenFile outFile goldenFile + bracketSem drepRegistrationCertSem $ + H.diffFileVsGoldenFile outFile goldenFile hprop_golden_governance_drep_registration_certificate_id_hex :: Property hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json" idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex" + goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json" outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" @@ -205,12 +224,13 @@ hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H. , "--out-file", outFile ] - H.diffFileVsGoldenFile outFile goldenFile + bracketSem drepRegistrationCertSem $ + H.diffFileVsGoldenFile outFile goldenFile hprop_golden_governance_drep_registration_certificate_id_bech32 :: Property hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do - goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json" idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32" + goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json" outFile <- H.noteTempFile tempDir "drep-reg-cert.txt" @@ -223,7 +243,8 @@ hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . , "--out-file", outFile ] - H.diffFileVsGoldenFile outFile goldenFile + bracketSem drepRegistrationCertSem $ + H.diffFileVsGoldenFile outFile goldenFile hprop_golden_governance_drep_registration_certificate_script_hash :: Property hprop_golden_governance_drep_registration_certificate_script_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs index 3c68330b81..782b53124b 100644 --- a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs +++ b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} + module Test.Cardano.CLI.Util ( checkTxCddlFormat , checkTextEnvelopeFormat @@ -12,13 +14,18 @@ module Test.Cardano.CLI.Util , noteTempFile , redactJsonField + , bracketSem ) where import Cardano.Api import Cardano.CLI.Read -import Control.Monad.Catch +import Control.Concurrent (QSem, signalQSem, waitQSem) +import Control.Exception.Lifted (bracket_) +import Control.Monad.Base +import Control.Monad.Catch hiding (bracket_) +import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Aeson.Key as Aeson @@ -276,3 +283,8 @@ redactJsonField fieldName replacement sourceFilePath targetFilePath = GHC.withFr else v v -> pure v H.evalIO $ LBS.writeFile targetFilePath (Aeson.encodePretty redactedJson) + +-- | Run action acquiring a semaphore, and releasing afterwards. Allows to guard against concurrent access to +-- a block of code +bracketSem :: MonadBaseControl IO m => QSem -> m c -> m c +bracketSem semaphore = bracket_ (liftBase $ waitQSem semaphore) (liftBase $ signalQSem semaphore)