Expect and send functions

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"