Parser.hs

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)