ParseRequest.hs

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