{-# OPTIONS_GHC -fallow-overlapping-instances #-}
module Hope.Session.Operations (newSession, deleteSession,
                                updateSession,
                                getSession, setSessionUser,
                                purgeSessions, listSessions) where

import Control.Monad.Trans (MonadIO, liftIO)
import System.Random
import System.Time

import Hope.User.Types
import Hope.Session.Types
import Hope.Util.Time
import Hope.DatabaseT

import Hope.Session.DB.Sessions as S


--
-- * Exported operations
--

-- | Starts a new session and stores it in the database.
newSession :: MonadDatabase m => Maybe UserID -> m Session
newSession muid =  
    do
    sid <- genSessionID
    now <- timeNow
    insert S.sessions (S.sessionid <<- sid #
                       S.userid <<- muid #
                       S.started <<- now #
                       S.last_use <<- now)
    let s = Session { 
                     sessionID = sid,
                     sessionUser = muid,
                     sessionStarted = now,
                     sessionLastUse = now
                    }
    return s

-- | Ends a session by removing it from the database.
deleteSession :: MonadDatabase m => SessionID -> m ()
deleteSession sid = 
    delete S.sessions (\r -> r!S.sessionid .==. constant sid)

-- | Update the stored session information for the given session.
updateSession :: MonadDatabase m => Session -> m ()
updateSession s =
    update S.sessions (\r -> r!S.sessionid .==. constant (sessionID s))
                      (\_ -> S.userid <<- sessionUser s
                             # S.started <<- sessionStarted s
                             # S.last_use <<- sessionLastUse s)

-- | Gets session information, and updates the last use
--   information. The 'sessionLastUse' field will contain
--   the last use information as it was before this call.
--   If the session has expired, the session is removed and
--   'Nothing' is returned. If the session does not exist,
--   'Nothing' is returned.
getSession :: MonadDatabase m => 
              SessionSettings -- ^ Settings for the sessions system
           -> SessionID    -- ^ The ID of the session to get.
           -> m (Maybe Session)
getSession settings sid = 
   do ms <- findSession sid
      case ms of
        Nothing -> return Nothing
        Just s -> do exp <- isExpired settings s
                     if exp then do deleteSession sid
                                    return Nothing
                            else do now <- timeNow
                                    let s' = s { sessionLastUse = now }
                                    updateSession s'
                                    return $ Just s'

-- | Sets the 'UserID' associated with a session.
setSessionUser :: MonadDatabase m => 
                  Session
               -> Maybe UserID 
               -> m (Session)
setSessionUser sess muid = 
    do updateSession sess'
       return sess'
  where sess' = sess { sessionUser = muid } 

purgeSessions :: MonadDatabase m => SessionSettings -> m ()
purgeSessions settings =
    do
    (min_started, min_last_use) <- getMinTimes settings
    let too_old r = r!S.started  .<. constant min_started
        too_idle r = r!S.last_use .<. constant min_last_use
    delete S.sessions (\r -> too_old r .||. too_idle r)

--
-- * Debugging operations
--

listSessions :: MonadDatabase m => m [Session]
listSessions =
    do
    rs <- query $ table S.sessions
    return $ map mkSession rs

--
-- * Private operations
--

genSessionID :: MonadDatabase m => m SessionID
genSessionID = 
    do
    sid <- liftIO $ randomRIO (0, 2^31)
    ms <- findSession sid
    case ms of
            Nothing -> return sid
            Just _  -> genSessionID

findSession :: MonadDatabase m => SessionID -> m (Maybe Session)
findSession sid =
    do rs <- query $ do s <- table S.sessions
                        restrict (s!S.sessionid .==. constant sid)
                        return s
       case rs of
         []  -> return Nothing
         [r] -> return $ Just $ mkSession r
         _   -> fail $ "Multiple sessions with ID " ++ show sid

mkSession r = Session { 
                       sessionID = r!S.sessionid,
                       sessionUser = r!S.userid,
                       sessionStarted = r!S.started,
                       sessionLastUse = r!S.last_use
                      }

isExpired :: MonadDatabase m => SessionSettings -> Session -> m Bool
isExpired settings sess =
    do
    (min_started, min_last_use) <- getMinTimes settings
    return (sessionStarted sess < min_started 
         || sessionLastUse sess < min_last_use)

getMinTimes :: MonadDatabase m => SessionSettings -> m (CalendarTime,CalendarTime)
getMinTimes settings = 
    do let max_age = sessionMaxAge settings
           max_idle = sessionMaxIdle settings
       now <- timeNow
       min_started  <- if max_age <= 0 
                         then return epoch
                         else max_age `minutesBefore` now
       min_last_use <- if max_idle <= 0
                         then return epoch
                         else max_idle `minutesBefore` now
       return (min_started, min_last_use)