network-attoparsec (empty) → 0.9.0
raw patch · 8 files changed
+362/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, exceptions, hspec, mtl, network, network-attoparsec, network-simple
Files
- LICENSE +22/−0
- README.md +9/−0
- Setup.hs +3/−0
- network-attoparsec.cabal +56/−0
- src/Network/Attoparsec.hs +104/−0
- test/Main.hs +10/−0
- test/Network/AttoparsecSpec.hs +157/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT) + +Copyright (c) 2015 Leon Mergen + +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. +
+ README.md view
@@ -0,0 +1,9 @@+haskell-network-attoparsec +===================== + +[](https://travis-ci.org/solatis/haskell-network-attoparsec) +[](https://coveralls.io/r/solatis/haskell-network-attoparsec?branch=master) +[](http://en.wikipedia.org/wiki/MIT_License) +[](http://haskell.org) + +Utility functions for running an attoparsec parser against a socket
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple + +main = defaultMain
+ network-attoparsec.cabal view
@@ -0,0 +1,56 @@+name: network-attoparsec +category: Network, Parsing +version: 0.9.0 +description: Run an attoparsec parser against a TCP socket +license: MIT +license-file: LICENSE +copyright: (c) 2014 Leon Mergen +author: Leon Mergen +maintainer: leon@solatis.com +stability: experimental +synopsis: Utility functions for running an attoparsec parser against a socket +build-type: Simple +data-files: LICENSE, README.md +cabal-version: >= 1.10 +tested-with: GHC == 7.8 + +library + hs-source-dirs: src + ghc-options: -Wall -ferror-spans + default-language: Haskell2010 + + exposed-modules: Network.Attoparsec + + build-depends: base >= 4.3 && < 5 + + , mtl + , network + , attoparsec + , bytestring + +test-suite test-suite + type: exitcode-stdio-1.0 + ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + other-modules: Network.AttoparsecSpec + Spec + Main + + build-depends: base >= 4.3 && < 5 + , hspec + + , exceptions + , bytestring + , mtl + , network + , network-simple + , attoparsec + , network-attoparsec + +source-repository head + type: git + location: git://github.com/solatis/haskell-network-attoparsec.git + branch: master
+ src/Network/Attoparsec.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Utility functions for running a parser against a socket + +module Network.Attoparsec (parseMany, parseOne) where + +import Control.Monad.Error + +import qualified Data.ByteString as BS +import qualified Network.Socket as NS +import qualified Network.Socket.ByteString as NSB +import qualified Data.Attoparsec.ByteString as Atto + +-- | The parsing continuation form of a "Data.Attoparsec" parser. +type ParseC a = BS.ByteString -> Atto.Result a + +-- | The type of parsing to perform, greedy or non-greedy +data ParseMode = Single | Many + +-- | Consumes input from socket and attempts to parse a structure. This function +-- will terminate if one of three conditions is met: +-- +-- * the parser has completed succesfully; +-- * the parser failed with invalid data; +-- * the connection is closed. +-- +-- Depending upon the available data on the socket, this function might block. +parseBuffer :: ( MonadIO m + , MonadError String m + , Show a) + => ParseC a -- ^ Initial parser state + -> ParseMode -- ^ Whether to perform greedy or non-greedy parsing + -> BS.ByteString -- ^ Unconsumed buffer from previous run + -> ParseC a -- ^ Current parser state + -> m (ParseC a, [a]) -- ^ Next parser state with parsed values +parseBuffer p0 mode = + + let next bCur pCur = + case pCur bCur of + -- On error, throw error through MonadError + Atto.Fail err _ _ -> throwError ("An error occured while parsing input: " ++ show err) + Atto.Partial p1 -> return (p1, []) + Atto.Done b1 v -> + if BS.null b1 + -- This means a "perfect parse" occured: exactly enough data was on + -- the socket to complete one parse round. + then return (p0, [v]) + else case mode of + -- We are in single-object parsing mode, have parsed one object, + -- but still have data left on the buffer: at this point, we can + -- either discard the data on the buffer, or throw an error. + -- + -- We throw an error, since within "single-object parsing mode" + -- we assume only perfect parses happen. + Single -> throwError ("Unconsumed data left on socket: " ++ show b1) + + -- Multi-object parsing mode, in which case we will enter + -- recursion. + Many -> do + (p1, xs) <- next b1 p0 + return (p1, v : xs) + + in next + +-- | Incrementally reads data from socket and parses as many objects as possible +parseMany :: ( MonadIO m + , MonadError String m + , Show a) + => NS.Socket -- ^ Socket to read data from + -> ParseC a -- ^ Initial parser state + -> ParseC a -- ^ Continuation parser state + -> m (ParseC a, [a]) -- ^ Next parser state with parsed values +parseMany s p0 pCur = do + buf <- liftIO $ NSB.recv s 4096 + (p1, xs) <- parseBuffer p0 Many buf pCur + return (p1, xs) + +-- | Similar to parseMany, but assumes that there will only be enough data for a +-- single succesful parse on the socket, and guarantees that exactly one item +-- will be parsed. +-- +-- __Warning:__ this function will /not/ work correctly when input data is +-- pipelined. The parser might consume more data than required from the socket, +-- or a partial second object is parsed, and the parser state and buffer will +-- be discarded. +parseOne :: ( MonadIO m + , MonadError String m + , Show a) + => NS.Socket -- ^ Socket to read data from + -> ParseC a -- ^ Initial parser state + -> m a -- ^ Parsed value +parseOne s p0 = do + buf <- liftIO $ NSB.recv s 4096 + (p1, value) <- parseBuffer p0 Single buf p0 + + case value of + -- We do not yet have enough data for a single item, let's request more + [] -> parseOne s p1 + [x] -> return x + + -- This is an internal error, since it means our single-object parser + -- returned multiple objects. + _ -> error ("More than one element parsed: " ++ show value)
+ test/Main.hs view
@@ -0,0 +1,10 @@+module Main where + +import Test.Hspec.Runner +import qualified Spec + +import Network (withSocketsDo) + +main :: IO () +main = + withSocketsDo $ hspecWith defaultConfig Spec.spec
+ test/Network/AttoparsecSpec.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.AttoparsecSpec where + +import Control.Concurrent (forkIO, killThread, + threadDelay) +import Control.Monad.Catch +import Control.Monad.Error + +import qualified Data.Attoparsec.ByteString as Atto + +import qualified Network.Simple.TCP as NS (Socket, accept, + connect, listen) +import qualified Network.Socket.ByteString as NS (send) + +import Data.Attoparsec.ByteString.Char8 (decimal, endOfLine) +import qualified Network.Attoparsec as Atto + +import Test.Hspec + +pairSockets :: ( MonadIO m + , MonadMask m) + => (NS.Socket -> IO a) + -> (NS.Socket -> IO b) + -> m b +pairSockets writeCallback readCallback = do + serverThread <- liftIO $ forkIO $ NS.listen "*" "1234" (\(lsock, _) -> + NS.accept lsock (\pair -> do + _ <- writeCallback (fst pair) + return ())) + + liftIO $ threadDelay 100000 + + result <- NS.connect "127.0.0.1" "1234" (\pair -> liftIO $ readCallback (fst pair)) + + liftIO $ killThread serverThread + + return result + +spec :: Spec +spec = do + describe "when parsing a single object" $ do + it "it should work with correct data" $ + let writeSocket s = NS.send s "1234" + readSocket s = runErrorT $ Atto.parseOne s (Atto.parse numberParser) + numberParser = decimal + + in (pairSockets writeSocket readSocket) `shouldReturn` Right 1234 + + it "it should work with partial data" $ + let writeSocket s = do + _ <- NS.send s "12" + threadDelay 100000 + NS.send s "34" + + readSocket s = runErrorT $ Atto.parseOne s (Atto.parse numberParser) + numberParser = decimal + + in (pairSockets writeSocket readSocket) `shouldReturn` Right 1234 + + it "it should leave unconsumed data in tact" $ + let writeSocket s = do + NS.send s "1234ab" + + readSocket s = runErrorT $ Atto.parseOne s (Atto.parse numberParser) + numberParser = decimal + + in (pairSockets writeSocket readSocket) `shouldReturn` Left "Unconsumed data left on socket: \"ab\"" + + it "it should throw an error when the provided data is incorrect" $ + let writeSocket s = do + NS.send s "ab" + + readSocket s = runErrorT $ Atto.parseOne s (Atto.parse numberParser) + numberParser = decimal + + in (pairSockets writeSocket readSocket) `shouldReturn` Left "An error occured while parsing input: \"ab\"" + + + describe "when providing multiple matching objects" $ do + it "should return error when using single object parser" $ + let writeSocket s = NS.send s "1234\n5678\n" + readSocket s = runErrorT $ Atto.parseOne s (Atto.parse numberParser) + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Left "Unconsumed data left on socket: \"5678\\n\"" + + it "should return multiple objects when using multi object parser" $ + let writeSocket s = NS.send s "1234\n5678\n" + readSocket s = runErrorT $ do + (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser) + return xs + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234, 5678] + + it "should return single object when using multi object parser and providing partial data" $ + let writeSocket s = NS.send s "1234\n56" + readSocket s = runErrorT $ do + (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser) + return xs + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234] + + it "should return multiple objects when using multi object parser and providing incremental data" $ + let writeSocket s = do + _ <- NS.send s "1234\n56" + threadDelay 100000 + NS.send s "78\n9012\n" + readSocket s = runErrorT $ do + (p, xs1) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser) + (_, xs2) <- Atto.parseMany s (Atto.parse numberParser) p + return (xs1 ++ xs2) + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234, 5678, 9012] + + it "should return nothing objects when using multi object parser and providing not enough data" $ + let writeSocket s = NS.send s "12" + readSocket s = runErrorT $ do + (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser) + return xs + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Right [] + + it "should return one object when using multi object parser and providing incremental data" $ + let writeSocket s = do + _ <- NS.send s "12" + threadDelay 100000 + NS.send s "34\n" + readSocket s = runErrorT $ do + (p, xs1) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser) + (_, xs2) <- Atto.parseMany s (Atto.parse numberParser) p + return (xs1 ++ xs2) + numberParser = do + num <- decimal + endOfLine + return num + + in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}