hack-handler-happstack 2009.4.51 → 2009.4.51.1

raw patch · 3 files changed

+32/−13 lines, 3 filesdep −hack-contribdep ~hack

Dependencies removed: hack-contrib

Dependency ranges changed: hack

Files

• changelog.md +13/−0
• hack-handler-happstack.cabal +2/−2
• src/Hack/Handler/Happstack.hs +17/−11

@@ -1,3 +1,16 @@+2009.4.51.1+-----------++### Feature++* configurable port+* specify serverName statically for now++### Fix++* remove ? in query string+* do not need hack-contrib to build+ 2009.4.51 ----------- 

@@ -1,5 +1,5 @@ Name:                 hack-handler-happstack-Version:              2009.4.51+Version:              2009.4.51.1 Build-type:           Simple Synopsis:             Hyena Kibro handler Description:          Hyena Kibro handler@@ -15,7 +15,7 @@  library   ghc-options: -Wall-  build-depends: base, cgi, network, bytestring, data-default >= 0.2, hack >= 2009.4.30, hack-contrib >= 2009.4.50, happstack-server, containers, mtl+  build-depends: base, cgi, network, bytestring, data-default >= 0.2, hack >= 2009.4.51, happstack-server, containers, mtl   hs-source-dirs: src/   exposed-modules:                       Hack.Handler.Happstack

@@ -1,9 +1,10 @@ {-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-} -module Hack.Handler.Happstack (run) where+module Hack.Handler.Happstack (run, runWithConfig, ServerConf) where  import Hack as Hack-import Happstack.Server.SimpleHTTP as Happstack+import Happstack.Server.SimpleHTTP as Happstack hiding (port)+import qualified Happstack.Server.SimpleHTTP as H  import Control.Arrow ((>>>)) import Data.Default@@ -17,14 +18,18 @@ import qualified Data.ByteString as L import qualified Data.ByteString.Internal as I -run_with_config :: Conf -> Hack.Application -> IO ()-run_with_config conf app =- Happstack.simpleHTTP conf $ myPart conf app+-- | we need this for 1. port 2. a bug in current Happstack.+--   i.e. rqPeer will not give the corrent value for serverName and port+data ServerConf = ServerConf { port :: Int, serverName :: String } +runWithConfig :: ServerConf -> Hack.Application -> IO ()+runWithConfig conf app =+ Happstack.simpleHTTP nullConf { H.port = port conf } $ myPart conf app+ run :: Hack.Application -> IO ()-run = run_with_config $ nullConf { port = 3000 }+run = runWithConfig $ ServerConf { port = 3000, serverName = "localhost" } -myPart :: Conf -> Hack.Application -> ServerPart (Happstack.Response)+myPart :: ServerConf -> Hack.Application -> ServerPart (Happstack.Response) myPart conf app = do   req <- Happstack.askRq   let env = reqToEnv conf req@@ -36,12 +41,13 @@       def { request_method = convertRequestMethod $ rqMethod req           , script_name = ""           , path_info = "/" ++ (intercalate "/" $ rqPaths req)-          , query_string = rqQuery req-          , server_name = "" -- fst $ rqPeer req+          , query_string = remove_question_mark $ rqQuery req+          , server_name = serverName conf' -- (fst $ rqPeer req) is supposed to work, but does not           , server_port = port conf'           , http = toHttp (rqHeaders req)           , hack_input = (\(Body x) -> C.unpack x) (rqBody req)           }+    remove_question_mark = dropWhile (== '?')               convertRequestMethod Happstack.OPTIONS     =     Hack.OPTIONS@@ -78,8 +84,8 @@     c2b x = L.pack $ map I.c2w x    --- happstack convert all request header to lowercase ...-+-- happstack converts all request header to lowercase ...+-- so we need to convert it back ... translate_header :: String -> String translate_header s = fromMaybe s $ find (map toLower >>> (== s) ) header_list