on master help sign in
reshuffle Session and Sessions definitions

-add sessionsAsRelation function (not yet implemented as tutd operator)

commitcadd679e0fd716cf551256ed47b402132057f91b authorAgentM <agentm@themactionfaction.com> dateTue 1 Dec 2015, 22:37 (11 years ago) parentb55d344
5 files changed+34−4
ProjectM36/Client.hs+1−1 ProjectM36/Server/RemoteCallTypes.hs+1−2 ProjectM36/Session.hs+3 ProjectM36/Sessions.hs+29 test/Server/Main.hs−1
ProjectM36/Client.hs+1−1
@@ -70,6 +70,7 @@ import Control.Distributed.Process.Serializable (Serializable)
7070--import Control.Distributed.Process.Debug
7171import qualified STMContainers.Map as STMMap
7272import ProjectM36.Session
73+import ProjectM36.Sessions
7374import ListT
7475
7576type Hostname = String
@@ -96,7 +97,6 @@ defaultHeadName = "master"
9697defaultRemoteConnectionInfo :: ConnectionInfo
9798defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort)
9899
99−type Sessions = STMMap.Map SessionId Session
100100
101101data Connection = InProcessConnection PersistenceStrategy Sessions (TVar TransactionGraph) |
102102 RemoteProcessConnection LocalNode ProcessId
ProjectM36/Server/RemoteCallTypes.hs+1−2
@@ -2,12 +2,11 @@
22module ProjectM36.Server.RemoteCallTypes where
33import ProjectM36.Base
44import ProjectM36.TransactionGraph
5+import ProjectM36.Session
56import GHC.Generics
67import Data.Binary
78import Data.UUID
89
9−type SessionId = UUID
10−
1110data Login = Login
1211 deriving (Binary, Generic)
1312data Logout = Logout
ProjectM36/Session.hs+3
@@ -2,6 +2,8 @@ module ProjectM36.Session where
22import ProjectM36.Base
33import Data.UUID
44
5+type SessionId = UUID
6+
57--the persistence of a session is as long as the life of the database (not serialized to disk)
68-- sessions are not associated with connections and have separate lifetimes
79data Session = Session DisconnectedTransaction
@@ -11,3 +13,4 @@ sessionContext (Session (DisconnectedTransaction _ context)) = context
1113
1214sessionParentUUID :: Session -> UUID
1315sessionParentUUID (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
1212
1313import System.Exit
1414import Control.Concurrent
15−import Data.UUID (nil)
1615import Data.Either (isRight)
1716import Data.Maybe (isJust)
1817