Haskell WebSocketサーバー

一度、何もすることなく、WebSocketサーバーを書くことにしました。書いた後、誰かが怠laz、機能的な清潔さ、その他のラムダがここで役立つことをおもしろいと思うかもしれません。

一般的な用語でサーバーがどのように機能するかを読んだ後、書き始めました。ちなみに、プロトコルは非常に簡単です。クライアントはランダムなキーを送信し、応答としてサーバーは接続を確認し、これらのキーの連結からmd5を送信します。そして、彼らはお互いにバイナリまたはテキストデータを送信しますが、それは概して違いはありません。

握手

下書きを開き、ハンドシェイク形式の説明を参照してください。

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回以上発生する値を示します。演算子&>

および<&

は、2つのルールを順番に接続しますが、一方のルールの意味のみに関心があることを示しています。この場合、 colon

とspaces

規則に従う値は興味が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

leadingLine

とbody

すべてが単純になりmessage

が、 message

定義にwrap

関数が表示されmessage

。事実は、ルールa <&> b

がタプルのルールを定義しているため、何らかの独自のルールが必要です。したがって、タプルからとタプルへの変換のために2つの関数を提供します。

さて、フィールドを持つ抽象メッセージを解析する方法を学びました。今度は、 Opening

（クライアントから）およびResponse

（サーバー応答）の方向を見ることができます。

開くには特定のフィールド（一部はオプション）が含まれている必要があるため、 message

ルールをoptIf

ラップしmessage

。また、8バイトの長さの本文も含まれます。

opening = ( toOpening , fromOpening ) `wrap` ( optIf hasFields message <&> body 8 ) where <br>

toOpening

、 fromOpening

関数は提供しません。

Response

これはまったく同じです。

フレーム

たとえば、手を振って整理すると、メッセージを取り上げる価値があります。

同じドラフトセクションで、フレーム形式の説明を確認できます。

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

を残すことを唯一の例外として書き直し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

関数は、関連付けられた値を無視し、書き込み時に、2番目の引数で指定された値を置き換えます。つまり textFrame

読み取るときtextFrame

テキストはフラグが0x7F以下のすべてのフレームであると見なしますが、メッセージをシリアル化するときは常に0を設定します。

byteSourceLength

は、これらのバイト数が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

は接続accept

受け入れ、入力ストリーム全体を遅延文字列としてonReceived

関数に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

を呼び出しcallback

。ただし、注意点が1つあります。

たとえば、すべてのユーザー入力を遅延ByteString

として表したいとします。

このように書くと：

input <- fix $ \ loop -> unsafeInterleaveIO $ liftM2 ( : ) getLine loop<br> 
      

        
        
        
      

     let byteString = pack $ map charToByte input<br>

次に、遅延ByteString

しようとすると、効果がないことに非常に驚かされます。この問題は、 pack

関数の厳密さの基本であり、一度に行全体を必要とします。

この場合、すべてのユーザー入力の遅延リストを取得してから、 fromChunks

関数を使用する方がfromChunks

です。入力するとすぐに、 ByteString

空のプロミスでByteString

なくなりますが、正直なところ、入力全体の一部が含まれます。

おわりに

なぜこれをすべて書いたのですか？さて、誰かが機能的浮遊の無益性についてのHaskellの懐疑論を喚起するか、または減少させることにさらに興味を持っていることを願っています。

All Articles

Haskell WebSocketサーバー

握手

フレーム

サーバー

おわりに

More articles: