X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=a9d487c0908188dbe1c5ad4294a5b224778e7ec2;hb=a2a726f3581933cea2d805b76aca0e93da778994;hp=e48ea217ff99b6c7bc9c6e0a3057ab8c904db636;hpb=fc530e41ff8f5f2372b261badecf10891c16546c;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index e48ea21..a9d487c 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -61,7 +61,8 @@
 module Network.HTTP.Lucu.Resource
     (
     -- * Monad
-    Resource
+      Resource
+    , FormData(..)
     , runRes -- private
 
     -- * Actions
@@ -73,6 +74,7 @@ module Network.HTTP.Lucu.Resource
     , getConfig
     , getRemoteAddr
     , getRemoteAddr'
+    , getRemoteHost
     , getRemoteCertificate
     , getRequest
     , getMethod
@@ -136,7 +138,6 @@ module Network.HTTP.Lucu.Resource
 
 import           Control.Concurrent.STM
 import           Control.Monad.Reader
-import           Data.Bits
 import qualified Data.ByteString as Strict (ByteString)
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
@@ -211,20 +212,15 @@ getRemoteAddr = do itr <- getInteraction
 -- you want a 'Network.Socket.SockAddr' instead of 'Prelude.String',
 -- use 'getRemoteAddr'.
 getRemoteAddr' :: Resource String
-getRemoteAddr' = do addr <- getRemoteAddr
-                    case addr of
-                      -- Network.Socket は IPv6 を考慮してゐないやうだ…
-                      SockAddrInet _ v4addr
-                          -> let b1 = (v4addr `shiftR` 24) .&. 0xFF
-                                 b2 = (v4addr `shiftR` 16) .&. 0xFF
-                                 b3 = (v4addr `shiftR`  8) .&. 0xFF
-                                 b4 =  v4addr              .&. 0xFF
-                             in
-                               return $ concat $ intersperse "." $ map show [b4, b3, b2, b1]
-                      SockAddrUnix path
-                          -> return path
-                      _
-                          -> undefined
+getRemoteAddr' = do addr          <- getRemoteAddr
+                    (Just str, _) <- liftIO $! getNameInfo [NI_NUMERICHOST] True False addr
+                    return str
+
+-- |Resolve an address to the remote host.
+getRemoteHost :: Resource String
+getRemoteHost = do addr          <- getRemoteAddr
+                   (Just str, _) <- liftIO $! getNameInfo [] True False addr
+                   return str
 
 -- | Return the X.509 certificate of the client, or 'Nothing' if:
 --
@@ -307,9 +303,17 @@ getPathInfo = do rsrcPath <- getResourcePath
 -- | Assume the query part of request URI as
 -- application\/x-www-form-urlencoded, and parse it. This action
 -- doesn't parse the request body. See 'inputForm'.
-getQueryForm :: Resource [(String, String)]
+getQueryForm :: Resource [FormData]
 getQueryForm = do uri <- getRequestURI
-                  return $! parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri
+                  return $! map pairToFormData $ parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri
+
+pairToFormData :: (String, String) -> FormData
+pairToFormData (name, value)
+    = FormData {
+        fdName     = name
+      , fdFileName = Nothing
+      , fdContent  = value
+      }
 
 -- |Get a value of given request header. Comparison of header name is
 -- case-insensitive. Note that this action is not intended to be used
@@ -721,7 +725,7 @@ inputChunkLBS limit
 -- makes 'Resource' abort with status \"415 Unsupported Media
 -- Type\". If the request has no \"Content-Type\", it aborts with
 -- \"400 Bad Request\".
-inputForm :: Int -> Resource [(String, String)]
+inputForm :: Int -> Resource [FormData]
 inputForm limit
     = limit `seq` 
       do cTypeM <- getContentType
@@ -738,7 +742,7 @@ inputForm limit
     where
       readWWWFormURLEncoded
           = do src <- input limit
-               return $ parseWWWFormURLEncoded src
+               return $ map pairToFormData $ parseWWWFormURLEncoded src
 
       readMultipartFormData params
           = do case find ((== "boundary") . map toLower . fst) params of
@@ -747,7 +751,7 @@ inputForm limit
                  Just (_, boundary)
                      -> do src <- inputLBS limit
                            case parse (multipartFormP boundary) src of
-                             (# Success pairs, _ #) -> return pairs
+                             (# Success fdList, _ #) -> return fdList
                              (# _, _ #)
                                  -> abort BadRequest [] (Just "Unparsable multipart/form-data")