diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011, Jinjing Wang +Copyright (c) 2017, Jinjing Wang All rights reserved. @@ -14,7 +14,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Jinjing Wang nor the names of other + * Neither the name of the copyright holder nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/Nemesis b/Nemesis deleted file mode 100644 --- a/Nemesis +++ /dev/null @@ -1,36 +0,0 @@ -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/Interface/Wai.hs") - - - desc "start hello" - task "hello" - do - sh "runghc -isrc test/hello.hs" - - - desc "start small app (using wai-devel)" - task "small-app" - do - sh "cd test; runghc -i../src runSmallApp.hs" diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -0,0 +1,5 @@ +# 2017.1.3 + +* make it compatible with the latest wai +* get rid of the stupid air dependency + diff --git a/hack2-interface-wai.cabal b/hack2-interface-wai.cabal --- a/hack2-interface-wai.cabal +++ b/hack2-interface-wai.cabal @@ -1,35 +1,33 @@ -Name: hack2-interface-wai -Version: 2012.5.25 -Build-type: Simple -Synopsis: Hack2 interface of WAI -Description: Hack2 interface of WAI -License: BSD3 -License-file: LICENSE -Author: Jinjing Wang -Maintainer: Jinjing Wang -Build-Depends: base -Cabal-version: >= 1.2 +name: hack2-interface-wai +version: 2017.1.4 +build-type: Simple +synopsis: Hack2 interface to WAI +description: Convert a Hack2 App to a WAI app +license: BSD3 +license-file: LICENSE +author: Jinjing Wang +maintainer: Jinjing Wang +cabal-version: >= 1.10 category: Web +extra-doc-files: readme.md, changelog.md + homepage: https://github.com/nfjinjing/hack2-interface-wai -data-files: readme.md, changelog.md, Nemesis library - build-depends: - base >= 4.0 && <= 100 + base >= 4.8 && < 5 , network , bytestring , data-default >= 0.2 , hack2 >= 2011.6.20 , containers - , mtl , wai , http-types , case-insensitive - , air , safe - hs-source-dirs: src/ + hs-source-dirs: src/ exposed-modules: Hack2.Interface.Wai + default-language: Haskell2010 diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1,5 +1,5 @@ Interfacing Hack2 and Wai - +-------------------------- Example: `test/hello` @@ -20,4 +20,3 @@ main = do putStrLn $ "http://localhost:3000/" run 3000 (hackAppToWaiApp app) - diff --git a/src/Hack2/Interface/Wai.hs b/src/Hack2/Interface/Wai.hs --- a/src/Hack2/Interface/Wai.hs +++ b/src/Hack2/Interface/Wai.hs @@ -1,25 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Hack2.Interface.Wai +module Hack2.Interface.Wai ( 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 Control.Monad.IO.Class (liftIO) +import Data.ByteString.Char8 (ByteString, pack) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as Lazy - +import qualified Data.CaseInsensitive as CaseInsensitive +import Data.Char (toUpper) +import Data.Default (def, Default) +import Data.Maybe (fromMaybe) +import Hack2 +import qualified Network.HTTP.Types as HTTPTypes +import qualified Network.Wai as Wai +import Prelude hiding ((-), (.)) import qualified Safe as Safe {- @@ -38,25 +35,45 @@ , 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)] - } - +infixr 0 - +{-# INLINE (-) #-} +(-) :: (a -> b) -> a -> b +f - x = f x + +infixl 9 . +{-# INLINE (.) #-} +(.) :: a -> (a -> b) -> b +a . f = f a + +requestToEnv :: Wai.Request -> IO Env +requestToEnv request = do + requestBody <- request.Wai.strictRequestBody + + let + (serverName:serverPort:_) = request.Wai.remoteHost.show.B.pack.B.split ':' ++ [mempty, mempty] + + return - + def + { + requestMethod = request.Wai.requestMethod.show.map toUpper.Safe.readDef GET + , pathInfo = request.Wai.rawPathInfo + , queryString = request.Wai.rawQueryString.B.dropWhile (== '?') + , serverName = serverName + , serverPort = Safe.readMay (show serverPort).fromMaybe 0 + , httpHeaders = request.Wai.requestHeaders.map caseInsensitiveHeaderToHeader + , hackUrlScheme = if request.Wai.isSecure then HTTPS else HTTP + , hackHeaders = [("RemoteHost", request.Wai.remoteHost.show.pack)] + , hackInput = Lazy.toStrict requestBody + } + + + caseInsensitiveHeaderToHeader :: (CaseInsensitive.CI ByteString, ByteString) -> (ByteString, ByteString) -caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) +caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y) headerToCaseInsensitiveHeader :: (ByteString, ByteString) -> (CaseInsensitive.CI ByteString, ByteString) -headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) +headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y) statusToStatusHeader :: Int -> HTTPTypes.Status statusToStatusHeader 200 = HTTPTypes.status200 @@ -82,25 +99,18 @@ statusToStatusHeader _ = HTTPTypes.status505 hackAppToWaiApp :: Application -> Wai.Application -hackAppToWaiApp app request = do - response <- io - app - requestToEnv request - - let wai_response = hackResponseToWaiResponse response - - return - wai_response - - - +hackAppToWaiApp app request respond = do + response <- liftIO - app =<< requestToEnv request + let wai_response = hackResponseToWaiResponse response + respond wai_response hackResponseToWaiResponse :: Response -> Wai.Response -hackResponseToWaiResponse response = +hackResponseToWaiResponse response = let s = response.status.statusToStatusHeader h = response.headers.map headerToCaseInsensitiveHeader - + b = Lazy.fromChunks [response.body] - + in - + Wai.responseLBS s h b - -