haskweb/Request.hs

{-# LANGUAGE ExistentialQuantification #-}

module Request (
    RequestHandler(..), handlePath
) where

import Network.URI
import Network.FastCGI
import Text.Regex.PCRE
import Database

import AppMonad

class RequestHandler a where
    handle :: a -> App CGIResult
    requireLogin :: a -> Bool
    requireLogin _ = False
    handleRequest :: a -> App CGIResult
    handleRequest x = do
        status <- isLoggedIn
        path <- uriPath <$> requestURI
        if not status && requireLogin x
            then redirect $ "/login?from=" ++ path
            else handle x

data RH = forall h. RequestHandler h => RH h

instance RequestHandler RH where
    requireLogin (RH x) = requireLogin x
    handle (RH x) = handle x

handlePath :: RequestHandler a => String -> String -> a -> Maybe RH
handlePath path pattern handler
    | path =~ pattern = Just (RH handler)
    | otherwise       = Nothing