summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2021-08-04 21:42:01 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2021-08-04 22:55:53 +0200
commit56854a666ed7bf2bd923c6be55cf4f753de2673f (patch)
tree80037825db46b8587ba4bc6fa7c6954bb40e18c0
parentbb9d723d3336e2f64beb04ac777a0ea45873f818 (diff)
Expect and send functions
-rw-r--r--erebos-tester.cabal1
-rw-r--r--src/Main.hs37
2 files changed, 37 insertions, 1 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index 0808f86..d9e25c7 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -38,6 +38,7 @@ executable erebos-tester-core
default-extensions: LambdaCase
build-depends: base ^>=4.13.0.0,
process ^>=1.6.9,
+ regex-tdfa ^>=1.3.1.0,
stm ^>=2.5.0.1,
hs-source-dirs: src
default-language: Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 4c9b1fc..169cec4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,6 +4,9 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
+import Text.Regex.TDFA
+import Text.Regex.TDFA.String
+
import System.Environment
import System.IO
import System.IO.Error
@@ -82,6 +85,31 @@ spawnOn node cmd = do
, procOutput = out
}
+tryMatch :: Regex -> [String] -> Maybe (String, [String])
+tryMatch re (x:xs) | Right (Just _) <- regexec re x = Just (x, xs)
+ | otherwise = fmap (x:) <$> tryMatch re xs
+tryMatch _ [] = Nothing
+
+expect :: Process -> String -> IO ()
+expect p pat = case compile defaultCompOpt defaultExecOpt ("^" ++ pat ++ "$") of
+ Right re -> do
+ mbmatch <- atomically $ do
+ out <- readTVar (procOutput p)
+ case tryMatch re out of
+ Nothing -> retry
+ Just (m, out') -> do
+ writeTVar (procOutput p) out'
+ return $ Just m
+ case mbmatch of
+ Just line -> putStrLn $ "\ESC[32m" ++ nodeName (procNode p) ++ "+> " ++ line ++ "\ESC[0m"
+ Nothing -> putStrLn $ "\ESC[31m" ++ nodeName (procNode p) ++ "/> expect failed" ++ "\ESC[0m"
+ Left err -> putStrLn $ "failed to parse re: " ++ err
+
+send :: Process -> String -> IO ()
+send p str = do
+ hPutStrLn (procStdin p) str
+ hFlush (procStdin p)
+
main :: IO ()
main = do
[tool] <- getArgs
@@ -93,4 +121,11 @@ main = do
p1 <- spawnOn node1 tool
p2 <- spawnOn node2 tool
- void $ return (p1, p2)
+ send p1 "create-identity Device1"
+ send p2 "create-identity Device2"
+ send p1 "start-server"
+ send p2 "start-server"
+ expect p1 "peer [0-9]+ 192.168.0.11:29665"
+ expect p1 "peer [0-9]+ 192.168.0.12:29665"
+ expect p2 "peer [0-9]+ 192.168.0.12:29665"
+ expect p2 "peer [0-9]+ 192.168.0.11:29665"