about summary refs log tree commit diff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorVincent Ambo <v.ambo@me.com>2012-03-13T05·35+0100
committerVincent Ambo <v.ambo@me.com>2012-03-13T05·35+0100
commit2cb2900b0747dfb83ebc78e7f129bd26fba920fe (patch)
treefc3606210ac5d14b38d4259842d576355f8ba16c /src/Main.hs
parent6092eb6f5e095c7a20f64e4149399391506dd9a0 (diff)
* updated some stuff, work on sessions
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs19
1 files changed, 14 insertions, 5 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 58de322183..3c585658a8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,7 +14,7 @@ import           Data.Acid
 import           Data.Acid.Advanced
 import           Data.Acid.Local
 import qualified Data.ByteString.Base64 as B64 (encode)
-import           Data.ByteString.Char8 (ByteString, pack)
+import           Data.ByteString.Char8 (ByteString, pack, unpack)
 import           Data.Data (Data, Typeable)
 import           Data.Monoid (mempty)
 import           Data.Text (Text)
@@ -50,7 +50,7 @@ tazBlog acid = do
          , do nullDir
               showIndex acid DE
          , do dir " " $ nullDir
-              seeOther ("https://plus.google.com/115916629925754851590" :: String) (toResponse ())
+              seeOther ("https://plus.google.com/115916629925754851590" :: Text) (toResponse ())
          , path $ \(year :: Int) -> path $ \(month :: Int) -> path $ \(id_ :: String) -> formatOldLink year month id_
          , dir "res" $ serveDirectory DisableBrowsing [] "../res"
          , dir "notice" $ ok $ toResponse showSiteNotice
@@ -131,7 +131,16 @@ processLogin acid = do
     password <- look "password"
     login <- query' acid (CheckUser (Username account) password)
     if' login
-      (addSessionCookie account)
-      (ok $ toResponse $ ("Fail?" :: Text))
+      (createSession account)
+      (ok $ toResponse $ adminTemplate adminLogin "Login failed")
   where
-    addSessionCookie = undefined
\ No newline at end of file
+    createSession account = do
+      now <- liftIO getCurrentTime
+      let sId = hashString $ show now
+      addCookie (MaxAge 43200) (mkCookie "session" $ unpack sId)
+      addCookie (MaxAge 43200) (mkCookie "sUser" $ T.unpack account)
+      (Just user) <- query' acid (GetUser $ Username account)
+      let nSession = Session (T.pack $ unpack sId) user now
+      update' acid (AddSession nSession)
+      seeOther ("/admin?do=login" :: Text) (toResponse())
+