about summary refs log tree commit diff
path: root/src
diff options
context:
space:
mode:
author"Vincent Ambo ext:(%22) <tazjin@me.com>2012-03-08T10·42+0100
committer"Vincent Ambo ext:(%22) <tazjin@me.com>2012-03-08T10·42+0100
commitbbdfa3eae29e124772257e5aaecb3ee042514769 (patch)
tree7f804764d62d96b6e1d61697cc72a9a76c5eb657 /src
parent7b8f95241325ef18ef62a0765838c2b69c924530 (diff)
* initializing Acid sessions
* guardSession
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs24
1 files changed, 20 insertions, 4 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 54b16fdfbce1..b0b06068a9d5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -5,7 +5,8 @@
 module Main where
 
 import           Control.Applicative ((<$>), (<*>), optional, pure)
-import           Control.Monad (msum)
+import           Control.Exception (bracket)
+import           Control.Monad (msum, mzero, when, unless)
 import           Control.Monad.State (get, put)
 import           Control.Monad.Reader (ask)
 import           Data.Acid
@@ -49,16 +50,31 @@ querySessions = sessions <$> ask
 
 $(makeAcidic ''SessionState ['addSession, 'querySessions])
 
+guardSession :: AcidState SessionState -> ServerPartT IO ()
+guardSession acid = do
+    sID <- lookCookieValue "session"
+    sDate <- readCookieValue "sdate"
+    cSessions <- query' acid QuerySessions
+    cDate <- liftIO $ currentSeconds
+    when (not $ elem (sID, sDate) cSessions)
+      mzero
+    when (32400 > (cDate - sDate))
+      mzero
+
+{- Server -}
+
 tmpPolicy :: BodyPolicy
 tmpPolicy = (defaultBodyPolicy "./tmp/" 0 1000 1000)
 
 main :: IO()
 main = do
     putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
-    simpleHTTP nullConf tazBlog
+    bracket (openLocalState initialSession)
+            (createCheckpointAndClose) 
+            (\acid -> simpleHTTP nullConf $ tazBlog acid)
 
-tazBlog :: ServerPart Response
-tazBlog = do
+tazBlog :: AcidState SessionState -> ServerPart Response
+tazBlog acid = do
     msum [ dir (show DE) $ blogHandler DE
          , dir (show EN) $ blogHandler EN
          , do nullDir