module Network.HTTP.RedHandler.Session (
  SessionState,
  getSessionedStateWithCookie,
  newSessionedStateWithCookie,
  updateSessionedStateWithCookie,
  deleteSessionedStateWithCookie
) where

import System.IO.Unsafe (unsafePerformIO)
import System.Time
import qualified Data.Map as Map
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar
import Network.HTTP.RedHandler.HTTP_Fork.HTTP
import Network.CGI.Cookie(findCookie, newCookie, showCookie, deleteCookie)

----------------------------------------
-- session stuff -----------------------
----------------------------------------

type SessionMap a = TVar (Map.Map String a)
type SessionState = Integer

-- global session map
sessionMap :: SessionMap SessionState
sessionMap = unsafePerformIO $ newTVarIO $ Map.empty

addSession :: SessionState -> IO String --automatically (randomly) generates string
addSession x =
               do tok <- getNewToken
                  updateSession tok x
                  return tok
                 where
                   getNewToken = getClockTime >>= toCalendarTime >>= (return . show . ctPicosec) -- dirty random numbers

updateSession :: String -> SessionState -> IO ()
updateSession tok x =
                  atomically (readTVar sessionMap
                                >>= return . Map.insert tok x
                                >>= writeTVar sessionMap)


readSession :: String -> IO (Maybe SessionState)
readSession tok = atomically (readTVar sessionMap >>= return . Map.lookup tok)

deleteSession :: String -> IO ()
deleteSession tok = atomically (readTVar sessionMap
                                  >>= return . Map.delete tok
                                  >>= writeTVar sessionMap)


-- just for testing
exportSessionMap :: IO [(String,SessionState)]
exportSessionMap = atomically (readTVar sessionMap) >>= return . Map.toList

----------------------------------------
-- cookies -----------------------------
----------------------------------------

lookupCookieValue :: HasHeaders a =>  String-> a-> Maybe String
lookupCookieValue cookname rq = do cookstr <- findHeader HdrCookie rq
                                   findCookie cookname cookstr


setCookie :: HasHeaders a => String -> String -> a -> a
setCookie cookname cookvalue =
                   insertHeaders [Header HdrSetCookie (showCookie $ newCookie cookname cookvalue)]

removeCookie :: HasHeaders a => String -> a -> a
removeCookie cookname =
                   insertHeaders [Header HdrSetCookie (showCookie $ deleteCookie $ newCookie cookname "")]


----------------------------------------
-- session and cookies -----------------
----------------------------------------

{- we assume that the cookies will expire when the user closes its browser, otherwise, we might need 
some combinators to refresh the cookie -}

-- | search the cookie with the given name in the headers (request headers) and get the session id.
--   Then search the Session Map for the value
getSessionedStateWithCookie :: HasHeaders request => String -> request -> IO (Maybe SessionState)
getSessionedStateWithCookie cookieName req
                                 = case (lookupCookieValue cookieName req) of
                                     Nothing -> return Nothing
                                     Just tok -> readSession tok

-- | set the value in a new session.
--   Then set responses headers with the cookie.
newSessionedStateWithCookie :: HasHeaders response => String -> SessionState -> IO (response -> response)
newSessionedStateWithCookie cookieName st
                               = do tok <- addSession st
                                    return $ setCookie cookieName tok

-- this is not going to be used. Just for testing
updateSessionedStateWithCookie :: HasHeaders request => String -> request -> SessionState -> IO ()
updateSessionedStateWithCookie cookieName req st
                                      = case lookupCookieValue cookieName req of
                                          Nothing -> return ()
                                          Just tok -> updateSession tok st

deleteSessionedStateWithCookie :: (HasHeaders request, HasHeaders response) => String -> request -> IO (response -> response)
deleteSessionedStateWithCookie cookieName req
                                   = do removeSession
                                        return $ removeCookie cookieName
                                    where
                                       removeSession :: IO ()
                                       removeSession = case lookupCookieValue cookieName req of
                                                         Nothing -> return ()
                                                         Just tok -> deleteSession tok