    {-# 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
      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)
      return $ \Run body
    run Req
    req -> do
        let url :: Method
    url = Req -> Method
    reqURL Req
    req
        before <- IO UTCTime
    getCurrentTime
        mresp <- atomicModifyIORef' cache $ \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 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
            resp <- Run body
    run Req
    req
            after <- getCurrentTime
            forM_ (shouldCache after req resp) $ \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, ())
            return 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]
      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]
      return $! fromIntegral age `addUTCTime` 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
    entryResponse :: forall body. CacheEntry body -> Response body
    entryExpires :: forall body. CacheEntry body -> Maybe UTCTime
    entryCreated :: forall body. CacheEntry body -> UTCTime
    ..} =
      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)