Event loop!
This commit is contained in:
189
test/Spec.hs
189
test/Spec.hs
@@ -10,7 +10,8 @@ import Wire
|
||||
import ContentStore
|
||||
import IODriver (IOPermissions(..), checkIOSentinel, runIO, runIOWithEnv, runIOWith, unsafePerms, defaultPerms)
|
||||
|
||||
import Control.Exception (evaluate, try, SomeException)
|
||||
import Control.Exception (bracket, evaluate, try, SomeException)
|
||||
import qualified Network.Socket as NS
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
@@ -1918,12 +1919,196 @@ ioDriverTests = testGroup "IO driver tests"
|
||||
build k = "bind (fork (pure \"x\")) (h : bind (await h) (_ : " ++ build (k - 1) ++ "))"
|
||||
(final, _) <- runIOSourceWith unsafePerms Leaf Leaf ("main = io (" ++ build n ++ ")")
|
||||
final @?= ofString "done"
|
||||
|
||||
, testGroup "Socket primitives"
|
||||
[ testCase "socket returns ok result with valid handle" $ do
|
||||
final <- runIOSource "main = io socket"
|
||||
final @?= ioOkResult (Fork (ofString "sock") (ofNumber 0))
|
||||
|
||||
, testCase "closeSocket on invalid handle returns error" $ do
|
||||
final <- runIOSource "main = io (closeSocket (pair \"sock\" 99999))"
|
||||
final @?= ioErrResult "invalid socket handle"
|
||||
|
||||
, testCase "bindSocket and listen succeed on loopback port 0" $ do
|
||||
final <- runIOSource "main = io (bind socket (result : matchResult (err rest : pure result) (sock rest : bind (bindSocket sock \"127.0.0.1\" 0) (bindResult : matchResult (err rest : pure bindResult) (_ rest : bind (listen sock 1) (listenResult : pure listenResult)) bindResult)) result))"
|
||||
final @?= ioOkResult Leaf
|
||||
|
||||
, testCase "connect to non-listening port returns error" $ do
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "main = io (bind socket (result :"
|
||||
, " matchResult"
|
||||
, " (err rest : pure \"socket-err\")"
|
||||
, " (sock rest : connect sock \"127.0.0.1\" 1)"
|
||||
, " result))"
|
||||
]
|
||||
case final of
|
||||
Fork Leaf (Fork _ Leaf) -> return ()
|
||||
other -> assertFailure $ "Expected error result, got: " ++ show other
|
||||
|
||||
, testCase "accept and recv receive bytes from forked client" $
|
||||
withFreePort $ \port -> do
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "preserveResult = (result okCase :"
|
||||
, " matchResult"
|
||||
, " (err rest : pure result)"
|
||||
, " okCase"
|
||||
, " result)"
|
||||
, ""
|
||||
, "client = port :"
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (sock rest :"
|
||||
, " bind (connect sock \"127.0.0.1\" port) (connectResult :"
|
||||
, " preserveResult connectResult (_ rest :"
|
||||
, " send sock [104 105]))))"
|
||||
, ""
|
||||
, "main = io ("
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (server rest :"
|
||||
, " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
|
||||
, " preserveResult bindResult (_ rest :"
|
||||
, " bind (listen server 1) (listenResult :"
|
||||
, " preserveResult listenResult (_ rest :"
|
||||
, " bind (fork (client " ++ show port ++ ")) (_ :"
|
||||
, " bind (accept server) (acceptResult :"
|
||||
, " preserveResult acceptResult (accepted rest :"
|
||||
, " matchPair"
|
||||
, " (clientSock addr : recv clientSock 2)"
|
||||
, " accepted))))))))))"
|
||||
]
|
||||
final @?= ioOkResult (ofBytes (BS.pack [104, 105]))
|
||||
|
||||
, testCase "client recv receives server response via accepted socket" $
|
||||
withFreePort $ \port -> do
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "preserveResult = (result okCase :"
|
||||
, " matchResult"
|
||||
, " (err rest : pure result)"
|
||||
, " okCase"
|
||||
, " result)"
|
||||
, ""
|
||||
, "serverTask = server :"
|
||||
, " bind (accept server) (acceptResult :"
|
||||
, " preserveResult acceptResult (accepted rest :"
|
||||
, " matchPair"
|
||||
, " (clientSock addr :"
|
||||
, " bind (recv clientSock 4) (msgResult :"
|
||||
, " preserveResult msgResult (_ rest :"
|
||||
, " send clientSock [112 111 110 103])))"
|
||||
, " accepted))"
|
||||
, ""
|
||||
, "clientTask = port :"
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (sock rest :"
|
||||
, " bind (connect sock \"127.0.0.1\" port) (connectResult :"
|
||||
, " preserveResult connectResult (_ rest :"
|
||||
, " bind (send sock [112 105 110 103]) (_ :"
|
||||
, " recv sock 4)))))"
|
||||
, ""
|
||||
, "main = io ("
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (server rest :"
|
||||
, " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
|
||||
, " preserveResult bindResult (_ rest :"
|
||||
, " bind (listen server 1) (listenResult :"
|
||||
, " preserveResult listenResult (_ rest :"
|
||||
, " bind (fork (serverTask server)) (_ :"
|
||||
, " clientTask " ++ show port ++ "))))))))"
|
||||
]
|
||||
final @?= ioOkResult (ofBytes (BS.pack [112, 111, 110, 103]))
|
||||
|
||||
, testCase "recv on closed peer returns connection closed" $
|
||||
withFreePort $ \port -> do
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "preserveResult = (result okCase :"
|
||||
, " matchResult"
|
||||
, " (err rest : pure result)"
|
||||
, " okCase"
|
||||
, " result)"
|
||||
, ""
|
||||
, "clientTask = port :"
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (sock rest :"
|
||||
, " bind (connect sock \"127.0.0.1\" port) (connectResult :"
|
||||
, " preserveResult connectResult (_ rest :"
|
||||
, " closeSocket sock))))"
|
||||
, ""
|
||||
, "main = io ("
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (server rest :"
|
||||
, " bind (bindSocket server \"127.0.0.1\" " ++ show port ++ ") (bindResult :"
|
||||
, " preserveResult bindResult (_ rest :"
|
||||
, " bind (listen server 1) (listenResult :"
|
||||
, " preserveResult listenResult (_ rest :"
|
||||
, " bind (fork (clientTask " ++ show port ++ ")) (_ :"
|
||||
, " bind (accept server) (acceptResult :"
|
||||
, " preserveResult acceptResult (accepted rest :"
|
||||
, " matchPair"
|
||||
, " (clientSock addr :"
|
||||
, " bind (yield) (_ :"
|
||||
, " recv clientSock 1))"
|
||||
, " accepted))))))))))"
|
||||
]
|
||||
final @?= ioErrResult "connection closed"
|
||||
|
||||
, testCase "accept invalid socket handle returns error" $ do
|
||||
final <- runIOSource "main = io (accept (pair \"sock\" 99999))"
|
||||
final @?= ioErrResult "invalid socket handle"
|
||||
|
||||
, testCase "recv invalid socket handle returns error" $ do
|
||||
final <- runIOSource "main = io (recv (pair \"sock\" 99999) 1)"
|
||||
final @?= ioErrResult "invalid socket handle"
|
||||
|
||||
, testCase "send invalid socket handle returns error" $ do
|
||||
final <- runIOSource "main = io (send (pair \"sock\" 99999) [(1)])"
|
||||
final @?= ioErrResult "invalid socket handle"
|
||||
|
||||
, testCase "getSocketName returns positive port after bind 0" $ do
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "preserveResult = (result okCase :"
|
||||
, " matchResult"
|
||||
, " (err rest : pure result)"
|
||||
, " okCase"
|
||||
, " result)"
|
||||
, ""
|
||||
, "main = io ("
|
||||
, " bind socket (result :"
|
||||
, " preserveResult result (server rest :"
|
||||
, " bind (bindSocket server \"127.0.0.1\" 0) (bindResult :"
|
||||
, " preserveResult bindResult (_ rest :"
|
||||
, " getSocketName server)))))"
|
||||
]
|
||||
case final of
|
||||
Fork (Stem Leaf) (Fork val Leaf) ->
|
||||
case toNumber val of
|
||||
Right port | port > 0 -> return ()
|
||||
Right 0 -> assertFailure "Expected positive port, got 0"
|
||||
Left _ -> assertFailure $ "Expected numeric port, got: " ++ show val
|
||||
other -> assertFailure $ "Expected ok result, got: " ++ show other
|
||||
]
|
||||
]
|
||||
|
||||
withFreePort :: (Int -> IO a) -> IO a
|
||||
withFreePort action =
|
||||
bracket
|
||||
(NS.socket NS.AF_INET NS.Stream NS.defaultProtocol)
|
||||
NS.close
|
||||
(\s -> do
|
||||
NS.setSocketOption s NS.ReuseAddr 1
|
||||
NS.bind s (NS.SockAddrInet 0 (NS.tupleToHostAddress (127, 0, 0, 1)))
|
||||
port <- NS.socketPort s
|
||||
action (fromIntegral port))
|
||||
|
||||
runIOSourceWith :: IOPermissions -> T -> T -> String -> IO (T, T)
|
||||
runIOSourceWith perms readerEnv initialState source = do
|
||||
ioEnv <- evaluateFile "./lib/io.tri"
|
||||
evalEnv <- evalTricuWithStore Nothing ioEnv (parseTricu source)
|
||||
sockEnv <- evaluateFile "./lib/socket.tri"
|
||||
let combinedEnv = Map.union sockEnv ioEnv
|
||||
evalEnv <- evalTricuWithStore Nothing combinedEnv (parseTricu source)
|
||||
let fullTree = mainResult evalEnv
|
||||
result <- runIOWith perms readerEnv initialState fullTree
|
||||
case result of
|
||||
|
||||
Reference in New Issue
Block a user