-
Notifications
You must be signed in to change notification settings - Fork 720
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
cardano-tracer: split the Linux-only cardano-tracer-test-ext from mul…
…ti-platform cardano-tracer-test
- Loading branch information
Showing
8 changed files
with
209 additions
and
123 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,11 +1,27 @@ | ||
| {-# LANGUAGE LambdaCase #-} | ||
|
|
||
| import Data.Functor.Identity | ||
| import System.Environment (getArgs) | ||
|
|
||
| import Cardano.Tracer.Test.Forwarder | ||
| import Cardano.Tracer.Test.TestSetup | ||
|
|
||
| main :: IO () | ||
| main = getArgs >>= \case | ||
| [localSock, "Initiator"] -> launchForwardersSimple Initiator localSock 1000 2000 | ||
| [localSock, "Responder"] -> launchForwardersSimple Responder localSock 1000 2000 | ||
| _ -> putStrLn "Usage: ./demo-forwarder /path/to/local/sock Initiator|Responder" | ||
| main = getArgs >>= | ||
| \case | ||
| [localSock, mode] -> | ||
| let ts = TestSetup | ||
| { tsTime = Identity 0 | ||
| , tsThreads = Identity 0 | ||
| , tsMessages = Identity $ Just 0 | ||
| , tsSockInternal = Identity localSock | ||
| , tsSockExternal = Identity "" | ||
| , tsNetworkMagic = Identity $ NetworkMagic 42 | ||
| , tsWorkDir = Identity "." | ||
| } | ||
| in case mode of | ||
| "Initiator" -> launchForwardersSimple ts Initiator localSock 1000 2000 | ||
| "Responder" -> launchForwardersSimple ts Responder localSock 1000 2000 | ||
| _ -> err | ||
| _ -> err | ||
| where err = error "Usage: ./demo-forwarder /path/to/local/sock Initiator|Responder" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,136 @@ | ||
| {-# LANGUAGE RecordWildCards #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# OPTIONS_GHC -Wno-unused-matches #-} | ||
|
|
||
| import Control.Concurrent (threadDelay) | ||
| import Control.Exception | ||
| import Control.Monad.Extra | ||
| import Data.Functor ((<&>)) | ||
| import Data.Functor.Identity | ||
| import Data.IORef (IORef, newIORef, readIORef, writeIORef) | ||
| import qualified Data.List as L | ||
| import Data.Monoid | ||
| import qualified System.Directory as Sys | ||
| import System.Environment (setEnv, unsetEnv) | ||
| import qualified System.IO as Sys | ||
| import System.PosixCompat.Files (fileExist) | ||
| import qualified System.Process as Sys | ||
| import Test.Tasty | ||
| import Test.Tasty.QuickCheck | ||
|
|
||
| import Cardano.Logging | ||
| import Cardano.Tracer.Test.ForwardingStressTest.Messages | ||
| import Cardano.Tracer.Test.ForwardingStressTest.Script | ||
| import Cardano.Tracer.Test.ForwardingStressTest.Types | ||
| import Cardano.Tracer.Test.Utils | ||
| import Ouroboros.Network.Magic (NetworkMagic (..)) | ||
| import Ouroboros.Network.NodeToClient (withIOManager) | ||
|
|
||
| main :: IO () | ||
| main = do | ||
| setEnv "TASTY_NUM_THREADS" "1" -- For sequential running of tests (because of Windows). | ||
|
|
||
| ts' <- getTestSetup | ||
| TestSetup | ||
| { tsTime = Last $ Just 10.0 | ||
| , tsThreads = Last $ Just 5 | ||
| , tsMessages = Last Nothing | ||
| , tsSockInternal = Last $ Just "tracer.sock" | ||
| , tsSockExternal = Last $ Just "tracer.sock" | ||
| , tsNetworkMagic = Last $ Just $ NetworkMagic 42 | ||
| , tsWorkDir = Last $ Just "./test" | ||
| } | ||
|
|
||
| -- 1. Prepare directory hierarchy | ||
| tracerRoot <- Sys.canonicalizePath $ unI (tsWorkDir ts') | ||
| putStrLn . mconcat $ [ "tsWorkDir ts: ", tracerRoot ] | ||
| -- Weird: using path canonicalisation leads to process shutdown failures | ||
| whenM (fileExist tracerRoot) $ | ||
| Sys.removeDirectoryRecursive tracerRoot | ||
| Sys.createDirectoryIfMissing True (tracerRoot <> "/logs") | ||
| Sys.setCurrentDirectory tracerRoot | ||
|
|
||
| sockInt <- Sys.canonicalizePath $ unI (tsSockInternal ts') | ||
| sockExt <- Sys.canonicalizePath $ unI (tsSockExternal ts') | ||
| let ts = ts' { tsWorkDir = Identity tracerRoot | ||
| , tsSockInternal = Identity sockInt | ||
| , tsSockExternal = Identity sockExt | ||
| } | ||
| putStrLn $ "Test setup: " <> show ts | ||
|
|
||
| -- 2. Actual tests | ||
| msgCounterRef <- newIORef 0 | ||
| tracerRef <- newIORef Nothing | ||
| let tracerGetter = getExternalTracerState ts tracerRef | ||
| defaultMain (allTests ts msgCounterRef (tracerGetter <&> snd)) | ||
| `catch` (\ (e :: SomeException) -> do | ||
| unsetEnv "TASTY_NUM_THREADS" | ||
| trState <- readIORef tracerRef | ||
| case trState of | ||
| Nothing -> pure () | ||
| Just (tracerHdl, _) -> | ||
| Sys.cleanupProcess (Nothing, Nothing, Nothing, tracerHdl) | ||
| throwIO e) | ||
|
|
||
| allTests :: | ||
| TestSetup Identity | ||
| -> IORef Int | ||
| -> IO (Trace IO Message) | ||
| -> TestTree | ||
| allTests ts msgCounter externalTracerGetter = | ||
| testGroup "Tests" | ||
| [ localOption (QuickCheckTests 10) $ testGroup "trace-forwarder" | ||
| [ testProperty "multi-threaded forwarder stress test" $ | ||
| runScriptForwarding ts msgCounter externalTracerGetter | ||
| ] | ||
| ] | ||
|
|
||
| -- Caution: non-thread-safe! | ||
| getExternalTracerState :: | ||
| TestSetup Identity | ||
| -> IORef (Maybe (Sys.ProcessHandle, Trace IO Message)) | ||
| -> IO (Sys.ProcessHandle, Trace IO Message) | ||
| getExternalTracerState TestSetup{..} ref = do | ||
| state <- readIORef ref | ||
| case state of | ||
| Just st -> pure st | ||
| Nothing -> do | ||
| stdTr <- standardTracer | ||
| (procHdl, fwdTr) <- setupFwdTracer | ||
| tr <- mkCardanoTracer | ||
| stdTr fwdTr Nothing | ||
| ["Test"] | ||
| namesForMessage severityForMessage privacyForMessage | ||
| let st = (procHdl, tr) | ||
| writeIORef ref $ Just st | ||
| pure st | ||
| where | ||
| setupFwdTracer :: IO (Sys.ProcessHandle, Trace IO FormattedMessage) | ||
| setupFwdTracer = do | ||
| Sys.writeFile "config.yaml" . L.unlines $ | ||
| [ "networkMagic: " <> show (unNetworkMagic $ unI tsNetworkMagic) | ||
| , "network:" | ||
| , " tag: AcceptAt" | ||
| , " contents: \""<> unI tsSockExternal <>"\"" | ||
| , "logging:" | ||
| , "- logRoot: \"logs\"" | ||
| , " logMode: FileMode" | ||
| , " logFormat: ForMachine" | ||
| ] | ||
| externalTracerHdl <- Sys.spawnProcess "cardano-tracer" | ||
| [ "--config" , "config.yaml" | ||
| , "--state-dir" , unI tsWorkDir <> "/tracer-statedir" | ||
| ] | ||
| threadDelay 1000000 --wait 1 seconds | ||
| res <- Sys.getProcessExitCode externalTracerHdl | ||
| case res of | ||
| Nothing -> putStrLn "cardano-tracer started.." | ||
| Just code -> | ||
| error $ "cardano-tracer failed to start with code " <> show code | ||
| -- TODO: check if this is the correct way to use withIOManager | ||
| (forwardSink, _dpStore) <- withIOManager $ \iomgr -> do | ||
| -- For simplicity, we are always 'Initiator', | ||
| -- so 'cardano-tracer' is always a 'Responder'. | ||
| let tracerSocketMode = Just (unI tsSockExternal, Initiator) | ||
| initForwarding iomgr simpleTestConfig (unI tsNetworkMagic) Nothing tracerSocketMode | ||
| pure (externalTracerHdl, forwardTracer forwardSink) |
Oops, something went wrong.