diff options
author | Vincent Ambo <v.ambo@me.com> | 2012-03-13T05·35+0100 |
---|---|---|
committer | Vincent Ambo <v.ambo@me.com> | 2012-03-13T05·35+0100 |
commit | 2cb2900b0747dfb83ebc78e7f129bd26fba920fe (patch) | |
tree | fc3606210ac5d14b38d4259842d576355f8ba16c /src/Main.hs | |
parent | 6092eb6f5e095c7a20f64e4149399391506dd9a0 (diff) |
* updated some stuff, work on sessions
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/src/Main.hs b/src/Main.hs index 58de3221837e..3c585658a8a4 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()) + |