hack2-handler-warp 2011.10.12 → 2012.5.25
raw patch · 2 files changed
+4/−146 lines, 2 filesdep +hack2-interface-waidep −blaze-builderdep −bytestringdep −case-insensitivePVP ok
version bump matches the API change (PVP)
Dependencies added: hack2-interface-wai
Dependencies removed: blaze-builder, bytestring, case-insensitive, containers, enumerator, http-types, mtl, network, safe, wai
API changes (from Hackage documentation)
Files
- hack2-handler-warp.cabal +2/−11
- src/Hack2/Handler/Warp.hs +2/−135
hack2-handler-warp.cabal view
@@ -1,5 +1,5 @@ Name: hack2-handler-warp-Version: 2011.10.12+Version: 2012.5.25 Build-type: Simple Synopsis: Hack2 warp handler Description: Hack2 warp handler@@ -17,20 +17,11 @@ build-depends: base >= 4.0 && <= 100- , network- , bytestring , data-default >= 0.2 , hack2 >= 2011.6.20- , containers- , mtl- , enumerator- , wai , warp- , blaze-builder- , http-types- , case-insensitive , air- , safe+ , hack2-interface-wai hs-source-dirs: src/ exposed-modules:
src/Hack2/Handler/Warp.hs view
@@ -17,145 +17,12 @@ import Prelude () import Air.Env hiding (def, Default) -import qualified Network.Wai as Wai import Hack2 import Data.Default (def, Default)-import qualified Network.HTTP.Types as HTTPTypes-import qualified Data.CaseInsensitive as CaseInsensitive-import Data.ByteString.Char8 (ByteString, pack)-import qualified Data.ByteString.Char8 as B-import Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_, Enumeratee, Step, (=$))-import qualified Data.Enumerator.List as EL-import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString) -import qualified Network.Wai.Handler.Warp as Warp-import qualified Safe as Safe -{---{ requestMethod :: RequestMethod-, scriptName :: ByteString-, pathInfo :: ByteString-, queryString :: ByteString-, serverName :: ByteString-, serverPort :: Int-, httpHeaders :: [(ByteString, ByteString)]-, hackVersion :: (Int, Int, Int)-, hackUrlScheme :: HackUrlScheme-, hackInput :: HackEnumerator-, hackErrors :: HackErrors-, hackHeaders :: [(ByteString, ByteString)]---}-requestToEnv :: Wai.Request -> Env-requestToEnv request = def- {- requestMethod = request.Wai.requestMethod.show.upper.Safe.readDef GET- , pathInfo = request.Wai.rawPathInfo - , queryString = request.Wai.rawQueryString.B.dropWhile (is '?')- , serverName = request.Wai.serverName- , serverPort = request.Wai.serverPort- , httpHeaders = request.Wai.requestHeaders.map caseInsensitiveHeaderToHeader- , hackUrlScheme = if request.Wai.isSecure then HTTPS else HTTP- , hackHeaders = [("RemoteHost", request.Wai.remoteHost.show.pack)]- }- --caseInsensitiveHeaderToHeader :: (CaseInsensitive.CI ByteString, ByteString) -> (ByteString, ByteString)-caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) --headerToCaseInsensitiveHeader :: (ByteString, ByteString) -> (CaseInsensitive.CI ByteString, ByteString)-headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) --statusToStatusHeader :: Int -> HTTPTypes.Status-statusToStatusHeader 200 = HTTPTypes.status200-statusToStatusHeader 201 = HTTPTypes.status201-statusToStatusHeader 206 = HTTPTypes.status206-statusToStatusHeader 301 = HTTPTypes.status301-statusToStatusHeader 302 = HTTPTypes.status302-statusToStatusHeader 303 = HTTPTypes.status303-statusToStatusHeader 304 = HTTPTypes.status304-statusToStatusHeader 400 = HTTPTypes.status400-statusToStatusHeader 401 = HTTPTypes.status401-statusToStatusHeader 403 = HTTPTypes.status403-statusToStatusHeader 404 = HTTPTypes.status404-statusToStatusHeader 405 = HTTPTypes.status405-statusToStatusHeader 412 = HTTPTypes.status412-statusToStatusHeader 416 = HTTPTypes.status416-statusToStatusHeader 500 = HTTPTypes.status500-statusToStatusHeader 501 = HTTPTypes.status501-statusToStatusHeader _ = HTTPTypes.statusNotImplemented--hackAppToWaiApp :: Application -> Wai.Application-hackAppToWaiApp app request = do- response <- io - app - requestToEnv request- - let wai_response_enumerator = hackResponseToWaiResponseEnumerator response - - return - Wai.ResponseEnumerator wai_response_enumerator- - - --hackResponseToWaiResponseEnumerator :: (forall a. Response -> Wai.ResponseEnumerator a)-hackResponseToWaiResponseEnumerator response f = - let s = response.status.statusToStatusHeader- h = response.headers.map headerToCaseInsensitiveHeader- - -- wai response enumerator expect the callback (iteratee) to acts on builder.- -- type ResponseEnumerator a =- -- (H.Status -> H.ResponseHeaders -> Iteratee Builder IO a) -> IO a- - server_iteratee :: Iteratee Builder IO a- server_iteratee = f s h-- - -- in Builder, fromByteString :: S.ByteString -> Builder- -- in Enumerator.List, map :: Monad m => (ao -> ai)- -- -> Enumeratee ao ai m b- - -- type Enumeratee ao ai m b = Step ai m b -> Iteratee ao m (Step ai m b)- -- builder_enumeratee :: Enumeratee ByteString Builder IO a- builder_enumeratee :: Step Builder IO a -> Iteratee ByteString IO (Step Builder IO a)- builder_enumeratee = EL.map fromByteString- - - {-- -- make fromByteString act as the preprocesser of server_iteratee,- -- by joining- -- ($$) :: Monad m- -- => (Step a m b -> Iteratee a' m b')- -- -> Iteratee a m b- -- -> Iteratee a' m b'- -- ($$) = (==<<)- -- this is similar to :: readFile >>= putStrLn, in a Monad context- bytestring_to_builder_layered_iteratee :: Iteratee ByteString IO (Step Builder IO a)- bytestring_to_builder_layered_iteratee = builder_enumeratee $$ server_iteratee- - -- iteratee is needs to be flattened- -- joinI :: Monad m => Iteratee a m (Step a' m b)- -- -> Iteratee a m b- -- joinI outer = outer >>= check where- -- check (Continue k) = k EOF >>== \s -> case s of- -- Continue _ -> error "joinI: divergent iteratee"- -- _ -> check s- -- check (Yield x _) = return x- -- check (Error e) = throwError e- - flattened_server_iteratee :: Iteratee ByteString IO a- flattened_server_iteratee = joinI bytestring_to_builder_layered_iteratee- -}- - flattened_server_iteratee :: Iteratee ByteString IO a- flattened_server_iteratee = builder_enumeratee =$ server_iteratee- - final_iteratee_taking_input_from_hack_enumerator :: Iteratee ByteString IO a- final_iteratee_taking_input_from_hack_enumerator = response.body.unHackEnumerator $$ flattened_server_iteratee- - - in- run_ final_iteratee_taking_input_from_hack_enumerator-+import qualified Network.Wai.Handler.Warp as Warp+import Hack2.Interface.Wai (hackAppToWaiApp) data ServerConfig = ServerConfig {