diff options
Diffstat (limited to 'src/server/RunHTTP.hs')
| -rw-r--r-- | src/server/RunHTTP.hs | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/src/server/RunHTTP.hs b/src/server/RunHTTP.hs new file mode 100644 index 000000000..cf536d054 --- /dev/null +++ b/src/server/RunHTTP.hs @@ -0,0 +1,41 @@ +module RunHTTP(runHTTP) where +import Network.URI(uriPath,uriQuery) +import Network.CGI(ContentType(..)) +import Network.CGI.Protocol(CGIResult(..),CGIRequest(..),Input(..), + Headers,HeaderName(..)) +import Network.CGI.Monad(runCGIT) +import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments) +import qualified Data.ByteString.Lazy.Char8 as BS(pack,unpack) +import qualified Data.Map as M(fromList) + +documentRoot = "www" + +runHTTP port = initServer port . cgiHandler + +cgiHandler h = fmap httpResp . runCGIT h . cgiReq + +httpResp :: (Headers,CGIResult) -> Response +httpResp (hdrs,r) = Response code (map name hdrs) (body r) + where + code = maybe 200 (read.head.words) (lookup (HeaderName "Status") hdrs) + body CGINothing = "" + body (CGIOutput s) = BS.unpack s + + name (HeaderName n,v) = (n,v) + +cgiReq :: Request -> CGIRequest +cgiReq (Request method uri hdrs body) = CGIRequest vars inputs body' + where + vars = M.fromList [("REQUEST_METHOD",method), + ("REQUEST_URI",show uri), + ("SCRIPT_FILENAME",documentRoot++uriPath uri), + ("QUERY_STRING",qs)] + qs = case uriQuery uri of + '?':s -> s + s -> s + inputs = map input $ queryToArguments qs -- assumes method=="GET" + body' = BS.pack body + + input (name,val) = (name,Input (BS.pack val) Nothing plaintext) + plaintext = ContentType "plain" "text" [] +
\ No newline at end of file |