wai-app-file-cgi 0.4.4 → 0.5.0
raw patch · 12 files changed
+305/−325 lines, 12 filesdep +attoparsec-conduitdep +conduitdep +http-conduitdep −enumeratordep −http-enumerator
Dependencies added: attoparsec-conduit, conduit, http-conduit, lifted-base
Dependencies removed: enumerator, http-enumerator
Files
- Network/Wai/Application/Classic.hs +2/−2
- Network/Wai/Application/Classic/CGI.hs +30/−66
- Network/Wai/Application/Classic/Conduit.hs +71/−0
- Network/Wai/Application/Classic/EnumLine.hs +0/−62
- Network/Wai/Application/Classic/File.hs +21/−19
- Network/Wai/Application/Classic/FileInfo.hs +1/−1
- Network/Wai/Application/Classic/Path.hs +129/−0
- Network/Wai/Application/Classic/RevProxy.hs +43/−38
- Network/Wai/Application/Classic/Status.hs +1/−1
- Network/Wai/Application/Classic/Types.hs +2/−2
- Network/Wai/Application/Classic/Utils.hs +0/−129
- wai-app-file-cgi.cabal +5/−5
Network/Wai/Application/Classic.hs view
@@ -16,11 +16,11 @@ , RevProxyAppSpec(..) , RevProxyRoute(..), revProxyApp -- * Path- , module Network.Wai.Application.Classic.Utils+ , module Network.Wai.Application.Classic.Path ) where import Network.Wai.Application.Classic.CGI import Network.Wai.Application.Classic.File+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.RevProxy import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils
Network/Wai/Application/Classic/CGI.hs view
@@ -1,28 +1,30 @@-{-# LANGUAGE OverloadedStrings, CPP #-}+{-# LANGUAGE OverloadedStrings, CPP, DoAndIfThenElse, ScopedTypeVariables #-} module Network.Wai.Application.Classic.CGI ( cgiApp ) where -import qualified Blaze.ByteString.Builder as BB import Control.Applicative-import Control.Exception+import Control.Exception (SomeException)+import Control.Exception.Lifted (catch) import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import qualified Data.ByteString as BS hiding (unpack) import qualified Data.ByteString.Char8 as BS (readInt, unpack)-import Data.CaseInsensitive hiding (map)-import Data.Enumerator hiding (map, filter, drop, break)-import qualified Data.Enumerator.Binary as EB-import qualified Data.Enumerator.List as EL+import Data.Conduit+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL import Network.HTTP.Types import Network.Wai-import Network.Wai.Application.Classic.EnumLine as ENL+import Network.Wai.Application.Classic.Conduit import Network.Wai.Application.Classic.Field import Network.Wai.Application.Classic.Header+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils import Network.Wai.Logger.Utils+import Prelude hiding (catch) import System.IO import System.Process @@ -52,72 +54,41 @@ cgiApp' :: Bool -> ClassicAppSpec -> CgiRoute -> Application cgiApp' body cspec cgii req = do- (rhdl,whdl,pid) <- tryIO $ execProcess cspec cgii req- let cleanup = do- hClose whdl- hClose rhdl- terminateProcess pid -- SIGTERM- -- HTTP body can be obtained in this Iteratee level only- toCGI whdl body `catchError` const (tryIO cleanup)- tryIO $ hClose whdl- respEnumerator $ \respIter ->- -- this is IO- fromCGI rhdl cspec req respIter `finally` cleanup+ (rhdl,whdl,tellEOF) <- liftIO (execProcess cspec cgii req) >>= register3+ when body $ toCGI whdl req+ tellEOF+ fromCGI rhdl cspec req where- respEnumerator = return . ResponseEnumerator+ register3 (rhdl,whdl,pid) = do+ register $ terminateProcess pid -- SIGTERM+ register $ hClose rhdl+ keyw <- register $ hClose whdl+ return (rhdl,whdl,release keyw) ---------------------------------------------------------------- -toCGI :: Handle -> Bool -> Iteratee ByteString IO ()-toCGI whdl body = when body tocgi- where- tocgi = do- m <- EL.head- case m of- Nothing -> return ()- Just b -> tryIO (BS.hPutStr whdl b) >> tocgi+toCGI :: Handle -> Request -> ResourceT IO ()+toCGI whdl req = requestBody req $$ CB.sinkHandle whdl -fromCGI :: Handle -> ClassicAppSpec -> Request -> ResponseEnumerator a-fromCGI rhdl cspec req respIter = run_ $ enumOutput $$ do- -- consuming the header part of CGI output- m <- (>>= check) <$> parseHeader+fromCGI :: Handle -> ClassicAppSpec -> Application+fromCGI rhdl cspec req = do+ bsrc <- bufferSource $ CB.sourceHandle rhdl+ m <- (check <$> (bsrc $$ parseHeader)) `catch` recover let (st, hdr, hasBody) = case m of Nothing -> (statusServerError,[],False) Just (s,h) -> (s,h,True) hdr' = addServer cspec hdr- -- logging- tryIO $ logger cspec req st Nothing -- cannot know body length- -- iteratee to build HTTP header and optionally HTTP body- if hasBody- then bodyAsBuilder =$ respIter st hdr'- else enumEOF $$ bodyAsBuilder =$ respIter st hdr'+ liftIO $ logger cspec req st Nothing+ let src = if hasBody then (toSource bsrc) else CL.sourceNull+ return $ ResponseSource st hdr' src where- enumOutput = EB.enumHandle 4096 rhdl- bodyAsBuilder = EL.map BB.fromByteString check hs = lookup fkContentType hs >> case lookup "status" hs of Nothing -> Just (status200, hs) Just l -> toStatus l >>= \s -> Just (s,hs') where hs' = filter (\(k,_) -> k /= "status") hs toStatus s = BS.readInt s >>= \x -> Just (Status (fst x) s)--------------------------------------------------------------------parseHeader :: Iteratee ByteString IO (Maybe RequestHeaders)-parseHeader = takeHeader >>= maybe (return Nothing)- (return . Just . map parseField)- where- parseField bs = (mk key, val)- where- (key,val) = case BS.breakByte 58 bs of -- ':'- kv@(_,"") -> kv- (k,v) -> let v' = BS.dropWhile (==32) $ BS.tail v in (k,v') -- ' '--takeHeader :: Iteratee ByteString IO (Maybe [ByteString])-takeHeader = ENL.head >>= maybe (return Nothing) $. \l ->- if l == ""- then return (Just [])- else takeHeader >>= maybe (return Nothing) (return . Just . (l:))+ recover (_ :: SomeException) = return Nothing ---------------------------------------------------------------- @@ -181,10 +152,3 @@ prog = pathString (dst </> prog') scriptName = pathString (src </> prog') pathinfo = pathString pathinfo'--------------------------------------------------------------------infixr 6 $.--($.) :: (a -> b) -> a -> b-($.) = ($)
+ Network/Wai/Application/Classic/Conduit.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Application.Classic.Conduit (+ byteStringToBuilder+ , toSource+ , parseHeader+ ) where++import Blaze.ByteString.Builder (Builder)+import qualified Blaze.ByteString.Builder as BB (fromByteString)+import Control.Applicative+import Data.Attoparsec+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI(..), mk)+import Data.Conduit+import Data.Conduit.Attoparsec+import Data.Word+import Network.HTTP.Types++----------------------------------------------------------------++byteStringToBuilder :: ByteString -> Builder+byteStringToBuilder = BB.fromByteString++----------------------------------------------------------------++toSource :: BufferedSource IO ByteString -> Source IO Builder+toSource = fmap byteStringToBuilder . unbufferSource++----------------------------------------------------------------++parseHeader :: Sink ByteString IO RequestHeaders+parseHeader = sinkParser parseHeader'++parseHeader' :: Parser RequestHeaders+parseHeader' = stop <|> loop+ where+ stop = [] <$ (crlf <|> endOfInput)+ loop = (:) <$> keyVal <*> parseHeader'++type RequestHeader = (CI ByteString, ByteString)++keyVal :: Parser RequestHeader+keyVal = do+ key <- takeTill (wcollon==)+ word8 wcollon+ skipWhile (wspace ==)+ val <- takeTill (`elem` [wlf,wcr])+ crlf+ return (mk key, val)++crlf :: Parser ()+crlf = (cr >> (lf <|> return ())) <|> lf++cr :: Parser ()+cr = () <$ word8 wcr++lf :: Parser ()+lf = () <$ word8 wlf++wcollon :: Word8+wcollon = 58++wcr :: Word8+wcr = 13++wlf :: Word8+wlf = 10++wspace :: Word8+wspace = 32
− Network/Wai/Application/Classic/EnumLine.hs
@@ -1,62 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Wai.Application.Classic.EnumLine (head) where--import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as S () -- for OverloadedStrings-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as L () -- for OverloadedStrings-import Data.Enumerator (Iteratee, Stream(..), yield, continue)-import Prelude hiding (head)--head :: Iteratee BS.ByteString IO (Maybe BS.ByteString)-head = line id False--line :: Builder -> Bool- -> Iteratee BS.ByteString IO (Maybe BS.ByteString)-line build dropLF = continue go- where- go (Chunks cnk) = breakLine (BL.fromChunks cnk)- go EOF = yield Nothing EOF- breakLine "" = line build dropLF- breakLine xs | dropLF && y == lf = yield (Just ln) (Chunks cnk)- where- y = BL.head xs- ys = BL.tail xs- ln = toStrict . build $ ""- cnk = BL.toChunks ys- breakLine xs = case BL.break eol xs of- (ys, "") -> line (build +++ toB ys) False- (ys, zs) -> dropCRLF ys zs- dropCRLF xs ys- | z == cr = dropCR xs zs- | otherwise = yield (Just ln) (Chunks cnks) -- dropLF- where- z = BL.head ys- zs = BL.tail ys- ln = toStrict . build $ xs- cnks = BL.toChunks zs- dropCR xs "" = line (build +++ toB xs) True- dropCR xs ys- | z == lf = yield (Just ln) (Chunks czs)- | otherwise = yield (Just ln) (Chunks cys)- where- z = BL.head ys- zs = BL.tail ys- ln = toStrict . build $ xs- cys = BL.toChunks ys- czs = BL.toChunks zs- lf = 10- cr = 13- eol = (`elem` [lf, cr])--type Builder = BL.ByteString -> BL.ByteString--(+++) :: Builder -> Builder -> Builder-a +++ b = a . b--toB :: BL.ByteString -> Builder-toB b = (b `BL.append`)--toStrict :: BL.ByteString -> BS.ByteString-toStrict = BS.concat . BL.toChunks
Network/Wai/Application/Classic/File.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.Wai.Application.Classic.File (@@ -6,38 +7,39 @@ ) where import Control.Applicative-import Control.Exception-import Data.ByteString (ByteString)+import Control.Exception (Exception, SomeException)+import Control.Exception.Lifted (catch, throwIO)+import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString.Char8 as BS (pack, concat) import qualified Data.ByteString.Lazy.Char8 as BL (length)-import Data.Enumerator (Iteratee(..), tryIO, catchError, throwError)+import Data.Conduit import Data.Typeable import Network.HTTP.Types import Network.Wai import Network.Wai.Application.Classic.Field import Network.Wai.Application.Classic.FileInfo+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Status import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils import Prelude hiding (catch) ---------------------------------------------------------------- -type Iter = Iteratee ByteString IO-type Rsp = Iter RspSpec+type RIO = ResourceT IO+type Rsp = ResourceT IO RspSpec -instance Alternative Iter where+instance Alternative RIO where empty = goNext- x <|> y = x `catchError` const y+ x <|> y = x `catch` (\(_ :: SomeException) -> y) -data AltIterErr = AltIterErr deriving (Show, Typeable)+data RIOErr = RIOErr deriving (Show, Typeable) -instance Exception AltIterErr+instance Exception RIOErr -goNext :: Iter a-goNext = throwError AltIterErr+goNext :: RIO a+goNext = throwIO RIOErr -runAlt :: [Iter a] -> Iter a+runAlt :: [RIO a] -> RIO a runAlt = foldr (<|>) goNext ----------------------------------------------------------------@@ -78,10 +80,10 @@ _ -> return notAllowed (response, mlen) <- case body of NoBody -> return $ noBody st- BodyStatus -> statusBody st <$> (tryIO $ getStatusInfo cspec spec langs st)+ BodyStatus -> statusBody st <$> (liftIO $ getStatusInfo cspec spec langs st) BodyFileNoBody hdr -> return $ bodyFileNoBody st hdr BodyFile hdr afile rng -> return $ bodyFile st hdr afile rng- tryIO $ logger cspec req st mlen+ liftIO $ logger cspec req st mlen return response where hinfo = HandlerInfo spec req file langs@@ -130,7 +132,7 @@ tryGetFile :: HandlerInfo -> Bool -> Lang -> Rsp tryGetFile (HandlerInfo spec req file _) ishtml lang = do- finfo <- tryIO (getFileInfo spec (lang file))+ finfo <- liftIO (getFileInfo spec (lang file)) let mtime = fileInfoTime finfo size = fileInfoSize finfo sfile = fileInfoName finfo@@ -159,7 +161,7 @@ tryHeadFile :: HandlerInfo -> Bool -> Lang -> Rsp tryHeadFile (HandlerInfo spec req file _) ishtml lang = do- finfo <- tryIO (getFileInfo spec (lang file))+ finfo <- liftIO (getFileInfo spec (lang file)) let mtime = fileInfoTime finfo size = fileInfoSize finfo hdr = newHeader ishtml (pathByteString file) mtime@@ -180,7 +182,7 @@ tryRedirectFile :: HandlerInfo -> Lang -> Rsp tryRedirectFile (HandlerInfo spec req file _) lang = do- _ <- tryIO $ getFileInfo spec (lang file)+ _ <- liftIO $ getFileInfo spec (lang file) return $ RspSpec statusMovedPermanently (BodyFileNoBody hdr) where hdr = locationHeader redirectURL
Network/Wai/Application/Classic/FileInfo.hs view
@@ -6,9 +6,9 @@ import Network.Wai import Network.Wai.Application.Classic.Field import Network.Wai.Application.Classic.Header+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Range import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils ----------------------------------------------------------------
+ Network/Wai/Application/Classic/Path.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Application.Classic.Path (+ Path(..)+ , fromString, fromByteString+ , (+++), (</>), (<\>), (<.>)+ , breakAtSeparator, hasTrailingPathSeparator+ , isSuffixOf+ ) where++import qualified Blaze.ByteString.Builder as BB+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (null, last, append, drop, length, breakByte, isSuffixOf)+import qualified Data.ByteString.Char8 as BS (pack, unpack)+import Data.Monoid+import Data.String+import Data.Word++----------------------------------------------------------------++data Path = Path {+ pathString :: FilePath+ , pathByteString :: ByteString+ } deriving Show++instance IsString Path where+ fromString path = Path {+ pathString = path+ , pathByteString = BS.pack path+ }++fromByteString :: ByteString -> Path+fromByteString path = Path {+ pathString = BS.unpack path+ , pathByteString = path+ }++pathDot :: Word8+pathDot = 46++pathSep :: Word8+pathSep = 47++{-|+ Checking if the path ends with the path separator.+-}+hasTrailingPathSeparator :: Path -> Bool+hasTrailingPathSeparator path+ | BS.null bs = False+ | BS.last bs == pathSep = True+ | otherwise = False+ where+ bs = pathByteString path++infixr +++++{-|+ Appending.+-}++(+++) :: Path -> Path -> Path+p1 +++ p2 = Path {+ pathString = BS.unpack p+ , pathByteString = p+ }+ where+ p = pathByteString p1 `BS.append` pathByteString p2++{-|+ Appending with the file separator.+-}++(</>) :: Path -> Path -> Path+p1 </> p2+ | hasTrailingPathSeparator p1 = p1 +++ p2+ | otherwise = Path {+ pathString = BS.unpack p+ , pathByteString = p+ }+ where+ p1' = pathByteString p1+ p2' = pathByteString p2+ p = BB.toByteString (BB.fromByteString p1'+ `mappend` BB.fromWord8 pathSep+ `mappend` BB.fromByteString p2')++{-|+ Removing prefix. The prefix of the second argument is removed+ from the first argument.+-}+(<\>) :: Path -> Path -> Path+p1 <\> p2 = Path {+ pathString = BS.unpack p+ , pathByteString = p+ }+ where+ p1' = pathByteString p1+ p2' = pathByteString p2+ p = BS.drop (BS.length p2') p1'++{-|+ Adding suffix.+-}+(<.>) :: Path -> Path -> Path+p1 <.> p2 = Path {+ pathString = BS.unpack p+ , pathByteString = p+ }+ where+ p1' = pathByteString p1+ p2' = pathByteString p2+ p = BB.toByteString (BB.fromByteString p1'+ `mappend` BB.fromWord8 pathDot+ `mappend` BB.fromByteString p2')++{-|+ Breaking at the first path separator.+-}+breakAtSeparator :: Path -> (Path,Path)+breakAtSeparator p = (fromByteString r1, fromByteString r2)+ where+ p' = pathByteString p+ (r1,r2) = BS.breakByte pathSep p'++isSuffixOf :: Path -> Path -> Bool+isSuffixOf p1 p2 = p1' `BS.isSuffixOf` p2'+ where+ p1' = pathByteString p1+ p2' = pathByteString p2
Network/Wai/Application/Classic/RevProxy.hs view
@@ -2,33 +2,32 @@ module Network.Wai.Application.Classic.RevProxy (revProxyApp) where -import Blaze.ByteString.Builder (Builder)-import qualified Blaze.ByteString.Builder as BB (fromByteString) import Control.Applicative-import Control.Exception+import Control.Exception (SomeException)+import Control.Exception.Lifted (catch) import Control.Monad.IO.Class (liftIO)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as BL-import Data.Enumerator (Iteratee, Enumeratee, run_, (=$), ($$), enumList)-import qualified Data.Enumerator.List as EL-import qualified Network.HTTP.Enumerator as H+import qualified Data.ByteString.Char8 as BS+import Data.Conduit+import Data.Int+import Data.Maybe+import qualified Network.HTTP.Conduit as H import Network.HTTP.Types import Network.Wai+import Network.Wai.Application.Classic.Conduit import Network.Wai.Application.Classic.Field+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils import Prelude hiding (catch) -toHTTPRequest :: Request -> RevProxyRoute -> BL.ByteString -> H.Request m-toHTTPRequest req route lbs = H.def {+toHTTPRequest :: Request -> RevProxyRoute -> Int64 -> H.Request IO+toHTTPRequest req route len = H.def { H.host = revProxyDomain route , H.port = revProxyPort route , H.secure = isSecure req- , H.checkCerts = H.defaultCheckCerts , H.requestHeaders = addForwardedFor req $ requestHeaders req , H.path = pathByteString path'- , H.queryString = queryString req- , H.requestBody = H.RequestBodyLBS lbs+ , H.queryString = rawQueryString req+ , H.requestBody = getBody req len , H.method = requestMethod req , H.proxy = Nothing , H.rawBody = False@@ -40,41 +39,47 @@ dst = revProxyDst route path' = dst </> (path <\> src) +getBody :: Request -> Int64 -> H.RequestBody IO+getBody req len = H.RequestBodySource len (toBodySource req)+ where+ toBodySource = (byteStringToBuilder <$>) . requestBody ++getLen :: Request -> Maybe Int64+getLen req = do+ len' <- lookup "content-length" $ requestHeaders req+ case reads $ BS.unpack len' of+ [] -> Nothing+ (i, _):_ -> Just i+ {-| Relaying any requests as reverse proxy. -} revProxyApp :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application-revProxyApp cspec spec route req = respEnumerator $ \respIter -> do- -- FIXME: stored-and-forward -> streaming- lbs <- BL.fromChunks <$> run_ EL.consume- run_ (H.http (toHTTPRequest req route lbs) (fromBS cspec req respIter) mgr)- `catch` badGateway cspec req respIter- where- respEnumerator = return . ResponseEnumerator- mgr = revProxyManager spec+revProxyApp cspec spec route req =+ revProxyApp' cspec spec route req+ `catch` badGateway cspec req -fromBS :: ClassicAppSpec -> Request- -> (Status -> ResponseHeaders -> Iteratee Builder IO a)- -> (Status -> ResponseHeaders -> Iteratee ByteString IO a)-fromBS cspec req respIter st hdr = do- liftIO $ logger cspec req st Nothing -- FIXME body length- bodyAsBuilder =$ respIter st hdr'+revProxyApp' :: ClassicAppSpec -> RevProxyAppSpec -> RevProxyRoute -> Application+revProxyApp' cspec spec route req = do+ let mlen = getLen req+ len = fromMaybe 0 mlen+ httpReq = toHTTPRequest req route len+ H.Response status hdr downbody <- H.http httpReq mgr+ let hdr' = fixHeader hdr+ liftIO $ logger cspec req status (fromIntegral <$> mlen)+ return $ ResponseSource status hdr' (byteStringToBuilder <$> downbody) where- hdr' = addVia cspec req $ filter p hdr+ mgr = revProxyManager spec+ fixHeader = addVia cspec req . filter p p ("Content-Encoding", _) = False p _ = True -badGateway :: ClassicAppSpec -> Request- -> (Status -> ResponseHeaders -> Iteratee Builder IO a)- -> SomeException -> IO a-badGateway cspec req respIter _ = do+badGateway :: ClassicAppSpec -> Request-> SomeException -> ResourceT IO Response+badGateway cspec req _ = do liftIO $ logger cspec req st Nothing -- FIXME body length- run_ $ bdy $$ bodyAsBuilder =$ respIter st hdr+ return $ ResponseBuilder st hdr bdy where hdr = addServer cspec textPlainHeader- bdy = enumList 1 ["Bad Gateway\r\n"]+ bdy = byteStringToBuilder "Bad Gateway\r\n" st = statusBadGateway--bodyAsBuilder :: Enumeratee ByteString Builder IO a-bodyAsBuilder = EL.map BB.fromByteString
Network/Wai/Application/Classic/Status.hs view
@@ -11,8 +11,8 @@ import Data.Maybe import qualified Data.StaticHash as M import Network.HTTP.Types+import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types-import Network.Wai.Application.Classic.Utils import Prelude hiding (catch) instance Alternative IO where
Network/Wai/Application/Classic/Types.hs view
@@ -2,10 +2,10 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)+import qualified Network.HTTP.Conduit as H import Network.HTTP.Date-import qualified Network.HTTP.Enumerator as H import Network.HTTP.Types-import Network.Wai.Application.Classic.Utils+import Network.Wai.Application.Classic.Path import Network.Wai.Logger.Prefork ----------------------------------------------------------------
− Network/Wai/Application/Classic/Utils.hs
@@ -1,129 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Wai.Application.Classic.Utils (- Path(..)- , fromString, fromByteString- , (+++), (</>), (<\>), (<.>)- , breakAtSeparator, hasTrailingPathSeparator- , isSuffixOf- ) where--import qualified Blaze.ByteString.Builder as BB-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS (null, last, append, drop, length, breakByte, isSuffixOf)-import qualified Data.ByteString.Char8 as BS (pack, unpack)-import Data.Monoid-import Data.String-import Data.Word--------------------------------------------------------------------data Path = Path {- pathString :: FilePath- , pathByteString :: ByteString- } deriving Show--instance IsString Path where- fromString path = Path {- pathString = path- , pathByteString = BS.pack path- }--fromByteString :: ByteString -> Path-fromByteString path = Path {- pathString = BS.unpack path- , pathByteString = path- }--pathDot :: Word8-pathDot = 46--pathSep :: Word8-pathSep = 47--{-|- Checking if the path ends with the path separator.--}-hasTrailingPathSeparator :: Path -> Bool-hasTrailingPathSeparator path- | BS.null bs = False- | BS.last bs == pathSep = True- | otherwise = False- where- bs = pathByteString path--infixr +++--{-|- Appending.--}--(+++) :: Path -> Path -> Path-p1 +++ p2 = Path {- pathString = BS.unpack p- , pathByteString = p- }- where- p = pathByteString p1 `BS.append` pathByteString p2--{-|- Appending with the file separator.--}--(</>) :: Path -> Path -> Path-p1 </> p2- | hasTrailingPathSeparator p1 = p1 +++ p2- | otherwise = Path {- pathString = BS.unpack p- , pathByteString = p- }- where- p1' = pathByteString p1- p2' = pathByteString p2- p = BB.toByteString (BB.fromByteString p1'- `mappend` BB.fromWord8 pathSep- `mappend` BB.fromByteString p2')--{-|- Removing prefix. The prefix of the second argument is removed- from the first argument.--}-(<\>) :: Path -> Path -> Path-p1 <\> p2 = Path {- pathString = BS.unpack p- , pathByteString = p- }- where- p1' = pathByteString p1- p2' = pathByteString p2- p = BS.drop (BS.length p2') p1'--{-|- Adding suffix.--}-(<.>) :: Path -> Path -> Path-p1 <.> p2 = Path {- pathString = BS.unpack p- , pathByteString = p- }- where- p1' = pathByteString p1- p2' = pathByteString p2- p = BB.toByteString (BB.fromByteString p1'- `mappend` BB.fromWord8 pathDot- `mappend` BB.fromByteString p2')--{-|- Breaking at the first path separator.--}-breakAtSeparator :: Path -> (Path,Path)-breakAtSeparator p = (fromByteString r1, fromByteString r2)- where- p' = pathByteString p- (r1,r2) = BS.breakByte pathSep p'--isSuffixOf :: Path -> Path -> Bool-isSuffixOf p1 p2 = p1' `BS.isSuffixOf` p2'- where- p1' = pathByteString p1- p2' = pathByteString p2
wai-app-file-cgi.cabal view
@@ -1,5 +1,5 @@ Name: wai-app-file-cgi-Version: 0.4.4+Version: 0.5.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -18,27 +18,27 @@ GHC-Options: -Wall Exposed-Modules: Network.Wai.Application.Classic Other-Modules: Network.Wai.Application.Classic.CGI- Network.Wai.Application.Classic.EnumLine+ Network.Wai.Application.Classic.Conduit Network.Wai.Application.Classic.Field Network.Wai.Application.Classic.File Network.Wai.Application.Classic.FileInfo Network.Wai.Application.Classic.Header Network.Wai.Application.Classic.Lang+ Network.Wai.Application.Classic.Path Network.Wai.Application.Classic.Range Network.Wai.Application.Classic.RevProxy Network.Wai.Application.Classic.Status Network.Wai.Application.Classic.Types- Network.Wai.Application.Classic.Utils Build-Depends: base >= 4 && < 5, process, network, transformers, filepath, directory, unix, containers, attoparsec >= 0.10.0.0,- wai, enumerator >= 0.4.9,+ wai, conduit, bytestring, blaze-builder, wai-app-static >= 0.3, http-types, http-date, case-insensitive, static-hash, wai-logger, wai-logger-prefork,- http-enumerator+ http-conduit, lifted-base, attoparsec-conduit Source-Repository head Type: git Location: https://github.com/kazu-yamamoto/wai-app-file-cgi