many changes

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

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index c8525af7497b0219c0ede9b54cf25198fe29c3ee..c8ca45d00579daff37db145dc98b217ab1f1a3d9 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -151,8 +151,7 @@ import qualified Data.Attoparsec.Char8 as P
 import qualified Data.Attoparsec.Lazy  as LP
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as Strict
-import qualified Data.ByteString.Char8 as C8
-import qualified Data.ByteString.Lazy  as Lazy
+import qualified Data.ByteString.Lazy as Lazy
 import Data.Foldable (toList)
 import Data.List
 import qualified Data.Map as M
@@ -276,24 +275,24 @@ getRequestVersion = reqVersion <$> getRequest
 -- >                        ...
 -- >   , ...
 -- >   }
-getResourcePath ∷ Resource [Ascii]
+getResourcePath ∷ Resource [Text]
 getResourcePath = (fromJust ∘ itrResourcePath) <$> getInteraction
 
 -- |This is an analogy of CGI PATH_INFO. The result is
 -- URI-unescaped. It is always @[]@ if the
 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' is not greedy. See
 -- 'getResourcePath'.
-getPathInfo ∷ Resource [ByteString]
+--
+-- Note that the returned path is URI-decoded and then UTF-8 decoded.
+getPathInfo ∷ Resource [Text]
 getPathInfo = do rsrcPath ← getResourcePath
-                 uri      ← getRequestURI
-                 let reqPathStr = uriPath uri
-                     reqPath    = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
+                 reqPath  ← splitPathInfo <$> getRequestURI
                  -- rsrcPath と reqPath の共通する先頭部分を reqPath か
                  -- ら全部取り除くと、それは PATH_INFO のやうなものにな
                  -- る。rsrcPath は全部一致してゐるに決まってゐる（でな
                  -- ければこの Resource が撰ばれた筈が無い）ので、
                  -- rsrcPath の長さの分だけ削除すれば良い。
-                 return $ map C8.pack $ drop (length rsrcPath) reqPath
+                 return $ drop (length rsrcPath) reqPath
 
 -- |Assume the query part of request URI as
 -- application\/x-www-form-urlencoded, and parse it to pairs of
@@ -653,7 +652,8 @@ input limit
                             -- 成功。itr 内にチャンクを置いたままにする
                             -- とメモリの無駄になるので除去。
                             chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
 
                driftTo DecidingHeader
@@ -716,7 +716,8 @@ inputChunk limit
                                          $ retry
                             -- 成功
                             chunk ← readItr itrReceivedBody seqToLBS itr
-                            writeItr itrReceivedBody (∅) itr
+                            writeItr itrReceivedBody    (∅) itr
+                            writeItr itrReceivedBodyLen 0   itr
                             return chunk
                when (Lazy.null chunk)
                    $ driftTo DecidingHeader
@@ -912,7 +913,7 @@ outputChunk wholeChunk
 
          unless (Lazy.null wholeChunk)
              $ liftIO $ atomically $
-               writeItr itrBodyIsNull False itr
+               writeItr itrSentNoBody False itr
     where
       sendChunks ∷ Lazy.ByteString → Int → Resource ()
       sendChunks str limit
@@ -976,7 +977,7 @@ driftTo newState
           = postprocess itr
 
       drift itr _ Done
-          = do bodyIsNull ← readItr itrBodyIsNull id itr
+          = do bodyIsNull ← readItr itrSentNoBody id itr
                when bodyIsNull
                         $ writeDefaultPage itr