Name: Lucu
Synopsis: HTTP Daemon Library
-Version: 0
+Version: 0.1
License: PublicDomain
Author: PHO
Homepage: http://ccm.sherry.jp/
Category: Incomplete
Build-Depends:
- base, mtl, network, stm, parsec, hxt
+ base, mtl, network, stm, parsec, hxt, haskell-src
Exposed-Modules:
+ Network.HTTP.Lucu.Abortion
+ Network.HTTP.Lucu.Chunk
Network.HTTP.Lucu.Config
+ Network.HTTP.Lucu.DefaultPage
+ Network.HTTP.Lucu.ETag
Network.HTTP.Lucu.Headers
- Network.HTTP.Lucu.Httpd
Network.HTTP.Lucu.HttpVersion
- Network.HTTP.Lucu.Response
- Network.HTTP.Lucu.Resource
+ Network.HTTP.Lucu.Httpd
+ Network.HTTP.Lucu.Interaction
+ Network.HTTP.Lucu.MIMEType
+ Network.HTTP.Lucu.MIMEType.Guess
+ Network.HTTP.Lucu.Parser
+ Network.HTTP.Lucu.Parser.Http
+ Network.HTTP.Lucu.Postprocess
+ Network.HTTP.Lucu.Preprocess
+ Network.HTTP.Lucu.RFC1123DateTime
Network.HTTP.Lucu.Request
+ Network.HTTP.Lucu.RequestReader
+ Network.HTTP.Lucu.Resource
+ Network.HTTP.Lucu.Resource.Tree
+ Network.HTTP.Lucu.Response
+ Network.HTTP.Lucu.ResponseWriter
+ Network.HTTP.Lucu.Utils
ghc-options: -threaded -fglasgow-exts
Executable: HelloWorld
rm -rf dist Setup Setup.o Setup.hi .setup-config
find . -name '*~' -exec rm -f {} \;
-.PHONY: run build clean
\ No newline at end of file
+install: build
+ ./Setup install
+
+.PHONY: run build clean install
\ No newline at end of file
)
where
-import Network
-import Network.BSD
-import System.IO.Unsafe
+import qualified Data.Map as M
+import Data.Map (Map)
+import Network
+import Network.BSD
+import Network.HTTP.Lucu.MIMEType
+import System.IO.Unsafe
+
data Config = Config {
cnfServerSoftware :: String
, cnfMaxPipelineDepth :: Int
, cnfMaxEntityLength :: Int
, cnfMaxURILength :: Int
+ , cnfExtToMIMEType :: Map String MIMEType
}
+
defaultConfig = Config {
cnfServerSoftware = "Lucu/1.0"
, cnfServerHost = unsafePerformIO getHostName
, cnfMaxPipelineDepth = 100
, cnfMaxEntityLength = 16 * 1024 * 1024 -- 16 MiB
, cnfMaxURILength = 4 * 1024 -- 4 KiB
- }
\ No newline at end of file
+ , cnfExtToMIMEType = undefined -- FIXME
+ }
module Network.HTTP.Lucu.ETag
( ETag
- , mkETag -- Bool -> String -> ETag
+ , mkETag -- Bool -> String -> ETag
+ , strongETag -- String -> ETag
+ , weakETag -- String -> ETag
, eTagP -- Parser ETag
, eTagListP -- Parser [ETag]
)
where
+import Control.Monad
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
data ETag = ETag {
, etagToken :: String
} deriving (Eq)
-
instance Show ETag where
show (ETag isWeak token) = (if isWeak then
"W/"
else
"")
++
- foldr (++) "" (["\""] ++ map quote token ++ ["\""])
- where
- quote :: Char -> String
- quote '"' = "\\\""
- quote c = [c]
+ quoteStr token
mkETag :: Bool -> String -> ETag
mkETag = ETag
+strongETag :: String -> ETag
+strongETag = ETag False
+
+
+weakETag :: String -> ETag
+weakETag = ETag True
+
+
eTagP :: Parser ETag
eTagP = do isWeak <- option False (string "W/" >> return True)
str <- quotedStr
eTagListP :: Parser [ETag]
eTagListP = allowEOF
- $ sepBy1 eTagP (do many sp
- char ','
- many sp)
+ $ do xs <- listOf eTagP
+ when (null xs)
+ $ fail ""
+ return xs
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
--- /dev/null
+module Network.HTTP.Lucu.MIMEType
+ ( MIMEType(..)
+ , (+/+) -- String -> String -> MIMEType
+ , (+:+) -- MIMEType -> (String, String) -> MIMEType
+ , (+=+) -- String -> String -> (String, String)
+ , mimeTypeP -- Parser MIMEType
+ , mimeTypeListP -- Parser [MIMEType]
+ )
+ where
+
+import Network.HTTP.Lucu.Parser
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+
+
+data MIMEType = MIMEType {
+ mtMajor :: String
+ , mtMinor :: String
+ , mtParams :: [ (String, String) ]
+ } deriving (Eq)
+
+
+instance Show MIMEType where
+ show (MIMEType maj min params)
+ = maj ++ "/" ++ min ++
+ if null params then
+ ""
+ else
+ "; " ++ joinWith "; " (map showPair params)
+ where
+ showPair :: (String, String) -> String
+ showPair (name, value)
+ = name ++ "=" ++ if any (not . isToken) value then
+ quoteStr value
+ else
+ value
+
+
+infix 9 +/+, +=+
+infixl 8 +:+
+
+
+(+/+) :: String -> String -> MIMEType
+maj +/+ min
+ = MIMEType maj min []
+
+
+(+:+) :: MIMEType -> (String, String) -> MIMEType
+mt@(MIMEType _ _ params) +:+ pair
+ = mt {
+ mtParams = mtParams mt ++ [pair]
+ }
+
+
+(+=+) :: String -> String -> (String, String)
+name +=+ value = (name, value)
+
+
+
+mimeTypeP :: Parser MIMEType
+mimeTypeP = allowEOF $
+ do maj <- token
+ char '/'
+ min <- token
+ params <- many paramP
+ return $ MIMEType maj min params
+ where
+ paramP :: Parser (String, String)
+ paramP = do many lws
+ char ';'
+ many lws
+ name <- token
+ char '='
+ value <- token <|> quotedStr
+ return (name, value)
+
+mimeTypeListP :: Parser [MIMEType]
+mimeTypeListP = allowEOF $ listOf mimeTypeP
--- /dev/null
+{- !!! WARNING !!!
+ This file is automatically generated from data/mime.types.
+ DO NOT EDIT BY HAND OR YOU WILL REGRET -}
+
+module Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
+ (defaultExtensionMap) where
+import Network.HTTP.Lucu.MIMEType
+import qualified Data.Map as M
+import Data.Map (Map)
+
+defaultExtensionMap :: Map String MIMEType
+defaultExtensionMap
+ = M.fromList
+ [("3gp", "application" +/+ "x-3gp"), ("669", "audio" +/+ "x-mod"),
+ ("Z", "application" +/+ "x-compress"),
+ ("a", "application" +/+ "x-ar"), ("ac3", "audio" +/+ "x-ac3"),
+ ("ai", "application" +/+ "postscript"),
+ ("aif", "audio" +/+ "x-aiff"), ("aifc", "audio" +/+ "x-aiff"),
+ ("aiff", "audio" +/+ "x-aiff"), ("amf", "audio" +/+ "x-mod"),
+ ("anx", "application" +/+ "ogg"),
+ ("ape", "application" +/+ "x-ape"), ("asc", "text" +/+ "plain"),
+ ("asf", "video" +/+ "x-ms-asf"),
+ ("atom", "application" +/+ "atom+xml"), ("au", "audio" +/+ "x-au"),
+ ("avi", "video" +/+ "x-msvideo"),
+ ("bcpio", "application" +/+ "x-bcpio"),
+ ("bin", "application" +/+ "octet-stream"),
+ ("bmp", "image" +/+ "bmp"), ("bz2", "application" +/+ "x-bzip"),
+ ("cabal", "text" +/+ "x-cabal"),
+ ("cdf", "application" +/+ "x-netcdf"), ("cgm", "image" +/+ "cgm"),
+ ("class", "application" +/+ "octet-stream"),
+ ("cpio", "application" +/+ "x-cpio"),
+ ("cpt", "application" +/+ "mac-compactpro"),
+ ("csh", "application" +/+ "x-csh"), ("css", "text" +/+ "css"),
+ ("dcr", "application" +/+ "x-director"),
+ ("dif", "video" +/+ "x-dv"),
+ ("dir", "application" +/+ "x-director"),
+ ("djv", "image" +/+ "vnd.djvu"), ("djvu", "image" +/+ "vnd.djvu"),
+ ("dll", "application" +/+ "octet-stream"),
+ ("dmg", "application" +/+ "octet-stream"),
+ ("dms", "application" +/+ "octet-stream"),
+ ("doc", "application" +/+ "msword"), ("dsm", "audio" +/+ "x-mod"),
+ ("dtd", "application" +/+ "xml-dtd"), ("dv", "video" +/+ "x-dv"),
+ ("dvi", "application" +/+ "x-dvi"),
+ ("dxr", "application" +/+ "x-director"),
+ ("eps", "application" +/+ "postscript"),
+ ("etx", "text" +/+ "x-setext"),
+ ("exe", "application" +/+ "octet-stream"),
+ ("ez", "application" +/+ "andrew-inset"),
+ ("far", "audio" +/+ "x-mod"), ("flac", "audio" +/+ "x-flac"),
+ ("flc", "video" +/+ "x-fli"), ("fli", "video" +/+ "x-fli"),
+ ("flv", "video" +/+ "x-flv"), ("gdm", "audio" +/+ "x-mod"),
+ ("gif", "image" +/+ "gif"), ("gram", "application" +/+ "srgs"),
+ ("grxml", "application" +/+ "srgs+xml"),
+ ("gtar", "application" +/+ "x-gtar"),
+ ("gz", "application" +/+ "x-gzip"),
+ ("hdf", "application" +/+ "x-hdf"),
+ ("hi", "application" +/+ "octet-stream"),
+ ("hqx", "application" +/+ "mac-binhex40"),
+ ("hs", "text" +/+ "x-haskell"), ("htm", "text" +/+ "html"),
+ ("html", "text" +/+ "html"),
+ ("ice", "x-conference" +/+ "x-cooltalk"),
+ ("ico", "image" +/+ "x-icon"), ("ics", "text" +/+ "calendar"),
+ ("ief", "image" +/+ "ief"), ("ifb", "text" +/+ "calendar"),
+ ("iff", "audio" +/+ "x-svx"), ("iges", "model" +/+ "iges"),
+ ("igs", "model" +/+ "iges"), ("ilbc", "audio" +/+ "iLBC-sh"),
+ ("imf", "audio" +/+ "x-mod"), ("it", "audio" +/+ "x-mod"),
+ ("jng", "image" +/+ "x-jng"),
+ ("jnlp", "application" +/+ "x-java-jnlp-file"),
+ ("jp2", "image" +/+ "jp2"), ("jpe", "image" +/+ "jpeg"),
+ ("jpeg", "image" +/+ "jpeg"), ("jpg", "image" +/+ "jpeg"),
+ ("js", "application" +/+ "x-javascript"),
+ ("kar", "audio" +/+ "midi"),
+ ("latex", "application" +/+ "x-latex"),
+ ("lha", "application" +/+ "octet-stream"),
+ ("lzh", "application" +/+ "octet-stream"),
+ ("m3u", "audio" +/+ "x-mpegurl"), ("m4a", "audio" +/+ "mp4a-latm"),
+ ("m4p", "audio" +/+ "mp4a-latm"),
+ ("m4u", "video" +/+ "vnd.mpegurl"), ("m4v", "video" +/+ "mpeg4"),
+ ("mac", "image" +/+ "x-macpaint"),
+ ("man", "application" +/+ "x-troff-man"),
+ ("mathml", "application" +/+ "mathml+xml"),
+ ("me", "application" +/+ "x-troff-me"),
+ ("med", "audio" +/+ "x-mod"), ("mesh", "model" +/+ "mesh"),
+ ("mid", "audio" +/+ "midi"), ("midi", "audio" +/+ "midi"),
+ ("mif", "application" +/+ "vnd.mif"),
+ ("mka", "video" +/+ "x-matroska"),
+ ("mkv", "video" +/+ "x-matroska"), ("mng", "video" +/+ "x-mng"),
+ ("mod", "audio" +/+ "x-mod"), ("mov", "video" +/+ "quicktime"),
+ ("movie", "video" +/+ "x-sgi-movie"), ("mp2", "audio" +/+ "mpeg"),
+ ("mp3", "audio" +/+ "mpeg"), ("mp4", "video" +/+ "mp4"),
+ ("mpc", "audio" +/+ "x-musepack"), ("mpe", "video" +/+ "mpeg"),
+ ("mpeg", "video" +/+ "mpeg"), ("mpg", "video" +/+ "mpeg"),
+ ("mpga", "audio" +/+ "mpeg"),
+ ("ms", "application" +/+ "x-troff-ms"),
+ ("msh", "model" +/+ "mesh"), ("mtm", "audio" +/+ "x-mod"),
+ ("mve", "video" +/+ "x-mve"), ("mxu", "video" +/+ "vnd.mpegurl"),
+ ("nar", "application" +/+ "x-nar"),
+ ("nc", "application" +/+ "x-netcdf"),
+ ("nist", "audio" +/+ "x-nist"), ("nuv", "video" +/+ "x-nuv"),
+ ("o", "application" +/+ "octet-stream"),
+ ("oda", "application" +/+ "oda"), ("ogg", "application" +/+ "ogg"),
+ ("ogm", "application" +/+ "ogg"), ("okt", "audio" +/+ "x-mod"),
+ ("paf", "audio" +/+ "x-paris"),
+ ("pbm", "image" +/+ "x-portable-bitmap"),
+ ("pct", "image" +/+ "pict"), ("pdb", "chemical" +/+ "x-pdb"),
+ ("pdf", "application" +/+ "pdf"),
+ ("pgm", "image" +/+ "x-portable-graymap"),
+ ("pgn", "application" +/+ "x-chess-pgn"),
+ ("pic", "image" +/+ "pict"), ("pict", "image" +/+ "pict"),
+ ("png", "image" +/+ "png"),
+ ("pnm", "image" +/+ "x-portable-anymap"),
+ ("pnt", "image" +/+ "x-macpaint"),
+ ("pntg", "image" +/+ "x-macpaint"),
+ ("ppm", "image" +/+ "x-portable-pixmap"),
+ ("ppt", "application" +/+ "vnd.ms-powerpoint"),
+ ("ps", "application" +/+ "postscript"),
+ ("qif", "image" +/+ "x-quicktime"),
+ ("qt", "video" +/+ "quicktime"),
+ ("qti", "image" +/+ "x-quicktime"),
+ ("qtif", "image" +/+ "x-quicktime"),
+ ("ra", "audio" +/+ "x-pn-realaudio"),
+ ("ram", "text" +/+ "uri-list"), ("rar", "application" +/+ "x-rar"),
+ ("ras", "image" +/+ "x-sun-raster"),
+ ("rdf", "application" +/+ "rdf+xml"), ("rgb", "image" +/+ "x-rgb"),
+ ("rm", "application" +/+ "vnd.rn-realmedia"),
+ ("roff", "application" +/+ "x-troff"), ("rtf", "text" +/+ "rtf"),
+ ("rtx", "text" +/+ "richtext"), ("s3m", "audio" +/+ "x-mod"),
+ ("sam", "audio" +/+ "x-mod"), ("sds", "audio" +/+ "x-sds"),
+ ("sf", "audio" +/+ "x-ircam"), ("sgm", "text" +/+ "sgml"),
+ ("sgml", "text" +/+ "sgml"), ("sh", "application" +/+ "x-sh"),
+ ("shar", "application" +/+ "x-shar"),
+ ("shn", "audio" +/+ "x-shorten"), ("sid", "audio" +/+ "x-sid"),
+ ("silo", "model" +/+ "mesh"),
+ ("sit", "application" +/+ "x-stuffit"),
+ ("skd", "application" +/+ "x-koan"),
+ ("skm", "application" +/+ "x-koan"),
+ ("skp", "application" +/+ "x-koan"),
+ ("skt", "application" +/+ "x-koan"),
+ ("smi", "application" +/+ "smil"),
+ ("smil", "application" +/+ "smil"), ("snd", "audio" +/+ "x-au"),
+ ("so", "application" +/+ "octet-stream"),
+ ("spc", "application" +/+ "x-spc"),
+ ("spl", "application" +/+ "x-futuresplash"),
+ ("src", "application" +/+ "x-wais-source"),
+ ("stm", "audio" +/+ "x-mod"), ("stx", "audio" +/+ "x-mod"),
+ ("sv4cpio", "application" +/+ "x-sv4cpio"),
+ ("sv4crc", "application" +/+ "x-sv4crc"),
+ ("svg", "image" +/+ "svg+xml"), ("svx", "audio" +/+ "x-svx"),
+ ("swf", "application" +/+ "x-shockwave-flash"),
+ ("swfl", "application" +/+ "x-shockwave-flash"),
+ ("t", "application" +/+ "x-troff"),
+ ("tar", "application" +/+ "x-tar"),
+ ("tbz", "application" +/+ "x-bzip"),
+ ("tcl", "application" +/+ "x-tcl"),
+ ("tex", "application" +/+ "x-tex"),
+ ("texi", "application" +/+ "x-texinfo"),
+ ("texinfo", "application" +/+ "x-texinfo"),
+ ("tgz", "application" +/+ "x-gzip"), ("tif", "image" +/+ "tiff"),
+ ("tiff", "image" +/+ "tiff"), ("tr", "application" +/+ "x-troff"),
+ ("ts", "video" +/+ "mpegts"),
+ ("tsv", "text" +/+ "tab-separated-values"),
+ ("tta", "audio" +/+ "x-ttafile"), ("txt", "text" +/+ "plain"),
+ ("ult", "audio" +/+ "x-mod"),
+ ("ustar", "application" +/+ "x-ustar"),
+ ("vcd", "application" +/+ "x-cdlink"),
+ ("voc", "audio" +/+ "x-voc"), ("vrml", "model" +/+ "vrml"),
+ ("vxml", "application" +/+ "voicexml+xml"),
+ ("w64", "audio" +/+ "x-w64"), ("wav", "audio" +/+ "x-wav"),
+ ("wbmp", "image" +/+ "vnd.wap.wbmp"),
+ ("wbxml", "application" +/+ "vnd.wap.wbxml"),
+ ("wm", "video" +/+ "x-ms-asf"), ("wma", "video" +/+ "x-ms-asf"),
+ ("wml", "text" +/+ "vnd.wap.wml"),
+ ("wmlc", "application" +/+ "vnd.wap.wmlc"),
+ ("wmls", "text" +/+ "vnd.wap.wmlscript"),
+ ("wmlsc", "application" +/+ "vnd.wap.wmlscriptc"),
+ ("wmv", "video" +/+ "x-ms-asf"), ("wrl", "model" +/+ "vrml"),
+ ("wv", "application" +/+ "x-wavpack"),
+ ("wvc", "application" +/+ "x-wavpack-correction"),
+ ("wvp", "application" +/+ "x-wavpack"),
+ ("xbm", "image" +/+ "x-xbitmap"), ("xcf", "image" +/+ "x-xcf"),
+ ("xht", "application" +/+ "xhtml+xml"),
+ ("xhtml", "application" +/+ "xhtml+xml"),
+ ("xls", "application" +/+ "vnd.ms-excel"),
+ ("xm", "audio" +/+ "x-mod"), ("xml", "application" +/+ "xml"),
+ ("xpm", "image" +/+ "x-xpixmap"), ("xsl", "application" +/+ "xml"),
+ ("xslt", "application" +/+ "xslt+xml"),
+ ("xul", "application" +/+ "vnd.mozilla.xul+xml"),
+ ("xwd", "image" +/+ "x-xwindowdump"),
+ ("xyz", "chemical" +/+ "x-xyz"), ("zip", "application" +/+ "zip")]
--- /dev/null
+module Network.HTTP.Lucu.MIMEType.Guess
+ ( parseExtMapFile -- FilePath -> IO (Map String MIMEType)
+ , outputExtMapAsHS -- Map String MIMEType -> FilePath -> IO ()
+ )
+ where
+
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.Maybe
+import Language.Haskell.Pretty
+import Language.Haskell.Syntax
+import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.Parser
+import Network.HTTP.Lucu.Parser.Http
+import System.IO
+
+import Debug.Trace
+
+parseExtMapFile :: FilePath -> IO (Map String MIMEType)
+parseExtMapFile fpath
+ = do file <- B.readFile fpath
+ case parse (allowEOF extMapP) file of
+ (Success xs, _) -> return $ compile xs
+ (_, input') -> let near = B.unpack $ B.take 100 input'
+ in
+ fail ("Failed to parse: " ++ fpath ++ " (near: " ++ near ++ ")")
+
+
+extMapP :: Parser [ (MIMEType, [String]) ]
+extMapP = do xs <- many (comment <|> validLine <|> emptyLine)
+ eof
+ return $ catMaybes xs
+ where
+ spc = oneOf " \t"
+
+ comment = do many spc
+ char '#'
+ many $ satisfy (/= '\n')
+ return Nothing
+
+ validLine = do many spc
+ mime <- mimeTypeP
+ many spc
+ exts <- sepBy token (many spc)
+ return $ Just (mime, exts)
+
+ emptyLine = oneOf " \t\n" >> return Nothing
+
+
+compile :: [ (MIMEType, [String]) ] -> Map String MIMEType
+compile = M.fromList . foldr (++) [] . map tr
+ where
+ tr :: (MIMEType, [String]) -> [ (String, MIMEType) ]
+ tr (mime, exts) = [ (ext, mime) | ext <- exts ]
+
+
+outputExtMapAsHS :: Map String MIMEType -> FilePath -> IO ()
+outputExtMapAsHS extMap fpath
+ = let hsModule = HsModule undefined modName (Just exports) imports decls
+ modName = Module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap"
+ exports = [HsEVar (UnQual (HsIdent "defaultExtensionMap"))]
+ imports = [ HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType") False Nothing Nothing
+ , HsImportDecl undefined (Module "Data.Map") True (Just (Module "M")) Nothing
+ , HsImportDecl undefined (Module "Data.Map") False Nothing (Just (False, [HsIAbs (HsIdent "Map")]))
+ ]
+ decls = [ HsTypeSig undefined [HsIdent "defaultExtensionMap"]
+ (HsQualType [] (HsTyApp (HsTyApp (HsTyCon (UnQual (HsIdent "Map")))
+ (HsTyCon (UnQual (HsIdent "String"))))
+ (HsTyCon (UnQual (HsIdent "MIMEType")))))
+ , HsFunBind [HsMatch undefined (HsIdent "defaultExtensionMap")
+ [] (HsUnGuardedRhs extMapExp) []]
+ ]
+ extMapExp = HsApp (HsVar (Qual (Module "M") (HsIdent "fromList"))) (HsList records)
+ comment = "{- !!! WARNING !!!\n"
+ ++ " This file is automatically generated from data/mime.types.\n"
+ ++ " DO NOT EDIT BY HAND OR YOU WILL REGRET -}\n\n"
+ in
+ writeFile fpath $ comment ++ prettyPrint hsModule ++ "\n"
+ where
+ records :: [HsExp]
+ records = map record $ M.assocs extMap
+
+ record :: (String, MIMEType) -> HsExp
+ record (ext, mime)
+ = HsTuple [HsLit (HsString ext), mimeToExp mime]
+
+ mimeToExp :: MIMEType -> HsExp
+ mimeToExp (MIMEType maj min params)
+ = foldl appendParam (HsInfixApp
+ (HsLit (HsString maj))
+ (HsQVarOp (UnQual (HsSymbol "+/+")))
+ (HsLit (HsString min))) params
+
+ appendParam :: HsExp -> (String, String) -> HsExp
+ appendParam x param
+ = HsInfixApp x (HsQVarOp (UnQual (HsSymbol "+:+"))) $ paramToExp param
+
+ paramToExp :: (String, String) -> HsExp
+ paramToExp (name, value)
+ = HsInfixApp
+ (HsLit (HsString name))
+ (HsQVarOp (UnQual (HsSymbol "+=+")))
+ (HsLit (HsString value))
\ No newline at end of file
( isCtl -- Char -> Bool
, isSeparator -- Char -> Bool
, isChar -- Char -> Bool
+ , isToken -- Char -> Bool
+ , listOf -- Parser a -> Parser [a]
, token -- Parser String
, lws -- Parser String
, text -- Parser Char
| otherwise = False
+isToken :: Char -> Bool
+isToken c = not (isCtl c || isSeparator c)
+
+
+listOf :: Parser a -> Parser [a]
+listOf p = do many lws
+ sepBy p (do many lws
+ char ','
+ many lws)
+
+
token :: Parser String
-token = many1 $ satisfy (\ c -> not (isCtl c || isSeparator c))
+token = many1 $ satisfy isToken
lws :: Parser String
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
import Network.HTTP.Lucu.Resource
+import Network.HTTP.Lucu.Resource.Tree
import Prelude hiding (catch)
import System.IO
-import GHC.Conc (unsafeIOToSTM)
requestReader :: Config -> ResTree -> Handle -> HostName -> InteractionQueue -> IO ()
requestReader cnf tree h host tQueue
module Network.HTTP.Lucu.Resource
- ( ResourceDef(..)
- , Resource
- , ResTree
- , mkResTree -- [ ([String], ResourceDef) ] -> ResTree
- , findResource -- ResTree -> URI -> Maybe ResourceDef
- , runResource -- ResourceDef -> Interaction -> IO ThreadId
+ ( Resource
, getMethod -- Resource Method
, getHeader -- String -> Resource (Maybe String)
+ , getAccept -- Resource [MIMEType]
+ , getContentType -- Resource (Maybe MIMEType)
- , foundEntity -- Bool -> String -> ClockTime -> Resource ()
- , foundETag -- Bool -> String -> Resource ()
+ , foundEntity -- ETag -> ClockTime -> Resource ()
+ , foundETag -- ETag -> Resource ()
, foundTimeStamp -- ClockTime -> Resource ()
, foundNoEntity -- Maybe String -> Resource ()
, setStatus -- StatusCode -> Resource ()
, setHeader -- String -> String -> Resource ()
, redirect -- StatusCode -> URI -> Resource ()
- , setETag -- Bool -> String -> Resource ()
+ , setETag -- ETag -> Resource ()
, setLastModified -- ClockTime -> Resource ()
+ , setContentType -- MIMEType -> Resource ()
, output -- String -> Resource ()
, outputChunk -- String -> Resource ()
, outputBS -- ByteString -> Resource ()
, outputChunkBS -- ByteString -> Resource ()
+
+ , driftTo -- InteractionState -> Resource ()
)
where
-import Control.Concurrent
import Control.Concurrent.STM
-import Control.Exception
import Control.Monad.Reader
import qualified Data.ByteString.Lazy.Char8 as B
import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.Dynamic
import Data.List
-import qualified Data.Map as M
-import Data.Map (Map)
import Data.Maybe
import GHC.Conc (unsafeIOToSTM)
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.RFC1123DateTime
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.MIMEType
import Network.HTTP.Lucu.Utils
import Network.URI
-import Prelude hiding (catch)
-import System.IO
-import System.IO.Error hiding (catch)
import System.Time
type Resource a = ReaderT Interaction IO a
-{- /aaa/bbb/ccc にアクセスされた時、もし /aaa/bbb に貪欲なリソースがあ
- れば、假に /aaa/bbb/ccc に何らかのリソースがあったとしても必ず
- /aaa/bbb が撰ばれる。/aaa/bbb のリソースが貪欲でなければ、それは無視
- される。 -}
-data ResourceDef = ResourceDef {
- resUsesNativeThread :: Bool
- , resIsGreedy :: Bool
- , resGet :: Maybe (Resource ())
- , resHead :: Maybe (Resource ())
- , resPost :: Maybe (Resource ())
- , resPut :: Maybe (Resource ())
- , resDelete :: Maybe (Resource ())
- }
-type ResTree = ResNode -- root だから Map ではない
-type ResSubtree = Map String ResNode
-data ResNode = ResNode (Maybe ResourceDef) ResSubtree
-
-
-mkResTree :: [ ([String], ResourceDef) ] -> ResTree
-mkResTree list = processRoot list
- where
- processRoot :: [ ([String], ResourceDef) ] -> ResTree
- processRoot list
- = let (roots, nonRoots) = partition (\ (path, _) -> path == []) list
- children = processNonRoot nonRoots
- in
- if null roots then
- -- / にリソースが定義されない。/foo とかにはあるかも。
- ResNode Nothing children
- else
- -- / がある。
- let (_, def) = last roots
- in
- ResNode (Just def) children
-
- processNonRoot :: [ ([String], ResourceDef) ] -> ResSubtree
- processNonRoot list
- = let subtree = M.fromList [(name, node name)
- | name <- childNames]
- childNames = [name | (name:_, _) <- list]
- node name = let defs = [def | (path, def) <- list, path == [name]]
- in
- if null defs then
- -- この位置にリソースが定義されない。
- -- もっと下にはあるかも。
- ResNode Nothing children
- else
- -- この位置にリソースがある。
- ResNode (Just $ last defs) children
- children = processNonRoot [(path, def)
- | (_:path, def) <- list, not (null path)]
- in
- subtree
-
-
-findResource :: ResTree -> URI -> Maybe ResourceDef
-findResource (ResNode rootDefM subtree) uri
- = let pathStr = uriPath uri
- path = [x | x <- splitBy (== '/') pathStr, x /= ""]
- in
- if null path then
- rootDefM
- else
- walkTree subtree path
- where
- walkTree :: ResSubtree -> [String] -> Maybe ResourceDef
-
- walkTree subtree (name:[])
- = case M.lookup name subtree of
- Nothing -> Nothing
- Just (ResNode defM _) -> defM
-
- walkTree subtree (x:xs)
- = case M.lookup x subtree of
- Nothing -> Nothing
- Just (ResNode defM children) -> case defM of
- Just (ResourceDef { resIsGreedy = True })
- -> defM
- _ -> walkTree children xs
-
-
-runResource :: ResourceDef -> Interaction -> IO ThreadId
-runResource def itr
- = fork
- $ catch ( runReaderT ( do fromMaybe notAllowed rsrc
- driftTo Done
- ) itr
- )
- $ \ exc -> processException (itrConfig itr) exc
- where
- fork :: IO () -> IO ThreadId
- fork = if (resUsesNativeThread def)
- then forkOS
- else forkIO
-
- rsrc :: Maybe (Resource ())
- rsrc = case reqMethod $ fromJust $ itrRequest itr of
- GET -> resGet def
- HEAD -> case resHead def of
- Just r -> Just r
- Nothing -> resGet def
- POST -> resPost def
- PUT -> resPut def
- DELETE -> resDelete def
-
- notAllowed :: Resource ()
- notAllowed = do setStatus MethodNotAllowed
- setHeader "Allow" $ joinWith ", " allowedMethods
-
- allowedMethods :: [String]
- allowedMethods = nub $ foldr (++) [] [ methods resGet ["GET"]
- , methods resHead ["GET", "HEAD"]
- , methods resPost ["POST"]
- , methods resPut ["PUT"]
- , methods resDelete ["DELETE"]
- ]
-
- methods :: (ResourceDef -> Maybe a) -> [String] -> [String]
- methods f xs = case f def of
- Just _ -> xs
- Nothing -> []
-
- processException :: Config -> Exception -> IO ()
- processException conf exc
- = do let abo = case exc of
- ErrorCall msg -> Abortion InternalServerError [] msg
- IOException ioE -> Abortion InternalServerError [] $ formatIOE ioE
- DynException dynE -> case fromDynamic dynE of
- Just (abo :: Abortion) -> abo
- Nothing
- -> Abortion InternalServerError []
- $ show exc
- _ -> Abortion InternalServerError [] $ show exc
- -- まだ DecidingHeader 以前の状態だったら、この途中終了
- -- を應答に反映させる餘地がある。さうでなければ stderr
- -- にでも吐くしか無い。
- state <- atomically $ readItr itr itrState id
- if state <= DecidingHeader then
- flip runReaderT itr
- $ do setStatus $ aboStatus abo
- -- FIXME: 同じ名前で複數の値があった時は、こ
- -- れではまずいと思ふ。
- mapM_ (\ (name, value) -> setHeader name value) $ aboHeaders abo
- setHeader "Content-Type" "application/xhtml+xml"
- output $ aboPage conf abo
- else
- hPutStrLn stderr $ show abo
-
- flip runReaderT itr $ driftTo Done
-
- formatIOE :: IOError -> String
- formatIOE ioE = if isUserError ioE then
- ioeGetErrorString ioE
- else
- show ioE
-
-
getMethod :: Resource Method
getMethod = do itr <- ask
return $ reqMethod $ fromJust $ itrRequest itr
return $ H.getHeader name $ fromJust $ itrRequest itr
+getAccept :: Resource [MIMEType]
+getAccept = do accept <- getHeader "Accept"
+ if accept == Nothing then
+ return []
+ else
+ case parseStr mimeTypeListP $ fromJust accept of
+ (Success xs, _) -> return xs
+ _ -> return []
+
+
+getContentType :: Resource (Maybe MIMEType)
+getContentType = do cType <- getHeader "Content-Type"
+ if cType == Nothing then
+ return Nothing
+ else
+ case parseStr mimeTypeP $ fromJust cType of
+ (Success t, _) -> return $ Just t
+ _ -> return Nothing
+
+
+
{- ExaminingRequest 時に使用するアクション群 -}
-foundEntity :: Bool -> String -> ClockTime -> Resource ()
-foundEntity isWeak token timeStamp
+foundEntity :: ETag -> ClockTime -> Resource ()
+foundEntity tag timeStamp
= do driftTo ExaminingRequest
method <- getMethod
when (method == GET || method == HEAD)
$ setHeader' "Last-Modified" $ formatHTTPDateTime timeStamp
- foundETag isWeak token
+ foundETag tag
driftTo GettingBody
-foundETag :: Bool -> String -> Resource ()
-foundETag isWeak token
+foundETag :: ETag -> Resource ()
+foundETag tag
= do driftTo ExaminingRequest
-
- let tag = mkETag isWeak token
method <- getMethod
when (method == GET || method == HEAD)
setHeader "Location" (uriToString id uri $ "")
-setETag :: Bool -> String -> Resource ()
-setETag isWeak token
- = setHeader "ETag" $ show $ mkETag isWeak token
+setETag :: ETag -> Resource ()
+setETag tag
+ = setHeader "ETag" $ show tag
setLastModified :: ClockTime -> Resource ()
= setHeader "Last-Modified" $ formatHTTPDateTime lastmod
+setContentType :: MIMEType -> Resource ()
+setContentType mType
+ = setHeader "Content-Type" $ show mType
+
+
{- DecidingBody 時に使用するアクション群 -}
output :: String -> Resource ()
--- /dev/null
+module Network.HTTP.Lucu.Resource.Tree
+ ( ResourceDef(..)
+ , Resource
+ , ResTree
+ , mkResTree -- [ ([String], ResourceDef) ] -> ResTree
+
+ , findResource -- ResTree -> URI -> Maybe ResourceDef
+ , runResource -- ResourceDef -> Interaction -> IO ThreadId
+ )
+ where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad.Reader
+import Data.Dynamic
+import Data.List
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.Maybe
+import Network.HTTP.Lucu.Abortion
+import Network.HTTP.Lucu.Config
+import Network.HTTP.Lucu.Request
+import Network.HTTP.Lucu.Resource
+import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Interaction
+import Network.HTTP.Lucu.Utils
+import Network.URI
+import System.IO
+import System.IO.Error hiding (catch)
+import Prelude hiding (catch)
+
+
+{- /aaa/bbb/ccc にアクセスされた時、もし /aaa/bbb に貪欲なリソースがあ
+ れば、假に /aaa/bbb/ccc に何らかのリソースがあったとしても必ず
+ /aaa/bbb が撰ばれる。/aaa/bbb のリソースが貪欲でなければ、それは無視
+ される。 -}
+data ResourceDef = ResourceDef {
+ resUsesNativeThread :: Bool
+ , resIsGreedy :: Bool
+ , resGet :: Maybe (Resource ())
+ , resHead :: Maybe (Resource ())
+ , resPost :: Maybe (Resource ())
+ , resPut :: Maybe (Resource ())
+ , resDelete :: Maybe (Resource ())
+ }
+type ResTree = ResNode -- root だから Map ではない
+type ResSubtree = Map String ResNode
+data ResNode = ResNode (Maybe ResourceDef) ResSubtree
+
+
+mkResTree :: [ ([String], ResourceDef) ] -> ResTree
+mkResTree list = processRoot list
+ where
+ processRoot :: [ ([String], ResourceDef) ] -> ResTree
+ processRoot list
+ = let (roots, nonRoots) = partition (\ (path, _) -> path == []) list
+ children = processNonRoot nonRoots
+ in
+ if null roots then
+ -- / にリソースが定義されない。/foo とかにはあるかも。
+ ResNode Nothing children
+ else
+ -- / がある。
+ let (_, def) = last roots
+ in
+ ResNode (Just def) children
+
+ processNonRoot :: [ ([String], ResourceDef) ] -> ResSubtree
+ processNonRoot list
+ = let subtree = M.fromList [(name, node name)
+ | name <- childNames]
+ childNames = [name | (name:_, _) <- list]
+ node name = let defs = [def | (path, def) <- list, path == [name]]
+ in
+ if null defs then
+ -- この位置にリソースが定義されない。
+ -- もっと下にはあるかも。
+ ResNode Nothing children
+ else
+ -- この位置にリソースがある。
+ ResNode (Just $ last defs) children
+ children = processNonRoot [(path, def)
+ | (_:path, def) <- list, not (null path)]
+ in
+ subtree
+
+
+findResource :: ResTree -> URI -> Maybe ResourceDef
+findResource (ResNode rootDefM subtree) uri
+ = let pathStr = uriPath uri
+ path = [x | x <- splitBy (== '/') pathStr, x /= ""]
+ in
+ if null path then
+ rootDefM
+ else
+ walkTree subtree path
+ where
+ walkTree :: ResSubtree -> [String] -> Maybe ResourceDef
+
+ walkTree subtree (name:[])
+ = case M.lookup name subtree of
+ Nothing -> Nothing
+ Just (ResNode defM _) -> defM
+
+ walkTree subtree (x:xs)
+ = case M.lookup x subtree of
+ Nothing -> Nothing
+ Just (ResNode defM children) -> case defM of
+ Just (ResourceDef { resIsGreedy = True })
+ -> defM
+ _ -> walkTree children xs
+
+
+runResource :: ResourceDef -> Interaction -> IO ThreadId
+runResource def itr
+ = fork
+ $ catch ( runReaderT ( do fromMaybe notAllowed rsrc
+ driftTo Done
+ ) itr
+ )
+ $ \ exc -> processException (itrConfig itr) exc
+ where
+ fork :: IO () -> IO ThreadId
+ fork = if (resUsesNativeThread def)
+ then forkOS
+ else forkIO
+
+ rsrc :: Maybe (Resource ())
+ rsrc = case reqMethod $ fromJust $ itrRequest itr of
+ GET -> resGet def
+ HEAD -> case resHead def of
+ Just r -> Just r
+ Nothing -> resGet def
+ POST -> resPost def
+ PUT -> resPut def
+ DELETE -> resDelete def
+
+ notAllowed :: Resource ()
+ notAllowed = do setStatus MethodNotAllowed
+ setHeader "Allow" $ joinWith ", " allowedMethods
+
+ allowedMethods :: [String]
+ allowedMethods = nub $ foldr (++) [] [ methods resGet ["GET"]
+ , methods resHead ["GET", "HEAD"]
+ , methods resPost ["POST"]
+ , methods resPut ["PUT"]
+ , methods resDelete ["DELETE"]
+ ]
+
+ methods :: (ResourceDef -> Maybe a) -> [String] -> [String]
+ methods f xs = case f def of
+ Just _ -> xs
+ Nothing -> []
+
+ processException :: Config -> Exception -> IO ()
+ processException conf exc
+ = do let abo = case exc of
+ ErrorCall msg -> Abortion InternalServerError [] msg
+ IOException ioE -> Abortion InternalServerError [] $ formatIOE ioE
+ DynException dynE -> case fromDynamic dynE of
+ Just (abo :: Abortion) -> abo
+ Nothing
+ -> Abortion InternalServerError []
+ $ show exc
+ _ -> Abortion InternalServerError [] $ show exc
+ -- まだ DecidingHeader 以前の状態だったら、この途中終了
+ -- を應答に反映させる餘地がある。さうでなければ stderr
+ -- にでも吐くしか無い。
+ state <- atomically $ readItr itr itrState id
+ if state <= DecidingHeader then
+ flip runReaderT itr
+ $ do setStatus $ aboStatus abo
+ -- FIXME: 同じ名前で複數の値があった時は、こ
+ -- れではまずいと思ふ。
+ mapM_ (\ (name, value) -> setHeader name value) $ aboHeaders abo
+ setHeader "Content-Type" "application/xhtml+xml"
+ output $ aboPage conf abo
+ else
+ hPutStrLn stderr $ show abo
+
+ flip runReaderT itr $ driftTo Done
+
+ formatIOE :: IOError -> String
+ formatIOE ioE = if isUserError ioE then
+ ioeGetErrorString ioE
+ else
+ show ioE
--- /dev/null
+module Network.HTTP.Lucu.StaticFile
+ (
+ )
+ where
+
+
+staticFile :: FilePath -> ResourceDef
+staticFile path
+ = ResourceDef {
+ resUsesNativeThread = False
+ , resIsGreedy = False
+ , resGet
+ = Just $ do
\ No newline at end of file
, trim -- (a -> Bool) -> [a] -> [a]
, noCaseEq -- String -> String -> Bool
, isWhiteSpace -- Char -> Bool
+ , quoteStr -- String -> String
)
where
isWhiteSpace :: Char -> Bool
isWhiteSpace = flip elem " \t\r\n"
+
+
+quoteStr :: String -> String
+quoteStr str = foldr (++) "" (["\""] ++ map quote str ++ ["\""])
+ where
+ quote :: Char -> String
+ quote '"' = "\\\""
+ quote c = [c]
\ No newline at end of file
--- /dev/null
+#!/usr/bin/env runghc
+
+import Network.HTTP.Lucu.MIMEType.Guess
+
+main = do extMap <- parseExtMapFile "/dev/stdin"
+ outputExtMapAsHS extMap "/dev/stdout"
--- /dev/null
+# MIME type Extensions
+application/andrew-inset ez
+application/atom+xml atom
+application/mac-binhex40 hqx
+application/mac-compactpro cpt
+application/mathml+xml mathml
+application/msword doc
+application/octet-stream bin dms lha lzh exe class so dll dmg hi o
+application/oda oda
+application/ogg anx ogg ogm
+application/pdf pdf
+application/postscript ai eps ps
+application/rdf+xml rdf
+application/smil smi smil
+application/srgs gram
+application/srgs+xml grxml
+application/vnd.mif mif
+application/vnd.mozilla.xul+xml xul
+application/vnd.ms-excel xls
+application/vnd.ms-powerpoint ppt
+application/vnd.rn-realmedia rm
+application/vnd.wap.wbxml wbxml
+application/vnd.wap.wmlc wmlc
+application/vnd.wap.wmlscriptc wmlsc
+application/voicexml+xml vxml
+application/x-3gp 3gp
+application/x-ape ape
+application/x-ar a
+application/x-bcpio bcpio
+application/x-bzip bz2 tbz
+application/x-cdlink vcd
+application/x-chess-pgn pgn
+application/x-compress Z
+application/x-cpio cpio
+application/x-csh csh
+application/x-director dcr dir dxr
+application/x-dvi dvi
+application/x-futuresplash spl
+application/x-gtar gtar
+application/x-gzip gz tgz
+application/x-hdf hdf
+application/x-javascript js
+application/x-java-jnlp-file jnlp
+application/x-koan skp skd skt skm
+application/x-latex latex
+application/x-nar nar
+application/x-netcdf nc cdf
+application/x-rar rar
+application/x-sh sh
+application/x-shar shar
+application/x-shockwave-flash swf swfl
+application/x-spc spc
+application/x-stuffit sit
+application/x-sv4cpio sv4cpio
+application/x-sv4crc sv4crc
+application/x-tar tar
+application/x-tcl tcl
+application/x-tex tex
+application/x-texinfo texinfo texi
+application/x-troff t tr roff
+application/x-troff-man man
+application/x-troff-me me
+application/x-troff-ms ms
+application/x-ustar ustar
+application/x-wavpack wv wvp
+application/x-wavpack-correction wvc
+application/x-wais-source src
+application/xhtml+xml xhtml xht
+application/xslt+xml xslt
+application/xml xml xsl
+application/xml-dtd dtd
+application/zip zip
+audio/basic au snd
+audio/iLBC-sh ilbc
+audio/midi mid midi kar
+audio/mp4a-latm m4a m4p
+audio/mpeg mpga mp2 mp3
+audio/x-ac3 ac3
+audio/x-aiff aif aiff aifc
+audio/x-au au snd
+audio/x-ircam sf
+audio/x-flac flac
+audio/x-mod 669 amf dsm gdm far imf it med mod mtm okt sam s3m stm stx ult xm
+audio/x-mpegurl m3u
+audio/x-musepack mpc
+audio/x-nist nist
+audio/x-paris paf
+audio/x-pn-realaudio ram ra
+audio/x-sds sds
+audio/x-shorten shn
+audio/x-sid sid
+audio/x-svx iff svx
+audio/x-ttafile tta
+audio/x-voc voc
+audio/x-w64 w64
+audio/x-wav wav
+chemical/x-pdb pdb
+chemical/x-xyz xyz
+image/bmp bmp
+image/cgm cgm
+image/gif gif
+image/ief ief
+image/jpeg jpeg jpg jpe
+image/jp2 jp2
+image/pict pict pic pct
+image/png png
+image/svg+xml svg
+image/tiff tiff tif
+image/vnd.djvu djvu djv
+image/vnd.wap.wbmp wbmp
+image/x-sun-raster ras
+image/x-macpaint pntg pnt mac
+image/x-icon ico
+image/x-jng jng
+image/x-portable-anymap pnm
+image/x-portable-bitmap pbm
+image/x-portable-graymap pgm
+image/x-portable-pixmap ppm
+image/x-quicktime qtif qti qif
+image/x-rgb rgb
+image/x-xbitmap xbm
+image/x-xcf xcf
+image/x-xpixmap xpm
+image/x-xwindowdump xwd
+model/iges igs iges
+model/mesh msh mesh silo
+model/vrml wrl vrml
+text/calendar ics ifb
+text/css css
+text/html html htm
+text/plain asc txt
+text/richtext rtx
+text/rtf rtf
+text/sgml sgml sgm
+text/tab-separated-values tsv
+text/uri-list ram
+text/vnd.wap.wml wml
+text/vnd.wap.wmlscript wmls
+text/x-cabal cabal
+text/x-haskell hs
+text/x-setext etx
+video/mp4 mp4
+video/mpeg mpeg mpg mpe
+video/mpeg4 m4v
+video/mpegts ts
+video/quicktime qt mov
+video/vnd.mpegurl mxu m4u
+video/x-dv dv dif
+video/x-fli flc fli
+video/x-flv flv
+video/x-matroska mkv mka
+video/x-ms-asf asf wm wma wmv
+video/x-msvideo avi
+video/x-mng mng
+video/x-mve mve
+video/x-nuv nuv
+video/x-sgi-movie movie
+x-conference/x-cooltalk ice
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.Httpd
+import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.MIMEType.Guess
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Resource
+import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.Response
import Network.URI
import System.Posix.Signals
, resIsGreedy = False
, resGet
= Just $ do time <- liftIO $ getClockTime
- foundEntity False "abcde" time
- setHeader "Content-Type" "text/plain"
+ foundEntity (strongETag "abcde") time
+ setContentType $ "text" +/+ "hello"
outputChunk "Hello, "
outputChunk "World!\n"
, resHead = Nothing
= Just $ do str1 <- inputChunk 3
str2 <- inputChunk 3
str3 <- inputChunk 3
- setHeader "Content-Type" "text/plain"
+ setContentType $ "text" +/+ "hello"
output ("[" ++ str1 ++ " - " ++ str2 ++ "#" ++ str3 ++ "]")
, resPut = Nothing
, resDelete = Nothing
projects / Lucu.git / commitdiff