HAppSHelpers 0.8 → 0.9

raw patch · 4 files changed

+23/−12 lines, 4 files

Files

• HAppS/Helpers/DirBrowse.hs +3/−1
• HAppS/Helpers/ParseRequest.hs +18/−9
• HAppS/Helpers/Redirect.hs +1/−1
• HAppSHelpers.cabal +1/−1

@@ -9,6 +9,8 @@   (browsedir, browsedirHS, browsedir') where +import System.FilePath+ import HAppS.Server  import Control.Monad.Trans (liftIO) import System.Directory (doesDirectoryExist,getDirectoryContents,doesFileExist)@@ -60,7 +62,7 @@ browsedir' paintdir paintfile diralias syspath = multi [   ServerPartT $ \rq -> do     let aliaspath = ( mypathstring . rqPaths $ rq )-    if (not . isPrefixOf diralias $ aliaspath)+    if (not $ isPrefixOf (addTrailingPathSeparator diralias) $ (addTrailingPathSeparator aliaspath) )        then noHandle        else do          -- to do: s/rqp/realpath/

@@ -6,20 +6,29 @@ 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+Try to return the "home page" of a happs server, basically, the host plus an optional path.+The "smart" part is trying 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. -}-getAppUrl :: String -> Request -> String-getAppUrl path' rq = -  let host =  either (const "getAppUrlCantDetermineHost") id $ getHost rq+smartAppUrl :: String -> Request -> String+smartAppUrl path' rq =+  let forwardinghost = getHeaderVal "x-forwarded-server" rq+      vanillahost = getHeaderVal "host" rq+      apphost = case forwardinghost of+        Right h -> h+        Left _ -> case vanillahost of+          Right h -> h+          Left _ -> "getAppUrlCantDetermineHost" --ugly way to propogate error!       -- trim starting slash if necessary       path = case path' of                "" -> ""                '/':cs -> cs-               cs -> cs -  in render1 [("host",host),("path",path)] "http://$host$/$path$"+               x -> x+  in render1 [("apphost",apphost),("path",path)] "http://$apphost$/$path$"++  {- |  getHost = getHeaderVal \"host\" 

@@ -12,7 +12,7 @@ redirectPath p rq = redirectToUrl $ getAppUrl p rq -} redirectPath :: String -> Request -> WebT IO Response-redirectPath p rq = redirectToUrl $ getAppUrl p rq+redirectPath p rq = redirectToUrl $ smartAppUrl p rq  {- | Escape a servrPartT handler by redirecting somewhere

@@ -1,5 +1,5 @@ Name: HAppSHelpers-Version: 0.8+Version: 0.9 License: BSD3 License-file: bsd3.txt Description: Functions I found I was using repeatedly when programming HAppS based web-apps.