wai-session-redis 0.1.0.2 → 0.1.0.3
raw patch · 3 files changed
+88/−61 lines, 3 filesdep ~hedisPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hedis
API changes (from Hackage documentation)
Files
- src/Network/Wai/Session/Redis.hs +13/−12
- test/Spec.hs +60/−34
- wai-session-redis.cabal +15/−15
src/Network/Wai/Session/Redis.hs view
@@ -50,6 +50,9 @@ disconnect conn return res +connectAndRunRedis_ :: MonadIO m => ConnectInfo -> Redis b -> m ()+connectAndRunRedis_ ci = void . connectAndRunRedis ci+ createSession :: MonadIO m => SessionSettings -> m ByteString createSession SessionSettings{..} = liftIO do sesId <- genSessionId@@ -60,7 +63,7 @@ isSesIdValid :: MonadIO m => SessionSettings -> ByteString -> m Bool isSesIdValid SessionSettings{..} sesId = liftIO do- res <- connectAndRunRedis redisConnectionInfo $ do+ res <- connectAndRunRedis redisConnectionInfo $ exists sesId return $ fromRight False res @@ -69,11 +72,10 @@ -> ByteString -- ^ Key -> ByteString -- ^ Value -> m ()-insertIntoSession SessionSettings{..} sesId key value = do- connectAndRunRedis redisConnectionInfo $ do- hset sesId key value- expire sesId expiratinTime- return ()+insertIntoSession SessionSettings{..} sesId key value =+ connectAndRunRedis_ redisConnectionInfo $ do+ hset sesId key value+ expire sesId expiratinTime lookupFromSession :: MonadIO m => SessionSettings -> ByteString -- ^ Session id@@ -90,14 +92,13 @@ clearSession :: MonadIO m => SessionSettings -> ByteString -- ^ Session id -> m ()-clearSession SessionSettings{..} sessionId = do- connectAndRunRedis redisConnectionInfo $ do- del [sessionId]- return ()+clearSession SessionSettings{..} sessionId =+ connectAndRunRedis_ redisConnectionInfo $+ del [sessionId] -- | Create new redis backend wai session store dbStore :: (MonadIO m1, MonadIO m2, Eq k, Serialize k, Serialize v) => SessionSettings -> m2 (SessionStore m1 k v)-dbStore s = do+dbStore s = return $ dbStore' s dbStore' :: (MonadIO m1, MonadIO m2, Eq k, Serialize k, Serialize v, Monad m2) => SessionSettings -> Maybe ByteString -> m2 (Session m1 k v, m2 ByteString)@@ -113,6 +114,6 @@ mkSessionFromSesId :: (MonadIO m1, Eq k, Serialize k, Serialize v) => SessionSettings -> ByteString -> Session m1 k v mkSessionFromSesId s sesId = (mkLookup, mkInsert) where- mkLookup k = liftIO $ fmap (join . fmap (eitherToMaybe . decode)) $ lookupFromSession s sesId (encode k)+ mkLookup k = liftIO (((eitherToMaybe . decode) =<<) <$> lookupFromSession s sesId (encode k)) mkInsert k v = liftIO $ insertIntoSession s sesId (encode k) (encode v)
test/Spec.hs view
@@ -1,11 +1,13 @@ -- Adapted from https://github.com/hce/postgresql-session/blob/master/test/Spec.hs--{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main where import Control.Concurrent import qualified Data.ByteString as B import Data.Default+import Network.Wai.Session import Test.Hspec import Network.Wai.Session.Redis@@ -14,50 +16,74 @@ main = hspec spec spec :: Spec-spec = describe "Network.Wai.Session.Redis" $ it "handles sessions" $ do- store <- dbStore testSettings+spec = describe "Network.Wai.Session.Redis" $ do+ it "Handles value insert" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ ((lookup, insert), mkSessionId) <- store Nothing+ sessionId <- mkSessionId - -- new session- ((lookupSess1, insertSess1), mknewsessid) <- store Nothing- sessid <- mknewsessid+ insert "foo" "foo"+ lookup "foo" `shouldReturn` Just "foo" - -- insert- insertSess1 ("foo" :: B.ByteString) ("foo" :: B.ByteString)- lookupSess1 "foo" `shouldReturn` Just "foo"+ it "Handles value update" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ ((lookup, insert), mkSessionId) <- store Nothing+ sessionId <- mkSessionId - -- update- insertSess1 ("foo" :: B.ByteString) ("bar" :: B.ByteString)- lookupSess1 "foo" `shouldReturn` Just "bar"+ insert "foo" "foo"+ lookup "foo" `shouldReturn` Just "foo" - -- non-existing key- lookupSess1 "bar" `shouldReturn` Nothing+ insert "foo" "bar"+ lookup "foo" `shouldReturn` Just "bar" - -- existing session- ((lookupSess2, insertSess2), mknewsessid) <- store $ Just sessid- newsessid <- mknewsessid+ it "Handles non-existing key" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ ((lookup, insert), mkSessionId) <- store Nothing+ sessionId <- mkSessionId - lookupSess2 "foo" `shouldReturn` Just "bar"+ lookup "foo" `shouldReturn` Nothing - newsessid `shouldBe` sessid+ it "Handles valid sesson id" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ let invalidSessionId = "ImInvalidId"+ ((lookup, insert), mkSessionId) <- store $ Just invalidSessionId - -- invalid session- let invalidsessid = "foobar"- ((lookupSess3, insertSess3), mknewsessid) <- store $ Just invalidsessid- newsessid2 <- mknewsessid+ newSessionId <- mkSessionId+ newSessionId `shouldNotBe` invalidSessionId+ lookup "foo" `shouldReturn` Nothing+ insert "foo" "foo" - newsessid2 `shouldNotBe` newsessid- newsessid2 `shouldNotBe` invalidsessid+ ((lookup, insert), mkSessionId) <- store $ Just newSessionId+ newSessionId2 <- mkSessionId+ lookup "foo" `shouldReturn` Just "foo"+ newSessionId2 `shouldBe` newSessionId - lookupSess3 "foo" `shouldReturn` Nothing+ it "Handles invalid sesson id" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ let invalidSessionId = "ImInvalidId"+ ((lookup, insert), mkSessionId) <- store $ Just invalidSessionId+ newSessionId <- mkSessionId+ newSessionId `shouldNotBe` invalidSessionId+ lookup "foo" `shouldReturn` Nothing - -- re-accessing session- ((lookupSess4, insertSess4), mknewsessid) <- store $ Just sessid- lookupSess4 "foo" `shouldReturn` Just "bar"+ it "Timeouts session" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ ((lookup, insert), mkSessionId) <- store Nothing - -- purged session- threadDelay 2000000- ((lookupSess5, insertSess5), mknewsessid) <- store $ Just sessid- lookupSess5 "foo" `shouldReturn` Nothing+ insert "foo" "foo"+ threadDelay 2000000+ lookup "foo" `shouldReturn` Nothing++ it "Clears sessions" do+ store :: SessionStore IO B.ByteString B.ByteString <- dbStore testSettings+ ((lookup, insert), mkSessionId) <- store Nothing++ insert "foo" "foo"+ lookup "foo" `shouldReturn` Just "foo"++ mkSessionId >>= clearSession testSettings+ lookup "foo" `shouldReturn` Nothing+ testSettings :: SessionSettings testSettings = def {expiratinTime = 1}
wai-session-redis.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: d2f497e5b577a59829bcf6936fb4ae6d8e510eee0eb2fe730ef1ca6e94da1080+-- hash: 963fcb2dd15f642fd86c4c482209668adb39ffddf9c09d0a0907a8d71088ae86 name: wai-session-redis-version: 0.1.0.2+version: 0.1.0.3 synopsis: Simple Redis backed wai-session backend. description: Simple Redis backed wai-session backend. This module allows you to store session data of wai-sessions in a Redis database. category: Web@@ -35,12 +35,12 @@ src build-depends: base >=4.10.0 && <5- , bytestring >=0.10 && <0.11+ , bytestring ==0.10.* , cereal >=0.5.8 && <0.6- , data-default >=0.7 && <0.8- , hedis >=0.14 && <0.15+ , data-default ==0.7.*+ , hedis >=0.14 && <0.16 , vault >=0.3.1 && <0.4- , wai >=3.2 && <3.3+ , wai ==3.2.* , wai-session >=0.3.3 && <0.4 default-language: Haskell2010 @@ -53,13 +53,13 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.10.0 && <5- , bytestring >=0.10 && <0.11+ , bytestring ==0.10.* , cereal >=0.5.8 && <0.6- , data-default >=0.7 && <0.8- , hedis >=0.14 && <0.15+ , data-default ==0.7.*+ , hedis >=0.14 && <0.16 , http-types <0.13 , vault >=0.3.1 && <0.4- , wai >=3.2 && <3.3+ , wai ==3.2.* , wai-session >=0.3.3 && <0.4 , wai-session-redis , warp <3.4@@ -75,13 +75,13 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.10.0 && <5- , bytestring >=0.10 && <0.11+ , bytestring ==0.10.* , cereal >=0.5.8 && <0.6- , data-default >=0.7 && <0.8- , hedis >=0.14 && <0.15+ , data-default ==0.7.*+ , hedis >=0.14 && <0.16 , hspec <2.9 , vault >=0.3.1 && <0.4- , wai >=3.2 && <3.3+ , wai ==3.2.* , wai-session >=0.3.3 && <0.4 , wai-session-redis default-language: Haskell2010