module Network.HTTP.Lucu.Resource
(
-- * Monad
- Resource
+ Resource
+ , FormData(..)
, runRes -- private
-- * Actions
, getConfig
, getRemoteAddr
, getRemoteAddr'
+ , getRemoteHost
+ , getRemoteCertificate
, getRequest
, getMethod
, getRequestURI
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)
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'
-- 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 [b1, b2, b3, b4]
- 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:
+--
+-- * 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.
-- | 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 = L8.pack 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
-- 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
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
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")