on master help sign in
add server-based notification test
commit93b859d511ff47adad5e0cbad3366929b78de957 authorAgentM <agentm@themactionfaction.com> dateMon 25 Jan 2016, 23:16 (11 years ago) parentc85fad4
1 file changed+25−8
test/Server/Main.hs+25−8
test/Server/Main.hs+25−8
@@ -15,8 +15,8 @@ import Control.Concurrent
1515import Data.Either (isRight)
1616import Data.Maybe (isJust)
1717
18−testList :: SessionId -> Connection -> Test
19−testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
18+testList :: SessionId -> Connection -> MVar () -> Test
19+testList sessionId conn notificationTestMVar = TestList $ map (\t -> t sessionId conn) [
2020 testRelationalExpr,
2121 testDatabaseContextExpr,
2222 testGraphExpr,
@@ -25,25 +25,27 @@ testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
2525 testTransactionGraphAsRelation,
2626 testHeadTransactionUUID,
2727 testHeadName,
28− testSession
28+ testSession,
29+ testNotification notificationTestMVar
2930 ]
3031
3132main :: IO ()
3233main = do
3334 port <- launchTestServer
34− eTestConn <- testConnection port
35+ notificationTestMVar <- newEmptyMVar
36+ eTestConn <- testConnection port notificationTestMVar
3537 case eTestConn of
3638 Left err -> putStrLn (show err) >> exitFailure
3739 Right (session, testConn) -> do
38− tcounts <- runTestTT (testList session testConn)
40+ tcounts <- runTestTT (testList session testConn notificationTestMVar)
3941 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
4042
4143testDatabaseName :: DatabaseName
4244testDatabaseName = "test"
4345
44−testConnection :: Port -> IO (Either ConnectionError (SessionId, Connection))
45−testConnection port = do
46− let connInfo = RemoteProcessConnectionInfo testDatabaseName (createNodeId "127.0.0.1" port) emptyNotificationCallback
46+testConnection :: Port -> MVar () -> IO (Either ConnectionError (SessionId, Connection))
47+testConnection port mvar = do
48+ let connInfo = RemoteProcessConnectionInfo testDatabaseName (createNodeId "127.0.0.1" port) (testNotificationCallback mvar)
4749 eConn <- connectProjectM36 connInfo
4850 case eConn of
4951 Left err -> pure $ Left err
@@ -137,3 +139,18 @@ testSession _ conn = TestCase $ do
137139 eSessionId2 <- createSessionAtCommit headUUID conn
138140 assertBool ("invalid session: " ++ show eSessionId2) (isRight eSessionId2)
139141 closeSession sessionId1 conn
142+
143+testNotificationCallback :: MVar () -> NotificationCallback
144+testNotificationCallback mvar _ _ = putMVar mvar ()
145+
146+-- create a relvar x, add a notification on x, update x and wait for the notification
147+testNotification :: MVar () -> SessionId -> Connection -> Test
148+testNotification mvar sess conn = TestCase $ do
149+ let relvarx = RelationVariable "x"
150+ let check x = x >>= maybe (pure ()) (\err -> assertFailure (show err))
151+ check $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationTrue))
152+ check $ executeDatabaseContextExpr sess conn (AddNotification "test notification" relvarx relvarx)
153+ check $ commit sess conn
154+ check $executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse))
155+ check $ commit sess conn
156+ takeMVar mvar