From: pho Date: Thu, 3 May 2007 07:26:59 +0000 (+0900) Subject: Documentation X-Git-Tag: RELEASE-0_2_1~44 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=a827a5e1ba744d89c5b2396bb195e344ae892306;p=Lucu.git Documentation darcs-hash:20070503072659-62b54-bb052a7ffeed55871b4c06f1be47cebf30cf3312.gz --- diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index 6f6e4d9..4ab6bc6 100644 --- a/Network/HTTP/Lucu.hs +++ b/Network/HTTP/Lucu.hs @@ -1,37 +1,73 @@ +-- | Lucu is an HTTP daemonic library. It can be embedded in any +-- Haskell program and runs in an independent thread. +-- +-- Features: +-- +-- [/Full support of HTTP\/1.1/] Lucu supports request pipelining, +-- chunked I\/O, ETag comparison and \"100 Continue\". +-- +-- [/Performance/] Lucu doesn't fork\/exec to handle requests like +-- CGI. It just spawns a new thread. Inter-process communication is +-- done with STM. +-- +-- Lucu is not a replacement for Apache. It is intended to be used to +-- create an efficient web-based application without messing around +-- FastCGI. It is also intended to be run behind a reverse-proxy so it +-- doesn't have the following (otherwise essential) facilities: +-- +-- [/Logging/] Lucu doesn't log any requests from any clients. +-- +-- [/Client Filtering/] Lucu always accept any clients. No IP filter +-- is implemented. +-- +-- [/SSL Support/] Lucu can handle HTTP only. +-- +-- [/Bandwidth Limitting/] Lucu doesn't limit bandwidth it consumes. +-- +-- [/Protection Against Wicked Clients/] Lucu is fragile against +-- wicked clients. No attacker should cause a buffer-overflow but +-- can possibly DoS it. +-- + + module Network.HTTP.Lucu - ( -- Abortion - abort - , abortA + ( -- * Entry Point + runHttpd - -- Config + -- * Configuration , module Network.HTTP.Lucu.Config - -- ETag + -- * Resource Tree + , ResourceDef(..) + , ResTree + , mkResTree + + -- * Resource Monad + , module Network.HTTP.Lucu.Resource + + -- ** Things to be used in the Resource monad + + -- *** Status Code + , StatusCode(..) + + -- *** Abortion + , abort + , abortA + + -- *** ETag , ETag(..) , strongETag , weakETag - -- Httpd - , runHttpd - - -- MIMEType + -- *** MIME Type , MIMEType(..) , () , (<:>) , (<=>) - -- Resource (driftTo だけは要らない) - , module Network.HTTP.Lucu.Resource + -- * Utility - -- Resource.Tree - , ResourceDef(..) - , ResTree - , mkResTree - - -- Response - , StatusCode(..) - - -- StaticFile + -- ** Static file handling , module Network.HTTP.Lucu.StaticFile ) where diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs index b9e4b11..0a42d71 100644 --- a/Network/HTTP/Lucu/Abortion.hs +++ b/Network/HTTP/Lucu/Abortion.hs @@ -1,3 +1,7 @@ +-- #prune + +-- | Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource' +-- in any IO monads or arrows. module Network.HTTP.Lucu.Abortion ( Abortion(..) , abort @@ -33,7 +37,29 @@ data Abortion = Abortion { , aboMessage :: Maybe String } deriving (Show, Typeable) - +-- | Computation of @'abort' status headers msg@ aborts the +-- 'Network.HTTP.Lucu.Resource.Resource' monad with given status, +-- additional response headers, and optional message string. +-- +-- What this really does is to just throw a special DynException. The +-- exception will be caught by the system. +-- +-- 1. If the 'Network.HTTP.Lucu.Resource.Resource' is in the /Deciding +-- Header/ or any precedent states, it is possible to use the +-- @status@ and such like as a HTTP response to be sent to the +-- client. +-- +-- 2. Otherwise the HTTP response can't be modified anymore so the +-- only possible thing the system can do is to dump it to the +-- stderr. See +-- 'Network.HTTP.Lucu.Config.cnfDumpTooLateAbortionToStderr'. +-- +-- Note that the status code doesn't have to be an error code so you +-- can use this action for redirection as well as error reporting e.g. +-- +-- > abort MovedPermanently +-- > [("Location", "http://example.net/")] +-- > (Just "It has been moved to example.net") abort :: MonadIO m => StatusCode -> [ (String, String) ] -> Maybe String -> m a abort status headers msg = let abo = Abortion status headers msg @@ -41,12 +67,14 @@ abort status headers msg in liftIO $ throwIO exc - +-- | Computation of @'abortSTM' status headers msg@ just computes +-- 'abort' in a STM monad. abortSTM :: StatusCode -> [ (String, String) ] -> Maybe String -> STM a abortSTM status headers msg = unsafeIOToSTM $ abort status headers msg - +-- | Computation of @'abortA' -< (status, (headers, msg))@ just +-- computes 'abort' in an ArrowIO. abortA :: ArrowIO a => a (StatusCode, ([ (String, String) ], Maybe String)) c abortA = arrIO3 abort diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index b49268a..17bf022 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -14,32 +14,35 @@ import Network.HTTP.Lucu.MIMEType.Guess import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap import System.IO.Unsafe --- |A configuration record for the Lucu httpd. You need to use +-- |Configuration record for the Lucu httpd. You need to use -- 'defaultConfig' or setup your own configuration to run the httpd. data Config = Config { -- |A string which will be sent to clients as \"Server\" field. - cnfServerSoftware :: String + cnfServerSoftware :: String -- |The host name of the server. This value will be used in -- built-in pages like \"404 Not Found\". - , cnfServerHost :: HostName + , cnfServerHost :: HostName -- |A port ID to listen to HTTP clients. - , cnfServerPort :: PortID + , cnfServerPort :: PortID -- |The maximum number of requests to accept in one connection -- simultaneously. If a client exceeds this limitation, its last -- request won't be processed until a response for its earliest -- pending request is sent back to the client. - , cnfMaxPipelineDepth :: Int + , cnfMaxPipelineDepth :: Int -- |The maximum length of request entity to accept in bytes. Note -- that this is nothing but the default value which is used when -- 'Network.HTTP.Lucu.Resource.input' and such like are applied to -- 'Network.HTTP.Lucu.Resource.defaultLimit', so there is no -- guarantee that this value always constrains all the requests. - , cnfMaxEntityLength :: Int + , cnfMaxEntityLength :: Int -- |The maximum length of chunk to output. This value is used by -- 'Network.HTTP.Lucu.Resource.output' and such like to limit the -- chunk length so you can safely output an infinite string (like -- a lazy stream of \/dev\/random) using those actions. , cnfMaxOutputChunkLength :: Int + -- | Whether to dump too late abortion to the stderr or not. See + -- 'Network.HTTP.Lucu.Abortion.abort'. + , cnfDumpTooLateAbortionToStderr :: Bool -- |A mapping from extension to MIME Type. This value is used by -- 'Network.HTTP.Lucu.StaticFile.staticFile' to guess the MIME -- Type of static files. Note that MIME Types are currently @@ -51,7 +54,7 @@ data Config = Config { -- a good idea to use GnomeVFS -- () -- instead of vanilla FS. - , cnfExtToMIMEType :: ExtMap + , cnfExtToMIMEType :: ExtMap } -- |The default configuration. Generally you can use this value as-is, @@ -59,11 +62,12 @@ data Config = Config { -- 'cnfServerPort'. defaultConfig :: Config defaultConfig = Config { - cnfServerSoftware = "Lucu/1.0" - , cnfServerHost = unsafePerformIO getHostName - , cnfServerPort = Service "http" - , cnfMaxPipelineDepth = 100 - , cnfMaxEntityLength = 16 * 1024 * 1024 -- 16 MiB - , cnfMaxOutputChunkLength = 5 * 1024 * 1024 -- 5 MiB - , cnfExtToMIMEType = defaultExtensionMap + cnfServerSoftware = "Lucu/1.0" + , cnfServerHost = unsafePerformIO getHostName + , cnfServerPort = Service "http" + , cnfMaxPipelineDepth = 100 + , cnfMaxEntityLength = 16 * 1024 * 1024 -- 16 MiB + , cnfMaxOutputChunkLength = 5 * 1024 * 1024 -- 5 MiB + , cnfDumpTooLateAbortionToStderr = True + , cnfExtToMIMEType = defaultExtensionMap } diff --git a/Network/HTTP/Lucu/Httpd.hs b/Network/HTTP/Lucu/Httpd.hs index 2be8736..c5e8f04 100644 --- a/Network/HTTP/Lucu/Httpd.hs +++ b/Network/HTTP/Lucu/Httpd.hs @@ -1,32 +1,61 @@ +-- | The entry point of Lucu httpd. module Network.HTTP.Lucu.Httpd - ( runHttpd -- Config -> ResTree -> IO () + ( runHttpd ) where import Control.Concurrent -import Control.Concurrent.STM -import qualified Data.ByteString.Lazy.Char8 as B -import Data.ByteString.Lazy.Char8 (ByteString) import Network import Network.HTTP.Lucu.Config import Network.HTTP.Lucu.Interaction import Network.HTTP.Lucu.RequestReader -import Network.HTTP.Lucu.Resource import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.ResponseWriter -import System.IO - +import System.Posix.Signals +-- | This is the entry point of Lucu httpd. It listens to a socket and +-- waits for clients. Computation of 'runHttpd' never stops by itself +-- so the only way to stop it is to raise an exception in the thread +-- computing it. +-- +-- Note that 'runHttpd' automatically makes SIGPIPE be ignored by +-- computing @installHandler sigPIPE Ignore Nothing@. This can hardly +-- cause a problem but it may do. +-- +-- Example: +-- +-- > module Main where +-- > import Network.HTTP.Lucu +-- > +-- > main :: IO () +-- > main = let config = defaultConfig +-- > resources = mkResTree [ ([], helloWorld) ] +-- > in +-- > runHttpd config resourcees +-- > +-- > helloWorld :: ResourceDef +-- > helloWorld = ResourceDef { +-- > resUsesNativeThread = False +-- > , resIsGreedy = False +-- > , resGet +-- > = Just $ do setContentType $ "text" "plain" +-- > output "Hello, world!" +-- > , resHead = Nothing +-- > , resPost = Nothing +-- > , resPut = Nothing +-- > , resDelete = Nothing +-- > } runHttpd :: Config -> ResTree -> IO () -runHttpd cnf table +runHttpd cnf tree = withSocketsDo $ - do so <- listenOn (cnfServerPort cnf) + do installHandler sigPIPE Ignore Nothing + so <- listenOn (cnfServerPort cnf) loop so where loop :: Socket -> IO () loop so = do (h, host, _) <- accept so tQueue <- newInteractionQueue - readerTID <- forkIO $ requestReader cnf table h host tQueue + readerTID <- forkIO $ requestReader cnf tree h host tQueue writerTID <- forkIO $ responseWriter cnf h tQueue readerTID loop so diff --git a/Network/HTTP/Lucu/Resource/Tree.hs b/Network/HTTP/Lucu/Resource/Tree.hs index be51282..4ed161f 100644 --- a/Network/HTTP/Lucu/Resource/Tree.hs +++ b/Network/HTTP/Lucu/Resource/Tree.hs @@ -1,3 +1,6 @@ +-- #prune + +-- | Repository of the resources in httpd. module Network.HTTP.Lucu.Resource.Tree ( ResourceDef(..) , ResTree @@ -35,20 +38,67 @@ import Prelude hiding (catch) -- があれば、假に "/aaa/bbb/ccc" に何らかのリソースがあったとしても必ず -- "/aaa/bbb" が撰ばれる。"/aaa/bbb" のリソースが貪欲でなければ、それは -- 無視される。 + +-- | 'ResourceDef' is basically a set of +-- 'Network.HTTP.Lucu.Resource.Resource' monads for each HTTP methods. data ResourceDef = ResourceDef { + -- | Whether to run a 'Network.HTTP.Lucu.Resource.Resource' on a + -- native thread (spawned using @forkOS@) or to run it on a user + -- thread (spanwed using @forkIO@). Generally you don't resUsesNativeThread :: Bool + -- | Whether to be greedy or not. + -- + -- Say a client is trying to access \/aaa\/bbb\/ccc. If there is a + -- greedy resource at \/aaa\/bbb, it is always chosen even if + -- there is another resource at \/aaa\/bbb\/ccc. If the resource + -- at \/aaa\/bbb is not greedy, it is just ignored. Greedy + -- resource is like a CGI script. , resIsGreedy :: Bool + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a GET + -- request comes for the resource path. If 'resGet' is Nothing, + -- the system responds \"405 Method Not Allowed\" for GET + -- requests. + -- + -- It also runs for HEAD request if the 'resHead' is Nothing. In + -- this case 'Network.HTTP.Lucu.Resource.output' and such like + -- don't actually write a response body. , resGet :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a HEAD + -- request comes for the resource path. If 'resHead' is Nothing, + -- the system runs 'resGet' instead. If 'resGet' is also Nothing, + -- the system responds \"405 Method Not Allowed\" for HEAD + -- requests. , resHead :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a POST + -- request comes for the resource path. If 'resPost' is Nothing, + -- the system responds \"405 Method Not Allowed\" for POST + -- requests. , resPost :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a PUT + -- request comes for the resource path. If 'resPut' is Nothing, + -- the system responds \"405 Method Not Allowed\" for PUT + -- requests. , resPut :: Maybe (Resource ()) + -- | A 'Network.HTTP.Lucu.Resource.Resource' to be run when a + -- DELETE request comes for the resource path. If 'resDelete' is + -- Nothing, the system responds \"405 Method Not Allowed\" for + -- DELETE requests. , resDelete :: Maybe (Resource ()) } + +-- | 'ResTree' is an opaque structure which is a map from resource +-- path to 'ResourceDef'. type ResTree = ResNode -- root だから Map ではない type ResSubtree = Map String ResNode data ResNode = ResNode (Maybe ResourceDef) ResSubtree - +-- | 'mkResTree' converts a list of @(path, def)@ to a 'ResTree' e.g. +-- +-- @ +-- mkResTree [ ([] , 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/stdio.h\" ) -- \/ +-- , ([\"unistd\"], 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/unistd.h\") -- \/unistd +-- ] +-- @ mkResTree :: [ ([String], ResourceDef) ] -> ResTree mkResTree list = processRoot list where @@ -182,7 +232,8 @@ runResource def itr mapM_ (\ (name, value) -> setHeader name value) $ aboHeaders abo output $ abortPage conf reqM res abo else - hPutStrLn stderr $ show abo + when (cnfDumpTooLateAbortionToStderr $ itrConfig itr) + $ hPutStrLn stderr $ show abo flip runReaderT itr $ driftTo Done diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs index d584009..928dab9 100644 --- a/examples/HelloWorld.hs +++ b/examples/HelloWorld.hs @@ -13,7 +13,6 @@ import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.Response import Network.HTTP.Lucu.StaticFile import Network.URI -import System.Posix.Signals import System.Time main :: IO () @@ -28,8 +27,7 @@ main = let config = defaultConfig { cnfServerPort = PortNumber 9999 } , staticDir "/usr/include" ) ] in - do installHandler sigPIPE Ignore Nothing - runHttpd config resources + runHttpd config resources helloWorld :: ResourceDef