~alcinnz/hurl

ref: a4ffbfc2089a8704a5bb76b4aeded612697c20f2 hurl/src/Network/URI/Cache.hs -rw-r--r-- 1.4 KiB
a4ffbfc2 — Adrian Cochrane Draft code to check whether to cachen an HTTP response. 4 years ago 
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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