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)
{- |

> case modRewriteAppUrl "tutorial/registered" of 
>   Left e -> ...
>   Right page -> ... 

Given a page path, try to return the "home page" of a happs server, basically, the host plus an optional path.
At the same time, try to deal sanely with HAppS serving behind apache mod rewrite,
a common situation for me at least
because it lets you have multiple happs servers listening on different ports, all
looking to the casual user like they are being served on port 80, and also unblocked by firewalls.

Can fail monadically
-}
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" 
      -- trim starting slash if necessary
      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 = getHeaderVal \"host\" 

returns host with port numbers, if anything other than default 80
-}
getHost :: Request -> Either String String
getHost = getHeaderVal "host" 

{- |
retrieve val of header for key supplied, or an error message if the key isn't found
-}
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 )

{- | 
host with port number stripped out, if any. 

Useful, for example, for getting the right address to ssh to. 
-}
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