Basic `listenOn` HTTP-Server" Recv Fehler: Verbindung zurückgesetzt durch Peer "

Question

Während Tauchen in Haskell Network Bibliothek, mache ich einen sehr einfachen HTTP-Server basierend auf Informationen aus this link.

import Control.Concurrent 
import Control.Monad 
import Network 
import System.IO 

main = withSocketsDo $ listenOn (PortNumber 8080) >>= loop 

loop :: Socket -> IO() 
loop sock = do 
    (h,_,_) <- accept sock 
    forkIO $ handleRequest h 
    loop sock 

handleRequest :: Handle -> IO() 
handleRequest h = do 
    hPutStr h $ httpRequest "Pong!\n" 
    hFlush h 
    hClose h 

httpRequest :: String -> String 
httpRequest body = "HTTP/1.0 200 OK\r\n" 
    ++ "Content-Length: " ++ (show.length) body ++ "\r\n" 
    ++ "\r\n" ++ body ++ "\r\n" 

Doch obwohl ich es schaffe eine Antwort zu erhalten, scheint die Griffe unerwartet bald geschlossen werden, wie Locke sagt mir (manchmal?):

$ curl localhost:8080 
Pong! 
curl: (56) Recv failure: Connection reset by peer 

NB: Manchmal weiß ich nicht erhalten Sie sogar die Nachricht (Pong!) oder nur einen Teil davon. Manchmal funktioniert es ... aber wenn ich 100 curl s in einer Reihe laufen lasse, bekomme ich schließlich einige Verbindung zurücksetzt.

Warum wird die Verbindung zurückgesetzt? Ich habe mit und ohne forkIO ohne Erfolg versucht. Habe ich etwas Wesentliches über IO-Streams in Haskell verpasst? Vielen Dank!

OS: aktuelle Ubuntu; GHC: 7.8.4

--- Edit: ---

jozefg identifiziert, dass das Problem kam die Anfrage des Inhalts von der Entwässerung! Allerdings würde ich gerne diesen Inhalt senden zurück an den Client und es hängt, während mit dem folgenden Code:

handleRequest :: Handle -> IO() 
handleRequest h = do 
    contents <- getHandleContents h 
    hPutStr h $ httpRequest contents 
    hFlush h 
    hClose h 

getHandleContents :: Handle -> IO String 
getHandleContents h = do 
    iseof <- hIsEOF h 
    if iseof 
    then return [] 
    else do 
     newLine <- hGetLine h 
     nextLines <- getHandleContents h 
     return $ newLine ++ '\n' : nextLines 

Außerdem hatte ich keinen Erfolg, den gesamten Inhalt mit hGetContents abzulassen. Irgendeine Idee warum?

Answer 1

Der Fehler scheint zu sein, dass Sie die Daten nicht vollständig lesen, die der Client sendet, wenn er eine Get-Anfrage absetzt, wie in dieser answer for Rust beschrieben. Die hier vorgeschlagene Lösung besteht im Wesentlichen darin, eine kleine Schleife zu schreiben, die den Header vom Handle löscht, bevor Sie antworten. Die Haskell-Version ist

drainHeaders :: Handle -> IO() 
drainHeaders h = do 
    line <- hGetLine h 
    if line == "\r" then return() else drainHeaders h 

so dann Ihr Code geschrieben werden kann

import Control.Concurrent 
import Control.Exception (bracket) 
import Control.Monad 
import Network 
import System.IO 

main = withSocketsDo $ 
    bracket (listenOn (PortNumber 8080)) sClose loop 

loop :: Socket -> IO() 
loop sock = do 
    (handle, _host, _port) <- accept sock 
    -- Handle is automatically closed now even in the face of async exns 
    forkFinally (handleRequest handle) (const $ hClose handle) 
    loop sock 

drainHeaders :: Handle -> IO() 
drainHeaders h = do 
    line <- hGetLine h -- Strips off a trailing \n 
    if line == "\r" then return() else drainHeaders h 

handleRequest :: Handle -> IO() 
handleRequest h = do 
    drainHeaders h 
    hPutStr h $ httpRequest "Pong!\n" 
    hFlush h 

httpRequest :: String -> String 
httpRequest body = 
    mconcat [ "HTTP/1.0 200 OK\r\nContent-Length: " 
      , (show . length) body 
      , "\r\n\r\n" 
      , body 
      , "\r\n" ] 

ich auch die Freiheit nahm, den Code von Tweaking es ein bisschen mehr Ausnahme sicher zu machen, indem forkFinally und bracket mit Schließung zu handhaben Dinge angesichts von Ausnahmen: Ich bezweifle, dass es 100% perfekt ist, aber es ist jetzt ein bisschen sauberer.