module Network.Salvia.Handlers.Parser (hParser) where import Control.Monad.State import Data.Record.Label import Network.Protocol.Http import Network.Salvia.Httpd import System.IO import Text.ParserCombinators.Parsec (parse) {- | The 'hParser' handler is used to parse the raw request message into the 'Message' data type. This handler is generally used as (one of) the first handlers in a configuration. The first handler argument is executed when the request is invalid, possibly due to parser errors. The second handler argument is executed when the request is valid. -} hParser :: (String -> Handler a) -- ^ The fail handler. -> Handler a -- ^ The succeed handler. -> Handler a hParser onfail onsuccess = do h <- getM sock -- TODO use try and fail with bad request or reject silently. msg <- lift $ readHeader h `catch` error "AAAAp" case parse pRequest "" (msg "") of Left err -> onfail (show err) Right x -> do setM request x onsuccess -- Read all lines until the first empty line. readHeader :: Handle -> IO (String -> String) readHeader h = do l <- hGetLine h let lf = showChar '\n' if l `elem` ["", "\r"] then return lf else liftM ((showString l . lf) .) (readHeader h)