MIMEParams is now an instance of collections-api's type classes.

[Lucu.git] / Network / HTTP / Lucu / Resource.hs

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 97b2cbe3cb491c4b64853fe6a60bfab0895ca171..4cf43e0c5b7f831a45da2487e7c23fd482bf374d 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
-    BangPatterns
+    CPP
+  , BangPatterns
   , GeneralizedNewtypeDeriving
   , DoAndIfThenElse
   , OverloadedStrings
@@ -82,7 +83,9 @@ module Network.HTTP.Lucu.Resource
     , getRemoteAddr
     , getRemoteAddr'
     , getRemoteHost
+#if defined(HAVE_SSL)
     , getRemoteCertificate
+#endif
     , getRequest
     , getMethod
     , getRequestURI
@@ -152,8 +155,8 @@ 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.List
-import qualified Data.Map as M
+import Data.Collections
+import Data.List (intersperse, sort)
 import Data.Maybe
 import Data.Monoid
 import Data.Monoid.Unicode
@@ -174,13 +177,13 @@ import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
-import Network.HTTP.Lucu.MIMEParams
 import Network.HTTP.Lucu.MIMEType (MIMEType(..))
 import qualified Network.HTTP.Lucu.MIMEType as MT
 import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Utils
 import Network.Socket hiding (accept)
 import Network.URI hiding (path)
+import Prelude hiding (any, drop, lookup, reverse)
 import Prelude.Unicode
 
 -- |Get the string representation of the address of remote host. If
@@ -450,7 +453,7 @@ foundTimeStamp timeStamp
          when (method ≡ POST)
              $ abort
              $ mkAbortion' InternalServerError
-               "Illegal computation of foundTimeStamp for POST request."
+               "Illegal call of foundTimeStamp for POST request."
 
          let statusForIfModSince
                  = if method ≡ GET ∨ method ≡ HEAD then
@@ -458,7 +461,6 @@ foundTimeStamp timeStamp
                    else
                        fromStatusCode PreconditionFailed
 
-         -- If-Modified-Since があればそれを見る。
          ifModSince ← getHeader "If-Modified-Since"
          case ifModSince of
            Just str → case HTTP.fromAscii str of
@@ -467,11 +469,11 @@ foundTimeStamp timeStamp
                                $ abort
                                $ mkAbortion' statusForIfModSince
                                $ "The entity has not been modified since " ⊕ A.toText str
-                         Left _
-                             → return () -- 不正な時刻は無視
+                         Left e
+                             → abort $ mkAbortion' BadRequest
+                                     $ "Malformed If-Modified-Since: " ⊕ T.pack e
            Nothing  → return ()
 
-         -- If-Unmodified-Since があればそれを見る。
          ifUnmodSince ← getHeader "If-Unmodified-Since"
          case ifUnmodSince of
            Just str → case HTTP.fromAscii str of
@@ -480,8 +482,9 @@ foundTimeStamp timeStamp
                                $ abort
                                $ mkAbortion' PreconditionFailed
                                $ "The entity has not been modified since " ⊕ A.toText str
-                         Left _
-                             → return () -- 不正な時刻は無視
+                         Left e
+                             → abort $ mkAbortion' BadRequest
+                                     $ "Malformed If-Unmodified-Since: " ⊕ T.pack e
            Nothing  → return ()
 
          driftTo ReceivingBody
@@ -595,8 +598,8 @@ getForm limit
               Just a  → return a
               Nothing → abort $ mkAbortion' BadRequest "Malformed x-www-form-urlencoded"
 
-      readMultipartFormData (MIMEParams m)
-          = case M.lookup "boundary" m of
+      readMultipartFormData m
+          = case lookup "boundary" m of
               Nothing
                   → abort $ mkAbortion' BadRequest "Missing boundary of multipart/form-data"
               Just boundary