cadd679 · project-m36 · git.iko.soy

ProjectM36/Client.hs+1−1

compare with master

unifiedsplit

@@ -70,6 +70,7 @@ import Control.Distributed.Process.Serializable (Serializable)

70--import Control.Distributed.Process.Debug

71import qualified STMContainers.Map as STMMap

72import ProjectM36.Session

73+import ProjectM36.Sessions

73import ListT

74import ListT

74

75

75type Hostname = String

76type Hostname = String

@@ -96,7 +97,6 @@ defaultHeadName = "master"

96defaultRemoteConnectionInfo :: ConnectionInfo

97defaultRemoteConnectionInfo :: ConnectionInfo

97defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort)

98defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort)

98

99

99−type Sessions = STMMap.Map SessionId Session

100

101data Connection = InProcessConnection PersistenceStrategy Sessions (TVar TransactionGraph) |

102 RemoteProcessConnection LocalNode ProcessId

ProjectM36/Server/RemoteCallTypes.hs+1−2

@@ -2,12 +2,11 @@

2module ProjectM36.Server.RemoteCallTypes where

3import ProjectM36.Base

4import ProjectM36.TransactionGraph

5+import ProjectM36.Session

5import GHC.Generics

6import GHC.Generics

6import Data.Binary

7import Data.Binary

7import Data.UUID

8import Data.UUID

8

9

9−type SessionId = UUID

10−

11data Login = Login

10data Login = Login

12 deriving (Binary, Generic)

11 deriving (Binary, Generic)

13data Logout = Logout

12data Logout = Logout

ProjectM36/Session.hs+3

@@ -2,6 +2,8 @@ module ProjectM36.Session where

2import ProjectM36.Base

3import Data.UUID

4

5+type SessionId = UUID

6+

5--the persistence of a session is as long as the life of the database (not serialized to disk)

7--the persistence of a session is as long as the life of the database (not serialized to disk)

6-- sessions are not associated with connections and have separate lifetimes

8-- sessions are not associated with connections and have separate lifetimes

7data Session = Session DisconnectedTransaction

9data Session = Session DisconnectedTransaction

@@ -11,3 +13,4 @@ sessionContext (Session (DisconnectedTransaction _ context)) = context

11

13

12sessionParentUUID :: Session -> UUID

14sessionParentUUID :: Session -> UUID

13sessionParentUUID (Session (DisconnectedTransaction parentUUID _)) = parentUUID

15sessionParentUUID (Session (DisconnectedTransaction parentUUID _)) = parentUUID

16+

ProjectM36/Sessions.hsnew file+29

@@ -0,0 +1,29 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module ProjectM36.Sessions where

3+import Control.Concurrent.STM

4+import qualified STMContainers.Map as STMMap

5+import ListT

6+import ProjectM36.Attribute

7+import ProjectM36.Base

8+import ProjectM36.Atom

9+import ProjectM36.Session

10+import ProjectM36.Relation

11+import ProjectM36.Error

12+import qualified Data.UUID as U

13+

14+type Sessions = STMMap.Map SessionId Session

15+

16+stmMapToList :: STMMap.Map k v -> STM [(k, v)]

17+stmMapToList = ListT.fold (\l -> return . (:l)) [] . STMMap.stream

18+

19+uuidAtom :: U.UUID -> Atom

20+uuidAtom = stringAtom . U.toText

21+

22+sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)

23+sessionsAsRelation sessions = do

24+ sessionAssocs <- stmMapToList sessions

25+ let atomMatrix = map (\(sessionId, (Session (DisconnectedTransaction parentUUID _))) -> [uuidAtom sessionId, uuidAtom parentUUID]) sessionAssocs

26+ pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" stringAtomType,

27+ Attribute "parentCommit" stringAtomType]) atomMatrix

28+

29+

test/Server/Main.hs−1

@@ -12,7 +12,6 @@ import ProjectM36.TupleSet

12

13import System.Exit

14import Control.Concurrent

15−import Data.UUID (nil)

16import Data.Either (isRight)

15import Data.Either (isRight)

17import Data.Maybe (isJust)

16import Data.Maybe (isJust)

18

17