packages feed

wai-extra 0.1.0 → 0.1.1

raw patch · 6 files changed

+184/−7 lines, 6 filesdep −zlib

Dependencies removed: zlib

Files

Network/Wai/Middleware/CleanPath.hs view
@@ -34,7 +34,7 @@ -- * There are any doubled slashes. splitPath :: B.ByteString -> Either B.ByteString [String] splitPath s =-    let corrected = B.pack $ ats $ rds $ B.unpack s+    let corrected = B.pack $ rts $ ats $ rds $ B.unpack s      in if corrected == s             then Right $ map (unEscapeString . B.unpack)                        $ filter (not . B.null)@@ -56,6 +56,14 @@     if last s == '/' || dbs (reverse s)         then s         else s ++ "/"++-- | Remove a trailing slash if the last piece has a period.+rts :: String -> String+rts [] = []+rts s =+    if last s == '/' && dbs (tail $ reverse s)+        then init s+        else s  -- | Is there a period before a slash here? dbs :: String -> Bool
Network/Wai/Middleware/Gzip.hs view
@@ -16,8 +16,7 @@ module Network.Wai.Middleware.Gzip (gzip) where  import Network.Wai-import Network.Wai.Enumerator (fromLBS', toLBS)-import Codec.Compression.GZip (compress)+import Network.Wai.Zlib import Data.Maybe (fromMaybe) import qualified Data.ByteString.Char8 as B @@ -54,7 +53,7 @@  compressE :: Either FilePath Enumerator -> Either FilePath Enumerator compressE (Left fp) = Left fp-compressE (Right e) = Right $ fromLBS' $ fmap compress $ toLBS e+compressE (Right e) = Right $ compress e  splitCommas :: String -> [String] splitCommas [] = []
Network/Wai/Middleware/Jsonp.hs view
@@ -27,6 +27,11 @@             then Just y'             else takeCallback $ B8.drop 1 z +dropQM :: B8.ByteString -> B8.ByteString+dropQM bs+    | B8.null bs = bs+    | B8.head bs == '?' = B8.tail bs+    | otherwise = bs  -- | Wrap json responses in a jsonp callback. --@@ -41,7 +46,7 @@     let callback :: Maybe B8.ByteString         callback =             if B8.pack "text/javascript" `B8.isInfixOf` accept-                then takeCallback $ queryString env+                then takeCallback $ dropQM $ queryString env                 else Nothing     let env' =             case callback of
+ Network/Wai/Zlib.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+module Network.Wai.Zlib (compress) where++import Prelude hiding (length)+import Network.Wai hiding (status)++import Data.ByteString.Unsafe+import Data.ByteString.Lazy.Internal (defaultChunkSize)++import Foreign.C+import Foreign.Ptr+import Foreign.Marshal.Alloc+import Control.Exception+import Control.Monad++import Data.ByteString.Char8 hiding (putStrLn)++chunkSize :: Int+chunkSize = defaultChunkSize++compress :: Enumerator -> Enumerator+compress enum =+    Enumerator $ \iter acc ->+        bracket+            c_create_z_stream+            c_free_z_stream+            (compressInner iter acc enum)++compressInner :: (acc -> ByteString -> IO (Either acc acc))+              -> acc+              -> Enumerator+              -> ZStream+              -> IO (Either acc acc)+compressInner iter acc enum stream = allocaBytes chunkSize $ \outbuff -> do+    when (stream == nullPtr) $ error "Error from zlib library"+    c_set_avail_out stream outbuff $ fromIntegral chunkSize+    eacc <- runEnumerator enum (compressIter iter stream outbuff) acc+    case eacc of+        Left acc' -> return $ Left acc'+        Right acc' -> finishStream iter stream outbuff acc'++drainOutput :: Bool -- ^ are we finishing?+            -> ZStream+            -> Ptr CChar -- ^ output buffer+            -> (acc -> ByteString -> IO (Either acc acc))+            -> acc+            -> IO (Either acc acc)+drainOutput isFinish stream outbuff iter acc = do+    if isFinish+        then c_call_deflate_finish stream >> return ()+        else c_call_deflate_noflush stream+    newAvail <- fromIntegral `fmap` c_get_avail_out stream+    if newAvail == 0 || (isFinish && newAvail /= chunkSize)+        then do+            bs <- unsafePackCStringLen (outbuff, chunkSize - newAvail)+            eacc <- iter acc bs+            case eacc of+                Left acc' -> return $ Left acc'+                Right acc' -> do+                    c_set_avail_out stream outbuff $ fromIntegral chunkSize+                    drainOutput isFinish stream outbuff iter acc'+        else return $ Right acc++finishStream :: (acc -> ByteString -> IO (Either acc acc))+             -> ZStream+             -> Ptr CChar+             -> acc+             -> IO (Either acc acc)+finishStream iter stream outbuff acc =+    drainOutput True stream outbuff iter acc++compressIter :: (acc -> ByteString -> IO (Either acc acc))+             -> ZStream+             -> Ptr CChar+             -> acc+             -> ByteString+             -> IO (Either acc acc)+compressIter iter stream outbuff acc bsInput = do+    unsafeUseAsCStringLen bsInput $ \(cstr, len) ->+        c_set_avail_in stream cstr $ fromIntegral len+    drainOutput False stream outbuff iter acc++data ZStreamStruct+type ZStream = Ptr ZStreamStruct++foreign import ccall unsafe "create_z_stream"+    c_create_z_stream :: IO ZStream++foreign import ccall unsafe "free_z_stream"+    c_free_z_stream :: ZStream -> IO ()++foreign import ccall unsafe "set_avail_in"+    c_set_avail_in :: ZStream -> Ptr CChar -> CUInt -> IO ()++foreign import ccall unsafe "set_avail_out"+    c_set_avail_out :: ZStream -> Ptr CChar -> CUInt -> IO ()++foreign import ccall unsafe "call_deflate_noflush"+    c_call_deflate_noflush :: ZStream -> IO ()++foreign import ccall unsafe "call_deflate_finish"+    c_call_deflate_finish :: ZStream -> IO CInt++foreign import ccall unsafe "get_avail_out"+    c_get_avail_out :: ZStream -> IO CUInt
+ c/helper.c view
@@ -0,0 +1,56 @@+#include <zlib.h>+#include <stdlib.h>+#include <assert.h>+#include <stdio.h>++z_stream * create_z_stream (void)+{+	z_stream *ret = malloc(sizeof(z_stream));+	ret->zalloc = Z_NULL;+	ret->zfree = Z_NULL;+	ret->opaque = Z_NULL;+	ret->next_in = NULL;+	ret->avail_in = 0;++	if (deflateInit2(ret, 7, Z_DEFLATED, 31, 8, Z_DEFAULT_STRATEGY)+		!= Z_OK)                 return NULL;+	else                             return ret;+}++void free_z_stream (z_stream *stream)+{+	deflateEnd(stream);+	free(stream);+}++void set_avail_in (z_stream *stream, char *buff, unsigned int avail)+{+	stream->next_in = buff;+	stream->avail_in = avail;+}++void set_avail_out (z_stream *stream, char *buff, unsigned int avail)+{+	stream->next_out = buff;+	stream->avail_out = avail;+}++void call_deflate_noflush (z_stream *stream)+{+	int ret;+	ret = deflate(stream, Z_NO_FLUSH);+	assert (ret == Z_OK);+}++int call_deflate_finish (z_stream *stream)+{+	int ret;+	ret = deflate(stream, Z_FINISH);+	assert (ret == Z_OK || ret == Z_STREAM_END);+	return ret;+}++unsigned int get_avail_out (z_stream *stream)+{+	return stream->avail_out;+}
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             0.1.0+Version:             0.1.1 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             BSD3@@ -18,7 +18,6 @@                      wai >= 0.0.0 && < 0.1,                      old-locale >= 1.0 && < 1.1,                      time >= 1.1.4 && < 1.2,-                     zlib >= 0.5.2.0 && < 0.6,                      sendfile >= 0.6.1 && < 0.7,                      network >= 2.2.1.5 && < 2.3   Exposed-modules:   Network.Wai.Handler.CGI@@ -26,5 +25,9 @@                      Network.Wai.Middleware.CleanPath                      Network.Wai.Middleware.Gzip                      Network.Wai.Middleware.Jsonp+                     Network.Wai.Zlib   Other-modules:     Network.Wai.Handler.Helper   ghc-options:       -Wall+  c-sources:         c/helper.c+  include-dirs:      c+  extra-libraries:   z