From b340a77fa7bd051dd13a41d0a5b1ad30220bc6b6 Mon Sep 17 00:00:00 2001 From: pho Date: Fri, 20 Apr 2007 23:06:38 +0900 Subject: [PATCH] Documentation darcs-hash:20070420140638-62b54-f215e17319df2499d4dcfb6eab687771084b6e27.gz --- Lucu.cabal | 2 +- Network/HTTP/Lucu.hs | 10 +++---- Network/HTTP/Lucu/Chunk.hs | 1 + Network/HTTP/Lucu/Config.hs | 41 ++++++++++++++++++++++++---- Network/HTTP/Lucu/DefaultPage.hs | 7 +++-- Network/HTTP/Lucu/ETag.hs | 32 ++++++++++++---------- Network/HTTP/Lucu/Headers.hs | 7 +++-- Network/HTTP/Lucu/Interaction.hs | 1 + Network/HTTP/Lucu/Parser.hs | 8 ++++++ Network/HTTP/Lucu/Postprocess.hs | 5 ++-- Network/HTTP/Lucu/Preprocess.hs | 3 +- Network/HTTP/Lucu/RFC1123DateTime.hs | 31 +++++++++++---------- Network/HTTP/Lucu/RequestReader.hs | 3 +- Network/HTTP/Lucu/ResponseWriter.hs | 3 +- Network/HTTP/Lucu/StaticFile.hs | 23 ++++++++++++---- 15 files changed, 121 insertions(+), 56 deletions(-) diff --git a/Lucu.cabal b/Lucu.cabal index e17c470..53bfa97 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -6,7 +6,7 @@ Author: PHO Homepage: http://ccm.sherry.jp/ Category: Incomplete Build-Depends: - base, mtl, network, stm, parsec, hxt, haskell-src, unix + base, mtl, network, stm, hxt, haskell-src, unix Exposed-Modules: Network.HTTP.Lucu Network.HTTP.Lucu.Abortion diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index 3f4350b..b2c88c6 100644 --- a/Network/HTTP/Lucu.hs +++ b/Network/HTTP/Lucu.hs @@ -4,12 +4,10 @@ module Network.HTTP.Lucu , abortA -- Config - , Config(..) - , defaultConfig + , module Network.HTTP.Lucu.Config -- ETag - , ETag - , mkETag + , ETag(..) , strongETag , weakETag @@ -26,7 +24,7 @@ module Network.HTTP.Lucu , Method(..) , Request(..) - -- Resource (driftTo だけは要らないが) + -- Resource (driftTo だけは要らない) , module Network.HTTP.Lucu.Resource -- Resource.Tree @@ -48,7 +46,7 @@ import Network.HTTP.Lucu.ETag import Network.HTTP.Lucu.Httpd import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.Request -import Network.HTTP.Lucu.Resource +import Network.HTTP.Lucu.Resource hiding (driftTo) import Network.HTTP.Lucu.Resource.Tree import Network.HTTP.Lucu.Response import Network.HTTP.Lucu.StaticFile diff --git a/Network/HTTP/Lucu/Chunk.hs b/Network/HTTP/Lucu/Chunk.hs index 342362c..44f2ae4 100644 --- a/Network/HTTP/Lucu/Chunk.hs +++ b/Network/HTTP/Lucu/Chunk.hs @@ -1,3 +1,4 @@ +-- #hide module Network.HTTP.Lucu.Chunk ( chunkHeaderP -- Num a => Parser a , chunkFooterP -- Parser () diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs index 2f63353..d33f35a 100644 --- a/Network/HTTP/Lucu/Config.hs +++ b/Network/HTTP/Lucu/Config.hs @@ -1,6 +1,7 @@ +-- |Configurations for the Lucu httpd like a port to listen. module Network.HTTP.Lucu.Config ( Config(..) - , defaultConfig -- Config + , defaultConfig ) where @@ -12,26 +13,56 @@ import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap import System.IO.Unsafe - +-- |A 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 + -- |The host name of the server. This value will be used in + -- built-in pages like \"404 Not Found\". , cnfServerHost :: HostName + -- |A port ID to listen to HTTP clients. , 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 + -- |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 - , cnfMaxURILength :: 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 + -- |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 + -- guessed only by file name. + -- + -- Guessing by file magic is indeed a wonderful idea but that is + -- not implemented (yet). But hey, don't you think it's better a + -- file system got a MIME Type as a part of inode? Or it might be + -- a good idea to use GnomeVFS + -- () + -- instead of vanilla FS. , cnfExtToMIMEType :: Map String MIMEType } - +-- |The default configuration. Generally you can use this value as-is, +-- or possibly you just want to replace the 'cnfServerSoftware' and +-- 'cnfServerPort'. +defaultConfig :: Config defaultConfig = Config { cnfServerSoftware = "Lucu/1.0" , cnfServerHost = unsafePerformIO getHostName , cnfServerPort = Service "http" , cnfMaxPipelineDepth = 100 , cnfMaxEntityLength = 16 * 1024 * 1024 -- 16 MiB - , cnfMaxURILength = 4 * 1024 -- 4 KiB , cnfMaxOutputChunkLength = 5 * 1024 * 1024 -- 5 MiB , cnfExtToMIMEType = defaultExtensionMap } diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs index f5cc476..988329d 100644 --- a/Network/HTTP/Lucu/DefaultPage.hs +++ b/Network/HTTP/Lucu/DefaultPage.hs @@ -1,7 +1,8 @@ +-- #hide, prune module Network.HTTP.Lucu.DefaultPage - ( getDefaultPage -- Config -> Maybe Request -> Response -> String - , writeDefaultPage -- Interaction -> STM () - , mkDefaultPage -- (ArrowXml a) => Config -> StatusCode -> a b XmlTree -> a b XmlTree + ( getDefaultPage + , writeDefaultPage + , mkDefaultPage ) where diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index 86dd429..8565883 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -1,10 +1,12 @@ +-- #prune + +-- |Creation and comparison of entity tags. module Network.HTTP.Lucu.ETag - ( ETag - , mkETag -- Bool -> String -> ETag - , strongETag -- String -> ETag - , weakETag -- String -> ETag - , eTagP -- Parser ETag - , eTagListP -- Parser [ETag] + ( ETag(..) + , strongETag + , weakETag + , eTagP + , eTagListP ) where @@ -13,9 +15,13 @@ import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Parser.Http import Network.HTTP.Lucu.Utils - +-- |An entity tag is made of a weakness flag and a opaque string. data ETag = ETag { + -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and + -- strong tags are like \"blahblah\". etagIsWeak :: Bool + -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~) + -- are allowed. , etagToken :: String } deriving (Eq) @@ -27,15 +33,13 @@ instance Show ETag where ++ quoteStr token - -mkETag :: Bool -> String -> ETag -mkETag = ETag - - +-- |This is an equivalent to @'ETag' False@. If you want to generate +-- an ETag from a file, try using +-- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'. strongETag :: String -> ETag strongETag = ETag False - +-- |This is an equivalent to @'ETag' True@. weakETag :: String -> ETag weakETag = ETag True @@ -43,7 +47,7 @@ weakETag = ETag True eTagP :: Parser ETag eTagP = do isWeak <- option False (string "W/" >> return True) str <- quotedStr - return $ mkETag isWeak str + return $ ETag isWeak str eTagListP :: Parser [ETag] diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index ccd5140..fee6fad 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -1,9 +1,10 @@ +-- #hide module Network.HTTP.Lucu.Headers ( Headers , HasHeaders(..) - , emptyHeaders -- Headers - , headersP -- Parser Headers - , hPutHeaders -- Handle -> Headers -> IO () + , emptyHeaders + , headersP + , hPutHeaders ) where diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs index 68c6c0e..0dd9259 100644 --- a/Network/HTTP/Lucu/Interaction.hs +++ b/Network/HTTP/Lucu/Interaction.hs @@ -1,3 +1,4 @@ +-- #hide module Network.HTTP.Lucu.Interaction ( Interaction(..) , InteractionState(..) diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs index ffbf6d1..c43dfa7 100644 --- a/Network/HTTP/Lucu/Parser.hs +++ b/Network/HTTP/Lucu/Parser.hs @@ -20,6 +20,7 @@ module Network.HTTP.Lucu.Parser , many1 -- Parser a -> Parser [a] , manyTill -- Parser a -> Parser end -> Parser [a] , many1Till -- Parser a -> Parser end -> Parser [a] + , count -- Int -> Parser a -> Parser [a] , option -- a -> Parser a -> Parser a , sepBy -- Parser a -> Parser sep -> Parser [a] , sepBy1 -- Parser a -> Parser sep -> Parser [a] @@ -190,6 +191,13 @@ many1Till p end = many1 $ do x <- p return x +count :: Int -> Parser a -> Parser [a] +count 0 _ = return [] +count n p = do x <- p + xs <- count (n-1) p + return (x:xs) + + option :: a -> Parser a -> Parser a option def p = p <|> return def diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs index 80fc722..24a07f1 100644 --- a/Network/HTTP/Lucu/Postprocess.hs +++ b/Network/HTTP/Lucu/Postprocess.hs @@ -1,6 +1,7 @@ +-- #hide module Network.HTTP.Lucu.Postprocess - ( postprocess -- Interaction -> STM () - , completeUnconditionalHeaders -- Config -> Response -> IO Response + ( postprocess + , completeUnconditionalHeaders ) where diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs index 1c11f89..74d6653 100644 --- a/Network/HTTP/Lucu/Preprocess.hs +++ b/Network/HTTP/Lucu/Preprocess.hs @@ -1,5 +1,6 @@ +-- #hide module Network.HTTP.Lucu.Preprocess - ( preprocess -- Interaction -> STM () + ( preprocess ) where diff --git a/Network/HTTP/Lucu/RFC1123DateTime.hs b/Network/HTTP/Lucu/RFC1123DateTime.hs index 9c58e51..ad683a9 100644 --- a/Network/HTTP/Lucu/RFC1123DateTime.hs +++ b/Network/HTTP/Lucu/RFC1123DateTime.hs @@ -1,15 +1,17 @@ module Network.HTTP.Lucu.RFC1123DateTime - ( formatRFC1123DateTime -- CalendarTime -> String - , formatHTTPDateTime -- ClockTime -> String - , parseHTTPDateTime -- String -> Maybe ClockTime + ( formatRFC1123DateTime + , formatHTTPDateTime + , parseHTTPDateTime ) where -import Control.Monad -import System.Time -import System.Locale -import Text.ParserCombinators.Parsec -import Text.Printf +import Control.Monad +import qualified Data.ByteString.Lazy.Char8 as B +import Data.ByteString.Lazy.Char8 (ByteString) +import Network.HTTP.Lucu.Parser +import System.Time +import System.Locale +import Text.Printf month = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"] week = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] @@ -33,17 +35,18 @@ formatHTTPDateTime = formatRFC1123DateTime . (\cal -> cal { ctTZName = "GMT" }) parseHTTPDateTime :: String -> Maybe ClockTime parseHTTPDateTime src - = case parse httpDateTime "" src of - Right ct -> Just ct - Left err -> Nothing + = case parseStr httpDateTime src of + (Success ct, _) -> Just ct + _ -> Nothing + httpDateTime :: Parser ClockTime -httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week) +httpDateTime = do foldl (<|>) (fail "") (map string week) char ',' char ' ' day <- liftM read (count 2 digit) char ' ' - mon <- foldl (<|>) (unexpected "") (map tryEqToFst (zip month [1..])) + mon <- foldl (<|>) (fail "") (map tryEqToFst (zip month [1..])) char ' ' year <- liftM read (count 4 digit) char ' ' @@ -71,5 +74,5 @@ httpDateTime = do foldl (<|>) (unexpected "") (map (try . string) week) } where tryEqToFst :: (String, a) -> Parser a - tryEqToFst (str, a) = try $ string str >> return a + tryEqToFst (str, a) = string str >> return a \ No newline at end of file diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs index 9b54ca5..08cc2e9 100644 --- a/Network/HTTP/Lucu/RequestReader.hs +++ b/Network/HTTP/Lucu/RequestReader.hs @@ -1,5 +1,6 @@ +-- #hide module Network.HTTP.Lucu.RequestReader - ( requestReader -- Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO () + ( requestReader ) where diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs index 1e2eacb..7130974 100644 --- a/Network/HTTP/Lucu/ResponseWriter.hs +++ b/Network/HTTP/Lucu/ResponseWriter.hs @@ -1,5 +1,6 @@ +-- #hide module Network.HTTP.Lucu.ResponseWriter - ( responseWriter -- Config -> Handle -> InteractionQueue -> IO () + ( responseWriter ) where diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs index 7937af9..e710fc9 100644 --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -1,9 +1,11 @@ module Network.HTTP.Lucu.StaticFile - ( staticFile -- FilePath -> ResourceDef - , handleStaticFile -- FilePath -> Resource () + ( staticFile + , handleStaticFile - , staticDir -- FilePath -> ResourceDef - , handleStaticDir -- FilePath -> Resource () + , staticDir + , handleStaticDir + + , generateETagFromFile ) where @@ -68,7 +70,18 @@ handleStaticFile path foundNoEntity Nothing --- inode-size-lastmod +-- |Computation @'generateETagFromFile' fpath@ generates a strong +-- entity tag from a file. The file doesn't necessarily have to be a +-- regular file; it may be a FIFO or a device file. The tag is made of +-- inode ID, size and modification time. +-- +-- Note that the tag is not strictly strong because the file could be +-- modified twice at a second without changing inode ID or size, but +-- it's not really possible to generate a strict strong ETag from a +-- file since we don't want to simply grab the entire file and use it +-- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to +-- increase strictness, but it's too inefficient if the file is really +-- large (say, 1 TiB). generateETagFromFile :: FilePath -> IO ETag generateETagFromFile path = do stat <- getFileStatus path -- 2.40.0