Question

要在服务器上验证jwt令牌，我正在使用jwk（Google）个证书（经常更改），甚至还有许多要下载的库（HTTP， curl，http-conduit，...），我找不到设置一些本地/全局/内存/每线程/ ... HTTP缓存的方法。

我目前丑陋但可行的替代方案是：

阅读Cache-Control和/或Expires标头并执行我自己丑陋的HTTP缓存。
配置一个（开箱即用服务器）代理。

如何处理服务器上的HTTP缓存？

谢谢！

Answer 1

选项1在这里

httpManager   <- newManager someManagerSettings
mySimpleCache <- makeSimpleHttpCache httpManager responseToMyCachedData
....
a <- mySimpleCache urlA
....

e.g。缓存响应体长

> c <- makeSimpleHttpCache m (\r -> putStrLn "Downloaded!" >> return $ C8.length $ responseBody r)
> c "https://some-url-with-small-cache-control"
Downloaded!
Right 21108
> c "https://some-url-with-small-cache-control"
Right 21108
> c "https://some-url-with-small-cache-control"
Right 21108
> c "https://some-url-with-small-cache-control"
Downloaded!
Right 21108
> c "https://some-url-with-small-cache-control"
Right 21108
>

码

{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.Cached where

import Control.Monad.IO.Class
import Network.Connection
import Network.HTTP.Types
import Network.HTTP.Conduit
import Control.Concurrent.MVar
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M
import Data.Time.Format
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Control.Arrow hiding ((+++))
import Control.Applicative
import Control.Monad.Catch
import Data.Maybe
import Text.ParserCombinators.ReadP
import Data.Char

type Res = Response L.ByteString

makeSimpleHttpCache :: (MonadCatch m, MonadIO m) => Manager -> (Res -> m a) -> m (String -> m (Either String a))
makeSimpleHttpCache manager onLoad = do
    cacheRef <- liftIO $ newMVar M.empty
    return $ \url -> do
        cache <- liftIO $ takeMVar cacheRef
        (cache', a) <- flip catchAll (\e -> return (cache, Left $ show e)) $ do
                            t <- liftIO getPOSIXTime
                            case (second (>t) <$> M.lookup url cache) of
                                Just (y, True) -> return (cache, Right y)
                                _ -> do
                                       u <- liftIO $ parseUrlThrow url
                                       r <- liftIO (httpLbs u manager)
                                       a <- onLoad r
                                       case computeExpireTime t r of
                                           Just t' -> return (M.insertWith const url (a, t') cache, Right a)
                                           _       -> return (cache, Right a)
        liftIO $ putMVar cacheRef cache'
        return a

computeExpireTime :: POSIXTime -> Res -> Maybe POSIXTime
computeExpireTime now rs =
    let hs              = responseHeaders rs
        expires         = do    e <- lookupHeader hExpires hs
                                t <- parseTimeM True defaultTimeLocale "%a, %e %b %Y %T %Z" (C8.unpack e)
                                return $ utcTimeToPOSIXSeconds t
        cachecontrol    = do    c <- lookupHeader hCacheControl hs
                                d <- readMaxAge $ C8.unpack c
                                return $ now + fromIntegral d
    in  cachecontrol <|> expires

readMaxAge :: String -> Maybe Int
readMaxAge = fmap fst . listToMaybe . readP_to_S p
    where p = (string "max-age=" >> read <$> munch isDigit) +++ (get >>= const p)

lookupHeader :: HeaderName -> [Header] -> Maybe C8.ByteString
lookupHeader h = listToMaybe . map snd . filter ((h==) . fst)

hExpires :: HeaderName
hExpires = "Expires"

使用HTTP缓存下载资源

1 个答案: