--- #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'
, getConfig
, getRemoteAddr
, getRemoteAddr'
+ , getRemoteCertificate
, getRequest
, getMethod
, getRequestURI
, getAcceptEncoding
, isEncodingAcceptable
, getContentType
+ , getAuthorization
-- ** Finding an entity
, setContentType
, setLocation
, setContentEncoding
+ , setWWWAuthenticate
-- ** Writing a response body
import Data.Maybe
import Data.Time
import Network.HTTP.Lucu.Abortion
+import Network.HTTP.Lucu.Authorization
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.ContentCoding
import Network.HTTP.Lucu.DefaultPage
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'
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.
-- doesn't parse the request body. See 'inputForm'.
getQueryForm :: Resource [(String, String)]
getQueryForm = do uri <- getRequestURI
- return $! parseWWWFormURLEncoded $ uriQuery uri
+ return $! parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri
-- |Get a value of given request header. Comparison of header name is
-- case-insensitive. Note that this action is not intended to be used
(Just $ "Unparsable Content-Type: " ++ C8.unpack cType)
+-- |Get the header \"Authorization\" as
+-- 'Network.HTTP.Lucu.Authorization.AuthCredential'.
+getAuthorization :: Resource (Maybe AuthCredential)
+getAuthorization
+ = do authM <- getHeader (C8.pack "Authorization")
+ case authM of
+ Nothing
+ -> return Nothing
+ Just auth
+ -> case parse authCredentialP (L8.fromChunks [auth]) of
+ (# Success a, _ #) -> return $ Just a
+ (# _ , _ #) -> return Nothing
+
+
{- ExaminingRequest 時に使用するアクション群 -}
-- |Tell the system that the 'Resource' found an entity for the
_ -> undefined
setHeader (C8.pack "Content-Encoding") (C8.pack $ joinWith ", " $ map tr codings)
+-- |Computation of @'setWWWAuthenticate' challenge@ sets the response
+-- header \"WWW-Authenticate\" to @challenge@.
+setWWWAuthenticate :: AuthChallenge -> Resource ()
+setWWWAuthenticate challenge
+ = setHeader (C8.pack "WWW-Authenticate") (C8.pack $ show challenge)
+
{- DecidingBody 時に使用するアクション群 -}