    {-# 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 :: Int -> IO (Run body -> Run body)
    cacheStore capacity :: Int
    capacity = do
      IORef (Store ByteString (CacheEntry body))
    cache <- Store ByteString (CacheEntry body)
    -> IO (IORef (Store ByteString (CacheEntry body)))
    forall a. a -> IO (IORef a)
    newIORef (Int -> Store ByteString (CacheEntry body)
    forall k v. Ord k => Int -> Store k v
    Store.empty Int
    capacity)
      (Run body -> Run body) -> IO (Run body -> Run body)
    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 :: Run body
    run req :: Req
    req -> do
        let url :: ByteString
    url = Req -> ByteString
    reqURL Req
    req
        UTCTime
    before <- IO UTCTime
    getCurrentTime
        Maybe (Response body)
    mresp <- IORef (Store ByteString (CacheEntry body))
    -> (Store ByteString (CacheEntry body)
        -> (Store ByteString (CacheEntry body), Maybe (Response body)))
    -> IO (Maybe (Response body))
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef (Store ByteString (CacheEntry body))
    cache ((Store ByteString (CacheEntry body)
      -> (Store ByteString (CacheEntry body), Maybe (Response body)))
     -> IO (Maybe (Response body)))
    -> (Store ByteString (CacheEntry body)
        -> (Store ByteString (CacheEntry body), Maybe (Response body)))
    -> IO (Maybe (Response body))
    forall a b. (a -> b) -> a -> b
    $ \s :: Store ByteString (CacheEntry body)
    s ->
          case ByteString
    -> Store ByteString (CacheEntry body)
    -> Maybe (CacheEntry body, Store ByteString (CacheEntry body))
    forall k v.
    (Ord k, Hashable k) =>
    k -> Store k v -> Maybe (v, Store k v)
    Store.lookup ByteString
    url Store ByteString (CacheEntry body)
    s of
            Nothing       -> (Store ByteString (CacheEntry body)
    s, Maybe (Response body)
    forall a. Maybe a
    Nothing)
            Just (ce :: CacheEntry body
    ce, s' :: Store ByteString (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 -> (ByteString
    -> Store ByteString (CacheEntry body)
    -> Store ByteString (CacheEntry body)
    forall k v. (Ord k, Hashable k) => k -> Store k v -> Store k v
    Store.delete ByteString
    url Store ByteString (CacheEntry body)
    s, Maybe (Response body)
    n)
                resp :: Maybe (Response body)
    resp      -> (Store ByteString (CacheEntry body)
    s', Maybe (Response body)
    resp)
        case Maybe (Response body)
    mresp of
          Just resp :: Response body
    resp -> Response body -> IO (Response body)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Response body
    resp
          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
    $ \ce :: CacheEntry body
    ce ->
              IORef (Store ByteString (CacheEntry body))
    -> (Store ByteString (CacheEntry body)
        -> (Store ByteString (CacheEntry body), ()))
    -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef (Store ByteString (CacheEntry body))
    cache ((Store ByteString (CacheEntry body)
      -> (Store ByteString (CacheEntry body), ()))
     -> IO ())
    -> (Store ByteString (CacheEntry body)
        -> (Store ByteString (CacheEntry body), ()))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \s :: Store ByteString (CacheEntry body)
    s -> (ByteString
    -> CacheEntry body
    -> Store ByteString (CacheEntry body)
    -> Store ByteString (CacheEntry body)
    forall k v. (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
    Store.insert ByteString
    url CacheEntry body
    ce Store ByteString (CacheEntry body)
    s, ())
            Response body -> IO (Response body)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Response body
    resp

    cacheableStatuses :: IntSet
    cacheableStatuses :: IntSet
    cacheableStatuses = [Int] -> IntSet
    IntSet.fromList [200, 203, 300, 301, 410]

    cacheableMethods :: HashSet Method
    cacheableMethods :: HashSet ByteString
    cacheableMethods = [ByteString] -> HashSet ByteString
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    HashSet.fromList ["GET", "HEAD", "OPTIONS"]

    possiblyCacheable :: Request -> Response body -> Bool
    possiblyCacheable :: Request -> Response body -> Bool
    possiblyCacheable req :: Request
    req resp :: Response body
    resp =
        (Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    method) ByteString -> HashSet ByteString -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `HashSet.member` HashSet ByteString
    cacheableMethods Bool -> Bool -> Bool
    &&
        (Response body
    resp Response body -> Getting Int (Response body) Int -> Int
    forall s a. s -> Getting a s a -> a
    ^. (Status -> Const Int Status)
    -> Response body -> Const Int (Response body)
    forall body. Lens' (Response body) Status
    responseStatus ((Status -> Const Int Status)
     -> Response body -> Const Int (Response body))
    -> ((Int -> Const Int Int) -> Status -> Const Int Status)
    -> Getting Int (Response body) Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Const Int Int) -> Status -> Const Int Status
    Lens' Status Int
    statusCode) Int -> IntSet -> Bool
    `IntSet.member` IntSet
    cacheableStatuses

    computeExpiration :: UTCTime -> [CacheResponse Seconds] -> Maybe UTCTime
    computeExpiration :: UTCTime -> [CacheResponse Int] -> Maybe UTCTime
    computeExpiration now :: UTCTime
    now crs :: [CacheResponse Int]
    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 Int
    forall age. [HeaderName] -> CacheResponse age
    NoCache [] CacheResponse Int -> [CacheResponse Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [CacheResponse Int]
    crs, CacheResponse Int
    forall age. CacheResponse age
    NoStore CacheResponse Int -> [CacheResponse Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [CacheResponse Int]
    crs]
      Int
    age <- [Int] -> Maybe Int
    forall a. [a] -> Maybe a
    listToMaybe ([Int] -> Maybe Int) -> [Int] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Int]
    forall a. Ord a => [a] -> [a]
    sort [Int
    age | MaxAge age :: Int
    age <- [CacheResponse Int]
    crs]
      UTCTime -> Maybe UTCTime
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
    forall a b. (a -> b) -> a -> b
    $! Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    age NominalDiffTime -> UTCTime -> UTCTime
    `addUTCTime` UTCTime
    now

    validateEntry :: UTCTime -> CacheEntry body -> Maybe (Response body)
    validateEntry :: UTCTime -> CacheEntry body -> Maybe (Response body)
    validateEntry now :: UTCTime
    now CacheEntry{..} =
      case Maybe UTCTime
    entryExpires of
        Nothing          -> Response body -> Maybe (Response body)
    forall a. a -> Maybe a
    Just Response body
    entryResponse
        Just e :: 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 (Response body)
    forall a. Maybe a
    Nothing

    shouldCache :: UTCTime -> Req -> Response body -> Maybe (CacheEntry body)
    shouldCache :: UTCTime -> Req -> Response body -> Maybe (CacheEntry body)
    shouldCache now :: UTCTime
    now (Req _ req :: Request
    req) resp :: 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 Int]
    crs = Response body
    resp Response body
    -> Getting
         (Endo [CacheResponse Int]) (Response body) (CacheResponse Int)
    -> [CacheResponse Int]
    forall s a. s -> Getting (Endo [a]) s a -> [a]
    ^.. HeaderName -> Traversal' (Response body) ByteString
    forall body. HeaderName -> Traversal' (Response body) ByteString
    responseHeader "Cache-Control" ((ByteString -> Const (Endo [CacheResponse Int]) ByteString)
     -> Response body
     -> Const (Endo [CacheResponse Int]) (Response body))
    -> ((CacheResponse Int
         -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
        -> ByteString -> Const (Endo [CacheResponse Int]) ByteString)
    -> Getting
         (Endo [CacheResponse Int]) (Response body) (CacheResponse Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Parser [CacheResponse Int] -> Fold ByteString [CacheResponse Int]
    forall a. Parser a -> Fold ByteString a
    atto_ Parser [CacheResponse Int]
    parseCacheResponse (([CacheResponse Int]
      -> Const (Endo [CacheResponse Int]) [CacheResponse Int])
     -> ByteString -> Const (Endo [CacheResponse Int]) ByteString)
    -> ((CacheResponse Int
         -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
        -> [CacheResponse Int]
        -> Const (Endo [CacheResponse Int]) [CacheResponse Int])
    -> (CacheResponse Int
        -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
    -> ByteString
    -> Const (Endo [CacheResponse Int]) ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                         (CacheResponse Int
     -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
    -> [CacheResponse Int]
    -> Const (Endo [CacheResponse Int]) [CacheResponse Int]
    forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
    folded ((CacheResponse Int
      -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
     -> [CacheResponse Int]
     -> Const (Endo [CacheResponse Int]) [CacheResponse Int])
    -> ((CacheResponse Int
         -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
        -> CacheResponse Int
        -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
    -> (CacheResponse Int
        -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
    -> [CacheResponse Int]
    -> Const (Endo [CacheResponse Int]) [CacheResponse Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CacheResponse Int -> CacheResponse Int)
    -> (CacheResponse Int
        -> Const (Endo [CacheResponse Int]) (CacheResponse Int))
    -> CacheResponse Int
    -> Const (Endo [CacheResponse Int]) (CacheResponse Int)
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    to CacheResponse Int -> CacheResponse Int
    forall age. CacheResponse age -> CacheResponse age
    simplifyCacheResponse
          dateHeader :: HeaderName
    -> p UTCTime (f UTCTime) -> Response body -> f (Response body)
    dateHeader name :: HeaderName
    name = HeaderName -> Traversal' (Response body) ByteString
    forall body. HeaderName -> Traversal' (Response body) ByteString
    responseHeader HeaderName
    name ((ByteString -> f ByteString)
     -> Response body -> f (Response body))
    -> (p UTCTime (f UTCTime) -> ByteString -> f ByteString)
    -> p UTCTime (f UTCTime)
    -> Response body
    -> f (Response body)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Maybe UTCTime)
    -> Optic' (->) f ByteString (Maybe UTCTime)
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    to ByteString -> Maybe UTCTime
    parseDate Optic' (->) f ByteString (Maybe UTCTime)
    -> (p UTCTime (f UTCTime) -> Maybe UTCTime -> f (Maybe UTCTime))
    -> p UTCTime (f UTCTime)
    -> ByteString
    -> f ByteString
    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 Int (f a) a
    folded
          mexpires :: Maybe UTCTime
    mexpires = case [CacheResponse Int]
    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 Int p, Applicative f) =>
    HeaderName
    -> p UTCTime (f UTCTime) -> Response body -> f (Response body)
    dateHeader "Expires"
                       _  -> UTCTime -> [CacheResponse Int] -> Maybe UTCTime
    computeExpiration UTCTime
    now [CacheResponse Int]
    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 Int p, Applicative f) =>
    HeaderName
    -> p UTCTime (f UTCTime) -> Response body -> f (Response body)
    dateHeader "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 expires :: UTCTime
    expires | UTCTime
    expires UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    <= UTCTime
    created                -> Maybe (CacheEntry body)
    forall (f :: * -> *) a. Alternative f => f a
    empty
        Nothing      | Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    method ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == "GET" Bool -> Bool -> Bool
    &&
                       Bool -> Bool
    not (ByteString -> Bool
    B.null (Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    queryString)) -> Maybe (CacheEntry body)
    forall (f :: * -> *) a. Alternative f => f a
    empty
        _ -> CacheEntry body -> Maybe (CacheEntry body)
    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
    /= :: CacheResponse age -> CacheResponse age -> Bool
    $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
    Eq, Int -> CacheResponse age -> ShowS
    [CacheResponse age] -> ShowS
    CacheResponse age -> String
    (Int -> CacheResponse age -> ShowS)
    -> (CacheResponse age -> String)
    -> ([CacheResponse age] -> ShowS)
    -> Show (CacheResponse age)
    forall age. Show age => Int -> CacheResponse age -> ShowS
    forall age. Show age => [CacheResponse age] -> ShowS
    forall age. Show age => CacheResponse age -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CacheResponse age] -> ShowS
    $cshowList :: forall age. Show age => [CacheResponse age] -> ShowS
    show :: CacheResponse age -> String
    $cshow :: forall age. Show age => CacheResponse age -> String
    showsPrec :: Int -> CacheResponse age -> ShowS
    $cshowsPrec :: forall age. Show age => Int -> CacheResponse age -> ShowS
    Show, a -> CacheResponse b -> CacheResponse a
    (a -> b) -> CacheResponse a -> CacheResponse b
    (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
    <$ :: a -> CacheResponse b -> CacheResponse a
    $c<$ :: forall a b. a -> CacheResponse b -> CacheResponse a
    fmap :: (a -> b) -> CacheResponse a -> CacheResponse b
    $cfmap :: forall a b. (a -> b) -> CacheResponse a -> CacheResponse b
    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
    $cto :: forall age x. Rep (CacheResponse age) x -> CacheResponse age
    $cfrom :: forall age x. CacheResponse age -> Rep (CacheResponse age) x
    Generic)

    instance Hashable age => Hashable (CacheResponse age)

    simplifyCacheResponse :: CacheResponse age -> CacheResponse age
    simplifyCacheResponse :: CacheResponse age -> CacheResponse age
    simplifyCacheResponse (Private _) = [HeaderName] -> CacheResponse age
    forall age. [HeaderName] -> CacheResponse age
    Private []
    simplifyCacheResponse (NoCache _) = [HeaderName] -> CacheResponse age
    forall age. [HeaderName] -> CacheResponse age
    NoCache []
    simplifyCacheResponse cr :: CacheResponse age
    cr          = CacheResponse age
    cr

    parseCacheResponse :: A.Parser [CacheResponse Seconds]
    parseCacheResponse :: Parser [CacheResponse Int]
    parseCacheResponse = Parser ByteString (CacheResponse Int) -> Parser [CacheResponse Int]
    forall a. Parser ByteString a -> Parser ByteString [a]
    commaSep1 Parser ByteString (CacheResponse Int)
    body
      where
        body :: Parser ByteString (CacheResponse Int)
    body = "public" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> CacheResponse Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CacheResponse Int
    forall age. CacheResponse age
    Public
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "private" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ([HeaderName] -> CacheResponse Int
    forall age. [HeaderName] -> CacheResponse age
    Private ([HeaderName] -> CacheResponse Int)
    -> Parser ByteString [HeaderName]
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser ByteString [HeaderName] -> Parser ByteString [HeaderName]
    forall b. Parser ByteString b -> Parser ByteString b
    eq Parser ByteString [HeaderName]
    headerNames Parser ByteString [HeaderName]
    -> Parser ByteString [HeaderName] -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [HeaderName] -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []))
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "no-cache" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ([HeaderName] -> CacheResponse Int
    forall age. [HeaderName] -> CacheResponse age
    NoCache ([HeaderName] -> CacheResponse Int)
    -> Parser ByteString [HeaderName]
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Parser ByteString [HeaderName] -> Parser ByteString [HeaderName]
    forall b. Parser ByteString b -> Parser ByteString b
    eq Parser ByteString [HeaderName]
    headerNames Parser ByteString [HeaderName]
    -> Parser ByteString [HeaderName] -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [HeaderName] -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []))
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "no-store" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> CacheResponse Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CacheResponse Int
    forall age. CacheResponse age
    NoStore
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "no-transform" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> CacheResponse Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CacheResponse Int
    forall age. CacheResponse age
    NoTransform
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "must-revalidate" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> CacheResponse Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CacheResponse Int
    forall age. CacheResponse age
    MustRevalidate
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "proxy-revalidate" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> CacheResponse Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CacheResponse Int
    forall age. CacheResponse age
    ProxyRevalidate
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "max-age" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall b. Parser ByteString b -> Parser ByteString b
    eq (Int -> CacheResponse Int
    forall age. age -> CacheResponse age
    MaxAge (Int -> CacheResponse Int)
    -> Parser ByteString Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Int
    forall a. Integral a => Parser a
    decimal)
           Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> "s-maxage" Parser ByteString ByteString
    -> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString (CacheResponse Int)
    -> Parser ByteString (CacheResponse Int)
    forall b. Parser ByteString b -> Parser ByteString b
    eq (Int -> CacheResponse Int
    forall age. age -> CacheResponse age
    SMaxAge (Int -> CacheResponse Int)
    -> Parser ByteString Int -> Parser ByteString (CacheResponse Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Int
    forall a. Integral a => Parser a
    decimal)
        headerNames :: Parser ByteString [HeaderName]
    headerNames = Char -> Parser Char
    A.char '"' Parser Char
    -> Parser ByteString [HeaderName] -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString HeaderName -> Parser ByteString [HeaderName]
    forall a. Parser ByteString a -> Parser ByteString [a]
    commaSep1 Parser ByteString HeaderName
    hdr Parser ByteString [HeaderName]
    -> Parser Char -> Parser ByteString [HeaderName]
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Char -> Parser Char
    A.char '"'
        hdr :: Parser ByteString HeaderName
    hdr = ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    mk (ByteString -> HeaderName)
    -> Parser ByteString ByteString -> Parser ByteString HeaderName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Bool) -> Parser ByteString ByteString
    A.takeWhile1 (String -> Char -> Bool
    inClass "a-zA-Z0-9_-")
        commaSep1 :: Parser ByteString a -> Parser ByteString [a]
    commaSep1 p :: Parser ByteString a
    p = (Parser ByteString a
    p Parser ByteString a -> Parser ByteString () -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString ()
    skipSpace) Parser ByteString a
    -> Parser ByteString () -> Parser ByteString [a]
    forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
    `sepBy1` (Char -> Parser Char
    A.char ',' Parser Char -> Parser ByteString () -> Parser ByteString ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString ()
    skipSpace)
        eq :: Parser ByteString b -> Parser ByteString b
    eq p :: Parser ByteString b
    p = Parser ByteString ()
    skipSpace Parser ByteString () -> Parser Char -> Parser Char
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Char -> Parser Char
    A.char '=' Parser Char -> Parser ByteString () -> Parser ByteString ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString ()
    skipSpace Parser ByteString () -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString b
    p

    parseDate :: B.ByteString -> Maybe UTCTime
    parseDate :: ByteString -> Maybe UTCTime
    parseDate s :: ByteString
    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
    $ [
        "%a, %d %b %Y %H:%M:%S %Z"
      , "%A, %d-%b-%y %H:%M:%S %Z"
      , "%a %b %e %H:%M:%S %Y"
      ]
      where tryout :: String -> First a
    tryout fmt :: 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 (ByteString -> String
    B.unpack ByteString
    s)