Request.hs

--------------------------------------------------------------------------------
-- | Converts HTTP requests to Socket.IO requests
{-# LANGUAGE OverloadedStrings #-}
module Web.SocketIO.Request (parseHTTPRequest) where

--------------------------------------------------------------------------------
import              Web.SocketIO.Types
import              Web.SocketIO.Protocol

--------------------------------------------------------------------------------
import              Control.Applicative                     ((<$>))   
import qualified    Network.Wai                             as Wai
import              Network.HTTP.Types                      (Method)

--------------------------------------------------------------------------------
-- | Information of a HTTP reqeust we need
type RequestInfo = (Method, Path, Framed Message)

--------------------------------------------------------------------------------
-- | Extracts from HTTP reqeusts
retrieveRequestInfo :: Wai.Request -> IO RequestInfo
retrieveRequestInfo request = do

    framedMessages <- parseHTTPBody request

    let path = parsePath (Wai.rawPathInfo request)

    return 
        (   Wai.requestMethod request
        ,   path 
        ,   framedMessages
        )

--------------------------------------------------------------------------------
-- | Converts to SocketIO request
processRequestInfo :: RequestInfo -> [Request]
processRequestInfo ("GET" , (WithoutSession _ _)         , _              ) = [Handshake]
processRequestInfo ("GET" , (WithSession _ _ _ sessionID), _              ) = [Connect sessionID]
processRequestInfo ("POST", (WithSession _ _ _ sessionID), Framed messages) = requests
    where   requests = foldr extractEvent [] messages
            extractEvent (MsgEvent _ _ event) acc = Emit sessionID event : acc
            extractEvent _                    acc = acc
processRequestInfo (_     , (WithSession _ _ _ sessionID), _              ) = [Disconnect sessionID]
processRequestInfo _    = error "error parsing http request"
 
--------------------------------------------------------------------------------
-- | The request part
parseHTTPRequest :: Wai.Request -> IO [Request]
parseHTTPRequest request = fmap processRequestInfo (retrieveRequestInfo request)

--------------------------------------------------------------------------------
-- | The message part
parseHTTPBody :: Wai.Request -> IO (Framed Message)
parseHTTPBody req = parseFramedMessage <$> Wai.lazyRequestBody req