module Network.Salvia.Handler.Environment ( hDefaultEnv , hSessionEnv ) where import Control.Concurrent.STM import Network.Protocol.Http import Network.Salvia.Handler.Banner import Network.Salvia.Handler.Counter import Network.Salvia.Handler.Close import Network.Salvia.Handler.Error import Network.Salvia.Handler.Head import Network.Salvia.Handler.Log import Network.Salvia.Handler.Parser import Network.Salvia.Handler.Printer import Network.Salvia.Handler.Session import Network.Salvia.Httpd import System.IO {- | This is the default stateless handler evnironment. It takes care of request parsing (`hParser`), response printing (`hPrinter`), request logging (`hLog`), connection keep-alives (`hKeepAlive`), handling `HEAD` requests (`hHead`) and printing the `salvia-httpd` server banner (`hBanner`). -} hDefaultEnv :: Handler () -- ^ Handler to run in the default environment. -> Handler () hDefaultEnv handler = hKeepAlive $ hParser (1000 * 15) (wrapper Nothing . parseError) (wrapper Nothing $ hHead handler) {- | This function is a more advanced version of the `hDefaultEnv` handler environment that takes a global state into account. It takes a shared variable containg the connection counter (used by `hCounter`) and a variable containing all session information (used by `hSession`). Handlers that run in this environment take should be parametrized with a session. -} hSessionEnv :: TVar Int -- ^ Request count variable. -> Sessions a -- ^ Session collection variable. -> SessionHandler a () -- ^ Handler parametrized with current session. -> Handler () hSessionEnv count sessions handler = hKeepAlive $ hParser (1000 * 15) (wrapper (Just count) . parseError) (wrapper (Just count) $ do session <- hSession sessions 300 hHead (handler session)) -- Helper functions. before :: Handler () before = hBanner "salvia-httpd" after :: Maybe (TVar Int) -> Handler () after mc = do hPrinter maybe (hLog stdout) (\c -> hCounter c >> hLogWithCounter c stdout) mc wrapper :: Maybe (TVar Int) -> Handler a -> Handler () wrapper c h = before >> h >> after c parseError :: String -> Handler () parseError err = do hError BadRequest sendStrLn [] sendStrLn err