module Network.WebSockets.Server
( ServerApp
, runServer
, runServerWith
) where
import Control.Concurrent (forkIO)
import Control.Exception (finally)
import Control.Monad (forever)
import Network.Socket (Socket)
import qualified Network.Socket as S
import qualified System.IO.Streams.Attoparsec as Streams
import qualified System.IO.Streams.Builder as Streams
import qualified System.IO.Streams.Network as Streams
import Network.WebSockets.Connection
import Network.WebSockets.Http
type ServerApp = PendingConnection -> IO ()
runServer :: String
-> Int
-> ServerApp
-> IO ()
runServer host port app = runServerWith host port defaultConnectionOptions app
runServerWith :: String -> Int -> ConnectionOptions -> ServerApp -> IO ()
runServerWith host port opts app = S.withSocketsDo $ do
sock <- S.socket S.AF_INET S.Stream S.defaultProtocol
_ <- S.setSocketOption sock S.ReuseAddr 1
host' <- S.inet_addr host
S.bindSocket sock (S.SockAddrInet (fromIntegral port) host')
S.listen sock 5
_ <- forever $ do
(conn, _) <- S.accept sock
_ <- forkIO $ finally (runApp conn opts app) (S.sClose conn)
return ()
S.sClose sock
runApp :: Socket
-> ConnectionOptions
-> ServerApp
-> IO ()
runApp socket opts app = do
(sIn, sOut) <- Streams.socketToStreams socket
bOut <- Streams.builderStream sOut
request <- Streams.parseFromStream (decodeRequestHead False) sIn
let pc = PendingConnection
{ pendingOptions = opts
, pendingRequest = request
, pendingOnAccept = \_ -> return ()
, pendingIn = sIn
, pendingOut = bOut
}
app pc