getRemoteAddr and getRemoteAddr'

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

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 7c1ceb0f027ee03d7aacbdb565cb81b16944a237..af8c16917e154dd12e0661b671659a5c462b7b71 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -69,6 +69,8 @@ module Network.HTTP.Lucu.Resource
     -- |These actions can be computed regardless of the current state,
     -- and they don't change the state.
     , getConfig
+    , getRemoteAddr
+    , getRemoteAddr'
     , getRequest
     , getMethod
     , getRequestURI
@@ -125,6 +127,7 @@ module Network.HTTP.Lucu.Resource
 
 import           Control.Concurrent.STM
 import           Control.Monad.Reader
+import           Data.Bits
 import qualified Data.ByteString.Lazy.Char8 as B
 import           Data.ByteString.Lazy.Char8 (ByteString)
 import           Data.List
@@ -144,6 +147,7 @@ import           Network.HTTP.Lucu.Request
 import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.MIMEType
 import           Network.HTTP.Lucu.Utils
+import           Network.Socket
 import           Network.URI
 import           System.Time
 
@@ -158,6 +162,31 @@ getConfig :: Resource Config
 getConfig = do itr <- ask
                return $ itrConfig itr
 
+
+-- |Get the SockAddr of the remote host. If you want a string
+-- representation instead of SockAddr, use 'getRemoteAddr''.
+getRemoteAddr :: Resource SockAddr
+getRemoteAddr = do itr <- ask
+                   return $ itrRemoteAddr itr
+
+
+-- |Get the string representation of the address of remote host. If
+-- you want a SockAddr instead of 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 [b1, b2, b3, b4]
+                      (SockAddrUnix path)
+                          -> return path
+
+
 -- |Get the 'Network.HTTP.Lucu.Request.Request' value which represents
 -- the request header. In general you don't have to use this action.
 getRequest :: Resource Request