mysnapsession 0.3.1 → 0.4

raw patch · 4 files changed

+19/−34 lines, 4 filesdep ~mtldep ~snapdep ~snap-core

Dependency ranges changed: mtl, snap, snap-core

Files

• mysnapsession.cabal +4/−4
• src/Snap/Extension/Session/Client.hs +1/−1
• src/Snap/Extension/Session/Memory.hs +2/−3
• src/Snap/SessionUtil.hs +12/−26

@@ -1,5 +1,5 @@ Name:                mysnapsession-Version:             0.3.1+Version:             0.4 Synopsis:            Sessions and continuations for Snap web apps Description:         This package provides two Snap extensions, implementing                      sessions as either memory-backed arbitrary types, or as@@ -30,9 +30,9 @@   Build-depends:     base == 4.*,     bytestring >= 0.9.1 && < 0.10,-    mtl == 2.*,-    snap == 0.3.*,-    snap-core == 0.3.*,+    mtl == 2.0.*,+    snap >= 0.4 && < 0.5,+    snap-core >= 0.4 && < 0.5,     time >= 1.1 && < 1.3,     random == 1.0.*,     containers >= 0.3 && < 0.5,

@@ -79,7 +79,7 @@ getSessionRecord :: (MonadSnap m, Serialize t)                  => ClientSessionManager t -> m (SessionRecord t) getSessionRecord mgr = do-     cookie <- getCookie "sessionval"+     cookie <- lookupCookie "sessionval"      case cookie of          Nothing -> valToRecord =<< liftIO (clientSessionDefault mgr)          Just c  -> case decrypt (clientSessionKey mgr) (cookieValue c) of

@@ -16,7 +16,6 @@ import Control.Applicative import Control.Concurrent import Control.Monad.Reader-import Data.List import Data.Time.Clock import Snap.Extension import Snap.Extension.Session@@ -132,9 +131,9 @@                    -> m (Maybe (SessionWrapper obj)) getExistingSession (MemorySessionManager oref sref _) = do     liftIO (readMVar oref) >>= flip unless mzero-    cookies <- fmap rqCookies getRequest     client  <- fmap rqRemoteAddr getRequest-    case find ((== "sessionid") . cookieName) cookies of+    ck      <- lookupCookie "sessionid"+    case ck of         Nothing  -> return Nothing         Just sid -> do             smap <- liftIO $ readMVar sref

@@ -4,8 +4,7 @@ module Snap.SessionUtil where  import Data.Word-import Snap.Iteratee (enumBS)-import Snap.Types hiding (redirect)+import Snap.Types import System.Random  import Data.ByteString.Char8 (ByteString)@@ -20,19 +19,19 @@     find this one even within the same request. -} setCookie :: MonadSnap m => Cookie -> m ()-setCookie cookie = do-    modifyRequest  req-    modifyResponse (updateHeaders (M.update cleanRsp "Set-Cookie"))-    modifyResponse (addCookie cookie)-  where-    req | B.null (cookieValue cookie)-            = \r -> r { rqCookies = cleanReq (rqCookies r) }-        | otherwise-            = \r -> r { rqCookies = cookie : cleanReq (rqCookies r) }-    cleanReq = filter ((/= cookieName cookie) . cookieName)-    cleanRsp = Just . filter (not . ((cookieName cookie `B.append` "=") `B.isPrefixOf`))+setCookie cookie = modifyResponse (addResponseCookie cookie)  {-|+    Retrieves a cookie, looking first in the response map, and if not there,+    then in the request.  This ensures that the most recently set cookie is+    retrieved.+-}+lookupCookie :: MonadSnap m => ByteString -> m (Maybe Cookie)+lookupCookie name = do+    rsp <- getResponse+    maybe (getCookie name) (return . Just) (getResponseCookie name rsp)++{-|     Clears a cookie.  This involves setting the cookie to the empty string,     with an expiration time in the past. -}@@ -51,19 +50,6 @@     if B.null x         then pass         else localRequest (\r -> r {rqPathInfo = B.drop 1 y}) (handler x)--{-|-    Temporarily here, in the hopes that the type of the original will be fixed-    in a future version of Snap.--}-redirect :: MonadSnap m => ByteString -> m a-redirect target = do-    r <- getResponse-    finishWith-        $ setResponseCode 302-        $ setContentLength 0-        $ modifyResponseBody (const $ enumBS "")-        $ setHeader "Location" target r  {-|     Ensure that we're at the top level of a request, and expect that it be a