1 files changed, 21 insertions(+), 9 deletions(-)

M src/Network/URI/Cache.hs

@@ 1,5 1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.URI.Cache(shouldCacheHTTP) where -- , storeCacheHTTP, writeCacheHTTP)
+module Network.URI.Cache(shouldCacheHTTP, cacheHTTP, readCacheHTTP) where
 import Network.HTTP.Client
 import Network.HTTP.Types.Status
 import Network.HTTP.Types.Header


@@ 16,7 16,7 @@ import System.IO as IO
 import System.FilePath
 import System.Directory
 
-import Data.Maybe (mapMaybe, listToMaybe, isJust, isNothing, fromMaybe)
+import Data.Maybe
 import Data.Char (isSpace)
 import Data.List as L
 import Control.Monad (forM)


@@ 59,27 59,39 @@ computeExpires resp
 cacheHTTP :: URI -> Response Lazy.ByteString -> IO ()
 cacheHTTP uri resp | shouldCacheHTTP resp = do
     expires <- computeExpires resp
-    write (uriToString' uri) ([
+    writeKV (uriToString' uri) ([
             ("mime", C.unpack $ fromMaybe "application/octet-stream" $ 
                     lookup "content-type" $ responseHeaders resp),
             ("expires", show expires)
         ], responseBody resp)
 cacheHTTP _ _ = return ()
 
+readCacheHTTP :: URI -> IO (Maybe (String, Lazy.ByteString))
+readCacheHTTP uri = do
+    (headers, body) <- readKV (uriToString' uri)
+    let mime = fromMaybe "application/octet-stream" $ lookup "mime" headers
+    case readMaybe =<< lookup "expires" headers of
+        Nothing -> return Nothing
+        Just expiry -> do
+            now <- getCurrentTime
+            if expiry <= now then return $ Just (mime, body)
+            else do
+                -- TODO validate via a HEAD request
+                return Nothing
 
 ------
 --- Key-value storage
 ------
 
-read :: String -> IO ([(String, String)], Lazy.ByteString)
-write :: String -> ([(String, String)], Lazy.ByteString) -> IO ()
-openKey :: String -> IO.IOMode -> (Handle -> IO r) -> IO r
+readKV :: String -> IO ([(String, String)], Lazy.ByteString)
+writeKV :: String -> ([(String, String)], Lazy.ByteString) -> IO ()
+openKV :: String -> IO.IOMode -> (Handle -> IO r) -> IO r
 
-openKey key mode act = do
+openKV key mode act = do
     dir <- getXdgDirectory XdgCache "nz.geek.adrian.hurl"
     IO.withFile (dir </> "http" </> escapeURIString isUnescapedInURIComponent key) mode act
 
-read key = openKey key ReadMode parseHeaders
+readKV key = openKV key ReadMode parseHeaders
   where
     parseHeaders h = do
         line <- IO.hGetLine h


@@ 92,7 104,7 @@ read key = openKey key ReadMode parseHeaders
                 return ((key, strip' value):headers, body)
     strip' = L.dropWhile isSpace . L.dropWhileEnd isSpace
 
-write key (headers, body) = openKey key WriteMode $ \h -> do
+writeKV key (headers, body) = openKV key WriteMode $ \h -> do
     forM headers $ \(key, value) -> do
         IO.hPutStrLn h (key++' ':value)
     IO.hPutStrLn h ""