module Web.Firefly
(
run
, App
, Handler
, HeaderMap
, route
, runHandler
, getPath
, getPathInfo
, getMethod
, getQueryString
, getQueries
, getQueriesMulti
, getQuery
, getQueryMulti
, getHeaders
, getBody
, getCookies
, getCookieMulti
, getCookie
, isSecure
, waiRequest
, pathMatches
, ToResponse(..)
, respond
, respondWith
, Json(..)
, addMiddleware
, module Network.HTTP.Types.Status
) where
import qualified Network.Wai.Handler.Warp as W
import qualified Network.Wai as W
import Network.HTTP.Types.Status
import Control.Monad.Reader
import Control.Monad.Except
import qualified Data.Text as T
import Web.Firefly.Handler
import Web.Firefly.Request
import Web.Firefly.Response
import Web.Firefly.Types
import Web.Firefly.Internal.Utils
run :: W.Port -> App () -> IO ()
run port app = W.run port warpApp
where
warpApp :: W.Request -> (W.Response -> IO W.ResponseReceived) -> IO W.ResponseReceived
warpApp req resp = runFirefly app req >>= resp
runFirefly :: App () -> W.Request -> IO W.Response
runFirefly app req = either id (const notFoundResp) <$> runExceptT unpackApp
where
unpackApp = do
reqBody <- fmap fromLBS . liftIO $ W.strictRequestBody req
runReaderT app ReqContext{request=req, requestBody=reqBody}
notFoundResp :: W.Response
notFoundResp = toResponse @(T.Text, Status) ("Not Found", notFound404)
addMiddleware :: App W.Request
-> (W.Response -> App W.Response)
-> App ()
-> App ()
addMiddleware before after app = pre `catchError` post
where
post resp = after resp >>= throwError
pre = before >>= \req -> local (\ctx -> ctx{request=req}) app