2 files changed, 32 insertions(+), 0 deletions(-)

M hurl.cabal
A src/Network/URI/Cache.hs

@@ 113,6 113,7 @@ library
     CPP-options:   -DWITH_HTTP_URI
     build-depends: http-client, http-types >= 0.12 && <0.13,
                    http-client-openssl, HsOpenSSL
+    other-modules: Network.URI.Cache
   if flag(gemini)
     CPP-options:   -DWITH_GEMINI_URI -DWITH_RAW_CONNECTIONS
     build-depends: HsOpenSSL, openssl-streams >= 1.2 && < 1.3, io-streams >= 1.5 && < 1.6

@@ 0,0 1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.URI.Cache(shouldCacheHTTP) where -- , storeCacheHTTP, writeCacheHTTP)
+import Network.HTTP.Client
+import Network.HTTP.Types.Status
+import Network.HTTP.Types.Header
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 as C
+
+import Data.Maybe (mapMaybe, listToMaybe, isJust, isNothing)
+import Data.Char (isSpace)
+
+strip = C.dropWhile isSpace -- FIXME Upgrade bytestring dependency for a real strip function.
+
+httpCacheDirective :: Response b -> ByteString -> Maybe ByteString
+httpCacheDirective response key | Just header <- lookup hCacheControl $ responseHeaders response =
+        let directives = Prelude.map strip $ C.split ',' header
+        in if key `Prelude.elem` directives
+            then Just ""
+            else listToMaybe $ mapMaybe (C.stripPrefix $ C.snoc key '=') directives
+    | otherwise = Nothing
+
+shouldCacheHTTP :: Response b -> Bool
+-- IETF RFC7234 Section 3
+shouldCacheHTTP response = -- Assume GET
+    statusCode (responseStatus response) `Prelude.elem` [200, 201, 404] && -- Supported response code
+        isNothing (httpCacheDirective response "no-store") && -- Honor no-store
+        True && -- This is a private cache, don't check for Cache-Control: private
+        (isJust (lookup hExpires $ responseHeaders response) || -- Support Expires: header
+        isJust (httpCacheDirective response "max-age") ||
+        isJust (httpCacheDirective response "public")) -- Override directive