Use time-http 0.3

Ditz-issue: 0a2a377be55430e655ab42fdc4902fa56a058b26

diff --git a/Lucu.cabal b/Lucu.cabal
index a35fb0858b36306b0d92a3a0d031cec03e413b42..2dcbcc8927bdd5de9ec6fd87c4050f545ce5e640 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -51,6 +51,7 @@ Flag ssl
 Library
     Build-Depends:
         ascii                      == 0.0.*,
+        attempt                    == 0.3.*,
         attoparsec                 == 0.9.*,
         base                       == 4.*,
         base-unicode-symbols       == 0.2.*,
@@ -62,6 +63,7 @@ Library
         collections-api            == 1.0.*,
         collections-base-instances == 1.0.*,
         containers                 == 0.4.*,
+        convertible-text           == 0.4.*,
         directory                  == 1.1.*,
         filepath                   == 1.2.*,
         mtl                        == 2.0.*,
@@ -70,10 +72,11 @@ Library
         stm                        == 2.2.*,
         stringsearch               == 0.3.*,
         syb                        == 0.3.*,
+        tagged                     == 0.2.*,
         template-haskell           == 2.5.*,
         text                       == 0.11.*,
         time                       == 1.2.*,
-        time-http                  == 0.2.*,
+        time-http                  == 0.3.*,
         transformers               == 0.2.*
 
     if flag(ssl)

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 41c74a30962ece35afc0cd0ed2eaa53afce032a3..d36c4d1773d4ebcaad2cf2937d5ce0fcddf716b0 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -33,10 +33,12 @@ import Control.Applicative
 import Control.Concurrent.STM
 import Data.Ascii (Ascii)
 import Data.ByteString (ByteString)
+import Data.Convertible.Base
 import Data.Monoid.Unicode
+import Data.Proxy
 import Data.Sequence (Seq)
 import Data.Time
-import qualified Data.Time.HTTP as HTTP
+import Data.Time.Format.HTTP
 import Data.Typeable
 import Network.Socket
 import Network.HTTP.Lucu.Config
@@ -49,6 +51,7 @@ import Network.HTTP.Lucu.Utils
 #if defined(HAVE_SSL)
 import OpenSSL.X509
 #endif
+import Prelude.Unicode
 
 class Typeable i ⇒ Interaction i where
     toInteraction ∷ i → SomeInteraction
@@ -244,7 +247,9 @@ mkNormalInteraction config remoteAddr (AugmentedRequest {..}) rsrcPath
 type InteractionQueue = TVar (Seq SomeInteraction)
 
 mkInteractionQueue ∷ IO InteractionQueue
+{-# INLINE mkInteractionQueue #-}
 mkInteractionQueue = newTVarIO (∅)
 
 getCurrentDate ∷ IO Ascii
-getCurrentDate = HTTP.toAscii <$> getCurrentTime
+{-# INLINE getCurrentDate #-}
+getCurrentDate = flip proxy http ∘ cs <$> getCurrentTime

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 652c5f7b6865d819738287288527a956e08f4332..5c45ace0d88c960e750ddd152f18830c3fbeb7b8 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -149,19 +149,23 @@ import Control.Monad.IO.Class
 import Control.Monad.Unicode
 import Data.Ascii (Ascii, CIAscii)
 import qualified Data.Ascii as A
+import Data.Attempt
 import qualified Data.Attoparsec.Char8 as P
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as Strict
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Collections
+import Data.Convertible.Base
 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 qualified Data.Text as T
 import Data.Time
-import qualified Data.Time.HTTP as HTTP
+import Data.Time.Format.HTTP
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Authentication
 import Network.HTTP.Lucu.Config
@@ -351,7 +355,9 @@ foundEntity tag timeStamp
 
          method ← getMethod
          when (method ≡ GET ∨ method ≡ HEAD)
-             $ setHeader "Last-Modified" (HTTP.toAscii timeStamp)
+             $ setHeader "Last-Modified"
+             $ flip proxy http
+             $ cs timeStamp
          when (method ≡ POST)
              $ abort
              $ mkAbortion' InternalServerError
@@ -445,7 +451,9 @@ foundTimeStamp timeStamp
 
          method ← getMethod
          when (method ≡ GET ∨ method ≡ HEAD)
-             $ setHeader "Last-Modified" (HTTP.toAscii timeStamp)
+             $ setHeader "Last-Modified"
+             $ flip proxy http
+             $ cs timeStamp
          when (method ≡ POST)
              $ abort
              $ mkAbortion' InternalServerError
@@ -459,28 +467,28 @@ foundTimeStamp timeStamp
 
          ifModSince ← getHeader "If-Modified-Since"
          case ifModSince of
-           Just str → case HTTP.fromAscii str of
-                         Right lastTime
+           Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of
+                         Just lastTime
                              → when (timeStamp ≤ lastTime)
                                $ abort
                                $ mkAbortion' statusForIfModSince
                                $ "The entity has not been modified since " ⊕ A.toText str
-                         Left e
+                         Nothing
                              → abort $ mkAbortion' BadRequest
-                                     $ "Malformed If-Modified-Since: " ⊕ T.pack e
+                                     $ "Malformed If-Modified-Since: " ⊕ A.toText str
            Nothing  → return ()
 
          ifUnmodSince ← getHeader "If-Unmodified-Since"
          case ifUnmodSince of
-           Just str → case HTTP.fromAscii str of
-                         Right lastTime
+           Just str → case fromAttempt $ ca (Tagged str ∷ Tagged HTTP Ascii) of
+                         Just lastTime
                              → when (timeStamp > lastTime)
                                $ abort
                                $ mkAbortion' PreconditionFailed
                                $ "The entity has not been modified since " ⊕ A.toText str
-                         Left e
+                         Nothing
                              → abort $ mkAbortion' BadRequest
-                                     $ "Malformed If-Unmodified-Since: " ⊕ T.pack e
+                                     $ "Malformed If-Unmodified-Since: " ⊕ A.toText str
            Nothing  → return ()
 
          driftTo ReceivingBody

diff --git a/bugs/issue-0a2a377be55430e655ab42fdc4902fa56a058b26.yaml b/bugs/issue-0a2a377be55430e655ab42fdc4902fa56a058b26.yaml
index e731191e821344dc1abb10568b0b48c748b4d20c..79fa84b2991bc0c40c44fdf0ab1395f7aa73e725 100644 (file)
--- a/bugs/issue-0a2a377be55430e655ab42fdc4902fa56a058b26.yaml
+++ b/bugs/issue-0a2a377be55430e655ab42fdc4902fa56a058b26.yaml
@@ -1,11 +1,11 @@
 --- !ditz.rubyforge.org,2008-03-06/issue 
-title: Use convertible whenever appropriate.
+title: Use convertible wherever appropriate.
 desc: ""
 type: :task
 component: Lucu
 release: Lucu-1.0
 reporter: PHO <pho@cielonegro.org>
-status: :unstarted
+status: :in_progress
 disposition: 
 creation_time: 2011-12-14 14:07:41.367770 Z
 references: []
@@ -16,4 +16,12 @@ log_events:
   - PHO <pho@cielonegro.org>
   - created
   - ""
+- - 2011-12-15 00:08:57.500763 Z
+  - PHO <pho@cielonegro.org>
+  - edited title
+  - ""
+- - 2011-12-15 12:42:17.264054 Z
+  - PHO <pho@cielonegro.org>
+  - changed status from unstarted to in_progress
+  - ""
 git_branch: