git.iko.soy/project-m36
on master help sign in
implement missing session test and server entrypoints
48a1cfdAgentM
ProjectM36/Server.hs+2−1
compare with master
unifiedsplit
@@ -31,7 +31,8 @@ serverDefinition = defaultProcess {
31 handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph sessionId conn),
31 handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph sessionId conn),
32 handleCall (\conn Login -> handleLogin conn),
32 handleCall (\conn Login -> handleLogin conn),
33 handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead headn conn),
33 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)
35 ],
36 ],
36 unhandledMessagePolicy = Log
37 unhandledMessagePolicy = Log
37 }
38 }
ProjectM36/Server/EntryPoints.hs+6−1
@@ -65,4 +65,9 @@ handleCreateSessionAtCommit commitId conn = do
65handleCreateSessionAtHead :: HeadName -> Connection -> Process (ProcessReply (Either RelationalError SessionId) Connection)
65handleCreateSessionAtHead :: HeadName -> Connection -> Process (ProcessReply (Either RelationalError SessionId) Connection)
66handleCreateSessionAtHead headn conn = do
66handleCreateSessionAtHead headn conn = do
67 ret <- liftIO $ createSessionAtHead headn conn
67 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
12
12
13import System.Exit
13import System.Exit
14import Control.Concurrent
14import Control.Concurrent
15+import Data.UUID (nil)
16+import Data.Either (isRight)
17+import Data.Maybe (isJust)
15
18
16testList :: SessionId -> Connection -> Test
19testList :: SessionId -> Connection -> Test
17testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
20testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
@@ -22,7 +25,8 @@ testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
22 testPlanForDatabaseContextExpr,
25 testPlanForDatabaseContextExpr,
23 testTransactionGraphAsRelation,
26 testTransactionGraphAsRelation,
24 testHeadTransactionUUID,
27 testHeadTransactionUUID,
25− testHeadName
28+ testHeadName,
29+ testSession
26 ]
30 ]
27
31
28main :: IO ()
32main :: IO ()
@@ -111,7 +115,8 @@ testTransactionGraphAsRelation sessionId conn = TestCase $ do
111
115
112testHeadTransactionUUID :: SessionId -> Connection -> Test
116testHeadTransactionUUID :: SessionId -> Connection -> Test
113testHeadTransactionUUID sessionId conn = TestCase $ do
117testHeadTransactionUUID sessionId conn = TestCase $ do
114− _ <- headTransactionUUID sessionId conn
118+ uuid <- headTransactionUUID sessionId conn
119+ assertBool "invalid head transaction uuid" (isJust uuid)
115 pure ()
120 pure ()
116
121
117testHeadName :: SessionId -> Connection -> Test
122testHeadName :: SessionId -> Connection -> Test
@@ -119,4 +124,17 @@ testHeadName sessionId conn = TestCase $ do
119 mHeadName <- headName sessionId conn
124 mHeadName <- headName sessionId conn
120 assertEqual "headName failure" (Just "master") mHeadName
125 assertEqual "headName failure" (Just "master") mHeadName
121
126
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