Note that forkIO spawns a green thread, not an O/S thread, so if you spawn 1000 forkIO threads to handle simultaneous requests, that does not correspond to 1000 separate O/S (or "CPU") threads.
Anyway, yes, the RTS handles multiple blocking read/write calls concurrently without tying up O/S threads. In fact, by default when you compile and run a Haskell program without the -threaded flag or without the -N RTS option, it runs everything in a single O/S thread, even things you "fork" with forkIO, and multiple green threads can still block without blocking the (only) O/S thread.
You would also never run a Haskell server on 1000 separate O/S threads. The RTS can schedule thousands of green threads on a small pool of O/S threads much more efficiently than running each green thread on its own O/S thread, because switching between green threads doesn't require an expensive O/S context switch.
You may find this 2012 article about the Warp web server library helpful. In particular, they compare and contrast multiple possible architectures: one CPU thread per request (i.e., the design you're imagining), an event-driven architecture, a hybrid with one event-handling process per core, and the Haskell model of lightweight threads running on an O/S thread pool. Note that Warp uses Network.Socket under the hood. In their benchmark setup, they were handling requests for 1000 simultaneous clients using anywhere from 1-10 O/S threads.
If you'd like some concrete proof that forkIO threads won't block, here's a toy program:
import Control.Monad
import Control.Concurrent
import Network.Socket hiding (recv)
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as BS
forks = 10
main = withSocketsDo $ do
s <- socket AF_INET Datagram defaultProtocol
bind s (SockAddrInet 6667 (tupleToHostAddress (127,0,0,1)))
replicateM_ forks $ forkIO (BS.putStrLn =<< recv s 4096)
let loop = (putStrLn =<< getLine) >> loop
loop
If you compile and run this without threading:
$ stack ghc -- -O2 Socket.hs && ./Socket
it will spawn 10 waiting forkIO threads and then enter a getLine/putStrLn loop that will echo your input back to you. In the meantime, you can use netcat or your favorite networking tool to send requests to the waiting threads:
$ echo -n 'request' | nc -uw0 localhost 6667
which will also be echoed by the server. After 10 requests, you will have exhausted the waiting threads, and it will no longer respond to network requests.
Then you can bump up the threads with fork = 10000 to create 10000 waiting threads. While they're waiting, the main getLine/putStrLn loop will continue to run without a glitch.
All this is happening within a single O/S thread, as you can verify by looking at ps -Lf or whatever.
The question arose in a comment whether more threads were needed if multiple sockets are used simultaneously and the program is compiled with -threaded. The following test program:
import Control.Monad
import Control.Concurrent
import Network.Socket hiding (recv)
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as BS
forks = 50
main = withSocketsDo $ do
forM_ [0..forks-1] $ \i -> forkIO $ do
s <- socket AF_INET Datagram defaultProtocol
bind s (SockAddrInet (6667+i) (tupleToHostAddress (127,0,0,1)))
BS.putStrLn =<< recv s 4096
let loop = (putStrLn =<< getLine) >> loop
loop
creates 50 separate sockets on ports 6667 to 6716 and waits on them. If compiled without threading, it runs in one O/S thread without difficulty. If compiled with threading and provided with a capability count above one, like so:
$ stack ghc -- -O2 -threaded Socket.hs
$ ./Socket +RTS -N4
it appears to run 11 worker threads (which I think is a "main thread", four capabilities, plus six spare worker threads as specified by the constant MAX_SPARE_WORKERS in the RTS source) which share waiting on those 50 sockets.
As an aside, the way this is accomplished in the Network.Socket code is that a recv call, for example, is ultimately implemented as:
throwSocketErrorWaitRead sock "..." $
c_recv s (castPtr ptr) (fromIntegral nbytes) 0
with the throwSocketErrorWaitRead wrapper defined as:
throwSocketErrorWaitRead :: (Eq a, Num a) =>
Socket -> String -> IO a -> IO a
throwSocketErrorWaitRead sock name io =
throwSocketErrorIfMinus1RetryMayBlock name
(threadWaitRead $ fromIntegral $ fdSocket sock)
io
and throwSocketErrorIfMinus1RetryMayBlock documented like so:
throwSocketErrorIfMinus1RetryMayBlock
:: (Eq a, Num a)
=> String -- ^ textual description of the location
-> IO b -- ^ action to execute before retrying if an
-- immediate retry would block
-> IO a -- ^ the 'IO' operation to be executed
-> IO a
It's all a little complicated, but the upshot is that the wrappers call c_recv with is the actual recv system call. It never blocks because the socket is configured as non-blocking, and if it returns with an error code indicating it would block, the threadWaitRead call is used to alert the RTS that this green thread should sleep until data is available for reading.
