{-# OPTIONS -fglasgow-exts #-} -- >$Id: NewerCGI.hs,v 1.1 2007/07/28 01:41:18 oleg Exp oleg $ -- -- Library for writing CGI programs. Supports FastCGI using the FFI -- and the C client library (). -- Can autodetect whether to use regular CGI or FastCGI. -- -- Originally based on the version written by Jesse Tov, which was -- based on NewCGI -- () -- by Bjorn Bringert, et al. -- The current version is *significantly* different however. -- {- The present version implements a different CGI/FastCGI interface. The goal is the least latency and the least memory consumption. We aim to send data to the client as soon as they are available, modulo small buffering (which is provided by FCGXStream, or, in the case of CGI, by Haskell Handle facility). The current design specifically disallows changing of the already set headers. Once the headers including the status are sent they are sent. We never accumulate more data than necessary (again, modulo small buffering in the underlying low-level library). The big difference is that CGIT monad transformer no longer has any state (and its environment are just IO handles). State is EVIL! We also implement the new IO interface: the simple IO interface to read/write/copy via a single, large, only once allocated buffer. The buffer and its dimensions are hidden so to avoid the risk of writing into each too much. The hiding also assures that the buffer is used linearly. -} ---------- module Network.NewerCGI ( -- * CGI class MonadCGI(..), -- ** Types ResponseA, RequestInfo(..), CGIT, Input(..), Output(..), BCopy(..), -- ** Exception TerminateSession(..), -- *** FastCGI Options FcgiOption(..), -- * CGIT runners runCGI, runFastCGI, runAutoCGI, runOneFastCGI, -- * Input functions gGetStr, inputFd, inputStr, inputCombined, -- ** Parsed CGI fields fields, field, field_, -- ** Environment env, env_, -- * Output functions out, outerr, sendHeaders, headersAsStrings, gPutStr, outputFd, -- * Logging note, -- * Control print_exc, send_error_page, (<|>), -- * Tests tests__Network_BetterCGI ) where import Data.Typeable import Data.Dynamic import Data.Char ( toLower, isSpace, chr, isHexDigit, digitToInt ) import Data.Maybe ( listToMaybe ) import System.Environment ( getEnvironment ) import System.IO ( stdout, stderr, stdin, hPutStr, hPutStrLn, hPutChar, hFlush, hGetBuf, hPutBuf ) import System.IO.Error ( mkIOError, illegalOperationErrorType ) import System.Posix ( closeFd, Fd, setFdOption, FdOption(CloseOnExec) ) import Foreign import Foreign.C import Foreign.Storable import Foreign.Marshal import qualified Control.Monad.Reader as Reader import Data.IORef -- for the tests, actually import qualified Data.Map as Map import Util.Util import Network.FastCGI ---------- ---------- Generalized input and output ports and the copy function ---------- buffer_alloc_size = 16384 -- seems to be a reasobable value -- based on experience. -- | Generalized input port for reading. The port is a procedure -- that should read at most the specified number of bytes -- into the specified buffer. The procedure should return the number of -- bytes actually read. It should return 0 on EOF. It may throw -- various exceptions if reading didn't go well. -- The procedure is like a hGetBuf partially applied to a handle. newtype Input = Input (forall m. EMonadIO m => Ptr Word8 -> Int -> m Int) -- Other accessors -- Read into a Haskell string (no conversion) -- Alternatively, to avoid allocation (allocaBytes), we could have -- used the existing buffer: BCopy. gGetStr :: EMonadIO m => Input -> Int -> m String gGetStr (Input filler) len | len <= 0 = return "" gGetStr (Input filler) len = liftIO $ allocaBytes len read_conv where read_conv ptr = do len <- filler ptr len peekCAStringLen (castPtr ptr,len) -- The Input action of reading from an FD inputFd :: Fd -> Input inputFd fd = Input (\ptr len -> liftIO ( throwErrnoIfMinus1 "cRead" (cRead (fromIntegral fd) ptr (fromIntegral len)) >>= return.fromIntegral)) -- The Input action of reading from a supplied String inputStr :: EMonadIO m => String -> m Input inputStr str = liftIO $ withCAStringLen str body where body input_str_clen = do hin <- newIORef input_str_clen return $ Input (\ptr len -> liftIO $ do (hptr,hlen) <- readIORef hin let count = min len hlen if hlen == 0 then return 0 else do copyArray (castPtr ptr) hptr count writeIORef hin (advancePtr hptr count, hlen - count) return count) -- Combine two Input actions -- Take two input actions and return the combined one, which reads from -- the first until EOF and then reads from the second. inputCombined :: EMonadIO m => Input -> Input -> m Input inputCombined (Input i1) (Input i2) = do firstDoneR <- liftIO $ newIORef False return $ Input (\ptr len -> do firstDone <- liftIO $ readIORef firstDoneR if firstDone then i2 ptr len else do res <- i1 ptr len if res == 0 then do liftIO $ writeIORef firstDoneR True i2 ptr len else return res) -- It's weird but the Haskell standard libraries, System.Posix.IO, -- forget about write(2) and read(2)... foreign import ccall unsafe "unistd.h read" cRead :: CInt -> Ptr Word8 -> CInt -> IO CInt foreign import ccall unsafe "unistd.h write" cWrite :: CInt -> Ptr Word8 -> CInt -> IO CInt -- | Generalized output port for writing. The port is a procedure -- that should write the specified number of bytes from the specified -- buffer. It may throw various exceptions if writing didn't go well. -- The procedure is like a hPutBuf partially applied to a handle. newtype Output = Output (forall m. EMonadIO m => Ptr Word8 -> Int -> m ()) -- Other accessors -- Write a Haskell string (no conversion) -- Alternatively, to avoid allocation (withCAStringLen), we could have -- used the existing buffer: BCopy. -- See the FPS.unpack code for an example. gPutStr :: EMonadIO m => Output -> String -> m () gPutStr _ "" = return () gPutStr (Output writer) str = liftIO $ withCAStringLen str write_conv where write_conv (ptr,len) = writer (castPtr ptr) len {- -- Lifted from FastPackString.hsc {-# RULES "gPutStr/gPutStrAddress" forall s# . gPutStr output (unpackCString# s#) = gPutStrAddress output s# #-} -} -- The Output action of writing to FD outputFd :: Fd -> Output outputFd fd = Output (\ptr len' -> liftIO ( do let len = fromIntegral len' written <- throwErrnoIfMinus1 "cWrite" $ cWrite (fromIntegral fd) ptr len if written == len then return () else let loop off len = -- inv: off + len == original_len if len == 0 then return () else throwErrnoIfMinus1 "cWrite" (cWrite (fromIntegral fd) (ptr `plusPtr` (fromIntegral off)) len) >>= (\written -> loop (off+written) (len-written)) in loop written (len - written))) -- The function bcopy copies from the generalized input port to -- the generalized output port. One may limit the number of bytes to copy -- between the ports by specifying the third argument to `Just n'. -- If the number of bytes to copy was unlimited, we copy up to EOF -- and return Nothing. -- If the limit to copy was n, we return Just n', where n' is the -- remaining count of bytes to copy. The remaining count is 0 if -- all desired bytes were copied; it is equal to n if nothing was copied -- because EOF has occurred right away. -- The function bcopy does the copy via a large, once allocated buffer. -- The function hides the buffer and so prevents its inappropriate use -- (writing past the buffer's boundary, overwriting data in the buffer, aka -- non-linear use). newtype BCopy = BCopy (forall m. EMonadIO m => Input -> Output -> Maybe Int -> m (Maybe Int)) -- The arguments of make_bcopy is the allocated buffer (not exposed) -- and its length make_bcopy :: Ptr Word8 -> Int -> BCopy make_bcopy buffer buffer_size = BCopy (\ (Input reader) (Output writer) size -> maybe (loop_all reader writer) (loop_size reader writer) size) where -- copy the given number of bytes loop_size rd wr 0 = return (Just 0) loop_size rd wr count = do nbytes_read <- rd buffer (min buffer_size count) if nbytes_read == 0 then return (Just count) -- EOF else wr buffer nbytes_read >> loop_size rd wr (count - nbytes_read) -- copy until EOF loop_all rd wr = do nbytes_read <- rd buffer buffer_size if nbytes_read == 0 then return Nothing -- EOF else wr buffer nbytes_read >> loop_all rd wr ---------- ---------- The CGI Monad ---------- -- | 'MonadCGI': basic CGI interface class EMonadIO m => MonadCGI m where cgiout :: m Output -- generalized main output port cgierr :: m Output -- send error to web server log. -- Not that useful. bcopy :: m BCopy -- Generalized port copier -- Information about the request data RequestInfo = RequestInfo { req_env :: Map.Map String String, -- ^ The request environment req_fields :: Fields, -- ^ Parsed CGI variables req_clength :: Maybe Int, -- ^ Size of the HTTP body req_body :: Either String Input -- ^ Read from client } -- | CGI monad transformer. It carries a 'CGIEnv' in a reader monad newtype CGIT m a = CGIT { _unCGIT :: Reader.ReaderT CGIEnv m a } deriving (Monad, EMonad, MonadIO, MonadTrans) data CGIEnv = CGIEnv { _bcopy :: BCopy, -- ^ Generalized port copier _out :: Output, -- ^ Send to client _err :: Output -- ^ Send to error log } -- ResponseAction, which is to generate the response type ResponseA m = RequestInfo -> CGIT m () -- | We throw the following to abnormally terminate the current -- request processing session (with the specified CGI-error code). -- If this server can handle more than one request (e.g., FastCGI), -- it should stay alive and ask for the new request. data TerminateSession = TerminateSession Int String deriving (Show, Typeable) -- | The type of CGI variables, parsed type Fields = Map.Map String [String] -- | 'runFastCGI' takes a list of 'FcgiOption's, which modify -- its behavior data FcgiOption = FcgiBind String -- ^ Bind to a port | FcgiMaxRequests Int -- ^ Exit after /n/ requests | FcgiTimeout Int -- ^ Unimplemented ----- ----- CGIT Instances ----- instance EMonadIO m => MonadCGI (CGIT m) where bcopy = CGIT (Reader.ask) >>= return . _bcopy cgiout = CGIT (Reader.ask) >>= return . _out cgierr = CGIT (Reader.ask) >>= return . _err {- instance EMonadIO m => MonadIO (CGIT m) where liftIO io = CGIT (liftIO (gtry io)) >>= guntry -} instance EMonadIO m => EMonadIO (CGIT m) {- -- lift RequestInfo to a different monad liftRequestInfo :: (forall a. m a -> m' a) -> RequestInfo m -> RequestInfo m' liftRequestInfo f req = req { _inp = mapinp f (_inp req) } where mapinp f (Left x) = Left x mapinp f (Right i) = Right (f . i) -} ---------- ---------- CGIT RUNNERS ---------- -- | Collect the information about the request and build RequestInfo. -- The function receives an unparsed input and the environment a-list. buildRequestInfo :: EMonadIO m => [(String, String)] -> Input -> m RequestInfo buildRequestInfo envlist inp = do let env = Map.fromList envlist method = maybe "GET" id (Map.lookup "REQUEST_METHOD" env) ctype = case Map.lookup "CONTENT_TYPE" env of Nothing -> "" Just s -> map toLower (filter (not . isSpace) (fst (break (==';') s))) query = maybe "" id (Map.lookup "QUERY_STRING" env) clength = readMaybe =<< Map.lookup "CONTENT_LENGTH" env (fields, raw) <- if (method, ctype) == ("POST", "application/x-www-form-urlencoded") then do body <- maybe (return "") (gGetStr inp) clength return (_parseFields query body, Left body) else return (_parseFields query "", Right inp) return RequestInfo { req_env = env, req_fields = fields, req_clength = clength, req_body = raw } -- | Auxiliary function '_parseFields', given an environment map (with -- things like @QUERY_STRING@ in it) and a 'String' containing the body -- of a request, returns a multi-map (ie 'Map.Map' 'String' ['String']) -- of the CGI fields. If @REQUEST_METHOD@ is @POST@ and also -- @QUERY_STRING@ is non-empty, @QUERY_STRING@ gets precedence. _parseFields :: String -> String -> Fields _parseFields get post = Map.empty <<< post <<< get where infixl <<< (<<<) :: Fields -> String -> Fields m <<< s = foldr equals m (ampersand s) equals :: String -> Fields -> Fields equals s m = case break (=='=') s of (x, []) -> m (x, (_:y)) -> Map.insertWith (++) (percent x) [percent y] m ampersand :: String -> [String] ampersand [] = [] ampersand s = case break (=='&') s of (x, []) -> [x] (x, (_:y)) -> x : ampersand y percent :: String -> String percent s = loop s where loop s = case break (`elem` "%+") s of (s,"") -> s (s,'+':r) -> s ++ ' ':loop r (s,'%':d1:d2:r) -> if isHexDigit d1 && isHexDigit d2 then s ++ (chr (16*digitToInt d1 + digitToInt d2)):loop r else s ++ "*BAD %-escape*" ++ loop r (s,_:r) -> s ++ "*BAD %-escape*" ++ loop r -- | Run a 'CGIT' action, takling input from a string and -- accumulating the results as a pair of strings, -- the first for stdout, and the second for stderr. Very inefficient, -- but simple and probably good for testing. runCGI_with_strings :: EMonadIO m => String -> [(String, String)] -> ResponseA IO -> m (String, String) runCGI_with_strings input_str envlist resp = liftIO $ do inp <- inputStr input_str hout <- newIORef "" herr <- newIORef "" buildRequestInfo envlist inp >>= action hout herr res_out <- readIORef hout res_err <- readIORef herr return (res_out,res_err) where action hout herr req = Reader.runReaderT (_unCGIT (resp req)) (cgie hout herr) cgie hout herr = CGIEnv { _bcopy = undefined, _out = out hout, _err = out herr } out hout = Output (\ptr len -> liftIO $ do str <- peekCAStringLen (castPtr ptr,len) modifyIORef hout (++ str)) -- | Run as a standalone CGI runCGI :: EMonadIO m => ResponseA m -> m () runCGI f = do envlist <- liftIO getEnvironment req <- buildRequestInfo envlist inp gbracket (liftIO $ mallocBytes buffer_alloc_size) (\buffer -> liftIO $ free buffer >> flushAll) (\buffer -> Reader.runReaderT (_unCGIT (f req)) (cgie buffer)) `gcatch` (\e -> print_exc e >> gthrow e) where inp = Input (\ptr len -> liftIO $ hGetBuf stdin ptr len) flushAll :: MonadIO m => m () flushAll = do liftIO $ hFlush stdout; liftIO $ hFlush stderr cgie buffer = CGIEnv { _bcopy = make_bcopy buffer buffer_alloc_size, _out = Output (\ptr len ->liftIO $ hPutBuf stdout ptr len), _err = Output (\ptr len ->liftIO $ hPutBuf stderr ptr len) } -- | Choose FastCGI or normal CGI depending on the context and provided -- options. runAutoCGI :: EMonadIO m => [FcgiOption] -> ResponseA m -> m () runAutoCGI opts f = do is_cgi <- liftIO cFCGX_IsCGI if is_cgi && null [ () | FcgiBind path <- opts ] then runCGI f else runFastCGI opts f -- | FastCGI request\/response loop. runFastCGI :: EMonadIO m => [FcgiOption] -> ResponseA m -> m () runFastCGI opts f = withFastCGIRequest path (loop n) where path = listToMaybe [ path | FcgiBind path <- opts ] n = maybe (-1) id $ listToMaybe [ n | FcgiMaxRequests n <- opts ] loop n req = do runOneWithRequest req f case n of _ | n < 1 -> loop n req | n > 1 -> loop (pred n) req | otherwise -> return () -- | Handle one FastCGI request\/response cycle, then return. runOneFastCGI :: EMonadIO m => Maybe String -> ResponseA m -> m () runOneFastCGI path f = withFastCGIRequest path $ \req -> runOneWithRequest req f -- | Initializes and cleans up a FastCGI session. If given 'Just' /s/ -- as its first argument, attempts to bind to the port or UNIX domain -- socket described by /s/; otherwise, assumes that the calling -- process will do the bind (@spawn-fcgi(1)@, for example). Passes -- the newly initialized 'FCGX_Request' to the given continuation, -- and cleans up on the way out. withFastCGIRequest :: EMonadIO m => Maybe String -> ((Ptr FCGX_Request,BCopy) -> m a) -> m a withFastCGIRequest path k = gbracket before after body where before = liftIO $ do throwErrnoIf_ (/=0) "FCGX_Init" cFCGX_Init fd <- case path of Just str -> withCString str $ \cstr -> throwErrnoIf (<0) "FCGX_OpenSocket" (cFCGX_OpenSocket cstr 50) Nothing -> return 0 setFdOption fd CloseOnExec True req <- mallocBytes $ fromIntegral requestSize throwErrnoIf_ (/=0) "FCGX_InitRequest" (cFCGX_InitRequest req fd 0) buffer <- mallocBytes buffer_alloc_size return ((req,buffer),fd) body ((req,buffer),_) = k (req,make_bcopy buffer buffer_alloc_size) after ((req,buffer),fd) = liftIO $ do free req free buffer hFlush stderr case path of Just _ -> closeFd (fromIntegral fd) Nothing -> return () -- | Given a pointer to a 'FCGX_Request' object and a CGI action, -- runs one FastCGI request\/response cycle. -- We specifically handle the TerminateSession exception. -- It is considered normal, sort of. The current response -- is certainly truncated once the exception propagated to this stage. -- However, this server is consistent and can handle further requests. -- All other exceptions are however fatal. runOneWithRequest :: EMonadIO m => (Ptr FCGX_Request,BCopy) -> ResponseA m -> m () runOneWithRequest (req,bcopy) f = gbracket_ before after (handleRequest req `gcatch` handleExc) where before = liftIO $ throwErrnoIf_ (/=0) "cFCGX_Accept_r" (cFCGX_Accept_r req) after = do liftIO $ cFCGX_Finish_r req return () handleExc (DynException e) | Just e@(TerminateSession n msg) <- fromDynamic e = do note ["\nTerminating the current session: ", show n,msg] cgiout <- liftIO $ requestOut req liftIO $ cFCGX_SetExitStatus (fromIntegral n) cgiout handleExc e = print_exc e >> gthrow e -- fatal handleRequest req = do env <- liftIO $ requestEnv req cgiin <- liftIO $ requestIn req cgiout <- liftIO $ requestOut req cgierr <- liftIO $ requestErr req envlist <- liftIO $ environToTable env breq <- buildRequestInfo envlist (inp cgiin) Reader.runReaderT (_unCGIT (f breq)) CGIEnv {_bcopy = bcopy, _out = out cgiout, _err = out cgierr} where inp cgiin = Input (\ptr len -> liftIO (cFCGX_GetStr (castPtr ptr) (fromIntegral len) cgiin >>= return.fromIntegral)) out stream = Output (\ptr len -> do res <- liftIO $ cFCGX_PutStr (castPtr ptr) (fromIntegral len) stream when (res < 0) $ gthrow fcgiError) fcgiError = IOException $ mkIOError illegalOperationErrorType "FCGI stream error" Nothing Nothing environToTable :: Environ -> IO [(String,String)] environToTable arr = do css <- peekArray0 nullPtr arr ss <- mapM peekCString css return $ map (splitBy '=') ss ---------- ---------- INPUT ---------- -- | Read the value of a field, with a default. field_ :: RequestInfo -> String -> String -> String field_ req deflt n = maybe deflt id (field req n) -- | Read the value of a field. field :: RequestInfo -> String -> Maybe String field req n = case fields req n of v:_ -> Just v [] -> Nothing -- | Read all values associated with a field. fields :: RequestInfo -> String -> [String] fields req n = maybe [] id $ Map.lookup n $ req_fields req -- | Get the value of an environment variable, with a default. env_ :: RequestInfo -> String -> String -> String env_ req deflt key = maybe deflt id (env req key) -- | Get the value of an environment variable. env :: RequestInfo -> String -> Maybe String env req key = Map.lookup key (req_env req) ---------- ---------- OUTPUT ---------- out :: MonadCGI m => [String] -> m () out strs = do gout <- cgiout mapM_ (gPutStr gout) strs outerr :: MonadCGI m => [String] -> m () outerr strs = do gerr <- cgierr mapM_ (gPutStr gerr) strs _CRLF = "\r\n" -- Convert the headers (the list of (field,value) pairs) -- into the list of strings suitable to be passed to Output m -- functions -- We do mind the final empty string that terminates the headers -- Should we check for header duplication? Or just don't bother? headersAsStrings :: [(String,String)] -> [String] headersAsStrings hrds = concatMap (\ (n,v) -> [n,": ",v,_CRLF]) hrds ++ [_CRLF] -- | Send the headers (including the empty line) sendHeaders :: MonadCGI m => [(String,String)] -> m () sendHeaders hdrs = out (headersAsStrings hdrs) {- -- | Redirect and finish redirect :: Monad m => String -> CGIT m () redirect url = do clearHeaders setHeader "Location" url gthrowDyn (CGIStatus "301 Moved Permanently" $ Just $ "Redirecting to "++url++"") -} -- | Convenience function for logging, into stderr note :: MonadIO m => [String] -> m () note msgs = liftIO (mapM_ (hPutStr stderr) msgs >> hPutChar stderr '\n') -- Print the information about the exception print_exc :: MonadIO m => Exception -> m () print_exc (DynException e) | Just e@(TerminateSession _ _) <- fromDynamic e = note [show e] print_exc (DynException e) = note ["unknown dynamic exception"] print_exc e = note [show e] send_error_page :: (MonadIO m, MonadCGI m) => String -> String -> m () send_error_page status_msg msg = do note ["\nSending error page: ",status_msg,"\n",msg] sendHeaders [("status",status_msg), ("content-type","text/html")] out ["", status_msg, "

", status_msg, "

", msg, "

\n"] -- | This operator is intended for partial functions whose return type -- is Maybe a. If the result is Nothing, we throw the TerminateSession -- exception. Otherwise, we unwrap Just. That is, this operator is -- the transformer for partial functions, quite useful for various -- parsing tasks. (<|>) :: EMonad m => Maybe a -> (Int,String) -> m a Nothing <|> (n,msg) = gthrowDyn (TerminateSession n msg) (Just x) <|> _ = return x -- | Give error-handling functions the same fixity as (>>) and (>>=) infixl 1 <|> tests__Network_BetterCGI :: Test tests__Network_BetterCGI = let -- Helper for setting up decent CGI environment rc1 = runCGI_with_strings "" [ ("REQUEST_METHOD", "GET"), ("QUERY_STRING", "foo=bar&baz=qux+quux&a=b%20c") ] -- Check that an exception was thrown threw exc = maybe False (const True) exc @? "exception expected" in "Network.BetterCGI" ~: [ -- Trivial: does the CGI runner run? "simple return" ~: do (o, e) <- rc1 $ \req -> return () o @?= "" e @?= "" -- Send some output; do we capture it? , "simple out" ~: do (o, e) <- rc1 $ \req -> out ["hello"] o @?= "hello" e @?= "" -- How about error messages? , "simple err" ~: do (o, e) <- rc1 $ \req -> outerr ["hello"] o @?= "" e @?= "hello" -- Make sure both 'out' and 'err' go to the right places. , "simple both" ~: do (o, e) <- rc1 $ \req -> do out ["hel","lo"] outerr ["world"] o @?= "hello" e @?= "world" -- . . . even if we interleave them. , "simple interleave" ~: do (o, e) <- rc1 $ \req -> do out ["he"] outerr ["wo"] out ["llo"] outerr ["rld"] o @?= "hello" e @?= "world" -- Set a header and see it come out. , "headers" ~: do (o, e) <- rc1 $ \req -> do sendHeaders [("foo","bar")] out ["done"] o @?= ("foo: bar\r\n\r\ndone") e @?= "" {- -- Setting the same header again overwrites the first occurence, -- and also we're case-insensitive about it. , "headers overwrite" ~: do (o, e) <- rc1 $ \req -> do clearHeaders setHeader "foo" "bar" setHeader "FOO" "qux" sendHeaders exc @?= Nothing o @?= ("foo: qux\r\n\r\n") e @?= "" -- Throwing an exception skips the rest of the CGI and delivers -- the exception to the caller. , "throw" ~: do (o, e) <- rc1 $ \req -> do out "hello" fail "damn!" out "world" threw exc o @?= "hello" e @?= "" -} -- We can catch exceptions. , "catch" ~: do (o, e) <- rc1 $ \req -> do out ["a"] do out ["b"] fail "damn" out ["c"] `gcatch` \_ -> out ["d"] out ["e"] o @?= "abde" e @?= "" {- -- We can avoid catches statuses , "catch" ~: do (o, e) <- rc1 $ do status_ "500 blah" `gcatchCgi` \_ -> err "howdy" out "e" exc @?= Nothing e @?= "" -} -- Sending the status header , "status_" ~: do (o, e) <- rc1 $ \req -> do sendHeaders [("status","200 YEAH")] out ["hello"] o @?= ("status: 200 YEAH\r\n\r\nhello") e @?= "" -- Can we parse QUERY_STRING properly? , "parsing" ~: do (o, e) <- rc1 $ \req -> do let Just foo = field req "foo" let Just baz = field req "baz" let Just a = field req "a" out [foo] outerr [a] out [baz] o @?= "barqux quux" e @?= "b c" -- Do the field lookup functions do the right thing for missing -- fields? , "missing fields" ~: do (o, e) <- rc1 $ \req -> do out [field_ req "present" "foo"] outerr [field_ req "missing" "fooo", "; "] do baar <- field req "baar" <|> (400, "field not found: baar") return () `gcatchDyn` (\ (TerminateSession _ e) -> outerr [e]) o @?= "bar" e @?= "missing; field not found: baar" ]