on master help sign in
implement missing session test and server entrypoints
commit48a1cfd1a2ac4ac8062b3f70794fa3d277b46095 authorAgentM <agentm@themactionfaction.com> dateTue 1 Dec 2015, 21:01 (11 years ago) parent473263b
3 files changed+29−5
ProjectM36/Server.hs+2−1 ProjectM36/Server/EntryPoints.hs+6−1 test/Server/Main.hs+21−3
ProjectM36/Server.hs+2−1
@@ -31,7 +31,8 @@ serverDefinition = defaultProcess {
3131 handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph sessionId conn),
3232 handleCall (\conn Login -> handleLogin conn),
3333 handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead headn conn),
34− handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit commitId conn)
34+ handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit commitId conn),
35+ handleCall (\conn (CloseSession sessionId) -> handleCloseSession sessionId conn)
3536 ],
3637 unhandledMessagePolicy = Log
3738 }
ProjectM36/Server/EntryPoints.hs+6−1
@@ -65,4 +65,9 @@ handleCreateSessionAtCommit commitId conn = do
6565handleCreateSessionAtHead :: HeadName -> Connection -> Process (ProcessReply (Either RelationalError SessionId) Connection)
6666handleCreateSessionAtHead headn conn = do
6767 ret <- liftIO $ createSessionAtHead headn conn
68− reply ret conn
68+ reply ret conn
69+
70+handleCloseSession :: SessionId -> Connection -> Process (ProcessReply () Connection)
71+handleCloseSession sessionId conn = do
72+ liftIO $ closeSession sessionId conn
73+ reply () conn
test/Server/Main.hs+21−3
@@ -12,6 +12,9 @@ import ProjectM36.TupleSet
1212
1313import System.Exit
1414import Control.Concurrent
15+import Data.UUID (nil)
16+import Data.Either (isRight)
17+import Data.Maybe (isJust)
1518
1619testList :: SessionId -> Connection -> Test
1720testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
@@ -22,7 +25,8 @@ testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
2225 testPlanForDatabaseContextExpr,
2326 testTransactionGraphAsRelation,
2427 testHeadTransactionUUID,
25− testHeadName
28+ testHeadName,
29+ testSession
2630 ]
2731
2832main :: IO ()
@@ -111,7 +115,8 @@ testTransactionGraphAsRelation sessionId conn = TestCase $ do
111115
112116testHeadTransactionUUID :: SessionId -> Connection -> Test
113117testHeadTransactionUUID sessionId conn = TestCase $ do
114− _ <- headTransactionUUID sessionId conn
118+ uuid <- headTransactionUUID sessionId conn
119+ assertBool "invalid head transaction uuid" (isJust uuid)
115120 pure ()
116121
117122testHeadName :: SessionId -> Connection -> Test
@@ -119,4 +124,17 @@ testHeadName sessionId conn = TestCase $ do
119124 mHeadName <- headName sessionId conn
120125 assertEqual "headName failure" (Just "master") mHeadName
121126
122−
127+testSession :: SessionId -> Connection -> Test
128+testSession _ conn = TestCase $ do
129+ -- create and close a new session using AtHead and AtCommit
130+ eSessionId1 <- createSessionAtHead defaultHeadName conn
131+ case eSessionId1 of
132+ Left _ -> assertFailure "invalid session"
133+ Right sessionId1 -> do
134+ mHeadUUID <- headTransactionUUID sessionId1 conn
135+ case mHeadUUID of
136+ Nothing -> assertFailure "invalid head UUID"
137+ Just headUUID -> do
138+ eSessionId2 <- createSessionAtCommit headUUID conn
139+ assertBool ("invalid session: " ++ show eSessionId2) (isRight eSessionId2)
140+ closeSession sessionId1 conn