yesod-session-redis (empty) → 0.1.0

raw patch · 5 files changed

+153/−0 lines, 5 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, containers, cookie, hedis, mtl, network, pool-conduit, random, text, time, wai, yesod-core

Files

LICENSE +25/−0
Setup.hs +2/−0
Web/RedisSession.hs +46/−0
Yesod/Session/Redis.hs +60/−0
yesod-session-redis.cabal +20/−0

+ LICENSE view

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2012, Tom Streller. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ Web/RedisSession.hs view

@@ -0,0 +1,46 @@+module Web.RedisSession (+		setSession, setSessionExpiring,+		getSession,+		newKey,+		Redis+	) where++import Database.Redis+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Network.Socket.Internal (PortNumber)+import System.Random +import Control.Monad+import Control.Monad.Trans (liftIO)++setSessionExpiring :: Connection -> ByteString -> [(ByteString, ByteString)] -> Integer ->  IO ()+setSessionExpiring conn key values timeout = runRedis conn $ do+    del [key]+    forM_ values (\x -> hset key (fst x) (snd x))+    expire key timeout+    return ()++setSession :: Connection -> ByteString -> [(ByteString, ByteString)] ->  IO ()+setSession conn key values = runRedis conn $ do +    oldsess <- liftIO $ getSession conn key+    let todelete = case oldsess of+                       Just o -> o+                       Nothing -> []+    hdel key $ map fst todelete --- ISNT PROPERLY DELETING KEYS PLS FIX PLS! ;_; trying to remove all the hkeys without refreshing the expiry in redis ---+    forM_ values (\x -> hset key (fst x) (snd x))+    return ()++getSession :: Connection -> ByteString -> IO (Maybe [(ByteString, ByteString)])+getSession conn key = runRedis conn $ do+    result <- hgetall key+    let output = case result of+                     (Right b) -> Just b+                     _ -> Nothing+    return output++newKey = do+         let n = 30+         gen <- newStdGen +         let chars = ['0'..'9']++['a'..'z']++['A'..'B']+         let numbers = randomRs (0, (length chars - 1)) gen+         return $ BC.pack $ take n $ map (chars!!) numbers

+ Yesod/Session/Redis.hs view

@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+module Yesod.Session.Redis (+        redisSessionBackend+	) where++import qualified Web.RedisSession as R+import Yesod.Core+import Yesod.Core.Types+import qualified Network.Wai as W+import Web.Cookie+import Control.Monad.Trans (liftIO)+import Data.Time (UTCTime, addUTCTime, getCurrentTime)+import qualified Data.Text as T+import Data.ByteString (ByteString)+import Database.Redis+import Network.Socket.Internal (PortNumber)+import qualified Data.Map as M+import qualified Data.ByteString.Char8 as BC+import Data.Maybe++sessionName = "yesodSession"+timeout = 10++loadRedisSession :: Connection -> Integer -> W.Request -> IO (SessionMap, SaveSession)+loadRedisSession conn timeout req = do+        let val = do+            raw <- lookup "Cookie" $ W.requestHeaders req+            lookup sessionName $ parseCookies raw+        key <- case val of+            Nothing -> R.newKey+            Just k -> return k+        sess <- case val of+                        Nothing -> return M.empty+                        Just s -> do +                                     result <- R.getSession conn s+                                     return $ M.fromList $ map (\x -> ((T.pack . BC.unpack . fst) x, snd x)) $ fromJust result+        let save = saveRedisSession conn timeout key+        return (sess, save)++saveRedisSession :: Connection -> Integer -> ByteString -> SessionMap -> IO [Header]+saveRedisSession conn timeout key sess = do+    now <- getCurrentTime+    let expires = fromIntegral (timeout * 60) `addUTCTime` now+    R.setSessionExpiring conn key (map (\x -> ((BC.pack . T.unpack . fst) x, snd x)) (M.toList sess)) timeout+    return [AddCookie def {+            setCookieName = sessionName,+            setCookieValue = key,+            setCookiePath = Just "/",+            setCookieExpires = Just expires,+            setCookieDomain = Nothing,+            setCookieHttpOnly = True+        }]+++redisSessionBackend :: IO SessionBackend+redisSessionBackend  = do+	conn <- connect defaultConnectInfo+	return SessionBackend {+		sbLoadSession = loadRedisSession conn 20+	}

+ yesod-session-redis.cabal view

@@ -0,0 +1,20 @@+name: yesod-session-redis+version: 0.1.0+license: BSD3+license-file: LICENSE+author: Oliver Hunt+maintainer: Oliver Hunt+description: Redis-Powered Sessions for Haskell+synopsis: Redis-Powered Sessions for Haskell+category: Database+stability: experimental+cabal-version: >= 1.6+build-type: Simple+homepage: https://github.com/ollieh/yesod-session-redis+source-repository head+  type: git+  location: https://ollieh@github.com/ollieh/yesod-session-redis.git++library+  build-depends: base >= 4 && < 5, mtl, time, bytestring >= 0.9, text, hedis >= 0.6, cookie, binary, pool-conduit, yesod-core >= 1.0, wai, containers, network, random+  exposed-modules: Web.RedisSession, Yesod.Session.Redis