packages feed

netlines 0.4.3 → 1.0.0

raw patch · 6 files changed

+376/−165 lines, 6 filesdep +HTFdep +randomdep +textdep ~contstuffdep ~enumeratornew-component:exe:netlines-test

Dependencies added: HTF, random, text

Dependency ranges changed: contstuff, enumerator

Files

Data/Enumerator/NetLines.hs view
@@ -7,10 +7,14 @@ -- -- Enumerator tools for working with text-based network protocols. -{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}  module Data.Enumerator.NetLines-    ( -- * Iteratees+    ( -- * Reexports+      module Data.Enumerator.NetLines.Error,+      module Data.Enumerator.NetLines.IO,++      -- * Iteratees       netLine,       netLineEmpty,       netWord,@@ -24,143 +28,26 @@        -- * General stream splitters       netSplitBy,-      netSplitsBy,--      -- * Input/output-      TimeoutError(..),-      enumHandleSession,-      enumHandleTimeout,-      iterHandleTimeout+      netSplitsBy     )     where -import qualified Data.ByteString as B import Control.ContStuff as Monad-import Control.Exception as Ex-import Data.ByteString (ByteString) import Data.Enumerator as E-import Data.Time.Clock-import Data.Typeable-import Data.Word-import System.IO-import System.IO.Error as IOErr-import System.Timeout----- | Exception for timed out IO operations.--newtype TimeoutError = TimeoutError { timeoutErrorMessage :: String }-    deriving (Typeable)--instance Ex.Exception TimeoutError--instance Show TimeoutError where-    show (TimeoutError msg) = "Operation timed out: " ++ msg----- | Enumerate from a handle with the given buffer size (first--- argument), read timeout in milliseconds (second argument) and session--- timeout in milliseconds (third argument).  If either timeout is--- exceeded a 'TimeoutError' exception is thrown via 'throwError'.--enumHandleSession ::-    forall b m. MonadIO m =>-    Int -> Int -> Int -> Handle -> Enumerator ByteString m b-enumHandleSession bufSize readTime sessionTime h step = do-    startTime <- liftIO getCurrentTime-    loop startTime step--    where-    loop :: UTCTime -> Enumerator ByteString m b-    loop startTime (Continue k) = do-        now <- liftIO getCurrentTime-        let timeoutErr = TimeoutError "Read timeout"-            diff = sessionTime - round (1000 * diffUTCTime now startTime)-            timeout = min diff readTime-        when (timeout <= 0) $ throwError timeoutErr-        mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)-        case mHaveInput of-          Left err-              | isEOFError err -> continue k-              | otherwise      -> throwError err-          Right False -> throwError timeoutErr-          Right True  -> do-              str <- tryIO $ B.hGetNonBlocking h bufSize-              if B.null str-                then continue k-                else k (Chunks [str]) >>== loop startTime-    loop _ step = returnI step----- | Enumerate from a handle with the given buffer size (first argument)--- and timeout in milliseconds (second argument).  If the timeout is--- exceeded a 'TimeoutError' exception is thrown via 'throwError'.------ Note that this timeout is not a timeout for the whole enumeration,--- but for each individual read operation.  In other words, this timeout--- protects against dead/unresponsive peers, but not against (perhaps--- intentionally) slowly sending peers.--enumHandleTimeout ::-    forall b m. MonadIO m =>-    Int -> Int -> Handle -> Enumerator ByteString m b-enumHandleTimeout bufSize timeout h = loop-    where-    loop :: Enumerator ByteString m b-    loop (Continue k) = do-        mHaveInput <- liftIO $ IOErr.try (hWaitForInput h timeout)-        case mHaveInput of-          Left err-              | isEOFError err -> continue k-              | otherwise      -> throwError err-          Right False -> throwError $ TimeoutError "Read timeout"-          Right True  -> do-              str <- tryIO $ B.hGetNonBlocking h bufSize-              if B.null str-                then continue k-                else k (Chunks [str]) >>== loop-    loop step = returnI step----- | Predicate for ASCII whitespace.--isSpace :: Word8 -> Bool-isSpace n = n == 32 || (n >= 9 && n <= 13)+import Data.Enumerator.NetLines.Class as NL+import Data.Enumerator.NetLines.Error+import Data.Enumerator.NetLines.IO  --- | Writes its inputs to the given handle.  Times out after the given--- number of milliseconds with a 'TimeoutError' iteratee exception.  The--- handle should be unbuffered and in binary mode.  See 'hSetBuffering'--- and 'hSetBinaryMode'.------ Please note that only the write operations themselves are timed.--- Most notably the operation of the data source enumerator is *not*--- timed.  Hence the operation may time out later than the given time--- margin, but never earlier.--iterHandleTimeout ::-    forall m. MonadIO m => Int -> Handle -> Iteratee ByteString m ()-iterHandleTimeout maxTime h = do-    startTime <- tryIO getCurrentTime-    continue (loop startTime)+-- | 'True' for ASCII whitespace. -    where-    loop :: UTCTime -> Stream ByteString -> Iteratee ByteString m ()-    loop _ EOF = yield () EOF-    loop startTime (Chunks []) = continue (loop startTime)-    loop startTime (Chunks strs) = do-        let timeoutErr = TimeoutError "Write timeout"-        now <- tryIO getCurrentTime-        let restMs = 1000*maxTime - round (1000000 * diffUTCTime now startTime)-        when (restMs <= 0) (throwError timeoutErr)-        tryIO (timeout restMs (mapM_ (B.hPutStr h) strs)) >>=-            maybe (throwError timeoutErr) return-        continue (loop startTime)+isSpace :: Char -> Bool+isSpace n = n == ' ' || (n >= '\t' && n <= '\r')   -- | Get the next nonempty line from the stream using 'netLineEmpty'. -netLine :: forall m. Monad m => Int -> Iteratee ByteString m (Maybe ByteString)+netLine :: (Monad m, Splittable str) => Int -> Iteratee str m (Maybe str) netLine = nonEmpty . netLineEmpty  @@ -168,20 +55,20 @@ -- 'Int'.  This iteratee is error-tolerant by using LF as the line -- terminator and simply ignoring all CR characters. -netLineEmpty :: Monad m => Int -> Iteratee ByteString m (Maybe ByteString)-netLineEmpty = netSplitBy (== 10) (/= 13)+netLineEmpty :: (Monad m, Splittable str) => Int -> Iteratee str m (Maybe str)+netLineEmpty = netSplitBy (== '\n') (/= '\r')   -- | Convert a raw byte stream to a stream of lines based on 'netLine'. -netLines :: Monad m => Int -> Enumeratee ByteString ByteString m b+netLines :: (Monad m, Splittable str) => Int -> Enumeratee str str m b netLines = netSplitsBy . netLine   -- | Convert a raw byte stream to a stream of lines based on -- 'netLineEmpty'. -netLinesEmpty :: Monad m => Int -> Enumeratee ByteString ByteString m b+netLinesEmpty :: (Monad m, Splittable str) => Int -> Enumeratee str str m b netLinesEmpty = netSplitsBy . netLineEmpty  @@ -190,37 +77,36 @@ -- the given 'Int' and are truncated safely in constant space.  netSplitBy ::-    forall m. Monad m =>-    (Word8 -> Bool) -> (Word8 -> Bool) -> Int ->-    Iteratee ByteString m (Maybe ByteString)+    forall m str. (Monad m, Splittable str) =>+    (Char -> Bool) -> (Char -> Bool) -> Int ->+    Iteratee str m (Maybe str) netSplitBy breakP filterP n =-    continue (loop B.empty)+    continue (loop NL.empty)      where-    loop :: ByteString -> Stream ByteString ->-            Iteratee ByteString m (Maybe ByteString)-    loop line' EOF = yield (if B.null line' then Nothing else Just line') EOF+    loop :: str -> Stream str -> Iteratee str m (Maybe str)+    loop line' EOF = yield (if NL.null line' then Nothing else Just line') EOF     loop line' (Chunks []) = continue (loop line')     loop line' (Chunks (str:strs)) =-        if B.null line2'+        if NL.null line2'           then line `seq` loop line (Chunks strs)           else yield (Just line) (Chunks (line2:strs))          where-        (line1', line2') = B.break breakP str-        line1            = B.filter filterP line1'-        line2            = B.tail line2'-        line             = B.take n $ B.append line' line1+        (line1', line2') = NL.break breakP str+        line1            = NL.filter filterP line1'+        line2            = NL.tail line2'+        line             = NL.take n $ NL.append line' line1   -- | Split the stream using the supplied iteratee.  netSplitsBy ::-    forall b m. Monad m =>-    Iteratee ByteString m (Maybe ByteString) -> Enumeratee ByteString ByteString m b+    forall b m str. (Monad m, Splittable str) =>+    Iteratee str m (Maybe str) -> Enumeratee str str m b netSplitsBy getLine = loop     where-    loop :: Enumeratee ByteString ByteString m b+    loop :: Enumeratee str str m b     loop (Continue k) = do         mLine <- getLine         case mLine of@@ -232,7 +118,7 @@ -- | Get the next nonempty word from the stream with the given maximum -- length.  Based on 'netWordEmpty'. -netWord :: Monad m => Int -> Iteratee ByteString m (Maybe ByteString)+netWord :: (Monad m, Splittable str) => Int -> Iteratee str m (Maybe str) netWord = nonEmpty . netWordEmpty  @@ -240,30 +126,30 @@ -- This iteratee is error-tolerant by using ASCII whitespace as -- splitting characters. -netWordEmpty :: Monad m => Int -> Iteratee ByteString m (Maybe ByteString)+netWordEmpty :: (Monad m, Splittable str) => Int -> Iteratee str m (Maybe str) netWordEmpty = netSplitBy isSpace (const True)   -- | Split the raw byte stream into words based on 'netWord'. -netWords :: Monad m => Int -> Enumeratee ByteString ByteString m b+netWords :: (Monad m, Splittable str) => Int -> Enumeratee str str m b netWords = netSplitsBy . netWord   -- | Split the raw byte stream into words based on 'netWords'. -netWordsEmpty :: Monad m => Int -> Enumeratee ByteString ByteString m b+netWordsEmpty :: (Monad m, Splittable str) => Int -> Enumeratee str str m b netWordsEmpty = netSplitsBy . netWordEmpty   -- | Apply the given iteratee, until it returns a nonempty string.  nonEmpty ::-    forall a m. Monad m =>-    Iteratee a m (Maybe ByteString) -> Iteratee a m (Maybe ByteString)+    forall a m str. (Monad m, Splittable str) =>+    Iteratee a m (Maybe str) -> Iteratee a m (Maybe str) nonEmpty getStr = evalMaybeT loop     where-    loop :: MaybeT r (Iteratee a m) ByteString+    loop :: MaybeT r (Iteratee a m) str     loop = do         line <- liftF getStr-        if B.null line then loop else return line+        if NL.null line then loop else return line
+ Data/Enumerator/NetLines/Class.hs view
@@ -0,0 +1,63 @@+-- |+-- Module:     Data.Enumerator.NetLines.Class+-- Copyright:  (c) 2011 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Class for splittable stream types.++module Data.Enumerator.NetLines.Class+    ( -- * Splittable stream class+      Splittable(..)+    )+    where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.ByteString (ByteString)+import Data.Text (Text)+import System.IO+++-- | This is a type class for splittable streams.  Instances provide+-- support for efficient non-blocking reading and splitting.++class Splittable str where+    append  :: str -> str -> str+    break   :: (Char -> Bool) -> str -> (str, str)+    empty   :: str+    filter  :: (Char -> Bool) -> str -> str+    null    :: str -> Bool+    tail    :: str -> str+    take    :: Int -> str -> str++    hGetNonBlocking :: Handle -> Int -> IO str+    hPutStr         :: Handle -> str -> IO ()+++instance Splittable ByteString where+    append    = B.append+    break     = BC.break+    empty     = B.empty+    filter    = BC.filter+    null      = B.null+    tail      = B.tail+    take      = B.take++    hGetNonBlocking = B.hGetNonBlocking+    hPutStr         = B.hPutStr+++instance Splittable Text where+    append    = T.append+    break     = T.break+    empty     = T.empty+    filter    = T.filter+    null      = T.null+    tail      = T.tail+    take      = T.take++    hGetNonBlocking h = fmap T.decodeUtf8 . B.hGetNonBlocking h+    hPutStr h = B.hPutStr h . T.encodeUtf8
+ Data/Enumerator/NetLines/Error.hs view
@@ -0,0 +1,29 @@+-- |+-- Module:     Data.Enumerator.NetLines.Error+-- Copyright:  (c) 2011 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Error and exception types.++{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}++module Data.Enumerator.NetLines.Error+    ( -- * Exceptions+      TimeoutError(..)+    )+    where++import Control.Exception as Ex+import Data.Typeable+++-- | Exception for timed out IO operations.++newtype TimeoutError = TimeoutError { timeoutErrorMessage :: String }+    deriving (Typeable)++instance Ex.Exception TimeoutError++instance Show TimeoutError where+    show (TimeoutError msg) = "Operation timed out: " ++ msg
+ Data/Enumerator/NetLines/IO.hs view
@@ -0,0 +1,123 @@+-- |+-- Module:     Data.Enumerator.NetLines.IO+-- Copyright:  (c) 2011 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Efficient input and output with timeouts.++{-# LANGUAGE ScopedTypeVariables #-}++module Data.Enumerator.NetLines.IO+    ( -- * Enumerators (input)+      enumHandleSession,+      enumHandleTimeout,++      -- * Iteratees (output)+      iterHandleTimeout+    )+    where++import Control.ContStuff as Monad+import Data.Enumerator as E+import Data.Enumerator.NetLines.Class as NL+import Data.Enumerator.NetLines.Error+import Data.Time.Clock+import System.IO+import System.IO.Error as IO+import System.Timeout+++-- | Enumerate from a handle with the given buffer size (first+-- argument), read timeout in milliseconds (second argument) and session+-- timeout in milliseconds (third argument).  If either timeout is+-- exceeded a 'TimeoutError' exception is thrown via 'throwError'.++enumHandleSession ::+    forall b m str. (MonadIO m, Splittable str) =>+    Int -> Int -> Int -> Handle -> Enumerator str m b+enumHandleSession bufSize readTime sessionTime h step = do+    startTime <- liftIO getCurrentTime+    loop startTime step++    where+    loop :: UTCTime -> Enumerator str m b+    loop startTime (Continue k) = do+        now <- liftIO getCurrentTime+        let timeoutErr = TimeoutError "Read timeout"+            diff = sessionTime - round (1000 * diffUTCTime now startTime)+            timeout = min diff readTime+        when (timeout <= 0) $ throwError timeoutErr+        mHaveInput <- liftIO $ IO.try (hWaitForInput h timeout)+        case mHaveInput of+          Left err+              | isEOFError err -> continue k+              | otherwise      -> throwError err+          Right False -> throwError timeoutErr+          Right True  -> do+              str <- tryIO $ NL.hGetNonBlocking h bufSize+              if NL.null str+                then continue k+                else k (Chunks [str]) >>== loop startTime+    loop _ step = returnI step+++-- | Enumerate from a handle with the given buffer size (first argument)+-- and timeout in milliseconds (second argument).  If the timeout is+-- exceeded a 'TimeoutError' exception is thrown via 'throwError'.+--+-- Note that this timeout is not a timeout for the whole enumeration,+-- but for each individual read operation.  In other words, this timeout+-- protects against dead/unresponsive peers, but not against (perhaps+-- intentionally) slowly sending peers.++enumHandleTimeout ::+    forall b m str. (MonadIO m, Splittable str) =>+    Int -> Int -> Handle -> Enumerator str m b+enumHandleTimeout bufSize timeout h = loop+    where+    loop :: Enumerator str m b+    loop (Continue k) = do+        mHaveInput <- liftIO $ IO.try (hWaitForInput h timeout)+        case mHaveInput of+          Left err+              | isEOFError err -> continue k+              | otherwise      -> throwError err+          Right False -> throwError $ TimeoutError "Read timeout"+          Right True  -> do+              str <- tryIO $ NL.hGetNonBlocking h bufSize+              if NL.null str+                then continue k+                else k (Chunks [str]) >>== loop+    loop step = returnI step+++-- | Writes its inputs to the given handle.  Times out after the given+-- number of milliseconds with a 'TimeoutError' iteratee exception.  The+-- handle should be unbuffered and in binary mode.  See 'hSetBuffering'+-- and 'hSetBinaryMode'.+--+-- Please note that only the write operations themselves are timed.+-- Most notably the operation of the data source enumerator is *not*+-- timed.  Hence the operation may time out later than the given time+-- margin, but never earlier.++iterHandleTimeout ::+    forall m str. (MonadIO m, Splittable str) =>+    Int -> Handle -> Iteratee str m ()+iterHandleTimeout maxTime h = do+    startTime <- tryIO getCurrentTime+    continue (loop startTime)++    where+    loop :: UTCTime -> Stream str -> Iteratee str m ()+    loop _ EOF = yield () EOF+    loop startTime (Chunks []) = continue (loop startTime)+    loop startTime (Chunks strs) = do+        let timeoutErr = TimeoutError "Write timeout"+        now <- tryIO getCurrentTime+        let restMs = 1000*maxTime - round (1000000 * diffUTCTime now startTime)+        when (restMs <= 0) (throwError timeoutErr)+        tryIO (timeout restMs (mapM_ (NL.hPutStr h) strs)) >>=+            maybe (throwError timeoutErr) return+        continue (loop startTime)
+ Test.hs view
@@ -0,0 +1,104 @@+-- |+-- Module:     Main+-- Copyright:  (c) 2010 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability:  experimental+--+-- Test program.++{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import qualified Data.ByteString.Char8 as BC+import qualified Data.Enumerator as E+import qualified Data.Enumerator.List as EL+import qualified Data.Text as T+import Control.ContStuff+import Data.ByteString (ByteString)+import Data.Enumerator (Iteratee, enumList, ($$), (=$))+import Data.Enumerator.NetLines+import Data.Enumerator.NetLines.Class (Splittable)+import Data.Text (Text)+import System.Environment+import System.Exit+import System.Random+import Test.Framework+++type Bs = ByteString+type MBs = Maybe ByteString+type MT = Maybe Text+++iterEqual ::+    (Eq b, Show b, Splittable str) => b -> Iteratee str IO b -> Assertion+iterEqual expectedResult iter = do+    mLine <- E.run iter+    case mLine of+      Right actualResult -> assertEqual actualResult expectedResult+      Left exp           -> assertFailure ("Iteratee exception: " ++ show exp)+++test_netLine_empty :: Assertion+test_netLine_empty = do+    iterEqual (Nothing :: MBs) (netLine 512)+    iterEqual (Nothing :: MT) (netLine 512)+++test_netLine_single :: Assertion+test_netLine_single = do+    iterEqual (Just "abc") (enumList 1 ["abc" :: Bs] $$ netLine 8)+    iterEqual (Just "abc") (enumList 1 ["abc\nabc" :: Bs] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["12345678" :: Bs] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["12345678\n123" :: Bs] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["123456789" :: Bs] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["123456789\n123" :: Bs] $$ netLine 8)++    iterEqual (Just "abc") (enumList 1 ["abc" :: Text] $$ netLine 8)+    iterEqual (Just "abc") (enumList 1 ["abc\nabc" :: Text] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["12345678" :: Text] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["12345678\n123" :: Text] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["123456789" :: Text] $$ netLine 8)+    iterEqual (Just "12345678") (enumList 1 ["123456789\n123" :: Text] $$ netLine 8)+++test_netLine_multiple :: Assertion+test_netLine_multiple = do+    iterEqual [Just "abc" :: MBs, Just "def", Nothing, Nothing]+        (enumList 2 ["abc\n", "defghi\n"] $$ replicateM 4 (netLine 3))++    iterEqual [Just "abc" :: MT, Just "def", Nothing, Nothing]+        (enumList 2 ["abc\n", "defghi\n"] $$ replicateM 4 (netLine 3))+    iterEqual [Just "äöü" :: MT, Just "üßa", Nothing, Nothing]+        (enumList 2 ["äöü\n", "üßabc\n"] $$ replicateM 4 (netLine 3))+++test_netLine_longStream :: Assertion+test_netLine_longStream = do+    input <- replicateM 100000 (randomRIO ('\0', '\300'))++    let bsInputs = takeWhile (not . BC.null) . map (BC.pack . take 32) . iterate (drop 32) . filter (<= '\255') $ input+        txInputs = takeWhile (not . T.null) . map (T.pack . take 32) . iterate (drop 32) $ input++        bsExpected = map BC.pack . filter (not . null) . map (take 16) . asciiLines . filter (/= '\r') . filter (<= '\255') $ input+        txExpected = map T.pack . filter (not . null) . map (take 16) . asciiLines . filter (/= '\r') $ input++        asciiLines xs =+            case break (== '\n') xs of+              ("", "") -> []+              (pfx, "") -> [pfx]+              (pfx, '\n':sfx) -> pfx : asciiLines sfx+              _ -> undefined++    iterEqual bsExpected (enumList 16 bsInputs $$ netLines 16 =$ EL.consume)+    iterEqual txExpected (enumList 16 txInputs $$ netLines 16 =$ EL.consume)+++main :: IO ()+main =+    getArgs >>=+    flip runTestWithArgs allHTFTests >>=+    exitWith
netlines.cabal view
@@ -1,5 +1,5 @@ Name:          netlines-Version:       0.4.3+Version:       1.0.0 Category:      Network Synopsis:      Enumerator tools for text-based network protocols Maintainer:    Ertugrul Söylemez <es@ertes.de>@@ -13,23 +13,29 @@ Description:      Enumerator tools for text-based network protocols.  This includes,-    among other things, an enumeratee to split an incoming ByteString-    stream to a length-limited line stream in a safe manner (i.e. in-    constant space).+    among other things, an enumeratee to split an incoming stream to a+    length-limited line stream in a safe manner (i.e. in constant+    space).  Library     Build-depends:         base >= 4 && < 5,         bytestring >= 0.9.1.7,-        contstuff >= 1.2.4,-        enumerator >= 0.4.9.1,+        contstuff >= 1.2.6,+        enumerator >= 0.4.10,+        text >= 0.11.0.7,         time >= 1.2.0.3     GHC-Options: -W     Exposed-modules:         Data.Enumerator.NetLines+        Data.Enumerator.NetLines.Class+        Data.Enumerator.NetLines.Error+        Data.Enumerator.NetLines.IO --- Executable netlines-test---     Build-depends:---         base >= 4 && < 5---     GHC-Options: -W---     Main-is: Test.hs+Executable netlines-test+    Build-depends:+        base >= 4 && < 5,+        HTF >= 0.7.0.0,+        random >= 1.0.0.3+    GHC-Options: -W+    Main-is: Test.hs