module Happstack.Helpers.ParseRequest where
import Happstack.Server.HTTP.Types
import Text.StringTemplate.Helpers
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Data.String.Utils (split)
modRewriteAppUrl :: String -> Request -> Either String String
modRewriteAppUrl path' rq =
let apphost = case getHeaderVal "x-forwarded-server" rq of
Right h -> Right h
Left _ -> case getHeaderVal "host" rq of
Right h -> Right h
Left _ -> Left "modRewriteAppUrl, can't determine host"
path = case path' of
"" -> ""
'/':cs -> cs
x -> x
in case apphost of
Right apphost' -> Right $ render1 [("apphost",apphost'),("path",path)] "http://$apphost$/$path$"
Left e -> Left $ "modRewirteAppUrl error: " ++ e
getHost :: Request -> Either String String
getHost = getHeaderVal "host"
getHeaderVal :: String -> Request -> Either String String
getHeaderVal headerKey rq = maybe (Left $ "getHeaderVal, bad headerKey: " ++ headerKey)
( Right . B.unpack . head . hValue )
( M.lookup ( B.pack headerKey ) . rqHeaders $ rq )
getDomain :: Request -> Either String String
getDomain rq = do
h <- getHost rq
let parts = split ":" h
case parts of
[d] -> Right d
[d,_] -> Right d
_ -> Left $ "getDomain, bad domain: " ++ h