module Web.Respond.Response where
import Control.Applicative ((<$>))
import Network.Wai
import qualified Data.ByteString as BS
import Network.HTTP.Types.Status
import Network.HTTP.Types.Header
import Network.HTTP.Types.Method
import Control.Lens (view)
import Control.Monad (join)
import Control.Monad.Catch
import Data.Maybe (fromMaybe)
import Web.Respond.Types
import Web.Respond.Monad
findHeader :: MonadRespond m => HeaderName -> m (Maybe BS.ByteString)
findHeader header = lookup header . requestHeaders <$> getRequest
findHeaderDefault :: MonadRespond m => HeaderName -> BS.ByteString -> m BS.ByteString
findHeaderDefault header defValue = fromMaybe defValue <$> findHeader header
getAcceptHeader :: MonadRespond m => m BS.ByteString
getAcceptHeader = findHeaderDefault hAccept "*/*"
respondEmptyBody :: MonadRespond m => Status -> ResponseHeaders -> m ResponseReceived
respondEmptyBody status headers = respond $ responseLBS status headers ""
respondUsingBody :: MonadRespond m => Status -> ResponseHeaders -> ResponseBody -> m ResponseReceived
respondUsingBody status headers body = respond $ mkResponseForBody status headers body
respondWith :: (MonadRespond m, ToResponseBody a) => Status -> ResponseHeaders -> a -> m ResponseReceived
respondWith status headers body = getAcceptHeader >>= maybe handleUnacceptableResponse respond . mkResponse status headers body
respondStdHeaders :: (MonadRespond m, ToResponseBody a) => Status -> a -> m ResponseReceived
respondStdHeaders = flip respondWith []
respondOk :: (MonadRespond m, ToResponseBody a) => a -> m ResponseReceived
respondOk = respondStdHeaders ok200
respondReportError :: (MonadRespond m, ReportableError e) => Status -> ResponseHeaders -> e -> m ResponseReceived
respondReportError status headers err = getAcceptHeader >>= respondUsingBody status headers . reportError status err
respondNotFound :: (MonadRespond m, ReportableError e) => e -> m ResponseReceived
respondNotFound = respondReportError notFound404 []
handleUnsupportedMethod :: MonadRespond m => [StdMethod] -> Method -> m ResponseReceived
handleUnsupportedMethod supported unsupported = do
handler <- getHandler (view unsupportedMethod)
handler supported unsupported
handleUnmatchedPath :: MonadRespond m => m ResponseReceived
handleUnmatchedPath = join (getHandler (view unmatchedPath))
handleUnacceptableResponse :: MonadRespond m => m ResponseReceived
handleUnacceptableResponse = join (getHandler (view unacceptableResponse))
useHandlerForReport :: (MonadRespond m, ReportableError e)
=> (FailureHandlers -> e -> m ResponseReceived)
-> e
-> m ResponseReceived
useHandlerForReport getter e = do
h <- getHandler getter
h e
handleBodyParseFailure :: (MonadRespond m, ReportableError e) => e -> m ResponseReceived
handleBodyParseFailure = useHandlerForReport (view bodyParseFailed)
handleAuthFailed :: (MonadRespond m, ReportableError e) => e -> m ResponseReceived
handleAuthFailed = useHandlerForReport (view authFailed)
handleAccessDenied :: (ReportableError e, MonadRespond m) => e -> m ResponseReceived
handleAccessDenied = useHandlerForReport (view accessDenied)
handleCaughtException :: (ReportableError e, MonadRespond m) => e -> m ResponseReceived
handleCaughtException = useHandlerForReport (view caughtException)
getHandler :: MonadRespond m => (FailureHandlers -> a) -> m a
getHandler = (<$> getHandlers)
maybeNotFound :: (ReportableError e, MonadRespond m) => e -> (a -> m ResponseReceived) -> Maybe a -> m ResponseReceived
maybeNotFound = maybe . respondReportError notFound404 []
catchRespond :: (MonadCatch m, MonadRespond m, ReportableError r, Exception e) => (e -> r) -> m ResponseReceived -> m ResponseReceived
catchRespond = handle . (handleCaughtException .)