From: PHO <pho@cielonegro.org>
Date: Tue, 4 Oct 2011 05:20:17 +0000 (+0900)
Subject: Many changes
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=0ff0346;p=Lucu.git

Many changes

Ditz-issue: 8959dadc07db1bd363283dee401073f6e48dc7fa
---

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 9ef433b..c36ebc0 100644
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -27,6 +27,7 @@ import Control.Monad.Trans
 import Data.Ascii (Ascii, CIAscii)
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as Lazy
 import Data.Typeable
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.DefaultPage
@@ -99,7 +100,7 @@ abortA = proc (status, (headers, msg)) →
 -- aboMessage が Just なら單に mkDefaultPage に渡すだけで良いので樂だが、
 -- Nothing の場合は getDefaultPage を使ってデフォルトのメッセージを得な
 -- ければならない。
-abortPage :: Config → Maybe Request → Response → Abortion → Text
+abortPage :: Config → Maybe Request → Response → Abortion → Lazy.Text
 abortPage !conf !reqM !res !abo
     = case aboMessage abo of
         Just msg
@@ -108,7 +109,7 @@ abortPage !conf !reqM !res !abo
                                    writeDocumentToString [ withIndent True ]
                                  ) ()
               in
-                T.pack html
+                Lazy.pack html
         Nothing
             → let res'  = res { resStatus = aboStatus abo }
                   res'' = foldl (∘) id [setHeader name value
diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index bc75af5..c315424 100644
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -19,9 +19,9 @@ import Control.Concurrent.STM
 import Control.Monad
 import qualified Data.Ascii as A
 import Data.Maybe
-import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding
+import qualified Data.Text.Lazy as Lazy
+import qualified Data.Text.Lazy.Encoding as Lazy
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Interaction
@@ -34,7 +34,7 @@ import Text.XML.HXT.Arrow.XmlArrow
 import Text.XML.HXT.Arrow.XmlState
 import Text.XML.HXT.DOM.TypeDefs
 
-getDefaultPage ∷ Config → Maybe Request → Response → Text
+getDefaultPage ∷ Config → Maybe Request → Response → Lazy.Text
 {-# INLINEABLE getDefaultPage #-}
 getDefaultPage !conf !req !res
     = let msgA     = getMsg req res
@@ -43,7 +43,7 @@ getDefaultPage !conf !req !res
                              writeDocumentToString [ withIndent True ]
                            ) ()
       in
-        T.pack xmlStr
+        Lazy.pack xmlStr
 
 writeDefaultPage ∷ Interaction → STM ()
 writeDefaultPage !itr
@@ -56,7 +56,7 @@ writeDefaultPage !itr
                            page = getDefaultPage conf reqM res
 
                        putTMVar (itrBodyToSend itr)
-                                (BB.fromByteString $ encodeUtf8 page)
+                                (BB.fromLazyByteString $ Lazy.encodeUtf8 page)
 
 mkDefaultPage ∷ (ArrowXml a) ⇒ Config → StatusCode → a b XmlTree → a b XmlTree
 {-# INLINEABLE mkDefaultPage #-}
diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index ac9c46f..3508a51 100644
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -23,6 +23,7 @@ import Data.Ascii (Ascii)
 import qualified Data.ByteString as BS
 import Data.Sequence (Seq)
 import qualified Data.Sequence as S
+import Data.Text (Text)
 import Network.Socket
 import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Headers
@@ -36,7 +37,7 @@ data Interaction = Interaction {
     , itrLocalPort         ∷ !PortNumber
     , itrRemoteAddr        ∷ !SockAddr
     , itrRemoteCert        ∷ !(Maybe X509)
-    , itrResourcePath      ∷ !(Maybe [Ascii])
+    , itrResourcePath      ∷ !(Maybe [Text])
     , itrRequest           ∷ !(TVar (Maybe Request))
     , itrResponse          ∷ !(TVar Response)
 
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index c8525af..0caf6ce 100644
--- 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
diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs
index 4cb4932..b457072 100644
--- a/Network/HTTP/Lucu/Resource/Tree.hs
+++ b/Network/HTTP/Lucu/Resource/Tree.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE
+    DoAndIfThenElse
+  , OverloadedStrings
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- | Repository of the resources in httpd.
@@ -8,26 +13,31 @@ module Network.HTTP.Lucu.Resource.Tree
     , ResTree
     , FallbackHandler
 
-    , mkResTree    -- [ ([String], ResourceDef) ] -> ResTree
+    , mkResTree
 
-    , findResource -- ResTree -> URI -> Maybe ([String], ResourceDef)
-    , runResource  -- ResourceDef -> Interaction -> IO ThreadId
+    , findResource
+    , runResource
     )
     where
-
 import           Control.Arrow
+import Control.Applicative
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad
-import qualified Data.ByteString.Char8 as C8
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy.Encoding as LT
 import           Data.List
 import qualified Data.Map as M
 import           Data.Map (Map)
 import           Data.Maybe
+import Data.Monoid.Unicode
 import           Network.HTTP.Lucu.Abortion
 import           Network.HTTP.Lucu.Config
-import           Network.HTTP.Lucu.Headers (emptyHeaders, fromHeaders)
+import           Network.HTTP.Lucu.Headers (fromHeaders)
 import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Resource
 import           Network.HTTP.Lucu.Response
@@ -36,15 +46,15 @@ import           Network.HTTP.Lucu.Utils
 import           Network.URI hiding (path)
 import           System.IO
 import           Prelude hiding (catch)
+import Prelude.Unicode
 
 
 -- |'FallbackHandler' is an extra resource handler for resources which
--- can't be statically located somewhere in the resource tree. The
--- Lucu httpd first search for a resource in the tree, and then call
+-- can't be statically located anywhere in the resource tree. The Lucu
+-- httpd first searches for a resource in the tree, and then calls
 -- fallback handlers to ask them for a resource. If all of the
--- handlers returned 'Prelude.Nothing', the httpd responds with 404
--- Not Found.
-type FallbackHandler = [String] -> IO (Maybe ResourceDef)
+-- handlers returned 'Nothing', the httpd responds with 404 Not Found.
+type FallbackHandler = [Text] → IO (Maybe ResourceDef)
 
 
 -- "/aaa/bbb/ccc" にアクセスされた時、もし "/aaa/bbb" に貪欲なリソース
@@ -52,15 +62,14 @@ type FallbackHandler = [String] -> IO (Maybe ResourceDef)
 -- "/aaa/bbb" が撰ばれる。"/aaa/bbb" のリソースが貪欲でなければ、それは
 -- 無視される。
 
--- | 'ResourceDef' is basically a set of
--- 'Network.HTTP.Lucu.Resource.Resource' monads for each HTTP methods.
+-- | 'ResourceDef' is basically a set of 'Resource' monads for each
+-- HTTP methods.
 data ResourceDef = ResourceDef {
-    -- |Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a
-    -- native thread (spawned by 'Control.Concurrent.forkOS') or to
-    -- run it on a user thread (spanwed by
-    -- 'Control.Concurrent.forkIO'). Generally you don't need to set
-    -- this field to 'Prelude.True'.
-      resUsesNativeThread :: !Bool
+    -- |Whether to run a 'Resource' on a native thread (spawned by
+    -- 'forkOS') or to run it on a user thread (spanwed by
+    -- 'forkIO'). Generally you don't need to set this field to
+    -- 'True'.
+      resUsesNativeThread ∷ !Bool
     -- | Whether to be greedy or not.
     -- 
     -- Say a client is trying to access \/aaa\/bbb\/ccc. If there is a
@@ -68,37 +77,32 @@ data ResourceDef = ResourceDef {
     -- there is another resource at \/aaa\/bbb\/ccc. If the resource
     -- at \/aaa\/bbb is not greedy, it is just ignored. Greedy
     -- resources are like CGI scripts.
-    , resIsGreedy         :: !Bool
-    -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a GET
-    -- request comes for the resource path. If 'resGet' is Nothing,
-    -- the system responds \"405 Method Not Allowed\" for GET
-    -- requests.
+    , resIsGreedy         ∷ !Bool
+    -- | A 'Resource' to be run when a GET request comes for the
+    -- resource path. If 'resGet' is Nothing, the system responds
+    -- \"405 Method Not Allowed\" for GET requests.
     -- 
     -- It also runs for HEAD request if the 'resHead' is Nothing. In
-    -- this case 'Network.HTTP.Lucu.Resource.output' and such like
-    -- don't actually write a response body.
-    , resGet              :: !(Maybe (Resource ()))
-    -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a HEAD
-    -- request comes for the resource path. If 'resHead' is Nothing,
-    -- the system runs 'resGet' instead. If 'resGet' is also Nothing,
-    -- the system responds \"405 Method Not Allowed\" for HEAD
-    -- requests.
-    , resHead             :: !(Maybe (Resource ()))
-    -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a POST
-    -- request comes for the resource path. If 'resPost' is Nothing,
-    -- the system responds \"405 Method Not Allowed\" for POST
-    -- requests.
-    , resPost             :: !(Maybe (Resource ()))
-    -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a PUT
-    -- request comes for the resource path. If 'resPut' is Nothing,
-    -- the system responds \"405 Method Not Allowed\" for PUT
-    -- requests.
-    , resPut              :: !(Maybe (Resource ()))
-    -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a
-    -- DELETE request comes for the resource path. If 'resDelete' is
-    -- Nothing, the system responds \"405 Method Not Allowed\" for
-    -- DELETE requests.
-    , resDelete           :: !(Maybe (Resource ()))
+    -- this case 'output' and such like don't actually write a
+    -- response body.
+    , resGet              ∷ !(Maybe (Resource ()))
+    -- | A 'Resource' to be run when a HEAD request comes for the
+    -- resource path. If 'resHead' is Nothing, the system runs
+    -- 'resGet' instead. If 'resGet' is also Nothing, the system
+    -- responds \"405 Method Not Allowed\" for HEAD requests.
+    , resHead             ∷ !(Maybe (Resource ()))
+    -- | A 'Resource' to be run when a POST request comes for the
+    -- resource path. If 'resPost' is Nothing, the system responds
+    -- \"405 Method Not Allowed\" for POST requests.
+    , resPost             ∷ !(Maybe (Resource ()))
+    -- | A 'Resource' to be run when a PUT request comes for the
+    -- resource path. If 'resPut' is Nothing, the system responds
+    -- \"405 Method Not Allowed\" for PUT requests.
+    , resPut              ∷ !(Maybe (Resource ()))
+    -- | A 'Resource' to be run when a DELETE request comes for the
+    -- resource path. If 'resDelete' is Nothing, the system responds
+    -- \"405 Method Not Allowed\" for DELETE requests.
+    , resDelete           ∷ !(Maybe (Resource ()))
     }
 
 -- |'emptyResource' is a resource definition with no actual
@@ -116,7 +120,7 @@ data ResourceDef = ResourceDef {
 --                   , resDelete           = Nothing
 --                   }
 -- @
-emptyResource :: ResourceDef
+emptyResource ∷ ResourceDef
 emptyResource = ResourceDef {
                   resUsesNativeThread = False
                 , resIsGreedy         = False
@@ -130,7 +134,7 @@ emptyResource = ResourceDef {
 -- |'ResTree' is an opaque structure which is a map from resource path
 -- to 'ResourceDef'.
 newtype ResTree = ResTree ResNode -- root だから Map ではない
-type ResSubtree = Map String ResNode
+type ResSubtree = Map Text ResNode
 data ResNode    = ResNode (Maybe ResourceDef) ResSubtree
 
 -- |'mkResTree' converts a list of @(path, def)@ to a 'ResTree' e.g.
@@ -140,15 +144,15 @@ data ResNode    = ResNode (Maybe ResourceDef) ResSubtree
 --             , ([\"unistd\"], 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/unistd.h\") -- \/unistd
 --             ]
 -- @
-mkResTree :: [ ([String], ResourceDef) ] -> ResTree
+mkResTree ∷ [ ([Text], ResourceDef) ] → ResTree
 mkResTree = processRoot . map (first canonicalisePath)
     where
-      canonicalisePath :: [String] -> [String]
-      canonicalisePath = filter (/= "")
+      canonicalisePath ∷ [Text] → [Text]
+      canonicalisePath = filter (≢ "")
 
-      processRoot :: [ ([String], ResourceDef) ] -> ResTree
+      processRoot ∷ [ ([Text], ResourceDef) ] → ResTree
       processRoot list
-          = let (roots, nonRoots) = partition (\ (path, _) -> path == []) list
+          = let (roots, nonRoots) = partition (\ (path, _) → path == []) list
                 children = processNonRoot nonRoots
             in
               if null roots then
@@ -161,12 +165,12 @@ mkResTree = processRoot . map (first canonicalisePath)
                   in 
                     ResTree (ResNode (Just def) children)
 
-      processNonRoot :: [ ([String], ResourceDef) ] -> ResSubtree
+      processNonRoot ∷ [ ([Text], ResourceDef) ] → ResSubtree
       processNonRoot list
           = let subtree    = M.fromList [(name, node name)
-                                             | name <- childNames]
-                childNames = [name | (name:_, _) <- list]
-                node name  = let defs = [def | (path, def) <- list, path == [name]]
+                                             | name ← childNames]
+                childNames = [name | (name:_, _) ← list]
+                node name  = let defs = [def | (path, def) ← list, path == [name]]
                              in
                                if null defs then
                                    -- No resources are defined
@@ -177,89 +181,92 @@ mkResTree = processRoot . map (first canonicalisePath)
                                    -- There is a resource here.
                                    ResNode (Just $ last defs) children
                 children   = processNonRoot [(path, def)
-                                                 | (_:path, def) <- list]
+                                                 | (_:path, def) ← list]
             in
               subtree
 
 
-findResource :: ResTree -> [FallbackHandler] -> URI -> IO (Maybe ([String], ResourceDef))
+findResource ∷ ResTree → [FallbackHandler] → URI → IO (Maybe ([Text], ResourceDef))
 findResource (ResTree (ResNode rootDefM subtree)) fbs uri
-    = do let pathStr        = uriPath uri
-             path           = [unEscapeString x | x <- splitBy (== '/') pathStr, x /= ""]
+    = do let path           = splitPathInfo uri
              haveGreedyRoot = case rootDefM of
-                                Just def -> resIsGreedy def
-                                Nothing  -> False
-             foundInTree    = if haveGreedyRoot || null path then
-                                  do def <- rootDefM
+                                Just def → resIsGreedy def
+                                Nothing  → False
+             foundInTree    = if haveGreedyRoot ∨ null path then
+                                  do def ← rootDefM
                                      return ([], def)
                               else
                                   walkTree subtree path []
          if isJust foundInTree then
              return foundInTree
-           else
+         else
              fallback path fbs
     where
-      walkTree :: ResSubtree -> [String] -> [String] -> Maybe ([String], ResourceDef)
+      walkTree ∷ ResSubtree → [Text] → [Text] → Maybe ([Text], ResourceDef)
 
       walkTree _ [] _
           = error "Internal error: should not reach here."
 
       walkTree tree (name:[]) soFar
           = case M.lookup name tree of
-              Nothing               -> Nothing
-              Just (ResNode defM _) -> do def <- defM
-                                          return (soFar ++ [name], def)
+              Nothing               → Nothing
+              Just (ResNode defM _) → do def ← defM
+                                         return (soFar ⧺ [name], def)
 
       walkTree tree (x:xs) soFar
           = case M.lookup x tree of
-              Nothing                      -> Nothing
-              Just (ResNode defM children) -> case defM of
+              Nothing                      → Nothing
+              Just (ResNode defM children) → case defM of
                                                 Just (ResourceDef { resIsGreedy = True })
-                                                    -> do def <- defM
-                                                          return (soFar ++ [x], def)
-                                                _   -> walkTree children xs (soFar ++ [x])
+                                                    → do def ← defM
+                                                         return (soFar ++ [x], def)
+                                                _   → walkTree children xs (soFar ++ [x])
 
-      fallback :: [String] -> [FallbackHandler] -> IO (Maybe ([String], ResourceDef))
+      fallback ∷ [Text] → [FallbackHandler] → IO (Maybe ([Text], ResourceDef))
       fallback _    []     = return Nothing
-      fallback path (x:xs) = do m <- x path
+      fallback path (x:xs) = do m ← x path
                                 case m of
-                                  Just def -> return $! Just ([], def)
-                                  Nothing  -> fallback path xs
+                                  Just def → return $! Just ([], def)
+                                  Nothing  → fallback path xs
 
 
-runResource :: ResourceDef -> Interaction -> IO ThreadId
+runResource ∷ ResourceDef → Interaction → IO ThreadId
 runResource def itr
     = def `seq` itr `seq`
       fork
-      $! catch ( runRes ( do req <- getRequest
+      $! catch ( runRes ( do req ← getRequest
                              fromMaybe notAllowed $ rsrc req
                              driftTo Done
                         ) itr
                )
                processException
     where
-      fork :: IO () -> IO ThreadId
+      fork ∷ IO () → IO ThreadId
       fork = if resUsesNativeThread def
              then forkOS
              else forkIO
       
-      rsrc :: Request -> Maybe (Resource ())
+      rsrc ∷ Request → Maybe (Resource ())
       rsrc req
           = case reqMethod req of
-              GET    -> resGet def
-              HEAD   -> case resHead def of
-                          Just r  -> Just r
-                          Nothing -> resGet def
-              POST   -> resPost def
-              PUT    -> resPut def
-              DELETE -> resDelete def
-              _      -> undefined
+              GET    → resGet def
+              HEAD   → case resHead def of
+                          Just r  → Just r
+                          Nothing → resGet def
+              POST   → resPost def
+              PUT    → resPut def
+              DELETE → resDelete def
+              _      → undefined
 
-      notAllowed :: Resource ()
-      notAllowed = do setStatus MethodNotAllowed
-                      setHeader (C8.pack "Allow") (C8.pack $ joinWith ", " allowedMethods)
+      notAllowed ∷ Resource ()
+      notAllowed
+          = setStatus MethodNotAllowed
+            *>
+            (setHeader "Allow" $ A.fromAsciiBuilder
+                               $ joinWith ", "
+                               $ map A.toAsciiBuilder allowedMethods)
 
-      allowedMethods :: [String]
+      allowedMethods ∷ [Ascii]
       allowedMethods = nub $ concat [ methods resGet    ["GET"]
                                     , methods resHead   ["GET", "HEAD"]
                                     , methods resPost   ["POST"]
@@ -267,31 +274,32 @@ runResource def itr
                                     , methods resDelete ["DELETE"]
                                     ]
 
-      methods :: (ResourceDef -> Maybe a) -> [String] -> [String]
+      methods ∷ (ResourceDef → Maybe a) → [Ascii] → [Ascii]
       methods f xs = case f def of
-                       Just _  -> xs
-                       Nothing -> []
+                       Just _  → xs
+                       Nothing → []
 
-      toAbortion :: SomeException -> Abortion
-      toAbortion e = case fromException e of
-                       Just abortion -> abortion
-                       Nothing       -> Abortion InternalServerError emptyHeaders (Just (show e))
+      toAbortion ∷ SomeException → Abortion
+      toAbortion e
+          = case fromException e of
+              Just abortion → abortion
+              Nothing       → Abortion InternalServerError (∅) (Just $ T.pack $ show e)
 
-      processException :: SomeException -> IO ()
+      processException ∷ SomeException → IO ()
       processException exc
           = do let abo = toAbortion exc
                    conf = itrConfig itr
                -- まだ DecidingHeader 以前の状態だったら、この途中終了
                -- を應答に反映させる餘地がある。さうでなければ stderr
                -- にでも吐くしか無い。
-               state <- atomically $ readItr itr itrState id
-               reqM  <- atomically $ readItr itr itrRequest id
-               res   <- atomically $ readItr itr itrResponse id
-               if state <= DecidingHeader then
+               state ← atomically $ readItr itrState    id itr
+               reqM  ← atomically $ readItr itrRequest  id itr
+               res   ← atomically $ readItr itrResponse id itr
+               if state ≤ DecidingHeader then
                    flip runRes itr
                       $ do setStatus $ aboStatus abo
                            mapM_ (uncurry setHeader) $ fromHeaders $ aboHeaders abo
-                           output $ abortPage conf reqM res abo
+                           output $ LT.encodeUtf8 $ abortPage conf reqM res abo
                  else
                    when (cnfDumpTooLateAbortionToStderr $ itrConfig itr)
                             $ hPutStrLn stderr $ show abo
diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 9175ce9..5289f5f 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -13,7 +13,6 @@ module Network.HTTP.Lucu.StaticFile
     , generateETagFromFile
     )
     where
-
 import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Lazy.Char8 as B
@@ -30,10 +29,8 @@ import           Network.HTTP.Lucu.Utils
 import           System.FilePath.Posix
 import           System.Posix.Files
 
-
--- | @'staticFile' fpath@ is a
--- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
--- at @fpath@ on the filesystem.
+-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
+-- @fpath@ on the filesystem.
 staticFile :: FilePath -> ResourceDef
 staticFile path
     = ResourceDef {
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
index ec4b672..a488aaf 100644
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -10,6 +10,7 @@ module Network.HTTP.Lucu.Utils
     , joinWith
     , quoteStr
     , parseWWWFormURLEncoded
+    , splitPathInfo
     , show3
     )
     where
@@ -22,6 +23,8 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
 import Data.List hiding (last)
 import Data.Monoid.Unicode
+import Data.Text (Text)
+import Data.Text.Encoding as T
 import Network.URI
 import Prelude hiding (last)
 import Prelude.Unicode
@@ -89,6 +92,15 @@ parseWWWFormURLEncoded src
       plusToSpace '+' = ' '
       plusToSpace c   = c
 
+-- |> splitPathInfo "http://example.com/foo/bar"
+--  > ==> ["foo", "bar"]
+splitPathInfo ∷ URI → [Text]
+splitPathInfo uri
+    = let reqPathStr = uriPath uri
+          reqPath    = [unEscapeString x | x ← splitBy (≡ '/') reqPathStr, (¬) (null x)]
+      in
+        map (T.decodeUtf8 ∘ BS.pack) reqPath
+
 -- |> show3 5
 --  > ==> "005"
 show3 ∷ Integral n ⇒ n → AsciiBuilder