import Control.Concurrent
import System.IO
import System.Mem.Weak
import System.IO.Error

import Network.StreamServer
import Network.Address (getBindAddress)
import DPut
import DebugTag

sesh sock n h = do
    s <- hGetContents h
    putStr s

main = do
    setVerbose XMisc
    bind <- getBindAddress "8889" True
    serv <- forkStreamServer (withSession sesh) [bind]

    wtid <- getAcceptLoopThreadId serv
    mtid <- deRefWeak wtid
    case mtid of
        Nothing -> hPutStrLn stderr "missing accept loop?"
        Just tid -> do
            threadDelay 1000000
            hPutStrLn stderr "Throwing execption now..."
            let -- e = userError "resource exhausted" `ioeSetErrorType` fullErrorType
                e = mkIOError fullErrorType "resourceExhausted.hs" Nothing Nothing
            throwTo tid  e
            hPutStrLn stderr "Thrown."

    getLine

    quitListening serv
    return ()