implementation module SessionDB import StdEnv, StdMaybe import StdGeneric import TSt, Store import Time import Random instance SessionDB IWorld where getSessions :: !*IWorld -> (![Session], !*IWorld) getSessions iworld = sessionStore id iworld getSessionsForUser :: !User !*IWorld -> (![Session], !*IWorld) getSessionsForUser user iworld # (sessions, iworld) = sessionStore id iworld = ([s \\ s <- sessions | s.Session.user == user], iworld) getSession :: !SessionId !*IWorld -> (!Maybe Session, !*IWorld) getSession sid iworld # (sessions, iworld) = sessionStore id iworld = case [s \\ s <- sessions | s.Session.sessionId == sid] of [s] = (Just s, iworld) _ = (Nothing, iworld) createSession :: !User !*IWorld -> (!Session,!*IWorld) createSession user iworld # (sid, iworld) = genSessionId iworld # (ts, iworld) = getTimeStamp iworld # session = {Session | sessionId = sid, user = user, timestamp = ts} # (sessions, iworld)= sessionStore (\l -> [session:l]) iworld = (session,iworld) restoreSession :: !SessionId !*IWorld -> (!Maybe Session, !Bool, !*IWorld) restoreSession sid iworld # (sessions, iworld) = sessionStore id iworld # (ts, iworld) = getTimeStamp iworld # (mbSession, before, after) = findSession sid [] sessions = case mbSession of Nothing = (Nothing, False, iworld) // Not found and no timeout Just s | (ts - s.timestamp) > iworld.config.sessionTime // Session found but timed out # (_, iworld) = sessionStore (\_ -> (before ++ after)) iworld = (Nothing, True, iworld) | otherwise // Session found and still valid # (_, iworld) = sessionStore (\_ -> (before ++ [{s & timestamp = ts}: after])) iworld = (Just s, False, iworld) deleteSession :: !SessionId !*IWorld -> (!Bool,!*IWorld) deleteSession sid iworld # (sessions, iworld) = sessionStore id iworld # (mbSession, before, after)= findSession sid [] sessions | isJust mbSession # (_, iworld) = sessionStore (\_ -> (before ++ after)) iworld = (True,iworld) | otherwise = (False, iworld) findSession :: !String ![Session] ![Session] -> (!Maybe Session, ![Session], ![Session]) findSession sid before [] = (Nothing, reverse before, []) findSession sid before [s=:{sessionId}:after] | sid == sessionId = (Just s, reverse before, after) = findSession sid [s:before] after genSessionId :: !*IWorld -> (!String, !*IWorld) genSessionId iworld=:{IWorld|world} # (Timestamp t, world) = time world # (Clock c, world) = clock world = (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- genRandInt (t+c)]) , {IWorld|iworld & world = world}) getTimeStamp :: !*IWorld -> (!Int, !*IWorld) getTimeStamp iworld=:{IWorld|world} # (Timestamp t, world) = time world = (t, {IWorld|iworld & world = world}) sessionStore :: !([Session] -> [Session]) !*IWorld -> (![Session],!*IWorld) sessionStore fn iworld=:{IWorld|store,world} # (mbList,store,world) = loadValue "SessionDB" store world # list = fn (case mbList of Nothing = []; Just list = list) # store = storeValue "SessionDB" list store = (list, {IWorld|iworld & store = store, world = world }) instance SessionDB TSt where getSessions :: !*TSt -> (![Session], !*TSt) getSessions tst = accIWorldTSt getSessions tst getSessionsForUser :: !User !*TSt -> (![Session], !*TSt) getSessionsForUser user tst = accIWorldTSt (getSessionsForUser user) tst getSession :: !SessionId !*TSt -> (!Maybe Session, !*TSt) getSession sessionId tst = accIWorldTSt (getSession sessionId) tst createSession :: !User !*TSt -> (!Session,!*TSt) createSession user tst = accIWorldTSt (createSession user) tst restoreSession :: !SessionId !*TSt -> (!Maybe Session, !Bool, !*TSt) restoreSession sessionId tst=:{TSt|iworld} # (mbSession,timeout,iworld) = restoreSession sessionId iworld = (mbSession,timeout,{TSt|tst & iworld = iworld}) deleteSession :: !SessionId !*TSt -> (!Bool,!*TSt) deleteSession sessionId tst = accIWorldTSt (deleteSession sessionId) tst