{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, FlexibleContexts, OverloadedStrings, RecordWildCards #-} module Network.Wreq.Cache ( shouldCache , validateEntry , cacheStore ) where import Control.Applicative import Control.Lens ((^?), (^.), (^..), folded, non, pre, to) import Control.Monad (guard) import Data.Attoparsec.ByteString.Char8 as A import Data.CaseInsensitive (mk) import Data.Foldable (forM_) import Data.HashSet (HashSet) import Data.Hashable (Hashable) import Data.IntSet (IntSet) import Data.IORef (newIORef) import Data.List (sort) import Data.Maybe (listToMaybe) import Data.Monoid (First(..), mconcat) import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime) import Data.Time.Format (parseTimeM) import Data.Time.Locale.Compat (defaultTimeLocale) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Network.HTTP.Types (HeaderName, Method) import Network.Wreq.Internal.Lens import Network.Wreq.Internal.Types import Network.Wreq.Lens import qualified Data.ByteString.Char8 as B import qualified Data.HashSet as HashSet import qualified Data.IntSet as IntSet import qualified Network.Wreq.Cache.Store as Store #if MIN_VERSION_base(4,6,0) import Data.IORef (atomicModifyIORef') #else import Data.IORef (IORef, atomicModifyIORef) atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' = atomicModifyIORef #endif cacheStore :: Int -> IO (Run body -> Run body) cacheStore :: forall body. Seconds -> IO (Run body -> Run body) cacheStore Seconds capacity = do IORef (Store Method (CacheEntry body)) cache <- Store Method (CacheEntry body) -> IO (IORef (Store Method (CacheEntry body))) forall a. a -> IO (IORef a) newIORef (Seconds -> Store Method (CacheEntry body) forall k v. Ord k => Seconds -> Store k v Store.empty Seconds capacity) (Run body -> Run body) -> IO (Run body -> Run body) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ((Run body -> Run body) -> IO (Run body -> Run body)) -> (Run body -> Run body) -> IO (Run body -> Run body) forall a b. (a -> b) -> a -> b $ \Run body run Req req -> do let url :: Method url = Req -> Method reqURL Req req UTCTime before <- IO UTCTime getCurrentTime Maybe (Response body) mresp <- IORef (Store Method (CacheEntry body)) -> (Store Method (CacheEntry body) -> (Store Method (CacheEntry body), Maybe (Response body))) -> IO (Maybe (Response body)) forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef (Store Method (CacheEntry body)) cache ((Store Method (CacheEntry body) -> (Store Method (CacheEntry body), Maybe (Response body))) -> IO (Maybe (Response body))) -> (Store Method (CacheEntry body) -> (Store Method (CacheEntry body), Maybe (Response body))) -> IO (Maybe (Response body)) forall a b. (a -> b) -> a -> b $ \Store Method (CacheEntry body) s -> case Method -> Store Method (CacheEntry body) -> Maybe (CacheEntry body, Store Method (CacheEntry body)) forall k v. (Ord k, Hashable k) => k -> Store k v -> Maybe (v, Store k v) Store.lookup Method url Store Method (CacheEntry body) s of Maybe (CacheEntry body, Store Method (CacheEntry body)) Nothing -> (Store Method (CacheEntry body) s, Maybe (Response body) forall a. Maybe a Nothing) Just (CacheEntry body ce, Store Method (CacheEntry body) s') -> case UTCTime -> CacheEntry body -> Maybe (Response body) forall body. UTCTime -> CacheEntry body -> Maybe (Response body) validateEntry UTCTime before CacheEntry body ce of n :: Maybe (Response body) n@Maybe (Response body) Nothing -> (Method -> Store Method (CacheEntry body) -> Store Method (CacheEntry body) forall k v. (Ord k, Hashable k) => k -> Store k v -> Store k v Store.delete Method url Store Method (CacheEntry body) s, Maybe (Response body) n) Maybe (Response body) resp -> (Store Method (CacheEntry body) s', Maybe (Response body) resp) case Maybe (Response body) mresp of Just Response body resp -> Response body -> IO (Response body) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Response body resp Maybe (Response body) Nothing -> do Response body resp <- Run body run Req req UTCTime after <- IO UTCTime getCurrentTime Maybe (CacheEntry body) -> (CacheEntry body -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ (UTCTime -> Req -> Response body -> Maybe (CacheEntry body) forall body. UTCTime -> Req -> Response body -> Maybe (CacheEntry body) shouldCache UTCTime after Req req Response body resp) ((CacheEntry body -> IO ()) -> IO ()) -> (CacheEntry body -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \CacheEntry body ce -> IORef (Store Method (CacheEntry body)) -> (Store Method (CacheEntry body) -> (Store Method (CacheEntry body), ())) -> IO () forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef (Store Method (CacheEntry body)) cache ((Store Method (CacheEntry body) -> (Store Method (CacheEntry body), ())) -> IO ()) -> (Store Method (CacheEntry body) -> (Store Method (CacheEntry body), ())) -> IO () forall a b. (a -> b) -> a -> b $ \Store Method (CacheEntry body) s -> (Method -> CacheEntry body -> Store Method (CacheEntry body) -> Store Method (CacheEntry body) forall k v. (Ord k, Hashable k) => k -> v -> Store k v -> Store k v Store.insert Method url CacheEntry body ce Store Method (CacheEntry body) s, ()) Response body -> IO (Response body) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Response body resp cacheableStatuses :: IntSet cacheableStatuses :: IntSet cacheableStatuses = [Seconds] -> IntSet IntSet.fromList [Seconds 200, Seconds 203, Seconds 300, Seconds 301, Seconds 410] cacheableMethods :: HashSet Method cacheableMethods :: HashSet Method cacheableMethods = [Method] -> HashSet Method forall a. (Eq a, Hashable a) => [a] -> HashSet a HashSet.fromList [Method "GET", Method "HEAD", Method "OPTIONS"] possiblyCacheable :: Request -> Response body -> Bool possiblyCacheable :: forall body. Request -> Response body -> Bool possiblyCacheable Request req Response body resp = (Request req Request -> Getting Method Request Method -> Method forall s a. s -> Getting a s a -> a ^. Getting Method Request Method Lens' Request Method method) Method -> HashSet Method -> Bool forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool `HashSet.member` HashSet Method cacheableMethods Bool -> Bool -> Bool && (Response body resp Response body -> Getting Seconds (Response body) Seconds -> Seconds forall s a. s -> Getting a s a -> a ^. (Status -> Const Seconds Status) -> Response body -> Const Seconds (Response body) forall body (f :: * -> *). Functor f => (Status -> f Status) -> Response body -> f (Response body) responseStatus ((Status -> Const Seconds Status) -> Response body -> Const Seconds (Response body)) -> ((Seconds -> Const Seconds Seconds) -> Status -> Const Seconds Status) -> Getting Seconds (Response body) Seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . (Seconds -> Const Seconds Seconds) -> Status -> Const Seconds Status Lens' Status Seconds statusCode) Seconds -> IntSet -> Bool `IntSet.member` IntSet cacheableStatuses computeExpiration :: UTCTime -> [CacheResponse Seconds] -> Maybe UTCTime computeExpiration :: UTCTime -> [CacheResponse Seconds] -> Maybe UTCTime computeExpiration UTCTime now [CacheResponse Seconds] crs = do Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> Maybe ()) -> Bool -> Maybe () forall a b. (a -> b) -> a -> b $ [Bool] -> Bool forall (t :: * -> *). Foldable t => t Bool -> Bool and [[HeaderName] -> CacheResponse Seconds forall age. [HeaderName] -> CacheResponse age NoCache [] CacheResponse Seconds -> [CacheResponse Seconds] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` [CacheResponse Seconds] crs, CacheResponse Seconds forall age. CacheResponse age NoStore CacheResponse Seconds -> [CacheResponse Seconds] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` [CacheResponse Seconds] crs] Seconds age <- [Seconds] -> Maybe Seconds forall a. [a] -> Maybe a listToMaybe ([Seconds] -> Maybe Seconds) -> [Seconds] -> Maybe Seconds forall a b. (a -> b) -> a -> b $ [Seconds] -> [Seconds] forall a. Ord a => [a] -> [a] sort [Seconds age | MaxAge Seconds age <- [CacheResponse Seconds] crs] UTCTime -> Maybe UTCTime forall a. a -> Maybe a forall (m :: * -> *) a. Monad m => a -> m a return (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime forall a b. (a -> b) -> a -> b $! Seconds -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral Seconds age NominalDiffTime -> UTCTime -> UTCTime `addUTCTime` UTCTime now validateEntry :: UTCTime -> CacheEntry body -> Maybe (Response body) validateEntry :: forall body. UTCTime -> CacheEntry body -> Maybe (Response body) validateEntry UTCTime now CacheEntry{Maybe UTCTime UTCTime Response body entryCreated :: UTCTime entryExpires :: Maybe UTCTime entryResponse :: Response body entryCreated :: forall body. CacheEntry body -> UTCTime entryExpires :: forall body. CacheEntry body -> Maybe UTCTime entryResponse :: forall body. CacheEntry body -> Response body ..} = case Maybe UTCTime entryExpires of Maybe UTCTime Nothing -> Response body -> Maybe (Response body) forall a. a -> Maybe a Just Response body entryResponse Just UTCTime e | UTCTime e UTCTime -> UTCTime -> Bool forall a. Ord a => a -> a -> Bool > UTCTime now -> Response body -> Maybe (Response body) forall a. a -> Maybe a Just Response body entryResponse Maybe UTCTime _ -> Maybe (Response body) forall a. Maybe a Nothing shouldCache :: UTCTime -> Req -> Response body -> Maybe (CacheEntry body) shouldCache :: forall body. UTCTime -> Req -> Response body -> Maybe (CacheEntry body) shouldCache UTCTime now (Req Mgr _ Request req) Response body resp = do Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Request -> Response body -> Bool forall body. Request -> Response body -> Bool possiblyCacheable Request req Response body resp) let crs :: [CacheResponse Seconds] crs = Response body resp Response body -> Getting (Endo [CacheResponse Seconds]) (Response body) (CacheResponse Seconds) -> [CacheResponse Seconds] forall s a. s -> Getting (Endo [a]) s a -> [a] ^.. HeaderName -> Traversal' (Response body) Method forall body. HeaderName -> Traversal' (Response body) Method responseHeader HeaderName "Cache-Control" ((Method -> Const (Endo [CacheResponse Seconds]) Method) -> Response body -> Const (Endo [CacheResponse Seconds]) (Response body)) -> ((CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> Method -> Const (Endo [CacheResponse Seconds]) Method) -> Getting (Endo [CacheResponse Seconds]) (Response body) (CacheResponse Seconds) forall b c a. (b -> c) -> (a -> b) -> a -> c . Parser [CacheResponse Seconds] -> Fold Method [CacheResponse Seconds] forall a. Parser a -> Fold Method a atto_ Parser [CacheResponse Seconds] parseCacheResponse (([CacheResponse Seconds] -> Const (Endo [CacheResponse Seconds]) [CacheResponse Seconds]) -> Method -> Const (Endo [CacheResponse Seconds]) Method) -> ((CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> [CacheResponse Seconds] -> Const (Endo [CacheResponse Seconds]) [CacheResponse Seconds]) -> (CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> Method -> Const (Endo [CacheResponse Seconds]) Method forall b c a. (b -> c) -> (a -> b) -> a -> c . (CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> [CacheResponse Seconds] -> Const (Endo [CacheResponse Seconds]) [CacheResponse Seconds] forall (f :: * -> *) a. Foldable f => IndexedFold Seconds (f a) a IndexedFold Seconds [CacheResponse Seconds] (CacheResponse Seconds) folded ((CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> [CacheResponse Seconds] -> Const (Endo [CacheResponse Seconds]) [CacheResponse Seconds]) -> ((CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> (CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> [CacheResponse Seconds] -> Const (Endo [CacheResponse Seconds]) [CacheResponse Seconds] forall b c a. (b -> c) -> (a -> b) -> a -> c . (CacheResponse Seconds -> CacheResponse Seconds) -> (CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds)) -> CacheResponse Seconds -> Const (Endo [CacheResponse Seconds]) (CacheResponse Seconds) forall (p :: * -> * -> *) (f :: * -> *) s a. (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a to CacheResponse Seconds -> CacheResponse Seconds forall age. CacheResponse age -> CacheResponse age simplifyCacheResponse dateHeader :: HeaderName -> p UTCTime (f UTCTime) -> Response body -> f (Response body) dateHeader HeaderName name = HeaderName -> Traversal' (Response body) Method forall body. HeaderName -> Traversal' (Response body) Method responseHeader HeaderName name ((Method -> f Method) -> Response body -> f (Response body)) -> (p UTCTime (f UTCTime) -> Method -> f Method) -> p UTCTime (f UTCTime) -> Response body -> f (Response body) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Method -> Maybe UTCTime) -> (Maybe UTCTime -> f (Maybe UTCTime)) -> Method -> f Method forall (p :: * -> * -> *) (f :: * -> *) s a. (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a to Method -> Maybe UTCTime parseDate ((Maybe UTCTime -> f (Maybe UTCTime)) -> Method -> f Method) -> (p UTCTime (f UTCTime) -> Maybe UTCTime -> f (Maybe UTCTime)) -> p UTCTime (f UTCTime) -> Method -> f Method forall b c a. (b -> c) -> (a -> b) -> a -> c . p UTCTime (f UTCTime) -> Maybe UTCTime -> f (Maybe UTCTime) forall (f :: * -> *) a. Foldable f => IndexedFold Seconds (f a) a IndexedFold Seconds (Maybe UTCTime) UTCTime folded mexpires :: Maybe UTCTime mexpires = case [CacheResponse Seconds] crs of [] -> Response body resp Response body -> Getting (First UTCTime) (Response body) UTCTime -> Maybe UTCTime forall s a. s -> Getting (First a) s a -> Maybe a ^? HeaderName -> Getting (First UTCTime) (Response body) UTCTime forall {f :: * -> *} {p :: * -> * -> *} {body}. (Contravariant f, Indexable Seconds p, Applicative f) => HeaderName -> p UTCTime (f UTCTime) -> Response body -> f (Response body) dateHeader HeaderName "Expires" [CacheResponse Seconds] _ -> UTCTime -> [CacheResponse Seconds] -> Maybe UTCTime computeExpiration UTCTime now [CacheResponse Seconds] crs created :: UTCTime created = Response body resp Response body -> Getting UTCTime (Response body) UTCTime -> UTCTime forall s a. s -> Getting a s a -> a ^. Getting (First UTCTime) (Response body) UTCTime -> IndexPreservingGetter (Response body) (Maybe UTCTime) forall a s. Getting (First a) s a -> IndexPreservingGetter s (Maybe a) pre (HeaderName -> Getting (First UTCTime) (Response body) UTCTime forall {f :: * -> *} {p :: * -> * -> *} {body}. (Contravariant f, Indexable Seconds p, Applicative f) => HeaderName -> p UTCTime (f UTCTime) -> Response body -> f (Response body) dateHeader HeaderName "Date") ((Maybe UTCTime -> Const UTCTime (Maybe UTCTime)) -> Response body -> Const UTCTime (Response body)) -> ((UTCTime -> Const UTCTime UTCTime) -> Maybe UTCTime -> Const UTCTime (Maybe UTCTime)) -> Getting UTCTime (Response body) UTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c . UTCTime -> Iso' (Maybe UTCTime) UTCTime forall a. Eq a => a -> Iso' (Maybe a) a non UTCTime now case Maybe UTCTime mexpires of Just UTCTime expires | UTCTime expires UTCTime -> UTCTime -> Bool forall a. Ord a => a -> a -> Bool <= UTCTime created -> Maybe (CacheEntry body) forall a. Maybe a forall (f :: * -> *) a. Alternative f => f a empty Maybe UTCTime Nothing | Request req Request -> Getting Method Request Method -> Method forall s a. s -> Getting a s a -> a ^. Getting Method Request Method Lens' Request Method method Method -> Method -> Bool forall a. Eq a => a -> a -> Bool == Method "GET" Bool -> Bool -> Bool && Bool -> Bool not (Method -> Bool B.null (Request req Request -> Getting Method Request Method -> Method forall s a. s -> Getting a s a -> a ^. Getting Method Request Method Lens' Request Method queryString)) -> Maybe (CacheEntry body) forall a. Maybe a forall (f :: * -> *) a. Alternative f => f a empty Maybe UTCTime _ -> CacheEntry body -> Maybe (CacheEntry body) forall a. a -> Maybe a forall (m :: * -> *) a. Monad m => a -> m a return (CacheEntry body -> Maybe (CacheEntry body)) -> CacheEntry body -> Maybe (CacheEntry body) forall a b. (a -> b) -> a -> b $ UTCTime -> Maybe UTCTime -> Response body -> CacheEntry body forall body. UTCTime -> Maybe UTCTime -> Response body -> CacheEntry body CacheEntry UTCTime created Maybe UTCTime mexpires Response body resp type Seconds = Int data CacheResponse age = Public | Private [HeaderName] | NoCache [HeaderName] | NoStore | NoTransform | MustRevalidate | ProxyRevalidate | MaxAge age | SMaxAge age | Extension deriving (CacheResponse age -> CacheResponse age -> Bool (CacheResponse age -> CacheResponse age -> Bool) -> (CacheResponse age -> CacheResponse age -> Bool) -> Eq (CacheResponse age) forall age. Eq age => CacheResponse age -> CacheResponse age -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall age. Eq age => CacheResponse age -> CacheResponse age -> Bool == :: CacheResponse age -> CacheResponse age -> Bool $c/= :: forall age. Eq age => CacheResponse age -> CacheResponse age -> Bool /= :: CacheResponse age -> CacheResponse age -> Bool Eq, Seconds -> CacheResponse age -> ShowS [CacheResponse age] -> ShowS CacheResponse age -> String (Seconds -> CacheResponse age -> ShowS) -> (CacheResponse age -> String) -> ([CacheResponse age] -> ShowS) -> Show (CacheResponse age) forall age. Show age => Seconds -> CacheResponse age -> ShowS forall age. Show age => [CacheResponse age] -> ShowS forall age. Show age => CacheResponse age -> String forall a. (Seconds -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall age. Show age => Seconds -> CacheResponse age -> ShowS showsPrec :: Seconds -> CacheResponse age -> ShowS $cshow :: forall age. Show age => CacheResponse age -> String show :: CacheResponse age -> String $cshowList :: forall age. Show age => [CacheResponse age] -> ShowS showList :: [CacheResponse age] -> ShowS Show, (forall a b. (a -> b) -> CacheResponse a -> CacheResponse b) -> (forall a b. a -> CacheResponse b -> CacheResponse a) -> Functor CacheResponse forall a b. a -> CacheResponse b -> CacheResponse a forall a b. (a -> b) -> CacheResponse a -> CacheResponse b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall a b. (a -> b) -> CacheResponse a -> CacheResponse b fmap :: forall a b. (a -> b) -> CacheResponse a -> CacheResponse b $c<$ :: forall a b. a -> CacheResponse b -> CacheResponse a <$ :: forall a b. a -> CacheResponse b -> CacheResponse a Functor, Typeable, (forall x. CacheResponse age -> Rep (CacheResponse age) x) -> (forall x. Rep (CacheResponse age) x -> CacheResponse age) -> Generic (CacheResponse age) forall x. Rep (CacheResponse age) x -> CacheResponse age forall x. CacheResponse age -> Rep (CacheResponse age) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall age x. Rep (CacheResponse age) x -> CacheResponse age forall age x. CacheResponse age -> Rep (CacheResponse age) x $cfrom :: forall age x. CacheResponse age -> Rep (CacheResponse age) x from :: forall x. CacheResponse age -> Rep (CacheResponse age) x $cto :: forall age x. Rep (CacheResponse age) x -> CacheResponse age to :: forall x. Rep (CacheResponse age) x -> CacheResponse age Generic) instance Hashable age => Hashable (CacheResponse age) simplifyCacheResponse :: CacheResponse age -> CacheResponse age simplifyCacheResponse :: forall age. CacheResponse age -> CacheResponse age simplifyCacheResponse (Private [HeaderName] _) = [HeaderName] -> CacheResponse age forall age. [HeaderName] -> CacheResponse age Private [] simplifyCacheResponse (NoCache [HeaderName] _) = [HeaderName] -> CacheResponse age forall age. [HeaderName] -> CacheResponse age NoCache [] simplifyCacheResponse CacheResponse age cr = CacheResponse age cr parseCacheResponse :: A.Parser [CacheResponse Seconds] parseCacheResponse :: Parser [CacheResponse Seconds] parseCacheResponse = Parser Method (CacheResponse Seconds) -> Parser [CacheResponse Seconds] forall {a}. Parser Method a -> Parser Method [a] commaSep1 Parser Method (CacheResponse Seconds) body where body :: Parser Method (CacheResponse Seconds) body = Parser Method Method "public" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> CacheResponse Seconds -> Parser Method (CacheResponse Seconds) forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure CacheResponse Seconds forall age. CacheResponse age Public Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "private" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ([HeaderName] -> CacheResponse Seconds forall age. [HeaderName] -> CacheResponse age Private ([HeaderName] -> CacheResponse Seconds) -> Parser Method [HeaderName] -> Parser Method (CacheResponse Seconds) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Parser Method [HeaderName] -> Parser Method [HeaderName] forall {b}. Parser Method b -> Parser Method b eq Parser Method [HeaderName] headerNames Parser Method [HeaderName] -> Parser Method [HeaderName] -> Parser Method [HeaderName] forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> [HeaderName] -> Parser Method [HeaderName] forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure [])) Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "no-cache" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ([HeaderName] -> CacheResponse Seconds forall age. [HeaderName] -> CacheResponse age NoCache ([HeaderName] -> CacheResponse Seconds) -> Parser Method [HeaderName] -> Parser Method (CacheResponse Seconds) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Parser Method [HeaderName] -> Parser Method [HeaderName] forall {b}. Parser Method b -> Parser Method b eq Parser Method [HeaderName] headerNames Parser Method [HeaderName] -> Parser Method [HeaderName] -> Parser Method [HeaderName] forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> [HeaderName] -> Parser Method [HeaderName] forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure [])) Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "no-store" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> CacheResponse Seconds -> Parser Method (CacheResponse Seconds) forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure CacheResponse Seconds forall age. CacheResponse age NoStore Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "no-transform" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> CacheResponse Seconds -> Parser Method (CacheResponse Seconds) forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure CacheResponse Seconds forall age. CacheResponse age NoTransform Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "must-revalidate" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> CacheResponse Seconds -> Parser Method (CacheResponse Seconds) forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure CacheResponse Seconds forall age. CacheResponse age MustRevalidate Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "proxy-revalidate" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> CacheResponse Seconds -> Parser Method (CacheResponse Seconds) forall a. a -> Parser Method a forall (f :: * -> *) a. Applicative f => a -> f a pure CacheResponse Seconds forall age. CacheResponse age ProxyRevalidate Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "max-age" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall {b}. Parser Method b -> Parser Method b eq (Seconds -> CacheResponse Seconds forall age. age -> CacheResponse age MaxAge (Seconds -> CacheResponse Seconds) -> Parser Method Seconds -> Parser Method (CacheResponse Seconds) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Method Seconds forall a. Integral a => Parser a decimal) Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a. Parser Method a -> Parser Method a -> Parser Method a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Method Method "s-maxage" Parser Method Method -> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method (CacheResponse Seconds) -> Parser Method (CacheResponse Seconds) forall {b}. Parser Method b -> Parser Method b eq (Seconds -> CacheResponse Seconds forall age. age -> CacheResponse age SMaxAge (Seconds -> CacheResponse Seconds) -> Parser Method Seconds -> Parser Method (CacheResponse Seconds) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Method Seconds forall a. Integral a => Parser a decimal) headerNames :: Parser Method [HeaderName] headerNames = Char -> Parser Char A.char Char '"' Parser Char -> Parser Method [HeaderName] -> Parser Method [HeaderName] forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method HeaderName -> Parser Method [HeaderName] forall {a}. Parser Method a -> Parser Method [a] commaSep1 Parser Method HeaderName hdr Parser Method [HeaderName] -> Parser Char -> Parser Method [HeaderName] forall a b. Parser Method a -> Parser Method b -> Parser Method a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Char -> Parser Char A.char Char '"' hdr :: Parser Method HeaderName hdr = Method -> HeaderName forall s. FoldCase s => s -> CI s mk (Method -> HeaderName) -> Parser Method Method -> Parser Method HeaderName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Char -> Bool) -> Parser Method Method A.takeWhile1 (String -> Char -> Bool inClass String "a-zA-Z0-9_-") commaSep1 :: Parser Method a -> Parser Method [a] commaSep1 Parser Method a p = (Parser Method a p Parser Method a -> Parser Method () -> Parser Method a forall a b. Parser Method a -> Parser Method b -> Parser Method a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser Method () skipSpace) Parser Method a -> Parser Method () -> Parser Method [a] forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a] `sepBy1` (Char -> Parser Char A.char Char ',' Parser Char -> Parser Method () -> Parser Method () forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method () skipSpace) eq :: Parser Method b -> Parser Method b eq Parser Method b p = Parser Method () skipSpace Parser Method () -> Parser Char -> Parser Char forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Char -> Parser Char A.char Char '=' Parser Char -> Parser Method () -> Parser Method () forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method () skipSpace Parser Method () -> Parser Method b -> Parser Method b forall a b. Parser Method a -> Parser Method b -> Parser Method b forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Method b p parseDate :: B.ByteString -> Maybe UTCTime parseDate :: Method -> Maybe UTCTime parseDate Method s = First UTCTime -> Maybe UTCTime forall a. First a -> Maybe a getFirst (First UTCTime -> Maybe UTCTime) -> ([String] -> First UTCTime) -> [String] -> Maybe UTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c . [First UTCTime] -> First UTCTime forall a. Monoid a => [a] -> a mconcat ([First UTCTime] -> First UTCTime) -> ([String] -> [First UTCTime]) -> [String] -> First UTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> First UTCTime) -> [String] -> [First UTCTime] forall a b. (a -> b) -> [a] -> [b] map String -> First UTCTime forall {a}. ParseTime a => String -> First a tryout ([String] -> Maybe UTCTime) -> [String] -> Maybe UTCTime forall a b. (a -> b) -> a -> b $ [ String "%a, %d %b %Y %H:%M:%S %Z" , String "%A, %d-%b-%y %H:%M:%S %Z" , String "%a %b %e %H:%M:%S %Y" ] where tryout :: String -> First a tryout String fmt = Maybe a -> First a forall a. Maybe a -> First a First (Maybe a -> First a) -> Maybe a -> First a forall a b. (a -> b) -> a -> b $ Bool -> TimeLocale -> String -> String -> Maybe a forall (m :: * -> *) t. (MonadFail m, ParseTime t) => Bool -> TimeLocale -> String -> String -> m t parseTimeM Bool True TimeLocale defaultTimeLocale String fmt (Method -> String B.unpack Method s)