Что нужно? Создать сервер, организующий в своих сессиях простой потокол: любая команда кроме quit будет игнорироваться, а quit будет завершать сессию. Когда сессия установлена, требуется вывести ее порядковый номер. Порядковый номер будет вычисляться в другом сервере-счетчике. Сервер-счетчик Его задача отдать своё состояние и инкрементировать его. Тип состояния у нас будет Integer, значит сервер-счётчик будет отсылать результат процессу принимающему сообщения типа Integer. Сам сервер-счетчик будет принимать ссылку на процесс, которому нужно отослать своё состояние: counter :: Integer -> Proc (Process Integer) () counter n = do tcpHandler <- recv send tcpHandler n counter (n + 1) С этим сервером будет обмениваться наш обработчик как только будет запущен для определнной сессии. Описания типов Типом состояния обработчика у нас будет ссылка на сервер-счетчик. Тип процедуры сервера-счетчика у нас Proc (Process Integer) (), значит типом состояния обработчика у нас будет Process (Process Integer). Типом сообщения обработчика будет тип сообщений, которые отсылает сервер-счётчик, а значит он будет Integer. Описание обработчика в экземпляре Обработчик обменивается с сервером-счетчиком и реализует TCP-протокол в виде диалога (см. комментарии в коде): -- TCPServer <тип состояния> <тип сообщений обработчику> instance TCPServer (Process (Process Integer)) Integer where tcpHandler c (h, _, _) = do -- c -- ссылка на сервер-счетчик -- h -- Handle текущей сессии liftIO $ hSetBuffering h LineBuffering -- устанавливаем LineBuffering -- обмен сообщений с сервером-счетчиком me <- self -- ссылка на самого себя send c me -- запращиваем сервер-счётчик n <- recv -- получаем номер от счетчика -- организуем диалог liftIO $ hPutStrLn h ("Hello this connection #" ++ show n) let loop = do hPutStr h ("Type `quit' -> ") hFlush h s <- hGetLine h hPutStrLn h ("You type `" ++ init s ++ "'") when (init s /= "quit") (hPutStrLn h "Invalid command." >> loop) liftIO $ loop Описание функции запуска Для начало мы должны запустить сервер-счетчик. Затем TCP-сервер, передав ему ссылку на процесс сервера-счетчика в качестве состояния: start = action $ do c <- spawn $ counter 1 m <- startManager c True 4000 return (c, m) Функция запуска возвращает пару ссылок на процессы (сервера-счетчика, менеджера TCP-сервера). Эта пара также используется для функций останова и функции получения списка активных соединений. Описание функций остановок Для полной остановки мы должны сначала остановить TCP-сервер, а затем убить процесс-счётчик. Способ остановки через блокирование дальнейших подключений и ожидания завершения всех существующих реализуется так: stop (c, m) = action $ do stopManager m kill c Способ остановки через принудительный разрыв всех существующих соединений реализуется так: killserver (c, m) = action $ do killManager m kill c Описание функции получения информации об активных соединениях Позволяет получить список всех существующих подключений с их параметрами и ссылками на процессы обработчиков: connections (_, m) = action $ getConnections m Использование Предполагает использование через GHCi.
 Исходный код |