simple-session 0.7.0 → 0.8.0

raw patch · 2 files changed

+32/−22 lines, 2 filesdep ~simple

Dependency ranges changed: simple

Files

• simple-session.cabal +4/−3
• src/Web/Simple/Session.hs +28/−19

@@ -1,5 +1,5 @@ name:                simple-session-version:             0.7.0+version:             0.8.0 synopsis:            Cookie-based session management for the Simple web framework description: @@ -25,6 +25,7 @@   >     Just userId -> [handle request]  homepage:            http://simple.cx+Bug-Reports:         http://github.com/alevy/simple/issues license:             LGPL-3 license-file:        LICENSE author:              Amit Aryeh Levy@@ -48,12 +49,12 @@     , bytestring     , containers     , http-types-    , simple >= 0.7.0 && < 0.8+    , simple >= 0.8.0 && < 0.9     , transformers     , wai >= 2.0   default-language:    Haskell2010  source-repository head   type: git-  location: anonymous@gitstar.com:alevy/simple.git+  location: http://github.com/alevy/simple.git 

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}  {- | Adds cookie-based session management to simple 'Controller's. To add to an   application, declare the Controller setting\'s type an instance of@@ -24,6 +25,7 @@   , session, parseSession, dumpSession, addCookie   ) where +import Control.Monad import Control.Monad.IO.Class import Blaze.ByteString.Builder import Crypto.Hash@@ -35,9 +37,9 @@ import qualified Data.Map as M import Network.HTTP.Types.Header import Network.HTTP.Types.URI-import Network.Wai.Internal+import Network.Wai.Internal (Response(..)) import Web.Cookie-import Web.Simple+import Web.Simple.Controller import System.Environment  -- | Plaintext mapping of the session map. Both keys and values are@@ -94,10 +96,11 @@ -- | A middleware wrapper around a 'Controller' that sets the \"Set-Cookie\" -- header in the HTTP response if the Session is present, i.e. if it was -- accessed/modified by the 'Controller'.-withSession :: HasSession hs => Controller hs a -> Controller hs a-withSession (Controller act) = do+withSession :: HasSession hs+            => Controller hs a -> Controller hs a+withSession (ControllerT act) = do   sk <- sessionKey-  Controller $ \st0 -> do+  ControllerT $ \st0 -> do     (eres, st@(r, _)) <- act st0     case eres of       Left resp0 -> do@@ -113,20 +116,25 @@ -- The path set on the cookie is \"/\", meaning it applies to all routes on the -- domain, and no expiration is set. addCookie :: (S.ByteString, S.ByteString) -> Response -> Response-addCookie (key, value) resp =-  let (stat, hdrs, src) = responseToSource resp-  in ResponseSource stat (("Set-Cookie", cookie):hdrs) src-  where cookie = toByteString . renderSetCookie $-                  def { setCookieName = key-                      , setCookieValue = value-                      , setCookiePath = Just "/" }+addCookie (key, value) (ResponseSource stat hdrs src) =+  ResponseSource stat (("Set-Cookie", cookie key value):hdrs) src+addCookie (key, value) (ResponseFile stat hdrs fl mfp) =+  ResponseFile stat (("Set-Cookie", cookie key value):hdrs) fl mfp+addCookie (key, value) (ResponseBuilder stat hdrs bldr) =+  ResponseBuilder stat (("Set-Cookie", cookie key value):hdrs) bldr +cookie :: S.ByteString -> S.ByteString -> S.ByteString+cookie key value = toByteString . renderSetCookie $+    def { setCookieName = key+        , setCookieValue = value+        , setCookiePath = Just "/" }+ -- | Returns the current 'Session', either from the 'getSession' cache or by -- parsing the cookie from the 'Request' using 'sessionFromCookie'. session :: HasSession hs => Controller hs Session session = do-  msession <- getSession `fmap` controllerState-  case msession of+  cs <- controllerState+  case getSession cs of     Just sess -> return sess     Nothing -> do       sess <- sessionFromCookie@@ -136,7 +144,7 @@ -- | Get and parse a 'Session' from the current 'Request'. sessionFromCookie :: HasSession hs => Controller hs Session sessionFromCookie = do-  cookies <- (maybe [] parseCookies) `fmap` requestHeader hCookie+  cookies <- (maybe [] parseCookies) `liftM` requestHeader hCookie   sess <- case lookup "session" cookies of             Just sessionCookie -> do               sk <- sessionKey@@ -171,17 +179,18 @@ -- | Lookup a key from the current 'Request's session. sessionLookup :: HasSession hs               => S.ByteString -> Controller hs (Maybe S.ByteString)-sessionLookup key = M.lookup key `fmap` session+sessionLookup key = M.lookup key `liftM` session  -- | Insert or replace a key in the current 'Request's session. sessionInsert :: HasSession hs-              => S.ByteString -> S.ByteString -> Controller hs ()+              => S.ByteString -> S.ByteString -> Controller  hs () sessionInsert key value = do   sess <- session   setSession (M.insert key value sess)  -- | Remove a key from the current 'Request's session.-sessionDelete :: HasSession hs => S.ByteString -> Controller hs ()+sessionDelete :: HasSession hs+              => S.ByteString -> Controller hs () sessionDelete key = do   sess <- session   setSession $ M.delete key sess