create Session from cookies

2 files changed, 49 insertions, 3 deletions

diff --git a/src/Types/Session.hs b/src/Types/Session.hs
index 6307a48..bc11a05 100644
--- a/src/Types/Session.hs
+++ b/src/Types/Session.hs
@@ -4,6 +4,8 @@ import Types.Classes
 import Types.Clocks
 import Network.CGI.Cookie
 import System.Time
+import Data.List.Split (splitOn)
+import Data.Classes
 
 data Session = Session
     { currentClass :: Maybe Class
@@ -15,10 +17,25 @@ data Session = Session
 -- maybe the session from the state monad
 
 makeClassCookie             :: ClockTime -> Session -> Cookie
-makeClassCookie now session = undefined
+makeClassCookie now session =
+    Cookie { cookieName     = "class_cookie"
+           , cookieValue    = (show . currentClass) session
+           , cookieExpires  = Just $ endOfSchoolDay now
+           , cookieDomain   = Nothing
+           , cookiePath     = Nothing
+           , cookieSecure   = False}
 
 makeClockCookie             :: ClockTime -> Session -> Cookie
-makeClockCookie now session = undefined
+makeClockCookie now session =
+    Cookie { cookieName     = "clock_cookie"
+           , cookieValue    =
+               case currentClock session of
+               CountDownClock -> "0"
+               CountUpClock   -> "1"
+           , cookieExpires  = Just $ endOfSchoolDay now
+           , cookieDomain   = Nothing
+           , cookiePath     = Nothing
+           , cookieSecure   = False}
 
 endOfSchoolDay       :: ClockTime -> CalendarTime
 endOfSchoolDay now   = (toUTCTime . addToClockTime noTimeDiff { tdHour = hoursTilEndOfDay }) now
@@ -27,3 +44,17 @@ endOfSchoolDay now   = (toUTCTime . addToClockTime noTimeDiff { tdHour = hoursTi
                        { ctTZ = 9 * 60 * 60
                        , ctTZName = "KST"}
     hoursTilEndOfDay = 18 - ctHour koreanTime
+
+-- could use Maybe monad in the below!
+
+parseClassCookie   :: Maybe String -> Maybe Class
+parseClassCookie s =
+    case s of
+        Just s  -> parseClassCookie' s
+        Nothing -> Nothing
+
+parseClassCookie' :: String -> Maybe Class
+parseClassCookie' s =
+    case splitOn "-" s of
+        g:c:[] -> Just $ lookupSariulClass (read g) (read c)
+        _      -> Nothing
diff --git a/src/sariulclocks.hs b/src/sariulclocks.hs
index cf136c9..a32388e 100644
--- a/src/sariulclocks.hs
+++ b/src/sariulclocks.hs
@@ -7,6 +7,10 @@ import Types.Scores
 import Data.Classes
 import Data.List.Split (splitOn)
 import System.Time (getClockTime, CalendarTime, toCalendarTime)
+import Control.Monad (liftM)
+import Data.Maybe (fromMaybe)
+import Types.Session
+import Types.Clocks
 -- import Control.Monad.Reader
 -- import Control.Monad.State
 -- import System.IO (stdin, stdout)
@@ -38,15 +42,26 @@ page scores = (h1 << "Hello World!") +++ rankings (Just $ lookupSariulClass 5 3)
 
 cgiMain :: CGI CGIResult
 cgiMain = do
+    -- preparatory IO: templating, scores file, time (for cookies)
+
     htmlTemplate <- (liftIO . readFile) "html/main.html"
     maybeScores <- liftIO readScoresFile
-
     let scores = case maybeScores of
             Just s -> s
             _      -> zeroScores
 
     clockTime <- liftIO getClockTime
 
+    currentClock <- liftM (fromMaybe 0) $ readCookie "clock_cookie"
+    currentClass <- liftM (parseClassCookie) $ getCookie "class_cookie"
+    let session = Session { currentClass = currentClass
+                          , currentClock =
+                              case currentClock of
+                                  0 -> CountDownClock
+                                  1 -> CountUpClock}
+
+    -- now do our CGI work
+
     output $ templateInject htmlTemplate (page scores)
 
 main = runCGI . handleErrors $ cgiMain