wai-middleware-cache-redis 0.1.4 → 0.2.0

raw patch · 2 files changed

+18/−11 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Network.Wai.Middleware.Cache.Redis: redisBackend :: ConnectInfo -> Integer -> ByteString -> (Request -> Maybe Integer) -> (Request -> [ByteString]) -> (Request -> ByteString) -> (Request -> Maybe ByteString) -> CacheBackend

+ Network.Wai.Middleware.Cache.Redis: redisBackend :: ConnectInfo -> Integer -> ByteString -> (Request -> Maybe Integer) -> (Request -> [ByteString]) -> (Request -> ByteString) -> (Request -> Maybe ByteString) -> (Request -> Bool) -> CacheBackend

Files

src/Network/Wai/Middleware/Cache/Redis.hs +17/−10
wai-middleware-cache-redis.cabal +1/−1

src/Network/Wai/Middleware/Cache/Redis.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-} 
 
 -- | Redis backend for "Network.Wai.Middleware.Cache".
 --
@@ -49,9 +49,6 @@ 
 -- | Redis backend for "Network.Wai.Middleware.Cache". 
 --
---   Except caching, this backend always adds @ETag@ to 'Response' headers 
---   with hexed @SHA1@ as value.
---
 --   This backend can't cache files. Use routing or catch 'CacheBackendError'
 redisBackend ::
        R.ConnectInfo
@@ -72,8 +69,14 @@             -- ^ @ETag@ value extraction. To extract @If-None-Match@ header
             --   use 'lookupETag'. Use @(const Nothing)@ for block 
             --   @304@-responses.
+    -> (Request -> Bool)
+            -- ^ @ETag@ creation flag. If it 'True', backend adds @ETag@ to 
+            --   'Response' headers with hexed @SHA1@ as value
     -> CacheBackend
-redisBackend cInfo db cachePrefix ttlFn tagsFn keyFn eTagFn app req = do
+redisBackend cInfo db cachePrefix 
+             ttlFn tagsFn keyFn 
+             eTagFn needEtagFn
+             app req = do
     rawRes <- liftIO $  do
         conn <- R.connect cInfo
         R.runRedis conn $ do
@@ -86,13 +89,14 @@                         resourceThrow $ CacheBackendError $ BS8.pack $
                             "Can't cache files : " ++ fp ++ ":" ++ show part  
                     _ -> do 
-                        d <- parseResponse res
+                        d <- parseResponse needEtag res
                         return (d, ttl, tags)
     case buildResponse rawRes of
         Left e -> lift $ resourceThrow $ CacheBackendError e
         Right r -> return r
   where
-    (ttl, tags, key) = (ttlFn req, tagsFn req, keyFn req)
+    (ttl, tags, key, needEtag) = (ttlFn req, tagsFn req, 
+                                  keyFn req, needEtagFn req)
     eTag = case eTagFn req of
         Nothing -> Nothing
         Just v -> Just ("header:ETag", v)
@@ -118,11 +122,14 @@                         $ fromChunks bodyChunks
     decodeResp _ = Left "Data error"
         
-parseResponse :: Response -> ResourceT IO [(B.ByteString, B.ByteString)]
-parseResponse res = do
+parseResponse :: Bool -> Response 
+    -> ResourceT IO [(B.ByteString, B.ByteString)]
+parseResponse needEtag res = do
     bodyChunks <- b $= builderToByteStringFlush 
                     $= CL.map fromChunk $$ CL.consume
-    let bodyHash = hex . SHA.finalize . foldl SHA.update SHA.init $ bodyChunks
+    let bodyHash = if needEtag 
+        then hex . SHA.finalize . foldl SHA.update SHA.init $ bodyChunks
+        else ""
     return [("response", 
                 S.encode (sc, sm, map 
                           (A.first original) (("ETag", bodyHash):hs),

wai-middleware-cache-redis.cabal view

@@ -1,5 +1,5 @@ name:           wai-middleware-cache-redis
-version:        0.1.4
+version:        0.2.0
 cabal-version:  >= 1.8
 build-type:     Simple
 stability:      Experimental