main :: IO ()
main = do
    cert <- getCertificate
    key  <- getPrivateKey

    clients <- LL.emptyIO :: IO (LinkedList Client)
    let broadcast message =
            atomically $ LL.toList clients >>= mapM_ (flip writeTChan message)

    sock <- listenOn (PortNumber 1337)
    putStrLn "Listening on port 1337"
    let loop :: Integer -> IO loop
        loop n = do
            (handle, host, port) <- accept sock
            putStrLn $ "Accepted connection from " ++ host ++ ":" ++ show port
            _ <- forkIO $ do
                send_chan <- newTChanIO :: IO (TChan Message)
                stop_sending <- newTVarIO False
                sender_stopped <- newTVarIO False

                let setupReturnTeardown = do
                        conn <- connectServer handle cert key
                        node <- atomically $ LL.append send_chan clients

                        _ <- forkIO $ fix $ \sendLoop ->
                            join $ atomically $ do
                                stop <- readTVar stop_sending
                                if stop
                                    then do
                                        writeTVar sender_stopped True
                                        return $ return ()
                                    else do
                                        msg <- readTChan send_chan
                                        return $ do
                                            sendMessage conn msg
                                            sendLoop

                        return (conn, do
                            -- Remove client entry, and tell sender thread to stop
                            atomically $ do
                                LL.delete node
                                writeTVar stop_sending True

                            -- Wait for sender thread
                            atomically $ do
                                stopped <- readTVar sender_stopped
                                when (not stopped) retry

                            -- Close the connection
                            close conn)

                    serve conn = do
                        liftIO $ atomically $ writeTChan send_chan $
                            TestMessage $ "Hello, client " ++ show n
                        forever $ do
                            msg <- StateT $ recvMessage conn
                            case msg of
                                TestMessage s -> liftIO $ broadcast $ TestMessage $
                                                    "<client " ++ show n ++ ">: " ++ s
                                _             -> liftIO $ warnUnknownMessageType n msg

                bracket setupReturnTeardown snd (\(conn, _) -> evalStateT (serve conn) B.empty)
            loop $! n+1
     in loop 0