hack2-handler-warp (empty) → 2011.6.20

raw patch · 7 files changed

+239/−0 lines, 7 filesdep +airdep +basedep +blaze-buildersetup-changed

Dependencies added: air, base, blaze-builder, bytestring, case-insensitive, containers, data-default, enumerator, hack2, http-types, mtl, network, safe, wai, warp

Files

• LICENSE +31/−0
• Nemesis +35/−0
• Setup.lhs +4/−0
• changelog.md +0/−0
• hack2-handler-warp.cabal +38/−0
• readme.md +4/−0
• src/Hack2/Handler/Warp.hs +127/−0

@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jinjing Wang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,35 @@+nemesis = do+  +  clean+    [ "**/*.hi"+    , "**/*.o"+    , "manifest"+    , "main"+    , "nemesis-tmp.*"+    , "Test"+    ]+  ++  desc "prepare cabal dist"+  task "dist" $ do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"+++  desc "put all .hs files in manifest"+  task "manifest" $ do+    sh "find . | grep 'hs$' > manifest"+++  desc "start console"+  task "i" (sh "ghci -isrc src/Hack2/Handler/Warp.hs")+  ++  desc "test"+  task "test" $ do+    sh "runghc test.hs"+  +  desc "show sloc"+  task "stat" $ do+    sh "cloc -match-f=hs$ --quiet src"

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,38 @@+Name:                 hack2-handler-warp+Version:              2011.6.20+Build-type:           Simple+Synopsis:             Hack2 warp handler+Description:          Hack2 warp handler+License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Web+homepage:             https://github.com/nfjinjing/hack2-handler-warp+data-files:           readme.md, changelog.md, Nemesis++library++  build-depends: +                      base >= 4.0 && < 5+                    , network+                    , bytestring+                    , data-default >= 0.2+                    , hack2 >= 2011.6.20+                    , containers+                    , mtl+                    , enumerator < 5+                    , wai < 0.5+                    , warp < 0.5+                    , blaze-builder < 0.4+                    , http-types < 0.7+                    , case-insensitive < 0.3+                    , air+                    , safe+                    +  hs-source-dirs: src/+  exposed-modules:  +                    Hack2.Handler.Warp+                    

@@ -0,0 +1,4 @@+Serving Hack2 application with the great Warp server+-----------------------------------------------------++* enumerator enabled, constant memory consumption when enumerator all the way down

@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Hack2.Handler.Warp +(++  run+, runWithConfig+, ServerConfig(..)+, hackAppToWaiApp++) where++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 Data.Enumerator (Enumerator, Iteratee (..), ($$), joinI, run_)+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+  , 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 = hackResponseToWaiResponseEnumerator response +   +   return - Wai.ResponseEnumerator wai_response+   +  +  ++hackResponseToWaiResponseEnumerator :: Response -> (forall a.  Wai.ResponseEnumerator a)+hackResponseToWaiResponseEnumerator response f = +  let s = response.status.statusToStatusHeader+      h = response.headers.map headerToCaseInsensitiveHeader++  in+  run_ - response.body.unHackEnumerator $$ joinI - EL.map fromByteString $$ f s h+++data ServerConfig = ServerConfig+  {+    port :: Int+  }+  deriving (Show, Eq)++instance Default ServerConfig where+  def = ServerConfig+    {+      port = 3000+    }+++runWithConfig :: ServerConfig -> Application -> IO ()+runWithConfig config app = Warp.runSettings+  Warp.defaultSettings {Warp.settingsPort = config.port}+  (hackAppToWaiApp app)++run :: Application -> IO ()+run = runWithConfig def+