module Web.SocketIO.Request (sourceHTTPRequest, runRequest) where
import Web.SocketIO.Types
import Web.SocketIO.Protocol
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as Builder
import qualified Data.ByteString as B
import Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Network.Wai as Wai
runRequest :: (Request -> IO Message) -> Conduit Request IO (Flush Builder)
runRequest runner = CL.mapM runner =$= serializeMessage =$= toFlushBuilder
sourceHTTPRequest :: Wai.Request -> Source IO Request
sourceHTTPRequest request = do
let path = parsePath (Wai.rawPathInfo request)
let method = Wai.requestMethod request
case (method, path) of
("GET", (WithoutSession _ _)) -> yield Handshake
("GET", (WithSession _ _ _ sessionID)) -> yield (Connect sessionID)
("POST", (WithSession _ _ _ sessionID)) -> Wai.requestBody request $= demultiplexMessage =$= awaitForever (yield . Request sessionID)
(_, (WithSession _ _ _ sessionID)) -> yield (Disconnect sessionID)
_ -> error "error handling http request"
serializeMessage :: Conduit Message IO ByteString
serializeMessage = toByteString 0
where toByteString :: Int -> Conduit Message IO ByteString
toByteString i = do
m <- await
n <- await
case (m, n) of
(Nothing, Nothing) -> yield (serialize (Framed [] :: Framed Message))
(Just m', Nothing) -> if i == 0
then yield (serialize m')
else yield (frame m')
(Nothing, Just _ ) -> return ()
(Just m', Just n') -> do
yield (frame m')
leftover n'
toByteString (i + 1)
frame b = "�" <> serialize size <> "�" <> b'
where b' = serialize b
size = B.length b'
toFlushBuilder :: Conduit ByteString IO (Flush Builder)
toFlushBuilder = do
b <- await
case b of
Just b' -> do
yield $ Chunk (Builder.fromByteString b')
toFlushBuilder
Nothing -> yield $ Flush