{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric,
 FlexibleContexts, OverloadedStrings, RecordWildCards #-}moduleNetwork.Wreq.Cache(shouldCache ,validateEntry ,cacheStore )whereimportControl.ApplicativeimportControl.Lens((^?),(^.),(^..),folded,non,pre,to)importControl.Monad(guard)importData.Attoparsec.ByteString.Char8asAimportData.CaseInsensitive(mk)importData.Foldable(forM_)importData.HashSet(HashSet)importData.Hashable(Hashable)importData.IntSet(IntSet)importData.IORef(newIORef)importData.List(sort)importData.Maybe(listToMaybe)importData.Monoid(First(..),mconcat)importData.Time.Clock(UTCTime,addUTCTime,getCurrentTime)importData.Time.Format(parseTimeM)importData.Time.Locale.Compat(defaultTimeLocale)importData.Typeable(Typeable)importGHC.Generics(Generic)importNetwork.HTTP.Types(HeaderName,Method)importNetwork.Wreq.Internal.Lens importNetwork.Wreq.Internal.Types importNetwork.Wreq.Lens importqualifiedData.ByteString.Char8asBimportqualifiedData.HashSetasHashSetimportqualifiedData.IntSetasIntSetimportqualifiedNetwork.Wreq.Cache.Store asStore
#if MIN_VERSION_base(4,6,0)
importData.IORef(atomicModifyIORef')
#else
importData.IORef(IORef,atomicModifyIORef)atomicModifyIORef'::IORefa->(a->(a,b))->IObatomicModifyIORef'=atomicModifyIORef
#endif
cacheStore ::Int->IO(Run body ->Run body )cacheStore :: forall body. Seconds -> IO (Run body -> Run body)
cacheStore Seconds
capacity =doIORef (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 ->doleturl :: Method
url =Req -> Method
reqURL Req
req UTCTime
before <-IO UTCTime
getCurrentTimeMaybe (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 ->caseMethod
-> 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 ofMaybe (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' )->caseUTCTime -> CacheEntry body -> Maybe (Response body)
forall body. UTCTime -> CacheEntry body -> Maybe (Response body)
validateEntry UTCTime
before CacheEntry body
ce ofn :: 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 )caseMaybe (Response body)
mresp ofJustResponse body
resp ->Response body -> IO (Response body)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnResponse body
resp Maybe (Response body)
Nothing->doResponse body
resp <-Run body
run Req
req UTCTime
after <-IO UTCTime
getCurrentTimeMaybe (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
returnResponse body
resp cacheableStatuses ::IntSetcacheableStatuses :: IntSet
cacheableStatuses =[Seconds] -> IntSet
IntSet.fromList[Seconds
200,Seconds
203,Seconds
300,Seconds
301,Seconds
410]cacheableMethods ::HashSetMethodcacheableMethods :: 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->Responsebody ->BoolpossiblyCacheable :: 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 ]->MaybeUTCTimecomputeExpiration :: UTCTime -> [CacheResponse Seconds] -> Maybe UTCTime
computeExpiration UTCTime
now [CacheResponse Seconds]
crs =doBool -> 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
fromIntegralSeconds
age NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime`UTCTime
now validateEntry ::UTCTime->CacheEntry body ->Maybe(Responsebody )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
.. }=caseMaybe UTCTime
entryExpires ofMaybe UTCTime
Nothing->Response body -> Maybe (Response body)
forall a. a -> Maybe a
JustResponse body
entryResponse JustUTCTime
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
JustResponse body
entryResponse Maybe UTCTime
_->Maybe (Response body)
forall a. Maybe a
NothingshouldCache ::UTCTime->Req ->Responsebody ->Maybe(CacheEntry body )shouldCache :: forall body.
UTCTime -> Req -> Response body -> Maybe (CacheEntry body)
shouldCache UTCTime
now (Req Mgr
_Request
req )Response body
resp =doBool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Request -> Response body -> Bool
forall body. Request -> Response body -> Bool
possiblyCacheable Request
req Response body
resp )letcrs :: [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
toCacheResponse 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
toMethod -> 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
foldedmexpires :: 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
nonUTCTime
now caseMaybe UTCTime
mexpires ofJustUTCTime
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
emptyMaybe 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
emptyMaybe 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 typeSeconds =IntdataCacheResponse 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)instanceHashableage =>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 wherebody :: 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
pureCacheResponse 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
pureCacheResponse 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
pureCacheResponse 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
pureCacheResponse 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
pureCacheResponse 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.charChar
'"'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.charChar
'"'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
inClassString
"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.charChar
','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 ()
skipSpaceParser 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.charChar
'='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 ()
skipSpaceParser 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->MaybeUTCTimeparseDate :: 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]
mapString -> 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"]wheretryout :: 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
parseTimeMBool
TrueTimeLocale
defaultTimeLocaleString
fmt (Method -> String
B.unpackMethod
s )