module HAppS.Helpers.ParseRequest where import HAppS.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) {- | Useful hack for ensuring same behavior between local dev environment (host is localhost) and webserver getAppUrl \"\/some\/path\" rq => \"http:\/\/localhost:5001\/some\/path\" if I'm local, if I'm online it also does the right thing -} getAppUrl :: String -> Request -> String getAppUrl path' rq = let host = either (const "getAppUrlCantDetermineHost") id $ getHost rq -- trim starting slash if necessary path = case path' of "" -> "" '/':cs -> cs cs -> cs in render1 [("host",host),("path",path)] "http://$host$/$path$" {- | 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,p] -> Right d xs -> Left $ "getDomain, bad domain: " ++ h