Как-то раз от нечего делать я решил написать WebSocket сервер, а написав, подумал, что кому-то может оказаться интересным, чем же тут может помочь ленивость, функциональная чистота и прочие лямбды.
Прочитав, как в общих чертах работает сервер, я засел писать. Протокол, к слову, очень простой. Клиент шлёт случайные ключи, сервер в ответ подтверждает соединение, отсылая md5 от конкатенации этих ключей. А потом шлют они друг другу или бинарные, или текстовые данные, по большому счёту ничем не отличающиеся.
Открываем драфт и видим описание формата handshake:
Ну что ж, так его и запишем:
Поясню происходящее на примере первой строки.
Функция
Само сообщение состоит из заглавной строки, полей и данных определённой длины, идущих после полей.
Это записывается не сложнее:
С
Ладно, абстрактное сообщение с полями мы разбирать научились, теперь можно посмотреть и в сторону
Opening должен содержать определённые поля (некоторые же опциональны), поэтому правило
Функции
С
Допустим, c пожатием руки разобрались, теперь стоит взяться за сообщения.
В той же секции драфта можно увидеть описание формата фреймов:
Перепишем за тем лишь исключением, что оставим-таки
Оператор
Сами фреймы:
Функция
Длина же в WebSocket имеет переменный размер в байтах. Признак последнего байта — неустановленный старший бит.
Определения
Теперь можно попробовать написать нечто вроде сервера.
Функция ожидания подключения:
Работать с ленивыми списками удобно для понимания: есть список сообщений, мы для каждого вызываем соответствующий
К примеру, мы хотим представить весь пользовательский ввод как ленивый
Если мы напишем это так:
То попытавшись распечатать ленивый
В данном случае правильнее было бы получить ленивый список всех пользовательских вводов, а затем воспользоваться функцией
Зачем я всё это написал? Ну, надеюсь, у кого-нибудь дополнительный интерес к Haskell пробудило, или поубавило скептицизма относительно бесполезности функциональных приблуд.
Прочитав, как в общих чертах работает сервер, я засел писать. Протокол, к слову, очень простой. Клиент шлёт случайные ключи, сервер в ответ подтверждает соединение, отсылая md5 от конкатенации этих ключей. А потом шлют они друг другу или бинарные, или текстовые данные, по большому счёту ничем не отличающиеся.
Handshake
Открываем драфт и видим описание формата handshake:
field = 1*name-char colon [ space ] *any-char cr lf
colon = %x003A ; U+003A COLON (:)
space = %x0020 ; U+0020 SPACE
cr = %x000D ; U+000D CARRIAGE RETURN (CR)
lf = %x000A ; U+000A LINE FEED (LF)
name-char = %x0000-0009 / %x000B-000C / %x000E-0039 / %x003B-10FFFF
; a Unicode character other than U+000A LINE FEED (LF), U+000D CARRIAGE RETURN (CR), or U+003A COLON (:)
any-char = %x0000-0009 / %x000B-000C / %x000E-10FFFF
; a Unicode character other than U+000A LINE FEED (LF) or U+000D CARRIAGE RETURN (CR)
Ну что ж, так его и запишем:
field = (many1 nameChar <& colon <& spaces) <&> (many anyChar <& cr <& lf) where<br>
spaces = ignore (many space) [()]<br>
colon = lit ':' char<br>
space = lit ' ' char<br>
cr = lit '\r' char<br>
lf = lit '\n' char<br>
unicodeChar = optIf (<= '\x10FFFF') char<br>
nameChar = optIf (`notElem` ": \r\n") unicodeChar<br>
anyChar = optIf (`notElem` "\r\n") unicodeChar<br>
Поясню происходящее на примере первой строки.
field = (many1 nameChar <& colon <& spaces) <&> (many anyChar <& cr <& lf) where<br>
spaces = ignore (many space) [()]<br>
many1
описывает значение, встречающееся 1 и более раз, many
— 0 и более. Операторы &>
и <&
последовательно соединяют два правила, при этом указывая, что нас интересует значение лишь одного из них. В данном случае значения, которые пройдут по правилам colon
и spaces
нас не интересуют. Оператор же <&>
позволяет получить оба значения в виде кортежа.Функция
lit
задаёт жёсткое значение, которое должно быть встречено, а optIf
накладывает ограничение.Само сообщение состоит из заглавной строки, полей и данных определённой длины, идущих после полей.
Это записывается не сложнее:
message = (toMessage, fromMessage) `wrap` (leadingLine <&> many field) where<br>
toMessage (ll, fs) = Message {<br>
messageLeadingLine = ll,<br>
messageFields = fs }<br>
fromMessage (Message { messageLeadingLine = ll, messageFields = fs }) = (ll, fs)<br>
<br>
body len = cr &> lf &> times len unicodeChar<br>
<br>
leadingLine = many anyChar <& cr <& lf<br>
С
leadingLine
и body
всё просто, а вот в определении message
появляется функция wrap
. Дело в том, что правило a <&> b
определяет правило для кортежа, а нам нужен некий свой тип. Поэтому мы предоставляем две функции для преобразования из кортежа и в него.Ладно, абстрактное сообщение с полями мы разбирать научились, теперь можно посмотреть и в сторону
Opening
(от клиента) и Response
(ответ сервера).Opening должен содержать определённые поля (некоторые же опциональны), поэтому правило
message
мы обернём в optIf
; а также содержать тело длиной 8 байт.opening = (toOpening, fromOpening) `wrap` (optIf hasFields message <&> body 8) where<br>
Функции
toOpening
, fromOpening
я приводить не буду.С
Response
всё обстоит точно так же.Frames
Допустим, c пожатием руки разобрались, теперь стоит взяться за сообщения.
В той же секции драфта можно увидеть описание формата фреймов:
frames = *frame
frame = text-frame / binary-frame
text-frame = (%x00-7F) *(%x00-FE) %xFF
binary-frame = (%x80-FF) length < as many bytes as given by the length >
length = *(%x80-FF) (%x00-7F)
Перепишем за тем лишь исключением, что оставим-таки
closing-frame
:frames = (takeWhile (not . isClosing), takeWhile (not . isClosing)) `wrap` many frame<br>
frame = optIf isText textFrame <|> optIf isBinary binaryFrame <|> optIf isClosing closingFrame<br>
Оператор
<|>
— альтернатива. Сначала применяет левое правило, при неудаче — правое.Сами фреймы:
textFrame = (TextFrame, \(TextFrame s) -> s) `wrap` (textFlag &> many frameChar <& frameFF) where<br>
textFlag = ignore (optIf (<= 0x7F) word8) 0x00<br>
binaryFrame = (BinaryFrame, \(BinaryFrame s) -> s) `wrap` (binaryFlag &> byteSourceLength frameLength) where<br>
binaryFlag = ignore (optIf (liftM2 (&&) (> 0x7F) (/= 0xFF)) word8) 0xF0<br>
closingFrame = check (0xFF, 0x00) (word8 <&> word8) ClosingFrame<br>
Функция
ignore
игнорирует сопоставленное значение, а при записи подставляет указанное вторым аргументом значение. Т.е. при чтении textFrame
мы считаем текстовыми все фреймы, флаг у которых не более 0x7F, однако при сериализации сообщения мы ставим всегда 0.byteSourceLength
грузит/сохраняет тучу байт, предварив её количеством этих байт, которое [количество] будет загружено/сохранено с помощью переданного правила (frameLength
).Длина же в WebSocket имеет переменный размер в байтах. Признак последнего байта — неустановленный старший бит.
frameLength = (\(hs, l) -> toLength (hs ++ [l]), (init &&& last) . fromLength) `wrap` (many highWord <&> lowWord) where<br>
Определения
toLength
, fromLength
, highWord
и lowWord
я опущу.Сервер
Теперь можно попробовать написать нечто вроде сервера.
start port onAccept = do<br>
sock <- S.socket S.AF_INET S.Stream S.defaultProtocol<br>
S.bindSocket sock $ S.SockAddrInet port S.iNADDR_ANY<br>
S.listen sock S.maxListenQueue<br>
let<br>
-- Обработчик всех исключений. Игнорируем все исключения (перезапускаем функцию ожидания подключения), если только<br>
-- это не "убийство" потока.<br>
canDie e = if fromException e == Just ThreadKilled then throwIO ThreadKilled else return ()<br>
-- В отдельном потоке ожидаем подключения.<br>
th <- fork $ forever $ canDie `handle` acceptClient sock onAccept<br>
return $ Server th<br>
Функция ожидания подключения:
acceptClient socket onAccept = ignore $ accept socket onReceived where<br>
accept
принимает подключение и передаёт весь входной поток в функцию onReceived
в виде ленивой строки.onReceived sock income = do<br>
-- Парсинг тоже ленивый. Благодаря тому, что правило anything всегда истинно (и сматчит весь остаток входного потока),<br>
-- результат мы получаем сразу, как только по сети придёт opening.<br>
(o, tailData) <- letFail $ decode (opening <&> anything) income<br>
-- Посчитаем и сериализуем ответ.<br>
r <- letFail (responseTo o >>= mapException show . encode response)<br>
-- и отправим его.<br>
send sock r<br>
let con = connection (openingChannel o) (openingHost o) (openingOrigin o) (openingProtocol o) sock<br>
let<br>
-- Пришёл фрейм закрытия соединения. Отошлём такой же и вызовем callback.<br>
onConnect ClosingFrame = close con `finally` acceptOnClose handlers con<br>
-- Пришло обычное сообщение.<br>
onConnect f = acceptOnMessage handlers con f<br>
-- В отдельном потоке запустим callback "подключились".<br>
fork $ acceptOnOpen handlers con<br>
<br>
-- А тут мы просто-напросто парсим ленивую строку и получаем ленивый список сообщений, что весьма удобно.<br>
switch (const $ return ()) (mapM_ onConnect) $ decode frames tailData<br>
Работать с ленивыми списками удобно для понимания: есть список сообщений, мы для каждого вызываем соответствующий
callback
; но есть один нюанс.К примеру, мы хотим представить весь пользовательский ввод как ленивый
ByteString
.Если мы напишем это так:
input <- fix $ \loop -> unsafeInterleaveIO $ liftM2 (:) getLine loop<br>
let byteString = pack $ map charToByte input<br>
То попытавшись распечатать ленивый
ByteString
, можем сильно удивиться отсутствию эффекта. Дело элементарно в строгости функции pack
, ей нужна вся строка сразу.В данном случае правильнее было бы получить ленивый список всех пользовательских вводов, а затем воспользоваться функцией
fromChunks
. Тогда сразу по мере ввода наш ByteString
уже не будет пустым обещанием, а честно будет содержать часть всего ввода.Заключение
Зачем я всё это написал? Ну, надеюсь, у кого-нибудь дополнительный интерес к Haskell пробудило, или поубавило скептицизма относительно бесполезности функциональных приблуд.