freckle-http 0.3.1.0 → 0.4.0.0
raw patch · 7 files changed
+38/−36 lines, 7 files
Files
- CHANGELOG.md +5/−1
- freckle-http.cabal +1/−1
- library/Freckle/App/Http/Cache.hs +8/−14
- library/Freckle/App/Http/Cache/Memcached.hs +1/−0
- library/Freckle/App/Http/Cache/State.hs +1/−0
- package.yaml +1/−1
- tests/Freckle/App/Http/CacheSpec.hs +21/−19
CHANGELOG.md view
@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/freckle-http/compare/v0.3.1.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-http/compare/v0.4.0.0...main)++## [v0.4.0.0](https://github.com/freckle/freckle-http/compare/v0.3.1.0...v0.4.0.0)++- Add `HttpCacheSettings{cacheByHeaders}` ## [v0.3.1.0](https://github.com/freckle/freckle-http/compare/v0.3.0.1...v0.3.1.0)
freckle-http.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: freckle-http-version: 0.3.1.0+version: 0.4.0.0 license: MIT license-file: LICENSE maintainer: Freckle Education
library/Freckle/App/Http/Cache.hs view
@@ -45,7 +45,6 @@ , hETag , hExpires , hIfNoneMatch- , hVary ) import Network.HTTP.Types.Status (Status, statusCode) import Text.Read (readMaybe)@@ -53,6 +52,7 @@ data HttpCacheSettings m t = HttpCacheSettings { shared :: Bool , cacheable :: Request -> Bool+ , cacheByHeaders :: [HeaderName] , forceTTL :: Maybe CacheTTL , defaultTTL :: CacheTTL , getCurrentTime :: m UTCTime@@ -87,11 +87,10 @@ -- Wrap a function from "Freckle.App.Http" with caching -- -- Verify that the request is cacheable (e.g. a @GET@), then cache it at a--- derived key (from URL and considering any @Vary@ headers). The response will--- only be cached if @Cache-Control@ allows it. @Cache-Control@ is also used to--- determine TTL (e.g. @max-age@)+-- derived key (from URL and considering any 'cacheByHeaders' headers). The+-- response will only be cached if @Cache-Control@ allows it. @Cache-Control@ is+-- also used to determine TTL (e.g. @max-age@) ----- - <https://developer.mozilla.org/en-US/docs/Web/HTTP/Caching#vary> -- - <https://developer.mozilla.org/en-US/docs/Web/HTTP/Caching#fresh_and_stale_based_on_age> -- -- If a cached response is stale, but it has an @ETag@ header, we will make the@@ -199,7 +198,7 @@ -- - A @Cache-Control@ header with @no-store@ is not present -- -- If cacheable, the 'CacheKey' is built from: method, scheme, host, port, path,--- query + any @Vary@ headers.+-- query + any 'cacheByHeaders'. getCachableRequestKey :: HttpCacheSettings m t -> Request -> Maybe CacheKey getCachableRequestKey settings req = do@@ -218,7 +217,7 @@ , HTTP.port req , HTTP.path req , HTTP.queryString req- , concatMap (`getRequestHeader` req) requestHeaders.vary+ , concatMap (`getRequestHeader` req) settings.cacheByHeaders ) -- | Return a 'CacheTTL' for a 'Response', if it's cacheable@@ -302,17 +301,12 @@ fromCCHeader = filter ((== hCacheControl) . fst) $ getHeaders from toNonCCHeader = filter ((/= hCacheControl) . fst) $ getHeaders to -data RequestHeaders = RequestHeaders+newtype RequestHeaders = RequestHeaders { cacheControl :: [CacheControl]- , vary :: [HeaderName] } getRequestHeaders :: Request -> RequestHeaders-getRequestHeaders req =- RequestHeaders- { cacheControl = getCacheControl req- , vary = map CI.mk $ concatMap splitHeader $ getRequestHeader hVary req- }+getRequestHeaders req = RequestHeaders {cacheControl = getCacheControl req} data ResponseHeaders = ResponseHeaders { cacheControl :: [CacheControl]
library/Freckle/App/Http/Cache/Memcached.hs view
@@ -47,6 +47,7 @@ HttpCacheSettings { shared = True , cacheable = const True+ , cacheByHeaders = [] , forceTTL = Nothing , defaultTTL , getCurrentTime = liftIO getCurrentTime
library/Freckle/App/Http/Cache/State.hs view
@@ -56,6 +56,7 @@ HttpCacheSettings { shared = False , cacheable = const True+ , cacheByHeaders = [] , forceTTL = Nothing , defaultTTL = fiveMinuteTTL , getCurrentTime = liftIO getCurrentTime
package.yaml view
@@ -1,5 +1,5 @@ name: freckle-http-version: 0.3.1.0+version: 0.4.0.0 maintainer: Freckle Education category: HTTP github: freckle/freckle-http
tests/Freckle/App/Http/CacheSpec.hs view
@@ -98,7 +98,7 @@ cache.map `shouldSatisfy` ((== 0) . HashMap.size) - it "incorporates Vary headers into the cache key" $ do+ it "incorporates cacheByHeaders into the cache key" $ do let stubs = [ "https://example.com/1"@@ -118,31 +118,29 @@ reqEn1 = parseRequest_ "https://example.com/1" & addRequestHeader hAcceptLanguage "en"- & addRequestHeader hVary "Accept, Accept-Language" reqEn2 = parseRequest_ "https://example.com/2" & addRequestHeader hAcceptLanguage "en"- & addRequestHeader hVary "Accept, Accept-Language" reqEs1 = parseRequest_ "https://example.com/1" & addRequestHeader hAcceptLanguage "es"- & addRequestHeader hVary "Accept, Accept-Language" reqEs2 = parseRequest_ "https://example.com/2" & addRequestHeader hAcceptLanguage "es"- & addRequestHeader hVary "Accept, Accept-Language" + settings' = settings {cacheByHeaders = [hAcceptLanguage]}+ cache <- execCached $ do- requestBodyCached settings stubs reqEn1 `shouldReturn` "Hello\n"- requestBodyCached settings stubs reqEn2 `shouldReturn` "World\n"- requestBodyCached settings stubs reqEs1 `shouldReturn` "Hola\n"- requestBodyCached settings stubs reqEs2 `shouldReturn` "Mundo\n"+ requestBodyCached settings' stubs reqEn1 `shouldReturn` "Hello\n"+ requestBodyCached settings' stubs reqEn2 `shouldReturn` "World\n"+ requestBodyCached settings' stubs reqEs1 `shouldReturn` "Hola\n"+ requestBodyCached settings' stubs reqEs2 `shouldReturn` "Mundo\n" -- No stubs, so these would fail if not cached- requestBodyCached settings [] reqEn1 `shouldReturn` "Hello\n"- requestBodyCached settings [] reqEn2 `shouldReturn` "World\n"- requestBodyCached settings [] reqEs1 `shouldReturn` "Hola\n"- requestBodyCached settings [] reqEs2 `shouldReturn` "Mundo\n"+ requestBodyCached settings' [] reqEn1 `shouldReturn` "Hello\n"+ requestBodyCached settings' [] reqEn2 `shouldReturn` "World\n"+ requestBodyCached settings' [] reqEs1 `shouldReturn` "Hola\n"+ requestBodyCached settings' [] reqEs2 `shouldReturn` "Mundo\n" cache.map `shouldSatisfy` ((== 4) . HashMap.size) @@ -162,21 +160,25 @@ req = parseRequest_ "https://example.com/1"- & addRequestHeader hVary "accept-encoding" reqGzipped = parseRequest_ "https://example.com/1"- & addRequestHeader hVary "accept-encoding" & addRequestHeader hAcceptEncoding "gzip" reqGzippedAsIs = parseRequest_ "https://example.com/1"- & addRequestHeader hVary "accept-encoding" & addRequestHeader hAcceptEncoding "gzip" & disableRequestDecompress + -- User's shouldn't really need to do this, but since we've set up+ -- mocks that return meaningfully-different content within the+ -- gzip-or-not cases, we need to ensure they're cached separately. In+ -- reality, it wouldn't matter which is cached since we always+ -- correctly docompress or not based on content-encoding.+ settings' = settings {cacheByHeaders = [hAcceptEncoding]}+ cache <- execCached $ do- requestBodyCached settings stubs req `shouldReturn` "Hi (not zipped)\n"- requestBodyCached settings stubs reqGzipped `shouldReturn` "Hi (zipped)\n"- requestBodyCached settings stubs reqGzippedAsIs `shouldReturn` gzipped+ requestBodyCached settings' stubs req `shouldReturn` "Hi (not zipped)\n"+ requestBodyCached settings' stubs reqGzipped `shouldReturn` "Hi (zipped)\n"+ requestBodyCached settings' stubs reqGzippedAsIs `shouldReturn` gzipped cache.map `shouldSatisfy` ((== 2) . HashMap.size)