X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;fp=Network%2FHTTP%2FLucu%2FResource.hs;h=520502204df5d933484d85298115051574915dd3;hp=acc62057549f0527e40daac13e6024ff7395bda6;hb=3b448555e621530c3483f03b4b5156dc606b2035;hpb=f093019cb10a88fee13b8c99d05b60f895ceb01f diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index acc6205..5205022 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -164,7 +164,6 @@ import Data.List (intersperse, sort) import Data.Maybe import Data.Monoid import Data.Monoid.Unicode -import Data.Proxy import Data.Tagged import Data.Text (Text) import Data.Time @@ -357,8 +356,7 @@ foundEntity tag timeStamp method ← getMethod when (method ≡ GET ∨ method ≡ HEAD) $ setHeader "Last-Modified" - $ flip proxy http - $ cs timeStamp + $ formatUTCTime timeStamp when (method ≡ POST) $ abort $ mkAbortion' InternalServerError @@ -458,8 +456,7 @@ foundTimeStamp timeStamp method ← getMethod when (method ≡ GET ∨ method ≡ HEAD) $ setHeader "Last-Modified" - $ flip proxy http - $ cs timeStamp + $ formatUTCTime timeStamp when (method ≡ POST) $ abort $ mkAbortion' InternalServerError @@ -473,7 +470,7 @@ foundTimeStamp timeStamp ifModSince ← getHeader "If-Modified-Since" case ifModSince of - Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of + Just str → case untag' <$> (fromAttempt $ ca str) of Just lastTime → when (timeStamp ≤ lastTime) $ abort @@ -486,7 +483,7 @@ foundTimeStamp timeStamp ifUnmodSince ← getHeader "If-Unmodified-Since" case ifUnmodSince of - Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of + Just str → case untag' <$> (fromAttempt $ ca str) of Just lastTime → when (timeStamp > lastTime) $ abort @@ -498,6 +495,10 @@ foundTimeStamp timeStamp Nothing → return () driftTo ReceivingBody + where + untag' ∷ Tagged HTTP α → α + {-# INLINE untag' #-} + untag' = untag -- |@'foundNoEntity' mStr@ tells the system that the 'Rsrc' found no -- entity for the request URI. @mStr@ is an optional error message to