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
, abortA
-- Config
- , Config(..)
- , defaultConfig
+ , module Network.HTTP.Lucu.Config
-- ETag
- , ETag
- , mkETag
+ , ETag(..)
, strongETag
, weakETag
, Method(..)
, Request(..)
- -- Resource (driftTo だけは要らないが)
+ -- Resource (driftTo だけは要らない)
, module Network.HTTP.Lucu.Resource
-- Resource.Tree
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
+-- #hide
module Network.HTTP.Lucu.Chunk
( chunkHeaderP -- Num a => Parser a
, chunkFooterP -- Parser ()
+-- |Configurations for the Lucu httpd like a port to listen.
module Network.HTTP.Lucu.Config
( Config(..)
- , defaultConfig -- Config
+ , defaultConfig
)
where
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
+ -- (<http://developer.gnome.org/doc/API/2.0/gnome-vfs-2.0/>)
+ -- 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
}
+-- #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
+-- #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
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)
++
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
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]
+-- #hide
module Network.HTTP.Lucu.Headers
( Headers
, HasHeaders(..)
- , emptyHeaders -- Headers
- , headersP -- Parser Headers
- , hPutHeaders -- Handle -> Headers -> IO ()
+ , emptyHeaders
+ , headersP
+ , hPutHeaders
)
where
+-- #hide
module Network.HTTP.Lucu.Interaction
( Interaction(..)
, InteractionState(..)
, 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]
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
+-- #hide
module Network.HTTP.Lucu.Postprocess
- ( postprocess -- Interaction -> STM ()
- , completeUnconditionalHeaders -- Config -> Response -> IO Response
+ ( postprocess
+ , completeUnconditionalHeaders
)
where
+-- #hide
module Network.HTTP.Lucu.Preprocess
- ( preprocess -- Interaction -> STM ()
+ ( preprocess
)
where
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"]
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 ' '
}
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
+-- #hide
module Network.HTTP.Lucu.RequestReader
- ( requestReader -- Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO ()
+ ( requestReader
)
where
+-- #hide
module Network.HTTP.Lucu.ResponseWriter
- ( responseWriter -- Config -> Handle -> InteractionQueue -> IO ()
+ ( responseWriter
)
where
module Network.HTTP.Lucu.StaticFile
- ( staticFile -- FilePath -> ResourceDef
- , handleStaticFile -- FilePath -> Resource ()
+ ( staticFile
+ , handleStaticFile
- , staticDir -- FilePath -> ResourceDef
- , handleStaticDir -- FilePath -> Resource ()
+ , staticDir
+ , handleStaticDir
+
+ , generateETagFromFile
)
where
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
projects / Lucu.git / commitdiff