module Network.WebSockets.Hybi13.Demultiplex
( FrameType (..)
, Frame (..)
, DemultiplexState
, emptyDemultiplexState
, demultiplex
) where
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as B
import Control.Exception (Exception, throw)
import Data.Binary.Get (runGet, getWord16be)
import qualified Data.ByteString.Lazy as BL
import Data.Monoid (mappend)
import Data.Typeable (Typeable)
import Network.WebSockets.Types
data Frame = Frame
{ frameFin :: !Bool
, frameRsv1 :: !Bool
, frameRsv2 :: !Bool
, frameRsv3 :: !Bool
, frameType :: !FrameType
, framePayload :: !BL.ByteString
} deriving (Eq, Show)
data FrameType
= ContinuationFrame
| TextFrame
| BinaryFrame
| CloseFrame
| PingFrame
| PongFrame
deriving (Eq, Show)
data DemultiplexException = DemultiplexException
deriving (Show, Typeable)
instance Exception DemultiplexException
data DemultiplexState
= EmptyDemultiplexState
| DemultiplexState !FrameType !Builder
emptyDemultiplexState :: DemultiplexState
emptyDemultiplexState = EmptyDemultiplexState
demultiplex :: DemultiplexState
-> Frame
-> (Maybe Message, DemultiplexState)
demultiplex state (Frame fin _ _ _ tp pl) = case tp of
CloseFrame -> (Just (ControlMessage (uncurry Close parsedClose)), state)
PingFrame -> (Just (ControlMessage (Ping pl)), state)
PongFrame -> (Just (ControlMessage (Pong pl)), state)
ContinuationFrame -> case state of
EmptyDemultiplexState -> (Nothing, EmptyDemultiplexState)
DemultiplexState amt b
| not fin -> (Nothing, DemultiplexState amt b')
| otherwise -> case amt of
TextFrame -> (Just (DataMessage (Text m)), e)
BinaryFrame -> (Just (DataMessage (Binary m)), e)
_ -> throw DemultiplexException
where
b' = b `mappend` plb
m = B.toLazyByteString b'
TextFrame
| fin -> (Just (DataMessage (Text pl)), e)
| otherwise -> (Nothing, DemultiplexState TextFrame plb)
BinaryFrame
| fin -> (Just (DataMessage (Binary pl)), e)
| otherwise -> (Nothing, DemultiplexState BinaryFrame plb)
where
e = emptyDemultiplexState
plb = B.fromLazyByteString pl
parsedClose
| BL.length pl >= 2 = (runGet getWord16be pl, BL.drop 2 pl)
| otherwise = (1000, BL.empty)