tighttp 0.0.0.2 → 0.0.0.3

raw patch · 5 files changed

+24/−7 lines, 5 files

Files

src/Network/TigHTTP/Client.hs +4/−3
src/Network/TigHTTP/HttpTypes.hs +5/−1
src/Network/TigHTTP/Papillon.hs +3/−0
src/Network/TigHTTP/Server.hs +11/−2
tighttp.cabal +1/−1

src/Network/TigHTTP/Client.hs view

@@ -25,11 +25,12 @@ 	h -> Request h -> HandleMonad h (Response p h) request = httpGet httpGet sv req = do+	hlDebug sv "medium" "begin httpGet\n" 	putRequest sv req+	hlDebug sv "medium" "httpGet: after putRequest\n" 	src <- hGetHeader sv 	let res = parseResponse src---	mapM_ (hlDebug sv "critical" . (`BS.append` "\n") . BS.take 100)---		. catMaybes =<< showResponse sv res+	hlDebug sv "medium" "httpGet: after hGetHeader\n" 	let res' = putResponseBody sv res 		(httpContent (contentLength <$> responseContentLength res) sv) 	return res'@@ -119,5 +120,5 @@ hGetHeader :: HandleLike h => h -> HandleMonad h [BS.ByteString] hGetHeader h = do 	l <- hlGetLine h-	hlDebug h "medium" $ l `BS.append` "\n"+	hlDebug h "medium" $ l 	if BS.null l then return [] else (l :) `liftM` hGetHeader h

src/Network/TigHTTP/HttpTypes.hs view

@@ -112,6 +112,7 @@ 		("Content-Length: " +++) .  showContentLength <$> postContentLength p 		] ++ map (\(k, v) -> Just $ k +++ ": " +++ v) (postOthers p) ++ [  			Just "" ]+	hlDebug sv "medium" . crlf $ catMaybes hd 	hlPut sv . crlf $ catMaybes hd 	_ <- runPipe $ postBody p =$= putAll sv 	return ()@@ -188,7 +189,10 @@  parseRequestLine :: BS.ByteString -> (RequestType, Path, Version) parseRequestLine rl = let-	[rts, uris, vs] = BSC.words rl+	(rts, uris, vs) = case BSC.words rl of+		[r, u, v] -> (r, u, v)+		_ -> error $ "Network.TigHTTP.HttpTypes.parseRequestLine: " +++			show rl 	rt = case rts of 		"GET" -> RequestTypeGet 		"POST" -> RequestTypePost

src/Network/TigHTTP/Papillon.hs view

@@ -44,17 +44,20 @@ data Subtype 	= Plain 	| Html+	| Css 	| SubtypeRaw BS.ByteString 	deriving Show  mkSubtype :: BS.ByteString -> Subtype mkSubtype "html" = Html mkSubtype "plain" = Plain+mkSubtype "css" = Css mkSubtype s = SubtypeRaw s  showSubtype :: Subtype -> BS.ByteString showSubtype Plain = "plain" showSubtype Html = "html"+showSubtype Css = "css" showSubtype (SubtypeRaw s) = s  data Parameter

src/Network/TigHTTP/Server.hs view

@@ -26,7 +26,10 @@  getRequest :: HandleLike h => h -> HandleMonad h (Request h) getRequest cl = do+	hlDebug cl "medium" "begin getRequest\n" 	h <- hlGetHeader' cl+	hlDebug cl "medium" $ "hlGetHeader' cl: " `BS.append`+		BSC.pack (show h ++ "\n") 	let req = parseReq h 	r <- case req of 		RequestPost {} -> return . httpContent cl $@@ -48,15 +51,20 @@  getChunked :: HandleLike h => h -> Pipe () BS.ByteString (HandleMonad h) () getChunked h = do-	(n :: Int) <- lift $ (fst . head . readHex . BSC.unpack) `liftM` hlGetLine h+	(n :: Int) <- lift $ (fst . head . readHex . BSC.unpack) `liftM` hlGetLineNotNull h 	lift . hlDebug h "low" . BSC.pack . (++ "\n") $ show n 	case n of 		0 -> return () 		_ -> do	r <- lift $ hlGet h n-			"" <- lift $ hlGetLine h+--			"" <- lift $ hlGetLine h 			yield r 			getChunked h +hlGetLineNotNull :: HandleLike h => h -> HandleMonad h BS.ByteString+hlGetLineNotNull h = do+	ln <- hlGetLine h+	if BS.null ln then hlGetLineNotNull h else return ln+ mkChunked :: [BS.ByteString] -> LBS.ByteString mkChunked = flip foldr ("0\r\n\r\n") $ \b -> 	LBS.append (LBSC.pack (showHex (BS.length b) "") `LBS.append` "\r\n"@@ -85,6 +93,7 @@ hlGetHeader' :: HandleLike h => h -> HandleMonad h [BS.ByteString] hlGetHeader' h = do 	l <- hlGetLine h+	hlDebug h "medium" . BSC.pack $ show l 	if BS.null l then hlGetHeader' h else (l :) `liftM` hlGetHeader h  hlGetHeader :: HandleLike h => h -> HandleMonad h [BS.ByteString]

tighttp.cabal view

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		tighttp-version:	0.0.0.2+version:	0.0.0.3 stability:	Experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>