X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FInternal.hs;h=f8ea1b2aaf5b3b35edad73d7b3da2731d4b08d18;hb=b2da45926a7900603a5426e0c6d65e3ca630a1a2;hp=e066fa9074e8eaf4173ce60f715dc2b2bbdb3bdd;hpb=51eda5b02d4528e2e240cbfc228de02b1c83799a;p=Lucu.git diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index e066fa9..f8ea1b2 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE - DoAndIfThenElse + CPP + , DoAndIfThenElse , GeneralizedNewtypeDeriving , OverloadedStrings , RecordWildCards @@ -13,7 +14,9 @@ module Network.HTTP.Lucu.Resource.Internal , getConfig , getRemoteAddr +#if defined(HAVE_SSL) , getRemoteCertificate +#endif , getRequest , getResourcePath @@ -33,13 +36,15 @@ import Control.Applicative import Control.Concurrent import Control.Concurrent.STM import Control.Exception +import Control.Monad hiding (mapM_) import Control.Monad.IO.Class -import Control.Monad.Reader +import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.Unicode import Data.Ascii (Ascii, CIAscii) import qualified Data.Ascii as A import qualified Data.ByteString as Strict -import Data.List +import Data.Collections +import Data.List (intersperse, nub) import Data.Maybe import Data.Monoid import Data.Monoid.Unicode @@ -54,8 +59,10 @@ import Network.HTTP.Lucu.Postprocess import Network.HTTP.Lucu.Request import Network.HTTP.Lucu.Response import Network.Socket +#if defined(HAVE_SSL) import OpenSSL.X509 -import Prelude hiding (catch) +#endif +import Prelude hiding (catch, concat, mapM_, tail) import Prelude.Unicode import System.IO @@ -202,7 +209,7 @@ spawnResource (ResourceDef {..}) ni@(NI {..}) -- in the response. Hooray! flip runResource ni $ do setStatus $ aboStatus abo - mapM_ (uncurry setHeader) $ H.fromHeaders $ aboHeaders abo + mapM_ (uncurry setHeader) (aboHeaders abo) setHeader "Content-Type" defaultPageContentType deleteHeader "Content-Encoding" putBuilder $ abortPage niConfig (Just niRequest) res abo @@ -230,6 +237,7 @@ getConfig = niConfig <$> getInteraction getRemoteAddr ∷ Resource SockAddr getRemoteAddr = niRemoteAddr <$> getInteraction +#if defined(HAVE_SSL) -- | Return the X.509 certificate of the client, or 'Nothing' if: -- -- * This request didn't came through an SSL stream. @@ -241,6 +249,7 @@ getRemoteAddr = niRemoteAddr <$> getInteraction -- 'OpenSSL.Session.VerifyPeer'. getRemoteCertificate ∷ Resource (Maybe X509) getRemoteCertificate = niRemoteCert <$> getInteraction +#endif -- |Return the 'Request' value representing the request header. You -- usually don't need to call this function directly. @@ -311,7 +320,8 @@ setStatus sc $ do state ← readTVar $ niState ni when (state > DecidingHeader) $ fail "Too late to declare the response status." - setResponseStatus ni sc + res ← readTVar $ niResponse ni + writeTVar (niResponse ni) $ setStatusCode sc res -- |@'setHeader' name value@ declares the value of the response header -- @name@ as @value@. Note that this function is not intended to be @@ -366,6 +376,7 @@ deleteHeader name = liftIO ∘ atomically ∘ go =≪ getInteraction putBuilder ∷ Builder → Resource () putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction where + -- FIXME: should see if resCanHaveBody. go ∷ NormalInteraction → STM () go ni@(NI {..}) = do driftTo' ni SendingBody