mirror of
https://github.com/typeable/wai.git
synced 2024-12-26 07:35:38 +03:00
Remove some tricky handlers
This commit is contained in:
Michael Snoyman
parent
9cf4a6890e
commit
e2ce4d7599
25
.travis.yml
25
.travis.yml
@ -53,22 +53,22 @@ matrix:
|
||||
# addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #GHC 7.10.3"
|
||||
addons: {apt: {packages: [libfcgi-dev,cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #GHC 8.0.2"
|
||||
addons: {apt: {packages: [libfcgi-dev,cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #GHC 8.2.2"
|
||||
addons: {apt: {packages: [libfcgi-dev,cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
- env: BUILD=cabal GHCVER=8.4.3 CABALVER=2.2 HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #GHC 8.4.3"
|
||||
addons: {apt: {packages: [libfcgi-dev,cabal-install-2.2,ghc-8.4.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
|
||||
# Build with the newest GHC and cabal-install. This is an accepted failure,
|
||||
# see below.
|
||||
- env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7
|
||||
compiler: ": #GHC HEAD"
|
||||
addons: {apt: {packages: [libfcgi-dev,cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
|
||||
|
||||
# The Stack builds. We can pass in arbitrary Stack arguments via the ARGS
|
||||
# variable, such as using --stack-yaml to point to a different file.
|
||||
@ -86,7 +86,7 @@ matrix:
|
||||
|
||||
- env: BUILD=stack ARGS="--resolver lts-6" STACK_YAML="stack-lts-6.yaml"
|
||||
compiler: ": #stack 7.10.3"
|
||||
addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
#- env: BUILD=stack ARGS="--resolver lts-7"
|
||||
# compiler: ": #stack 8.0.1"
|
||||
@ -94,20 +94,20 @@ matrix:
|
||||
|
||||
- env: BUILD=stack ARGS="--resolver lts-9" STACK_YAML="stack-lts-9.yaml"
|
||||
compiler: ": #stack 8.0.2"
|
||||
addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
- env: BUILD=stack ARGS="--resolver lts-11" STACK_YAML="stack-lts-11.yaml"
|
||||
compiler: ": #stack 8.2.2"
|
||||
addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
- env: BUILD=stack ARGS="--resolver lts-12" STACK_YAML="stack-lts-12.yaml"
|
||||
compiler: ": #stack 8.4.3"
|
||||
addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
# Nightly builds are allowed to fail
|
||||
- env: BUILD=stack ARGS="--resolver nightly" STACK_YAML="stack-nightly.yaml"
|
||||
compiler: ": #stack nightly"
|
||||
addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
# Build on macOS in addition to Linux
|
||||
#- env: BUILD=stack ARGS=""
|
||||
@ -166,11 +166,6 @@ before_install:
|
||||
if [ `uname` = "Darwin" ]
|
||||
then
|
||||
travis_retry curl --insecure -L https://get.haskellstack.org/stable/osx-x86_64.tar.gz | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin
|
||||
|
||||
# brew no longer has fcgi
|
||||
# brew install fcgi
|
||||
grep -v wai-handler-fastcgi < $STACK_YAML > tmp
|
||||
mv tmp $STACK_YAML
|
||||
else
|
||||
travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
|
||||
fi
|
||||
|
||||
@ -7,7 +7,6 @@ packages:
|
||||
- ./warp
|
||||
- ./warp-tls
|
||||
- ./wai-app-static
|
||||
- ./wai-handler-fastcgi
|
||||
- ./wai-websockets
|
||||
- ./wai-conduit
|
||||
flags:
|
||||
|
||||
@ -7,7 +7,6 @@ packages:
|
||||
- ./warp
|
||||
- ./warp-tls
|
||||
- ./wai-app-static
|
||||
- ./wai-handler-fastcgi
|
||||
- ./wai-websockets
|
||||
- ./wai-conduit
|
||||
flags:
|
||||
|
||||
@ -7,7 +7,6 @@ packages:
|
||||
- ./warp
|
||||
- ./warp-tls
|
||||
- ./wai-app-static
|
||||
- ./wai-handler-fastcgi
|
||||
- ./wai-websockets
|
||||
- ./wai-conduit
|
||||
extra-deps:
|
||||
|
||||
@ -7,7 +7,6 @@ packages:
|
||||
- ./warp
|
||||
- ./warp-tls
|
||||
- ./wai-app-static
|
||||
- ./wai-handler-fastcgi
|
||||
- ./wai-websockets
|
||||
- ./wai-conduit
|
||||
extra-deps:
|
||||
|
||||
@ -7,7 +7,6 @@ packages:
|
||||
- ./warp
|
||||
- ./warp-tls
|
||||
- ./wai-app-static
|
||||
- ./wai-handler-fastcgi
|
||||
- ./wai-websockets
|
||||
- ./wai-conduit
|
||||
flags:
|
||||
|
||||
4
wai-handler-fastcgi/.gitignore
vendored
4
wai-handler-fastcgi/.gitignore
vendored
@ -1,4 +0,0 @@
|
||||
/dist/
|
||||
*.swp
|
||||
*.hi
|
||||
*.o
|
||||
@ -1,3 +0,0 @@
|
||||
## 3.0.0.2
|
||||
|
||||
* Support wai 3.2
|
||||
@ -1,20 +0,0 @@
|
||||
Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
@ -1,192 +0,0 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Network.Wai.Handler.FastCGI
|
||||
-- Copyright : (c) Bjorn Bringert 2004-2005, (c) Lemmih 2006, (c) Michael Snoyman 2010
|
||||
-- License : BSD-style (see the file libraries/network/LICENSE)
|
||||
--
|
||||
-- Maintainer : michael@snoyman.com
|
||||
-- Stability : experimental
|
||||
-- Portability : non-portable (uses FFI)
|
||||
--
|
||||
-- Interface for FastCGI <http://fastcgi.com/>, using the fcgiapp API.
|
||||
-- Totally ripped off by Michael Snoyman to work with Hack, then WAI.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
module Network.Wai.Handler.FastCGI
|
||||
( run
|
||||
, runSendfile
|
||||
, runFork
|
||||
) where
|
||||
|
||||
import Control.Monad ( liftM, forever )
|
||||
import Data.Word (Word8)
|
||||
import Foreign ( Ptr, castPtr, nullPtr, peekArray0
|
||||
, throwIfNeg_, mallocBytes, free )
|
||||
#ifdef GHC_7_4
|
||||
import Foreign.C (CInt(..), CString, CStringLen)
|
||||
#else
|
||||
import Foreign.C (CInt, CString, CStringLen)
|
||||
#endif
|
||||
import Control.Exception (finally)
|
||||
import Foreign.Storable ( Storable (..) )
|
||||
|
||||
import qualified Network.Wai as W
|
||||
import qualified Network.Wai.Handler.CGI as CGI
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Internal as BSB
|
||||
import qualified Data.ByteString.Unsafe as BSB
|
||||
|
||||
import Control.Arrow ((***))
|
||||
|
||||
#include <fcgiapp.h>
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
data FCGX_Stream
|
||||
type StreamPtr = Ptr FCGX_Stream
|
||||
type Environ = Ptr CString
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
foreign import ccall unsafe "fcgiapp.h FCGX_GetStr" fcgx_getStr
|
||||
:: CString -> CInt -> StreamPtr -> IO CInt
|
||||
|
||||
foreign import ccall unsafe "fcgiapp.h FCGX_PutStr" fcgx_putStr
|
||||
:: CString -> CInt -> StreamPtr -> IO CInt
|
||||
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
foreign import ccall unsafe "fcgiapp.h FCGX_Init" fcgx_init
|
||||
:: IO CInt
|
||||
|
||||
runFork :: Maybe S.ByteString -> (IO () -> IO a) -> Int -> W.Application -> IO ()
|
||||
runFork sf fork threads app = do
|
||||
testReturn "FCGX_Init" $ fcgx_init
|
||||
let oneThread = forever $ oneRequest app sf
|
||||
mapM_ fork $ replicate (threads - 1) oneThread
|
||||
oneThread
|
||||
|
||||
-- | Handle FastCGI requests in an infinite loop.
|
||||
run :: W.Application -> IO ()
|
||||
run = runFork Nothing id 1
|
||||
|
||||
-- | Handle FastCGI requests in an infinite loop. For a server which supports
|
||||
-- the X-Sendfile header.
|
||||
runSendfile :: S.ByteString -> W.Application -> IO ()
|
||||
runSendfile sf = runFork (Just sf) id 1
|
||||
|
||||
oneRequest :: W.Application
|
||||
-> Maybe S.ByteString -- X-Sendfile
|
||||
-> IO ()
|
||||
oneRequest app xsendfile = withRequest $ \r -> do
|
||||
putStrLn "Received 1 request"
|
||||
env <- peekEnvp r
|
||||
ins <- peekIn r
|
||||
outs <- peekOut r
|
||||
handleRequest app ins outs env xsendfile
|
||||
|
||||
peekIn, peekOut :: Ptr FCGX_Request -> IO (Ptr FCGX_Stream)
|
||||
peekIn = (#peek FCGX_Request, in)
|
||||
peekOut = (#peek FCGX_Request, out)
|
||||
|
||||
peekEnvp :: Ptr FCGX_Request -> IO Environ
|
||||
peekEnvp = (#peek FCGX_Request, envp)
|
||||
|
||||
foreign import ccall unsafe "fcgiapp.h FCGX_InitRequest" fcgx_initrequest
|
||||
:: Ptr FCGX_Request -> CInt -> CInt -> IO CInt
|
||||
|
||||
foreign import ccall safe "fcgiapp.h FCGX_Accept_r" fcgx_accept_r
|
||||
:: Ptr FCGX_Request -> IO CInt
|
||||
|
||||
acceptRequest :: IO (Ptr FCGX_Request)
|
||||
acceptRequest = do
|
||||
reqp <- mallocBytes (#size FCGX_Request)
|
||||
initAndAccept reqp
|
||||
return reqp
|
||||
where initAndAccept reqp = do
|
||||
testReturn "FCGX_InitRequest" $ fcgx_initrequest reqp 0 0
|
||||
testReturn "FCGX_Accept_r" $ fcgx_accept_r reqp
|
||||
|
||||
withRequest :: (Ptr FCGX_Request -> IO ()) -> IO ()
|
||||
withRequest f = do
|
||||
req <- acceptRequest
|
||||
f req `finally` finishRequest req
|
||||
|
||||
foreign import ccall unsafe "fcgiapp.h FCGX_Finish_r" fcgx_finish_r
|
||||
:: Ptr FCGX_Request -> IO ()
|
||||
|
||||
finishRequest :: Ptr FCGX_Request -> IO ()
|
||||
finishRequest reqp = do
|
||||
fcgx_finish_r reqp
|
||||
free reqp
|
||||
|
||||
handleRequest :: W.Application
|
||||
-> StreamPtr
|
||||
-> StreamPtr
|
||||
-> Environ
|
||||
-> Maybe S.ByteString -- sendfile
|
||||
-> IO ()
|
||||
handleRequest f ins outs env xsendfile = do
|
||||
vars <- environToTable env
|
||||
let vars' = map (S8.unpack *** S8.unpack) vars
|
||||
let input = const $ sRead ins
|
||||
let hPut = sPutStr' outs
|
||||
CGI.runGeneric vars' (CGI.requestBodyFunc input) hPut xsendfile f
|
||||
|
||||
data FCGX_Request
|
||||
|
||||
--
|
||||
-- * Stream IO
|
||||
--
|
||||
|
||||
sPutStr' :: StreamPtr -> BS.ByteString -> IO ()
|
||||
sPutStr' h str =
|
||||
BSB.unsafeUseAsCStringLen str $ fcgxPutCStringLen h
|
||||
|
||||
fcgxPutCStringLen :: StreamPtr -> CStringLen -> IO ()
|
||||
fcgxPutCStringLen h (cs,len) =
|
||||
testReturn "FCGX_PutStr" $ fcgx_putStr cs (fromIntegral len) h
|
||||
|
||||
sRead :: StreamPtr -> IO (Maybe BS.ByteString)
|
||||
sRead h = buildByteString (fcgxGetBuf h) 4096
|
||||
|
||||
fcgxGetBuf :: StreamPtr -> Ptr a -> Int -> IO Int
|
||||
fcgxGetBuf h p c =
|
||||
liftM fromIntegral $ fcgx_getStr (castPtr p) (fromIntegral c) h
|
||||
|
||||
--
|
||||
-- * ByteString utilities
|
||||
--
|
||||
|
||||
-- | Data.ByteString.Lazy.hGetContentsN generalized to arbitrary
|
||||
-- reading functions.
|
||||
buildByteString :: (Ptr Word8 -> Int -> IO Int) -> Int -> IO (Maybe BS.ByteString)
|
||||
buildByteString f k = do
|
||||
ps <- BSB.createAndTrim k $ \p -> f p k
|
||||
case BS.length ps of
|
||||
0 -> return Nothing
|
||||
_ -> return $ Just ps
|
||||
|
||||
--
|
||||
-- * Utilities
|
||||
--
|
||||
|
||||
testReturn :: String -> IO CInt -> IO ()
|
||||
testReturn e = throwIfNeg_ (\n -> e ++ " failed with error code: "++ show n)
|
||||
|
||||
environToTable :: Environ -> IO [(S.ByteString, S.ByteString)]
|
||||
environToTable arr = do
|
||||
css <- peekArray0 nullPtr arr
|
||||
ss <- mapM S.packCString css
|
||||
return $ map splitEq ss
|
||||
where
|
||||
splitEq s =
|
||||
let (a, b) = S.breakByte 61 s
|
||||
in (a, S.drop 1 b)
|
||||
@ -1,3 +0,0 @@
|
||||
## wai-handler-fastcgi
|
||||
|
||||
Calls out to the libfcgi C library.
|
||||
@ -1,7 +0,0 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
> module Main where
|
||||
> import Distribution.Simple
|
||||
|
||||
> main :: IO ()
|
||||
> main = defaultMain
|
||||
9
wai-handler-fastcgi/configure
vendored
9
wai-handler-fastcgi/configure
vendored
@ -1,9 +0,0 @@
|
||||
#!/bin/sh
|
||||
#
|
||||
|
||||
# subst standard header path variables
|
||||
if test -n "$CPPFLAGS" ; then
|
||||
echo "Found CPPFLAGS in environment: '$CPPFLAGS'"
|
||||
sed 's,@CPPFLAGS@,'"$CPPFLAGS"',g;s,@LDFLAGS@,'"$LDFLAGS"',g' \
|
||||
< fastcgi.buildinfo.in > fastcgi.buildinfo
|
||||
fi
|
||||
@ -1,3 +0,0 @@
|
||||
ghc-options: -optc@CPPFLAGS@
|
||||
cc-options: @CPPFLAGS@
|
||||
ld-options: @LDFLAGS@
|
||||
@ -1,19 +0,0 @@
|
||||
# Run with lighttpd -D -f lighttpd.conf
|
||||
server.port = 3000
|
||||
server.document-root = "."
|
||||
server.modules = ("mod_fastcgi", "mod_rewrite")
|
||||
|
||||
url.rewrite-once = (
|
||||
"(.*)" => "/app/$1"
|
||||
)
|
||||
|
||||
fastcgi.server = (
|
||||
"/app" => ((
|
||||
"socket" => "/tmp/test.fastcgi.socket",
|
||||
"check-local" => "disable",
|
||||
"bin-path" => "./test",
|
||||
"min-procs" => 1,
|
||||
"max-procs" => 12,
|
||||
"idle-timeout" => 30
|
||||
))
|
||||
)
|
||||
@ -1,19 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.FastCGI
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Char8 as L8
|
||||
import qualified Data.Enumerator as E
|
||||
|
||||
main = run app
|
||||
|
||||
app req
|
||||
| pathInfo req == "/" = return $ responseLBS status200 [("Content-Type", "text/html")] "<form method='post' action='/post'><input type='text' name='name'><input type='submit'></form>"
|
||||
app req = do
|
||||
bss <- E.consume
|
||||
return $ responseLBS status200 [("Content-Type", "text/plain")] $ L.concat
|
||||
[ L8.pack $ show $ requestHeaders req
|
||||
, "\n"
|
||||
, L.fromChunks bss
|
||||
]
|
||||
@ -1,31 +0,0 @@
|
||||
name: wai-handler-fastcgi
|
||||
version: 3.0.0.2
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
maintainer: Michael Snoyman <michael@snoyman.com>
|
||||
synopsis: Wai handler to fastcgi
|
||||
description: API docs and the README are available at <http://www.stackage.org/package/wai-handler-fastcgi>.
|
||||
category: Web
|
||||
stability: stable
|
||||
cabal-version: >= 1.6
|
||||
build-type: Configure
|
||||
extra-source-files: configure fastcgi.buildinfo.in README.md ChangeLog.md
|
||||
homepage: http://www.yesodweb.com/book/web-application-interface
|
||||
|
||||
library
|
||||
build-depends: base >= 4 && < 5
|
||||
, wai >= 3.0 && < 3.3
|
||||
, wai-extra >= 3.0 && < 3.1
|
||||
, bytestring >= 0.9.1.4
|
||||
exposed-modules: Network.Wai.Handler.FastCGI
|
||||
ghc-options: -Wall
|
||||
includes: fcgiapp.h
|
||||
extra-libraries: fcgi
|
||||
|
||||
if impl(ghc >= 7.4)
|
||||
cpp-options: -DGHC_7_4
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: git://github.com/yesodweb/wai.git
|
||||
2
wai-handler-launch/.gitignore
vendored
2
wai-handler-launch/.gitignore
vendored
@ -1,2 +0,0 @@
|
||||
dist/
|
||||
*.swp
|
||||
@ -1,35 +0,0 @@
|
||||
## 3.0.2.4
|
||||
|
||||
* Drop dependency on blaze-builder, requiring streaming-commons >= 0.2
|
||||
|
||||
## 3.0.2.3
|
||||
|
||||
* `process` package bump
|
||||
|
||||
## 3.0.2.2
|
||||
|
||||
* Improvements to ping's javascript script. [#494](https://github.com/yesodweb/wai/pull/494)
|
||||
|
||||
## 3.0.2.1
|
||||
|
||||
* Relax upper bound on process
|
||||
|
||||
## 3.0.2
|
||||
|
||||
* Don't launch if server fails; kill server on exit [#537](https://github.com/yesodweb/wai/issues/537) [#541](https://github.com/yesodweb/wai/pull/541)
|
||||
|
||||
## 3.0.1
|
||||
|
||||
* make host configurable too (fixes #538) [#539](https://github.com/yesodweb/wai/pull/539)
|
||||
|
||||
## 3.0.0.5
|
||||
|
||||
* Support wai/warp 3.2
|
||||
|
||||
## 3.0.0.3
|
||||
|
||||
Allow blaze-builder 0.4
|
||||
|
||||
## 3.0.0.2
|
||||
|
||||
* Support for Win64
|
||||
@ -1,20 +0,0 @@
|
||||
Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
@ -1,222 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Network.Wai.Handler.Launch
|
||||
( run
|
||||
, runUrl
|
||||
, runUrlPort
|
||||
, runHostPortUrl
|
||||
) where
|
||||
|
||||
import Network.Wai
|
||||
import Network.Wai.Internal
|
||||
import Network.HTTP.Types
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import Data.IORef
|
||||
import Data.Monoid (mappend)
|
||||
import Data.String (fromString)
|
||||
import Control.Concurrent (forkIO, threadDelay, newEmptyMVar, putMVar, takeMVar)
|
||||
import Control.Concurrent.Async (race)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad (unless)
|
||||
import Control.Exception (throwIO)
|
||||
import Data.Function (fix)
|
||||
import qualified Data.ByteString as S
|
||||
import Data.ByteString.Builder (Builder, byteString)
|
||||
import qualified Data.ByteString.Builder.Extra as Builder (flush)
|
||||
#if WINDOWS
|
||||
import Foreign
|
||||
import Foreign.C.String
|
||||
#else
|
||||
import System.Process (rawSystem)
|
||||
#endif
|
||||
import Data.Streaming.ByteString.Builder as B (newBuilderRecv, defaultStrategy)
|
||||
import qualified Data.Streaming.Zlib as Z
|
||||
|
||||
ping :: IORef Bool -> Middleware
|
||||
ping active app req sendResponse
|
||||
| pathInfo req == ["_ping"] = do
|
||||
liftIO $ writeIORef active True
|
||||
sendResponse $ responseLBS status200 [] ""
|
||||
| otherwise = app req $ \res -> do
|
||||
let isHtml hs =
|
||||
case lookup "content-type" hs of
|
||||
Just ct -> "text/html" `S.isPrefixOf` ct
|
||||
Nothing -> False
|
||||
if isHtml $ responseHeaders res
|
||||
then do
|
||||
let (s, hs, withBody) = responseToStream res
|
||||
(isEnc, headers') = fixHeaders id hs
|
||||
headers'' = filter (\(x, _) -> x /= "content-length") headers'
|
||||
withBody $ \body ->
|
||||
sendResponse $ responseStream s headers'' $ \sendChunk flush ->
|
||||
addInsideHead sendChunk flush $ \sendChunk' flush' ->
|
||||
if isEnc
|
||||
then decode sendChunk' flush' body
|
||||
else body sendChunk' flush'
|
||||
else sendResponse res
|
||||
|
||||
decode :: (Builder -> IO ()) -> IO ()
|
||||
-> StreamingBody
|
||||
-> IO ()
|
||||
decode sendInner flushInner streamingBody = do
|
||||
(blazeRecv, blazeFinish) <- newBuilderRecv defaultStrategy
|
||||
inflate <- Z.initInflate $ Z.WindowBits 31
|
||||
let send builder = blazeRecv builder >>= goBuilderPopper
|
||||
goBuilderPopper popper = fix $ \loop -> do
|
||||
bs <- popper
|
||||
unless (S.null bs) $ do
|
||||
Z.feedInflate inflate bs >>= goZlibPopper
|
||||
loop
|
||||
goZlibPopper popper = fix $ \loop -> do
|
||||
res <- popper
|
||||
case res of
|
||||
Z.PRDone -> return ()
|
||||
Z.PRNext bs -> do
|
||||
sendInner $ byteString bs
|
||||
loop
|
||||
Z.PRError e -> throwIO e
|
||||
streamingBody send (send Builder.flush)
|
||||
mbs <- blazeFinish
|
||||
case mbs of
|
||||
Nothing -> return ()
|
||||
Just bs -> Z.feedInflate inflate bs >>= goZlibPopper
|
||||
Z.finishInflate inflate >>= sendInner . byteString
|
||||
|
||||
toInsert :: S.ByteString
|
||||
toInsert = "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping?\" + (new Date()).getTime(),true);x.send();},60000)</script>"
|
||||
|
||||
addInsideHead :: (Builder -> IO ())
|
||||
-> IO ()
|
||||
-> StreamingBody
|
||||
-> IO ()
|
||||
addInsideHead sendInner flushInner streamingBody = do
|
||||
(blazeRecv, blazeFinish) <- newBuilderRecv defaultStrategy
|
||||
ref <- newIORef $ Just (S.empty, whole)
|
||||
streamingBody (inner blazeRecv ref) (flush blazeRecv ref)
|
||||
state <- readIORef ref
|
||||
mbs <- blazeFinish
|
||||
held <- case mbs of
|
||||
Nothing -> return state
|
||||
Just bs -> push state bs
|
||||
case state of
|
||||
Nothing -> return ()
|
||||
Just (held, _) -> sendInner $ byteString held `mappend` byteString toInsert
|
||||
where
|
||||
whole = "<head>"
|
||||
|
||||
flush blazeRecv ref = inner blazeRecv ref Builder.flush
|
||||
|
||||
inner blazeRecv ref builder = do
|
||||
state0 <- readIORef ref
|
||||
popper <- blazeRecv builder
|
||||
let loop state = do
|
||||
bs <- popper
|
||||
if S.null bs
|
||||
then writeIORef ref state
|
||||
else push state bs >>= loop
|
||||
loop state0
|
||||
|
||||
push Nothing x = sendInner (byteString x) >> return Nothing
|
||||
push (Just (held, atFront)) x
|
||||
| atFront `S.isPrefixOf` x = do
|
||||
let y = S.drop (S.length atFront) x
|
||||
sendInner $ byteString held
|
||||
`mappend` byteString atFront
|
||||
`mappend` byteString toInsert
|
||||
`mappend` byteString y
|
||||
return Nothing
|
||||
| whole `S.isInfixOf` x = do
|
||||
let (before, rest) = S.breakSubstring whole x
|
||||
let after = S.drop (S.length whole) rest
|
||||
sendInner $ byteString held
|
||||
`mappend` byteString before
|
||||
`mappend` byteString whole
|
||||
`mappend` byteString toInsert
|
||||
`mappend` byteString after
|
||||
return Nothing
|
||||
| x `S.isPrefixOf` atFront = do
|
||||
let held' = held `S.append` x
|
||||
atFront' = S.drop (S.length x) atFront
|
||||
return $ Just (held', atFront')
|
||||
| otherwise = do
|
||||
let (held', atFront', x') = getOverlap whole x
|
||||
sendInner $ byteString held `mappend` byteString x'
|
||||
return $ Just (held', atFront')
|
||||
|
||||
getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)
|
||||
getOverlap whole x =
|
||||
go whole
|
||||
where
|
||||
go piece
|
||||
| S.null piece = ("", whole, x)
|
||||
| piece `S.isSuffixOf` x =
|
||||
let x' = S.take (S.length x - S.length piece) x
|
||||
atFront = S.drop (S.length piece) whole
|
||||
in (piece, atFront, x')
|
||||
| otherwise = go $ S.init piece
|
||||
|
||||
fixHeaders :: ([Header] -> [Header])
|
||||
-> [Header]
|
||||
-> (Bool, [Header])
|
||||
fixHeaders front [] = (False, front [])
|
||||
fixHeaders front (("content-encoding", "gzip"):rest) = (True, front rest)
|
||||
fixHeaders front (x:xs) = fixHeaders (front . (:) x) xs
|
||||
|
||||
#if WINDOWS
|
||||
foreign import ccall "launch"
|
||||
launch' :: Int -> CString -> IO ()
|
||||
#endif
|
||||
|
||||
launch :: Int -> String -> IO ()
|
||||
|
||||
#if WINDOWS
|
||||
launch port s = withCString s $ launch' port
|
||||
#else
|
||||
launch port s = forkIO (rawSystem
|
||||
#if MAC
|
||||
"open"
|
||||
#else
|
||||
"xdg-open"
|
||||
#endif
|
||||
["http://127.0.0.1:" ++ show port ++ "/" ++ s] >> return ()) >> return ()
|
||||
#endif
|
||||
|
||||
run :: Application -> IO ()
|
||||
run = runUrl ""
|
||||
|
||||
runUrl :: String -> Application -> IO ()
|
||||
runUrl = runUrlPort 4587
|
||||
|
||||
runUrlPort :: Int -> String -> Application -> IO ()
|
||||
runUrlPort = runHostPortUrl "*4"
|
||||
|
||||
-- |
|
||||
--
|
||||
-- @since 3.0.1
|
||||
runHostPortUrl :: String -> Int -> String -> Application -> IO ()
|
||||
runHostPortUrl host port url app = do
|
||||
ready <- newEmptyMVar
|
||||
active <- newIORef True
|
||||
let settings =
|
||||
Warp.setPort port $
|
||||
Warp.setOnException (\_ _ -> return ()) $
|
||||
Warp.setHost (fromString host) $
|
||||
Warp.setBeforeMainLoop (putMVar ready ()) $
|
||||
Warp.defaultSettings
|
||||
-- Run these threads concurrently; when either one terminates or
|
||||
-- raises an exception, the same happens to the other.
|
||||
fmap (either id id) $ race
|
||||
-- serve app, keep updating the activity flag
|
||||
(Warp.runSettings settings (ping active app))
|
||||
-- wait for server startup, launch browser, poll until server idle
|
||||
(takeMVar ready >> launch port url >> loop active)
|
||||
|
||||
loop :: IORef Bool -> IO ()
|
||||
loop active = do
|
||||
let seconds = 120
|
||||
threadDelay $ 1000000 * seconds
|
||||
b <- readIORef active
|
||||
if b
|
||||
then writeIORef active False >> loop active
|
||||
else return ()
|
||||
@ -1,4 +0,0 @@
|
||||
## wai-handler-launch
|
||||
|
||||
This handles cross-platform launching and inserts Javascript code to ping the
|
||||
server. When the server no longer receives pings, it shuts down.
|
||||
@ -1,7 +0,0 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
> module Main where
|
||||
> import Distribution.Simple
|
||||
|
||||
> main :: IO ()
|
||||
> main = defaultMain
|
||||
@ -1,22 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Network.Wai.Handler.Launch (insideHead)
|
||||
import Test.Hspec
|
||||
import Test.Hspec.HUnit
|
||||
import Data.Enumerator hiding (map)
|
||||
import Test.HUnit
|
||||
import qualified Data.ByteString as S
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ describe "insideHead"
|
||||
[ it "handles single chunks" $ helper "bar<head>foobaz" ["bar<head>baz"]
|
||||
, it "handles single chunks, no <head>" $ helper "barfoo" ["bar"]
|
||||
, it "handles whole chunks" $ helper "bar<head>foobaz" ["bar", "<head>", "baz"]
|
||||
, it "handles split chunks" $ helper "bar<head>foobaz" ["bar", "<he", "ad>", "baz"]
|
||||
, it "handles many chunks" $ helper "bar<head>foobaz1234567890" ["bar", "<he", "ad>", "baz", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"]
|
||||
, it "handles many pieces" $ helper "bar<head>foobaz" $ map S.singleton $ S.unpack "bar<head>baz"
|
||||
]
|
||||
|
||||
helper :: S.ByteString -> [S.ByteString] -> Assertion
|
||||
helper res pieces = do
|
||||
x <- run_ $ enumList 1 pieces $$ joinI $ insideHead "foo" $$ consume
|
||||
S.concat x @?= res
|
||||
@ -1,7 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Network.Wai
|
||||
import Network.HTTP.Types
|
||||
import Network.Wai.Handler.Launch
|
||||
import Network.Wai.Middleware.Gzip
|
||||
|
||||
main = runUrl "FIXME" $ gzip def $ \_ f -> f $ responseLBS status200 [("Content-Type", "text/html; charset=utf8")] "<html><head></head><body>HELLO THERE"
|
||||
@ -1,36 +0,0 @@
|
||||
Name: wai-handler-launch
|
||||
Version: 3.0.2.4
|
||||
Synopsis: Launch a web app in the default browser.
|
||||
description: API docs and the README are available at <http://www.stackage.org/package/wai-handler-launch>.
|
||||
License: MIT
|
||||
License-file: LICENSE
|
||||
Author: Michael Snoyman
|
||||
Maintainer: michael@snoyman.com
|
||||
Category: Web
|
||||
Build-type: Simple
|
||||
Cabal-version: >=1.6
|
||||
extra-source-files: README.md ChangeLog.md
|
||||
|
||||
Library
|
||||
Exposed-modules: Network.Wai.Handler.Launch
|
||||
build-depends: base >= 4 && < 5
|
||||
, wai >= 3.0 && < 3.3
|
||||
, warp >= 3.0 && < 3.3
|
||||
, http-types >= 0.7
|
||||
, transformers >= 0.2.2
|
||||
, bytestring >= 0.10.4
|
||||
, streaming-commons >= 0.2
|
||||
, async
|
||||
|
||||
if os(windows)
|
||||
c-sources: windows.c
|
||||
cpp-options: -DWINDOWS
|
||||
extra-libraries: Shell32 msvcrt
|
||||
else
|
||||
build-depends: process >= 1.0 && < 1.7
|
||||
if os(darwin)
|
||||
cpp-options: -DMAC
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: git://github.com/yesodweb/wai.git
|
||||
@ -1,12 +0,0 @@
|
||||
#include <windows.h>
|
||||
#include <shellapi.h>
|
||||
#include <stdio.h>
|
||||
|
||||
void launch(int port, char *s)
|
||||
{
|
||||
int len = 8 + strlen("http://127.0.0.1:") + strlen(s);
|
||||
char *buff = malloc(len);
|
||||
_snprintf(buff, len, "http://127.0.0.1:%d/%s", port, s);
|
||||
ShellExecute(NULL, "open", buff, NULL, NULL, SW_SHOWNORMAL);
|
||||
free(buff);
|
||||
}
|
||||
2
wai-handler-webkit/.gitignore
vendored
2
wai-handler-webkit/.gitignore
vendored
@ -1,2 +0,0 @@
|
||||
dist
|
||||
*.swp
|
||||
@ -1,3 +0,0 @@
|
||||
## 3.0.0.3
|
||||
|
||||
* Support for wai/warp 3.2
|
||||
@ -1,20 +0,0 @@
|
||||
Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
@ -1,21 +0,0 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
module Network.Wai.Handler.Webkit (run) where
|
||||
|
||||
import Network.Wai (Application)
|
||||
import qualified Network.Wai.Handler.Warp as S
|
||||
import Control.Concurrent (forkOS)
|
||||
import Control.Concurrent.MVar
|
||||
import Foreign.C.String (CString, withCString)
|
||||
import Control.Exception (finally)
|
||||
|
||||
run :: String -- ^ Title to show in titlebar
|
||||
-> Application -> IO ()
|
||||
run title app = do
|
||||
mvar <- newEmptyMVar
|
||||
_ <- forkOS $ finally (S.run 3000 app) (putMVar mvar ())
|
||||
_ <- forkOS $ finally (withCString title startBrowser) (putMVar mvar ())
|
||||
_ <- takeMVar mvar
|
||||
return ()
|
||||
|
||||
foreign import ccall "start_browser"
|
||||
startBrowser :: CString -> IO ()
|
||||
@ -1,53 +0,0 @@
|
||||
wai-handler-webkit
|
||||
==================
|
||||
|
||||
Turn WAI applications into standalone GUIs using Qt WebKit.
|
||||
|
||||
|
||||
Linux
|
||||
-----
|
||||
|
||||
You'll need the appropriate system libraries, on Ubuntu:
|
||||
|
||||
apt-get install libqtwebkit-dev
|
||||
|
||||
On Lucid, this required adding a PPA:
|
||||
|
||||
sudo add-apt-repository ppa:kubuntu-ppa/backports
|
||||
|
||||
|
||||
Windows
|
||||
-------
|
||||
|
||||
Install the Qt SDK from <http://qt.nokia.com/downloads/>
|
||||
|
||||
Your application's Cabal file will require certain options for Windows,
|
||||
shown below. In particular, we need to link with `g++`, so make sure
|
||||
it's in your `PATH`. The option `-optl-mwindows` ensures that the
|
||||
application does not open a terminal.
|
||||
|
||||
if os(windows)
|
||||
ghc-options: -Wall -threaded -pgml g++ -optl-static -optl-mwindows
|
||||
else
|
||||
ghc-options: -Wall
|
||||
|
||||
Run `cabal-install` with the Qt `include` and `lib` directories.
|
||||
|
||||
export QT_PATH=c:/QtSDK/Desktop/Qt/4.7.3/mingw
|
||||
|
||||
cabal-dev install \
|
||||
--extra-include-dirs=$QT_PATH/include \
|
||||
--extra-include-dirs=$QT_PATH/include/QtCore \
|
||||
--extra-include-dirs=$QT_PATH/include/QtNetwork \
|
||||
--extra-include-dirs=$QT_PATH/include/QtGui \
|
||||
--extra-include-dirs=$QT_PATH/include/QtWebKit \
|
||||
--extra-lib-dirs=$QT_PATH/lib
|
||||
|
||||
You'll need to include these DLLs with your application:
|
||||
|
||||
phonon4.dll
|
||||
libgcc_s_dw2-1.dll
|
||||
QtCore4.dll
|
||||
QtGui4.dll
|
||||
QtNetwork4.dll
|
||||
QtWebKit4.dll
|
||||
@ -1,7 +0,0 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
> module Main where
|
||||
> import Distribution.Simple
|
||||
|
||||
> main :: IO ()
|
||||
> main = defaultMain
|
||||
@ -1,10 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Webkit
|
||||
import Network.HTTP.Types
|
||||
|
||||
main :: IO ()
|
||||
main = run "Sample App" app
|
||||
|
||||
app :: Application
|
||||
app _ response = response $ responseLBS status200 [("Content-Type", "text/html")] "<h1>Hello World!</h1>"
|
||||
@ -1,30 +0,0 @@
|
||||
name: wai-handler-webkit
|
||||
version: 3.0.0.3
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
maintainer: Michael Snoyman <michael@snoyman.com>
|
||||
synopsis: Turn WAI applications into standalone GUIs using QtWebkit.
|
||||
description: API docs and the README are available at <http://www.stackage.org/package/wai-handler-webkit>.
|
||||
category: Web
|
||||
stability: unstable
|
||||
cabal-version: >= 1.6
|
||||
build-type: Simple
|
||||
homepage: https://github.com/yesodweb/wai/tree/master/wai-handler-webkit
|
||||
extra-source-files: README.md ChangeLog.md
|
||||
|
||||
library
|
||||
build-depends: base >= 4 && < 5
|
||||
, wai >= 3.0 && < 3.3
|
||||
, warp >= 3.0 && < 3.3
|
||||
ghc-options: -Wall
|
||||
exposed-modules: Network.Wai.Handler.Webkit
|
||||
c-sources: webkit.cpp
|
||||
if os(windows)
|
||||
extra-libraries: QtCore4, QtGui4, QtNetwork4, QtWebKit4
|
||||
else
|
||||
pkgconfig-depends: QtWebKit
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: git://github.com/yesodweb/wai.git
|
||||
@ -1,19 +0,0 @@
|
||||
#include <QApplication>
|
||||
#include <QPushButton>
|
||||
#include <QtWebKit>
|
||||
|
||||
extern "C" {
|
||||
int start_browser(char *title)
|
||||
{
|
||||
char *argv[1];
|
||||
argv[0] = title;
|
||||
int argc = 1;
|
||||
|
||||
QApplication app(argc, argv);
|
||||
QWebView *view = new QWebView();
|
||||
view->load(QUrl("http://localhost:3000/"));
|
||||
view->show();
|
||||
|
||||
return app.exec();
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user