@@ -39,7 +39,6 @@ import Data.Text (Text)
3939import qualified Data.Text as T
4040
4141import Data.Either (rights)
42−import Data.Maybe (isJust, fromJust)
4342import Network.HTTP.Date (parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
4443import Data.Monoid (First (First, getFirst), mconcat)
4544
@@ -116,95 +115,77 @@ checkPieces ss@StaticSettings {..} pieces req = do
116115 res <- ssLookupFile pieces
117116 case res of
118117 LRNotFound -> return NotFound
119− LRFile file -> serveFile ss pieces req file
118+ LRFile file -> serveFile ss req file
120119 LRFolder folder -> serveFolder ss pieces req folder
121120
122−serveFile :: StaticSettings -> Pieces -> W.Request -> File -> IO StaticResponse
123−serveFile StaticSettings {..} pieces req file =
124− handleCache
121+serveFile :: StaticSettings -> W.Request -> File -> IO StaticResponse
122+serveFile StaticSettings {..} req file
123+ -- First check etag values, if turned on
124+ | ssUseHash = do
125+ mHash <- fileGetHash file
126+ case (mHash, lookup "if-none-match" $ W.requestHeaders req) of
127+ -- if-none-match matches the actual hash, return a 304
128+ (Just hash, Just lastHash) | hash == lastHash -> return NotModified
129+
130+ -- Didn't match, but we have a hash value. Send the file contents
131+ -- with an ETag header.
132+ --
133+ -- Note: It would be arguably better to next check
134+ -- if-modified-since and return a 304 if that indicates a match as
135+ -- well. However, the circumstances under which such a situation
136+ -- could arise would be very anomolous, and should likely warrant a
137+ -- new file being sent anyway.
138+ (Just hash, _) -> respond [("ETag", hash)]
139+
140+ -- No hash value available, fall back to last modified support.
141+ (Nothing, _) -> lastMod
142+ -- etag turned off, so jump straight to last modified
143+ | otherwise = lastMod
125144 where
126− headers = W.requestHeaders req
127− queryString = W.queryString req
128−
129− -- FIXME This whole thing seems like a mess.
130−
131− -- HTTP caching has a cache control header that you can set an expire time for a resource.
132− -- Max-Age is easiest because it is a simple number
133− -- a cache-control asset will only be downloaded once (if the browser maintains its cache)
134− -- and the server will never be contacted for the resource again (until it expires)
135− --
136− -- A second caching mechanism is ETag and last-modified
137− -- this form of caching is not as good as the static- the browser can avoid downloading the file, but it always need to send a request with the etag value or the last-modified value to the server to see if its copy is up to date
138− --
139− -- We should set a cache control and one of ETag or last-modifed whenever possible
140− --
141− -- In a Yesod web application we can append an etag parameter to static assets.
142− -- This signals that both a max-age and ETag header should be set
143− -- if there is no etag parameter
144− -- * don't set the max-age
145− -- * set ETag or last-modified
146− -- * ETag must be calculated ahead of time.
147− -- * last-modified is just the file mtime.
148− handleCache =
149− if not ssUseHash then lastModifiedCache
150− else do
151− let etagParam = lookup "etag" queryString
152−
153− case etagParam of
154− Nothing -> do -- no query parameter. Set appropriate ETag headers
155− mHash <- fileGetHash file
156− case mHash of
157− Nothing -> lastModifiedCache
158− Just hash ->
159− case lookup "if-none-match" headers of
160− Just lastHash ->
161− if hash == lastHash
162− then return NotModified
163− else return $ FileResponse file $ [("ETag", hash)]
164− Nothing -> return $ FileResponse file $ [("ETag", hash)]
165−
166− Just mEtag -> do
167− mHash <- fileGetHash file
168− case mHash of
169− -- a file used to have an etag parameter, but no longer does
170− Nothing -> return $ Redirect pieces Nothing
171− Just hash ->
172− if isJust mEtag && hash == fromJust mEtag
173− then return $ FileResponse file $ ("ETag", hash):cacheControl
174− else return $ Redirect pieces (Just hash)
175−
176−
177− lastModifiedCache =
178− case (lookup "if-modified-since" headers >>= parseHTTPDate, fileGetModified file) of
179− (mLastSent, Just modified) -> do
180− let mdate = epochTimeToHTTPDate modified in
181− case mLastSent of
182− Just lastSent ->
183− if lastSent == mdate
184− then return NotModified
185− else return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]
186− Nothing -> return $ FileResponse file $ [("last-modified", formatHTTPDate mdate)]
187− _ -> return $ FileResponse file []
188−
189− cacheControl = headerCacheControl $ headerExpires []
190− where
191− ccInt =
192− case ssMaxAge of
193− NoMaxAge -> Nothing
194− MaxAgeSeconds i -> Just i
195− MaxAgeForever -> Just oneYear
196− oneYear :: Int
197− oneYear = 60 * 60 * 24 * 365
198−
199− headerCacheControl =
200− case ccInt of
201− Nothing -> id
202− Just i -> (:) ("Cache-Control", S8.append "public, max-age=" $ S8.pack $ show i)
203− headerExpires =
204− case ssMaxAge of
205− NoMaxAge -> id
206− MaxAgeSeconds _ -> id -- FIXME
207− MaxAgeForever -> (:) ("Expires", "Thu, 31 Dec 2037 23:55:55 GMT")
145+ mLastSent = lookup "if-modified-since" (W.requestHeaders req) >>= parseHTTPDate
146+ lastMod =
147+ case (fmap epochTimeToHTTPDate $ fileGetModified file, mLastSent) of
148+ -- File modified time is equal to the if-modified-since header,
149+ -- return a 304.
150+ --
151+ -- Question: should the comparison be, date <= lastSent?
152+ (Just mdate, Just lastSent)
153+ | mdate == lastSent -> return NotModified
154+
155+ -- Did not match, but we have a new last-modified header
156+ (Just mdate, _) -> respond [("last-modified", formatHTTPDate mdate)]
157+
158+ -- No modification time available
159+ (Nothing, _) -> respond []
160+
161+ -- Send a file response with the additional weak headers provided.
162+ respond headers = return $ FileResponse file $ cacheControl ssMaxAge headers
163+
164+-- | Return a difference list of headers based on the specified MaxAge.
165+--
166+-- This function will return both Cache-Control and Expires headers, as
167+-- relevant.
168+cacheControl :: MaxAge -> (H.ResponseHeaders -> H.ResponseHeaders)
169+cacheControl maxage =
170+ headerCacheControl . headerExpires
171+ where
172+ ccInt =
173+ case maxage of
174+ NoMaxAge -> Nothing
175+ MaxAgeSeconds i -> Just i
176+ MaxAgeForever -> Just oneYear
177+ oneYear :: Int
178+ oneYear = 60 * 60 * 24 * 365
179+
180+ headerCacheControl =
181+ case ccInt of
182+ Nothing -> id
183+ Just i -> (:) ("Cache-Control", S8.append "public, max-age=" $ S8.pack $ show i)
184+ headerExpires =
185+ case maxage of
186+ NoMaxAge -> id
187+ MaxAgeSeconds _ -> id -- FIXME
188+ MaxAgeForever -> (:) ("Expires", "Thu, 31 Dec 2037 23:55:55 GMT")
208189
209190-- | Turn a @StaticSettings@ into a WAI application.
210191staticApp :: StaticSettings -> W.Application