]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Resource.hs
Fixed reversed IP adress
[Lucu.git] / Network / HTTP / Lucu / Resource.hs
index d3967edf8ab5224c7e08dd2e1285669223f26944..e48ea217ff99b6c7bc9c6e0a3057ab8c904db636 100644 (file)
@@ -1,4 +1,4 @@
--- #prune
+{-# OPTIONS_HADDOCK prune #-}
 
 -- |This is the Resource Monad; monadic actions to define the behavior
 -- of each resources. The 'Resource' Monad is a kind of 'Prelude.IO'
@@ -73,6 +73,7 @@ module Network.HTTP.Lucu.Resource
     , getConfig
     , getRemoteAddr
     , getRemoteAddr'
+    , getRemoteCertificate
     , getRequest
     , getMethod
     , getRequestURI
@@ -163,6 +164,7 @@ import           Network.HTTP.Lucu.MIMEType
 import           Network.HTTP.Lucu.Utils
 import           Network.Socket hiding (accept)
 import           Network.URI hiding (path)
+import           OpenSSL.X509
 
 -- |The 'Resource' monad. This monad implements
 -- 'Control.Monad.Trans.MonadIO' so it can do any 'Prelude.IO'
@@ -218,12 +220,25 @@ getRemoteAddr' = do addr <- getRemoteAddr
                                  b3 = (v4addr `shiftR`  8) .&. 0xFF
                                  b4 =  v4addr              .&. 0xFF
                              in
-                               return $ concat $ intersperse "." $ map show [b1, b2, b3, b4]
+                               return $ concat $ intersperse "." $ map show [b4, b3, b2, b1]
                       SockAddrUnix path
                           -> return path
                       _
                           -> undefined
 
+-- | Return the X.509 certificate of the client, or 'Nothing' if:
+--
+--   * This request didn't came through an SSL stream.
+--
+--   * The client didn't send us its certificate.
+--
+--   * The 'OpenSSL.Session.VerificationMode' of
+--     'OpenSSL.Session.SSLContext' in
+--     'Network.HTTP.Lucu.Config.SSLConfig' has not been set to
+--     'OpenSSL.Session.VerifyPeer'.
+getRemoteCertificate :: Resource (Maybe X509)
+getRemoteCertificate = do itr <- getInteraction
+                          return $! itrRemoteCert itr
 
 -- |Get the 'Network.HTTP.Lucu.Request.Request' value which represents
 -- the request header. In general you don't have to use this action.