pcapng (empty) → 0.1.0.0
raw patch · 18 files changed
+1353/−0 lines, 18 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, bytestring-arbitrary, cereal, cereal-conduit, conduit, conduit-extra, directory, filepath, genvalidity-hspec, genvalidity-property, hspec, hspec-core, lens, pcapng, resourcet, text, unliftio-core, validity
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +9/−0
- Setup.hs +2/−0
- app/Main.hs +20/−0
- pcapng.cabal +108/−0
- src/Data/WordString32.hs +162/−0
- src/Data/WordString32/Conduit.hs +57/−0
- src/Network/Pcap/NG/Block.hs +130/−0
- src/Network/Pcap/NG/BlockType.hs +172/−0
- src/Network/Pcap/NG/Endianness.hs +29/−0
- src/Network/Pcap/NG/Options.hs +247/−0
- test/Spec.hs +157/−0
- test/Test/Data/WordString32.hs +80/−0
- test/Test/Network/Pcap/NG/BlockType.hs +30/−0
- test/Test/Network/Pcap/NG/Endianness.hs +20/−0
- test/Test/Network/Pcap/NG/Options.hs +42/−0
- test/Test/Validity/Enum.hs +55/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for pcapng++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michał J. Gajda (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michał J. Gajda nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# pcapng++This is a partial implementation of PcapNG format+that can be used by Wireshark and system journal.+It provides a fast Conduit for your convenience.++This release is provided without any warranty+in case you find it useful.+It will not be supported by the author.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,20 @@+module Main where++import Conduit+import Control.Lens+import Data.Conduit.List (consume)+import System.Environment++import qualified Data.WordString32.Conduit as WSC+import Network.Pcap.NG.Block++main :: IO ()+main = do+ getArgs >>= mapM_ parse++parse filename = runConduitRes+ $ WSC.sourceFile filename .| blockConduit .| blockTypes .| consume++blockTypes = awaitForever $ \block -> do+ liftIO $ print $ block ^. blockType+ yield (block ^. blockType)
+ pcapng.cabal view
@@ -0,0 +1,108 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: e97aedf78580aa053a52e55805fe5c3d47a6cd2a65fe41d68434e000c0940558++name: pcapng+version: 0.1.0.0+description: PCAP-NG and PCAP format reader and writer.+homepage: https://github.com/mgajda/pcapng#readme+bug-reports: https://github.com/mgajda/pcapng/issues+author: Michał J. Gajda+maintainer: mjgajda@gmail.com+copyright: BSD3+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/mgajda/pcapng++library+ exposed-modules:+ Data.WordString32+ Data.WordString32.Conduit+ Network.Pcap.NG.Block+ Network.Pcap.NG.BlockType+ Network.Pcap.NG.Endianness+ Network.Pcap.NG.Options+ other-modules:+ Paths_pcapng+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cereal+ , cereal-conduit+ , conduit+ , conduit-extra >=1.3.0+ , lens+ , resourcet+ , text+ , unliftio-core+ default-language: Haskell2010++executable pcapng-exe+ main-is: Main.hs+ other-modules:+ Paths_pcapng+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cereal+ , cereal-conduit+ , conduit+ , conduit-extra >=1.3.0+ , lens+ , pcapng+ , resourcet+ , text+ , unliftio-core+ default-language: Haskell2010++test-suite pcapng-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Data.WordString32+ Test.Network.Pcap.NG.BlockType+ Test.Network.Pcap.NG.Endianness+ Test.Network.Pcap.NG.Options+ Test.Validity.Enum+ Paths_pcapng+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , bytestring+ , bytestring-arbitrary+ , cereal+ , cereal-conduit+ , conduit+ , conduit-extra >=1.3.0+ , directory+ , filepath+ , genvalidity-hspec+ , genvalidity-property+ , hspec+ , hspec-core+ , lens+ , pcapng+ , resourcet+ , text+ , unliftio-core+ , validity+ default-language: Haskell2010
+ src/Data/WordString32.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- | Word32 strings for convenient handling+-- Just like ByteString, but with 32-bit each+--+-- Note that we only use methods from fast-parsing instance of xeno and XML Typelift+-- NOTE: put paper reference here when it is published+module Data.WordString32 (+ WordString -- opaque for safety+ , fromBS+ , toBS+ , null+ , index+ , drop+ , take+ , takeBytes+ , empty+ , length+ , append -- Use Semigroup.<>+ ) where++import Control.Exception (assert)+import qualified Data.ByteString as BS (empty, take)+import qualified Data.ByteString.Internal as BS+import Data.Function (on)+import Data.Word+import Debug.Trace+import Foreign.C.Types (CSize (..))+import Foreign.ForeignPtr (ForeignPtr, castForeignPtr,+ withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Prelude hiding (drop, length, null, take)+import System.IO.Unsafe (unsafeDupablePerformIO)++-- | Opaque array of 32-bit words+data WordString = WS {+ wsPtr :: ForeignPtr Word32+ , wsOffset :: Int+ , wsLen :: Int+ }++instance Show WordString where+ --show ws = show (BS.take 16 $ toBS ws)+ show ws =+ unwords [show bsOfs+ ,show bsLen+ ,show $ BS.take 16 bs+ ,show $ BS.take 16 nullBs]+ where+ bs@(BS.PS bsPtr bsOfs bsLen) = toBS ws+ nullBs = BS.PS bsPtr 0 bsLen++-- | Assume these instances will not be used often.+instance Eq WordString where+ (==) = (==) `on` toBS++instance Ord WordString where+ compare = compare `on` toBS++-- TODO: make a direct conduit?+{-# INLINE fromBS #-}+fromBS :: BS.ByteString -> WordString+fromBS (BS.PS wsPtr bsOffset bsLen) =+ if bsOffset `mod` 4 /= 0+ then error $ "ByteString offset must be divisible by 4 for Data.WordString32.fromBS, is: " <> show bsOffset+ else+ if bsLen `mod` 4 /= 0+ then error $ "ByteString length must be divisible by 4 for Data.WordString32.fromBS, is: " <> show bsLen+ else WS (castForeignPtr wsPtr) wsOffset wsLen+ where+ wsOffset = bsOffset `div` 4+ wsLen = bsLen `div` 4++{-# INLINE toBS #-}+toBS :: WordString -> BS.ByteString+toBS (WS wsPtr wsOffset wsLen) = BS.PS (castForeignPtr wsPtr) (wsOffset*4) (wsLen*4)++{-# INLINE index #-}+index :: WordString -> Int -> Word32+index _ i | i < 0 = error "index cannot be negative"+index (WS wsPtr wsOffset wsLen) i =+ assert (offset < wsLen) $+ unsafeDupablePerformIO $+ withForeignPtr wsPtr $+ (`peekElemOff` offset)+ where+ offset = wsOffset + i++{-# INLINE null #-}+null :: WordString -> Bool+null (WS wsPtr wsOffset wsLen) = wsOffset == wsLen++{-# INLINE drop #-}+drop :: Int -> WordString -> WordString+drop i _ | i < 0 = error "Dropping negative number of words"+drop i (WS wsPtr wsOffset wsLen) =+ assert (newWsOffset<wsLen) $+ WS wsPtr (min newWsOffset wsLen) wsLen+ where+ newWsOffset = wsOffset+i++{-# INLINE take #-}+take :: Int -> WordString -> WordString+take i _ | i < 0 = error "Taking negative number of words"+take i (WS wsPtr wsOffset wsLen) =+ WS wsPtr wsOffset $ min wsLen $ wsOffset+i++{-# INLINE takeBytes #-}+takeBytes :: Int -> WordString -> WordString+takeBytes i _ | i < 0 = error "Taking negative number of bytes"+takeBytes i _ | i `mod` 4 /= 0 = error "Can only take number of bytes divisible by 4"+takeBytes i ws = take (i `div` 4) ws++empty :: WordString+empty = fromBS $ BS.empty++length :: WordString -> Int+length (WS _ ofs len) = len-ofs++instance Monoid WordString where+ mempty = empty++instance Semigroup WordString where+ (<>) = append++foreign import ccall unsafe "string.h memcpy" c_memcpy+ :: Ptr Word32 -> Ptr Word32 -> CSize -> IO (Ptr Word32)++memcpy :: Ptr Word32 -> Ptr Word32 -> Int -> IO ()+memcpy p q s = do+ _ <- c_memcpy p q $ fromIntegral s*4+ return ()++append a b | null b = a+append a b | null a = b+append a@(WS aPtr aOffset aLen)+ b@(WS bPtr bOffset bLen) = --trace ("<append here>: " <> show a <> " <> " <> show b) $+ unsafeDupablePerformIO $ do+ newPtr :: ForeignPtr Word32 <- mallocPlainForeignPtrBytes (4*totalLen)+ withForeignPtr newPtr $ \destPtrA -> do+ withForeignPtr aPtr $ \srcPtrA ->+ memcpy destPtrA (srcPtrA `plusWords` aOffset) aWords+ let destPtrB = (destPtrA :: Ptr Word32) `plusWords` aWords+ withForeignPtr bPtr $ \srcPtrB ->+ memcpy destPtrB (srcPtrB `plusWords` bOffset) bWords+ let result = WS newPtr 0 totalLen+ --trace ("result is: " <> show result) $+ return result+ where+ totalLen = aWords+bWords+ aWords = aLen-aOffset+ bWords = bLen-bOffset++plusWords :: Ptr a -> Int -> Ptr a+plusWords a b = a `plusPtr` (b*4)++indexWord16 :: BS.ByteString -> Word16+indexWord16 = undefined++indexWord64 :: WordString -> Word64+indexWord64 = undefined
+ src/Data/WordString32/Conduit.hs view
@@ -0,0 +1,57 @@+module Data.WordString32.Conduit(+ sourceFile+ , sinkFile+ , atLeast+ ) where++import Control.Monad.Trans.Resource (MonadResource (..))+import qualified Data.ByteString as BS+import Data.Conduit (ConduitT, await, yield, (.|))+import qualified Data.Conduit.Binary as C+import qualified Data.Conduit.List as C+import qualified Data.WordString32 as WS++import Debug.Trace (trace)++sourceFile :: (MonadResource m+ ,MonadFail m)+ => FilePath+ -> ConduitT () WS.WordString m ()+sourceFile filepath = C.sourceFile filepath .| go+ where+ go = do+ maybeBs <- trace "sourceFile chunk" $ await+ case maybeBs of+ Nothing -> return ()+ Just bs | BS.length bs `mod` 4 /= 0 -> do+ -- OMG, why do we need to do this (hspec error)+ let msg = "Incorrect PCAP file - not aligned to 4 byte boundary: " <> show (BS.length bs)+ trace msg $+ yield $ WS.fromBS $ BS.take ((BS.length bs `div` 4)*4) bs+ return () -- fail after partial read+ Just bs -> yield $ WS.fromBS bs++sinkFile :: MonadResource m => FilePath -> ConduitT WS.WordString () m ()+sinkFile filepath = C.map WS.toBS .| C.sinkFile filepath++-- | Make sure that we give chunks of at least N words+--+-- This conduit has a hidden state, so cannot be easily aborted.+-- NOTE: example of how conduit could get better by feedback upstream (needed input size)+-- WARNING: may lead to suboptimal performance if make misaligned reads+atLeast :: MonadFail m+ => Int+ -> ConduitT WS.WordString WS.WordString m ()+atLeast n = go WS.empty+ where+ go rest = do+ maybeChunk <- await+ case maybeChunk of+ Nothing | WS.null rest -> return ()+ Nothing -> fail+ $ mconcat ["Not enough bytes to satisfy atLeast: ",+ show $ WS.length rest, " wanting: ", show n]+ Just chunk | WS.length rest + WS.length chunk >= n ->+ trace "long chunk" $+ yield $ rest <> chunk+ Just shortChunk -> trace "short chunk" $ go $ rest <> shortChunk
+ src/Network/Pcap/NG/Block.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}+module Network.Pcap.NG.Block(Block(..)+ ,blockType+ ,blockEndianness+ ,blockBody+ ,blockConduit) where+-- * This module provides a PcapNG conduit+-- for undifferentiated, undecoded PcapNG blocks+-- without using libpcap per set.+-- It sticks to the same types, but allows reading any stream of packets+-- not necessarily from libpcap, file or live source.++import Conduit+import Control.Exception (assert)+import Control.Lens+import Control.Lens.TH+import Control.Monad (when)+import qualified Data.ByteString.Char8 as BS+import qualified Data.WordString32 as WS+import qualified Data.WordString32.Conduit as WSC+import GHC.Generics++import Network.Pcap.NG.BlockType+import Network.Pcap.NG.Endianness++import Debug.Trace (trace)++data Block = Block {+ _blockType :: BlockType+ , _blockEndianness :: Endianness+ , _blockBody :: BS.ByteString+ } deriving (Eq, Show, Generic)++makeLenses ''Block++blockConduit :: MonadFail m => ConduitT WS.WordString Block m ()+blockConduit = WSC.atLeast 12 -- PcapNG files are expected to be word aligned, with 12 minimum block size+ .| blockConduitWithEndianness sameEndianness -- SHB in the beginning should fix endianness anyway++-- TODO: how to ensure unrolling on endianness?+blockConduitWithEndianness ::+ Monad m+ => Endianness+ -> ConduitT WS.WordString Block m ()+blockConduitWithEndianness endianness =+ awaitForever $ \dta -> do+ if dta `WS.index` 0 == 0x0A0D0D0A+ then do -- Section header block, palindromic identification+ -- identify endianness from magic number+ let newEndianness | dta `WS.index` 2 == 0x1A2B3C4D = trace "same endianness" sameEndianness -- same endianness as the machine+ | dta `WS.index` 2 == 0x4D3C2B1A = trace "other endianness" otherEndianness -- opposite endianness on magic+ | otherwise = error $ "Cannot recover endianness from: " <> show (dta `WS.index` 2)+ decodeBlock newEndianness dta+ blockConduitWithEndianness newEndianness+ else decodeBlock endianness dta++{-# INLINE decodeBlock #-}+decodeBlock :: Monad m+ => Endianness+ -> WS.WordString+ -> ConduitT WS.WordString Block m ()+decodeBlock endianness dta =+ {-trace ("Block type " <> show decodedBlockType+ <> " len is " <> show headingLen <> " after swap " <> show (swapper endianness (dta `WS.index` 1))+ <> " data " <> show dta+ <> " rest " <> show rest) $-}+ assert (headingWords > 3) $+ assert (bodyWords >= 0) $+ assert (headingLen >= 12) $+ assert (headingLen == trailingLen) $ do+ yield Block { _blockType = decodedBlockType+ , _blockEndianness = endianness+ , _blockBody = WS.toBS body+ }+ when (WS.length rest > 0) $ leftover rest+ where+ decodedBlockType = toEnum $ fromEnum+ $ swapper endianness+ $ dta `WS.index` 0+ headingWords = headingLen `div` 4+ headingLen = fromIntegral+ $ swapper endianness+ $ dta `WS.index` 1+ bodyLen = headingLen - 12+ bodyWords = bodyLen `div` 4+ body = WS.takeBytes bodyLen+ $ WS.drop 2 dta+ rest = WS.drop headingWords dta+ trailingLen = fromIntegral+ $ swapper endianness+ $ dta `WS.index` (headingLen - 1)++{-+data Pkt = Pkt {+ _hdr :: PktHdr+ , _content :: BS.ByteString+ }++data PktHdr = PktHdr {+ _epochSeconds :: Word32+ , _nanoSeconds :: Word32+ , _captureLength :: Word32+ , _wireLength :: Word32+ }++$(makeLenses ''PktHdr)++data PcapFormat = PcapFormat {+ littleEndian :: Endianness+ , version :: FormatVersion+ } deriving (Eq, Show, Read, Enum, Bounded)++$(makeLenses ''PcapFormat)++data FormatVersion =+ Pcap+ | PcapNG+ deriving (Eq, Show, Read, Enum, Bounded)++magicNumber :: FormatVersion -> Word32+magicNumber = undefined++readFormat :: Conduit Void BS.ByteString m ()+ -> m PcapFormat++pktConduit :: PcapFormat -> Conduit BS.ByteString Pkt ()+pktConduit = return ()+ -}
+ src/Network/Pcap/NG/BlockType.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE StrictData #-}+module Network.Pcap.NG.BlockType(+ BlockType(..)+ , encodeBlockType+ , decodeBlockType+ , knownBlockTypes+ ) where+-- * This module provides a Pcap conduit+-- without using libpcap per set.+-- It sticks to the same types, but allows reading any stream of packets+-- not necessarily from libpcap, file or live source.++import qualified Data.ByteString.Char8 as BS+import Data.Function+import Data.Serialize+import Data.Typeable+import Data.Word+import GHC.Generics+import Numeric (showHex)++-- | PCAP-NG block type+--+-- See: file:///home/m/src/pcapng/draft-tuexen-opsawg-pcapng.html#rfc.section.11.1+data BlockType =+ IfDesc+ | Packet+ | SimplePacket -- obsolete+ | NameResolution+ | IfStats+ | EnhancedPacket+ | IRIGTimestamp+ | EncapsulationInfo+ | SystemDJournal+ | DecryptionSecrets+ | HoneMachInfo+ | HoneConnEvent+ | SysdigMachInfo+ | SysdigProcInfo { version :: Int }+ | SysdigFDList+ | SysdigEvent+ | SysdigIfList+ | SysdigEventWithFlags+ | SysdigUserList+ | Custom { copyBlock :: Bool}+ | SectionHeader+ -- Special block type codes+ | Reserved Word32+ | Corruption Word32+ | LocalUse Word32+ deriving (Typeable, Generic)++instance Show BlockType where+ show (Corruption w) = "Corruption " <> showHex w ""+ show (Reserved w) = "Reserved " <> showHex w ""+ show (LocalUse w) = "LocalUse " <> showHex w ""+ show IfDesc = "IfDesc"+ show Packet = "Packet"+ show SimplePacket = "SimplePacket (obsolete)"+ show NameResolution = "NameResolution"+ show IfStats = "IfStats"+ show EnhancedPacket = "EnhancedPacket"+ show IRIGTimestamp = "IRIGTimestamp"+ show EncapsulationInfo = "EncapsulationInfo"+ show SystemDJournal = "SystemDJournal"+ show DecryptionSecrets = "DecryptionSecrets"+ show HoneMachInfo = "HoneMachInfo"+ show HoneConnEvent = "HoneConnEvent"+ show SysdigMachInfo = "SysdigMachInfo"+ show SysdigProcInfo { version } = "SysdigProcInfo v" <> show version+ show SysdigFDList = "SysdigFDList"+ show SysdigEvent = "SysdigEvento"+ show SysdigIfList = "SysdigIfList"+ show SysdigEventWithFlags = "SysdigEventWithFlags"+ show SysdigUserList = "SysdigUserList"+ show Custom { copyBlock } = mconcat ["Custom (", copyCode, ">"]+ where+ copyCode | copyBlock = "copy"+ | otherwise = "do not copy"+ show SectionHeader = "SectionHeader"++instance Eq BlockType where+ (==) = (==) `on` encodeBlockType++instance Ord BlockType where+ compare = compare `on` encodeBlockType++instance Enum BlockType where+ fromEnum = fromEnum . encodeBlockType+ toEnum = decodeBlockType . toEnum++decodeBlockType 0x00000000 = Reserved 0x00000000+decodeBlockType 0x00000001 = IfDesc+decodeBlockType 0x00000002 = Packet+decodeBlockType 0x00000003 = SimplePacket+decodeBlockType 0x00000004 = NameResolution+decodeBlockType 0x00000005 = IfStats+decodeBlockType 0x00000006 = EnhancedPacket+decodeBlockType 0x00000007 = IRIGTimestamp+decodeBlockType 0x00000008 = EncapsulationInfo+decodeBlockType 0x00000009 = SystemDJournal+decodeBlockType 0x0000000A = DecryptionSecrets+decodeBlockType 0x00000101 = HoneMachInfo+decodeBlockType 0x00000102 = HoneConnEvent+decodeBlockType 0x00000201 = SysdigMachInfo+decodeBlockType 0x00000202 = SysdigProcInfo 1+decodeBlockType 0x00000203 = SysdigFDList+decodeBlockType 0x00000204 = SysdigEvent+decodeBlockType 0x00000205 = SysdigIfList+decodeBlockType 0x00000206 = SysdigUserList+decodeBlockType 0x00000207 = SysdigProcInfo 2+decodeBlockType 0x00000208 = SysdigEventWithFlags+decodeBlockType 0x00000209 = SysdigProcInfo 3+decodeBlockType 0x00000210 = SysdigProcInfo 4+decodeBlockType 0x00000211 = SysdigProcInfo 5+decodeBlockType 0x00000212 = SysdigProcInfo 6+decodeBlockType 0x00000213 = SysdigProcInfo 7+decodeBlockType 0x00000BAD = Custom True+decodeBlockType 0x40000BAD = Custom False+decodeBlockType 0x0A0D0D0A = SectionHeader+decodeBlockType a | a >= 0x0A0D0A00+ && a <= 0x0A0D0AFF = Corruption a+decodeBlockType a | a >= 0x000A0D0A+ && a <= 0xFF0A0D0A = Corruption a+decodeBlockType a | a >= 0x000A0D0D+ && a <= 0xFF0A0D0D = Corruption a+decodeBlockType a | a >= 0x0D0D0A00+ && a <= 0x0D0D0AFF = Corruption a+decodeBlockType a | a >= 0x80000000+ && a <= 0xFFFFFFFF = LocalUse a+decodeBlockType a = Reserved a++encodeBlockType :: BlockType -> Word32+encodeBlockType (Corruption c) = c+encodeBlockType (Reserved c) = c+encodeBlockType (LocalUse c) = c+encodeBlockType IfDesc = 0x00000001+encodeBlockType Packet = 0x00000002+encodeBlockType SimplePacket = 0x00000003+encodeBlockType NameResolution = 0x00000004+encodeBlockType IfStats = 0x00000005+encodeBlockType EnhancedPacket = 0x00000006+encodeBlockType IRIGTimestamp = 0x00000007+encodeBlockType EncapsulationInfo = 0x00000008+encodeBlockType SystemDJournal = 0x00000009+encodeBlockType DecryptionSecrets = 0x0000000A+encodeBlockType HoneMachInfo = 0x00000101+encodeBlockType HoneConnEvent = 0x00000102+encodeBlockType SysdigMachInfo = 0x00000201+encodeBlockType (SysdigProcInfo 1) = 0x00000202+encodeBlockType SysdigFDList = 0x00000203+encodeBlockType SysdigEvent = 0x00000204+encodeBlockType SysdigIfList = 0x00000205+encodeBlockType SysdigUserList = 0x00000206+encodeBlockType (SysdigProcInfo 2) = 0x00000207+encodeBlockType SysdigEventWithFlags = 0x00000208+encodeBlockType (SysdigProcInfo 3) = 0x00000209+encodeBlockType (SysdigProcInfo 4) = 0x00000210+encodeBlockType (SysdigProcInfo 5) = 0x00000211+encodeBlockType (SysdigProcInfo 6) = 0x00000212+encodeBlockType (SysdigProcInfo 7) = 0x00000213+encodeBlockType (Custom True ) = 0x00000BAD+encodeBlockType (Custom False) = 0x40000BAD+encodeBlockType SectionHeader = 0x0A0D0D0A+encodeBlockType other = error $ "Error in block type: " <> show other++knownBlockTypes = [SectionHeader, IfDesc .. EnhancedPacket]++instance Serialize BlockType where+ get = decodeBlockType <$> getWord32le+ put = putWord32le . encodeBlockType
+ src/Network/Pcap/NG/Endianness.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StrictData #-}+module Network.Pcap.NG.Endianness where+-- * This module provides a PcapNG conduit+-- for undifferentiated, undecoded PcapNG blocks+-- without using libpcap per set.+-- It sticks to the same types, but allows reading any stream of packets+-- not necessarily from libpcap, file or live source.++import Data.Word+import GHC.Generics++-- | Big or little endian?+data Endianness =+ LittleEndian+ | BigEndian+ deriving (Eq, Show, Read, Enum, Bounded, Generic)++-- TODO: use CAF+sameEndianness, otherEndianness :: Endianness+sameEndianness = LittleEndian+otherEndianness = BigEndian++-- | Swap bytes from given endianness+-- to local byte order.+swapper :: Endianness -> Word32 -> Word32+swapper endianness+ | sameEndianness == endianness = id+swapper _ = byteSwap32
+ src/Network/Pcap/NG/Options.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData #-}+module Network.Pcap.NG.Options where++import Control.Exception (assert)+import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import qualified Data.ByteString as BS+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text (decodeUtf8)+import Data.Typeable+import Data.Word+import GHC.Generics++import qualified Data.WordString32 as WS+import Network.Pcap.NG.BlockType+import Network.Pcap.NG.Endianness++{-+Quote from pcap-ng spec:+1 2 3+0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1++-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++| Option Code | Option Length |++-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++/ Option Value /+/ variable length, padded to 32 bits /++-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++/ /+/ . . . other options . . . /+/ /++-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-++| Option Code == opt_endofopt | Option Length == 0 |++-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+++ -}++data Option a where+ Option :: { optionCode :: OptionCode a+ , optionValue :: WS.WordString+ } -> Option a+ Comment :: { commentString :: Text }+ -> Option a+ CustomString :: {+ customString :: Text+ , customCopy :: Bool+ , customPEN :: Word32+ } -> Option a+ CustomBinary :: {+ customBinary :: WS.WordString+ , customCopy :: Bool+ , customPEN :: Word32+ } -> Option a+ SHBHardware :: { shbHardware :: Text } -> Option SectionHeader+ SHBOS :: { shbOsString :: Text } -> Option SectionHeader+ SHBUserAppl :: { shbUserAppl :: Text } -> Option SectionHeader+ EPBFlags :: { epbInboundOutbound :: InboundOutbound+ , epbReceptionType :: ReceptionType+ , epbFCSLength :: Word8 -- actually 4 bits+ , epbLinkLayerErrors :: Word16+ }+ -> Option EnhancedPacket+ EPBHash :: { epbHash :: WS.WordString }+ -> Option EnhancedPacket -- TODO: check if length is in words?+ EPBDropCount :: { epbDropCount :: Word64 }+ -> Option EnhancedPacket++data InboundOutbound =+ Inbound+ | Outbound+ | InboundOutboundNA++instance Enum InboundOutbound where+ toEnum 0b00 = InboundOutboundNA+ toEnum 0b01 = Inbound+ toEnum 0b10 = Outbound+ toEnum other = error+ $ "InboundOutbound specification unrecognized: " <> show other+ fromEnum InboundOutboundNA = 0b00+ fromEnum Inbound = 0b01+ fromEnum Outbound = 0b10++data ReceptionType =+ Unspecified+ | Unicast+ | Multicast+ | Broadcast+ | Promiscuous+ deriving (Eq,Ord,Show,Typeable,Generic)++instance Enum ReceptionType where+ toEnum 0b000 = Unspecified+ toEnum 0b001 = Unicast+ toEnum 0b010 = Multicast+ toEnum 0b011 = Broadcast+ toEnum 0b100 = Promiscuous+ toEnum other = error ("Unknown reception type: " <> show other)+ fromEnum Unspecified = 0b000+ fromEnum Unicast = 0b001+ fromEnum Multicast = 0b010+ fromEnum Broadcast = 0b011+ fromEnum Promiscuous = 0b100+++data OptionCode (a :: BlockType) where+ OptEnd :: OptionCode a+ OptComment :: OptionCode a+ OptBlockSpecific :: Word16 -> OptionCode a+ OptCustom :: { customContainsString :: Bool+ , customDoCopy :: Bool+ } -> OptionCode a+ OptSHBHardware :: OptionCode SectionHeader+ OptSHBOS :: OptionCode SectionHeader+ OptSHBUserAppl :: OptionCode SectionHeader+ OptIDBName :: OptionCode IfDesc+ OptIDBDesc :: OptionCode IfDesc+ OptIDBIPv4Addr :: OptionCode IfDesc+ OptIDBIPv6Addr :: OptionCode IfDesc+ OptIDBEUIAddr :: OptionCode IfDesc+ OptIDBSpeed :: OptionCode IfDesc+ OptIDBTSResol :: OptionCode IfDesc+ OptIDBTZ :: OptionCode IfDesc+ OptIDBFilter :: OptionCode IfDesc+ OptIDBOS :: OptionCode IfDesc+ OptIDBFCSLen :: OptionCode IfDesc+ OptIDBTSOffset :: OptionCode IfDesc+ OptIDBHardware :: OptionCode IfDesc+ OptEPBDropCount :: OptionCode EnhancedPacket+ OptEPBHash :: OptionCode EnhancedPacket+ OptEPBFlags :: OptionCode EnhancedPacket++decodeOptionCode :: Proxy a+ -> Word16+ -> OptionCode a+decodeOptionCode _ 0 = OptEnd+decodeOptionCode _ 1 = OptComment+decodeOptionCode _ 2988 = OptCustom True True+decodeOptionCode _ 2989 = OptCustom False True+decodeOptionCode _ 19372 = OptCustom True False+decodeOptionCode _ 19373 = OptCustom False False++decodeBlockSpecific :: forall bt+ . Endianness+ -> OptionCode bt+ -> WS.WordString+ -> Option bt+decodeBlockSpecific _ oc ws =+ case oc of+ OptSHBOS -> decodeTextOption SHBOS ws+ OptSHBHardware -> decodeTextOption SHBHardware ws+ OptSHBUserAppl -> decodeTextOption SHBOS ws+ OptEPBFlags -> decodeWordOption decodeEPBFlags ws+ OptEPBHash -> EPBHash ws+ OptEPBDropCount -> decodeWord64Option EPBDropCount ws+ other -> undefined++decodeEPBFlags :: Word32 -> Option EnhancedPacket+decodeEPBFlags aWord = EPBFlags {..}+ where+ epbInboundOutbound = toEnum+ $ fromIntegral (aWord .&. 0b11)+ epbReceptionType = toEnum+ $ fromIntegral ((aWord `shiftR` 3) .&. 0b111)+ epbFCSLength = fromIntegral+ $ (aWord `shiftR` 5) .&. 0b1111 -- actually 4 bits+ epbLinkLayerErrors = fromIntegral+ $ aWord `shiftR` 16++decodeOptions :: Endianness+ -> Proxy bt+ -> WS.WordString+ -> [Option bt]+decodeOptions endianness bt ws =+ case optCode of+ OptEnd -> []+ other -> decodedOption optCode+ : decodeOptions endianness bt rest+ where+ decodedOption OptEnd = error "Impossible!"+ decodedOption OptCustom { customContainsString = True+ , customDoCopy } =+ CustomString { customCopy=customDoCopy, .. }+ decodedOption OptCustom { customContainsString = False+ , customDoCopy } =+ CustomBinary { customCopy=customDoCopy, .. }+ -- TODO: decode per-block options+ decodedOption OptComment = Comment+ $ Text.decodeUtf8+ $ WS.toBS optionValue+ decodedOption optionCode =+ decodeBlockSpecific endianness+ optionCode+ optionValue+ --optionCode -> Option {..}+ -- TODO: this swapping is suspect+ optCode = decodeOptionCode Proxy+ $ fromIntegral+ (swapper endianness+ (ws `WS.index` 0)+ .&. 0xFFFF)+ optionLen = (swapper endianness+ (ws `WS.index` 0)+ .&. 0xFFFF0000)+ `shiftL` 16+ optionValue = WS.takeBytes (fromIntegral optionLen)+ $ WS.drop 1 ws+ customBinary = WS.drop 1 optionValue+ customString = Text.decodeUtf8+ $ WS.toBS customBinary+ customPEN = WS.index ws 1+ rest = WS.drop (fromIntegral $ optionLen + 1)+ ws++decodeTextOption :: (Text -> Option a)+ -> WS.WordString+ -> Option a+decodeTextOption opt = opt+ . Text.decodeUtf8+ . WS.toBS+decodeWord64Option :: (Word64 -> Option a)+ -> WS.WordString+ -> Option a+decodeWord64Option opt optionValue =+ assert (WS.length optionValue == 2)+ -- fixme: word swap+ $ opt+ $ fromIntegral (WS.index optionValue 0)+ .|. (fromIntegral (WS.index optionValue 1)+ `shiftR` 32)+ -- ignoring high word for now++decodeWordOption :: (Word32 -> Option a)+ -> WS.WordString+ -> Option a+decodeWordOption opt ws =+ assert (WS.length ws == 1)+ $ opt+ $ ws `WS.index` 0
+ test/Spec.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Lens ((^.))+import Control.Monad (forM, forM_)+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.Conduit+import Data.Conduit.Cereal (sinkGet)+import qualified Data.Conduit.Combinators as C (head, sourceFile)+import Data.Conduit.List (consume)+import Data.List (isPrefixOf)+import Data.Serialize (get)+import System.Directory+import System.FilePath.Posix (takeExtension, takeFileName,+ (</>))+import System.IO (hPutStrLn, stderr)+import Test.Hspec+import Test.Hspec.Core.Runner+import Test.QuickCheck++import qualified Data.WordString32.Conduit as WSC+import Network.Pcap.NG.Block+import Network.Pcap.NG.BlockType++import qualified Test.Data.WordString32 (spec)+import qualified Test.Network.Pcap.NG.BlockType (spec)+import qualified Test.Network.Pcap.NG.Endianness (spec)+import qualified Test.Network.Pcap.NG.Options (spec)++main :: IO ()+main = hspecWith config spec+ where+ config = defaultConfig {+ configColorMode = ColorAlways+ , configFailureReport = Just "failure.log"+ , configDiff = True+ }+++filesWithExts :: FilePath -- ^ Directory to search+ -> [String ]-- ^ Extensions list+ -> IO [FilePath]+filesWithExts dirName exts =+ map (dirName </>) . filter matchExt <$> getDirectoryContents dirName+ where+ matchExt = (`elem` exts)+ . takeExtension++consumeBlock :: MonadIO m => ConduitT Block Void m ()+consumeBlock = awaitForever+ $ liftIO . hPutStrLn stderr . show . (^. blockType)++testPcapFile :: FilePath -> Spec+testPcapFile filename =+ it filename $ do+ parse filename >>= (`shouldMatchList` [])++testPcapFileSections :: FilePath -> [BlockType] -> Spec+testPcapFileSections filename bts =+ it filename $+ parse filename >>= (`shouldMatchList` bts)++testPcapFilePrefixAndCount :: FilePath -> [BlockType] -> Int -> Spec+testPcapFilePrefixAndCount filename prefix count = do+ describe filename $ do+ it (filename <> " has correct prefix") $ do+ actualBts <- parse filename+ actualBts `shouldSatisfy` (isPrefixOf prefix)+ it (filename <> "has correct number of packets") $ do+ actualBts <- parse filename+ length actualBts `shouldBe` count++blockTypes = awaitForever $ \block -> do+ liftIO $ print $ block ^. blockType+ yield (block ^. blockType)++parse filename = runConduitRes+ $ WSC.sourceFile filename .| blockConduit .| blockTypes .| consume++{-+parse :: FilePath -> IO ()+parse filename = runConduitRes+ $ WSC.sourceFile filename .| pcapNgConduit2 .| consumeBlock+ -}++testPcapFileHeader :: FilePath -> Spec+testPcapFileHeader filename =+ it filename $+ parseHeader filename `shouldReturn` SectionHeader++parseHeader filename = do+ header :: Maybe Block <- runConduitRes+ $ WSC.sourceFile filename .| blockConduit .| C.head+ case header of+ Just h -> do+ print $ h ^. blockType+ return $ h ^. blockType+ Nothing -> error "No blocktype here!"++spec = do+ describe "Network.Pcap.NG.BlockType" $+ Test.Network.Pcap.NG.BlockType.spec+ describe "Network.Pcap.NG.Options" $+ Test.Network.Pcap.NG.Options.spec+ describe "Data.WordString32" $+ Test.Data.WordString32.spec+ describe "Block recognition" $ do+ return ()+ describe "Undifferentiated blocks" $ do+ describe "Pcap.org examples" $ do+ files <- runIO $ filesWithExts "test/pcapng.org" [".ntar", ".pcapng"]+ runIO $ putStrLn $ "Test files found: " <> show files+ describe "parse first block" $+ forM_ files testPcapFileHeader+ describe "parse all blocks" $ do+ testPcapFileSections "test/pcapng.org/dhcp.pcapng" $+ [SectionHeader, IfDesc, EnhancedPacket, EnhancedPacket, EnhancedPacket, EnhancedPacket]+ testPcapFilePrefixAndCount "test/pcapng.org/pcap-ng_Wi-Fi_Bluetooth_USB_Cooked_timestamps_issue_1.ntar"+ [SectionHeader,IfDesc,EnhancedPacket] 224+ testPcapFileSections "test/pcapng.org/dhcp_big_endian.pcapng" $+ [SectionHeader, IfDesc, NameResolution] <> replicate 4 EnhancedPacket+ testPcapFileSections "test/pcapng.org/dhcp_little_endian.pcapng" $+ [SectionHeader, IfDesc, NameResolution] <> replicate 4 EnhancedPacket+ testPcapFileSections "test/pcapng.org/many_interfaces.pcapng" $+ [SectionHeader] <> replicate 11 IfDesc+ <> replicate 64 EnhancedPacket+ <> [NameResolution]+ <> replicate 11 IfStats+ xdescribe "Failing tests" $ do+ testPcapFileSections "test/pcapng.org/http.bigendian.ntar" $+ []+ testPcapFileSections "test/pcapng.org/icmp2.ntar" $+ []+ describe "Wireshark examples" $ do+ testPcapFileSections "test/wireshark/dhcp-nanosecond.pcapng" $+ [SectionHeader, IfDesc] <> replicate 4 EnhancedPacket+ testPcapFileSections "test/wireshark/dmgr.pcapng" $+ [SectionHeader, IfDesc] <> replicate 42 EnhancedPacket+ testPcapFileSections "test/wireshark/http2-brotli.pcapng" $+ [SectionHeader, IfDesc, DecryptionSecrets] <> replicate 25 EnhancedPacket+ testPcapFileSections "test/wireshark/ikev2-decrypt-aes256cbc.pcapng" $+ [SectionHeader, IfDesc, IfDesc] <> replicate 4 EnhancedPacket <> [IfStats, IfStats]+ testPcapFileSections "test/wireshark/packet-h2-14_headers.pcapng" $+ [SectionHeader, IfDesc] <> replicate 15 EnhancedPacket <> [IfStats]+ testPcapFileSections "test/wireshark/tls12-dsb.pcapng" $+ [SectionHeader, IfDesc, DecryptionSecrets] <> replicate 9 EnhancedPacket+ <> [DecryptionSecrets] <> replicate 8 EnhancedPacket+ testPcapFileSections "test/wireshark/dhcp.pcapng" $ [SectionHeader, IfDesc] <> replicate 4 EnhancedPacket+ testPcapFileSections "test/wireshark/dtls12-aes128ccm8-dsb.pcapng" $+ [SectionHeader, IfDesc, DecryptionSecrets] <> replicate 13 EnhancedPacket+ testPcapFileSections "test/wireshark/http-brotli.pcapng" $+ [SectionHeader, IfDesc] <> replicate 10 EnhancedPacket <> [IfStats]+ testPcapFileSections "test/wireshark/ikev2-decrypt-aes256ccm16.pcapng" $+ [SectionHeader,IfDesc,IfDesc] <> replicate 4 EnhancedPacket <> replicate 2 IfStats+ testPcapFileSections "test/wireshark/sip.pcapng" $ [SectionHeader,IfDesc] <> replicate 6 EnhancedPacket+ testPcapFileSections "test/wireshark/wireguard-ping-tcp-dsb.pcapng" $+ [SectionHeader, IfDesc, DecryptionSecrets] <> replicate 22 EnhancedPacket
+ test/Test/Data/WordString32.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE TypeApplications #-}+module Test.Data.WordString32(spec) where++import Data.WordString32 as WS++import qualified Data.ByteString as BS+import qualified Data.ByteString.Arbitrary as ABS+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Test.Validity+import Test.Validity.Arbitrary+import Test.Validity.Eq+import Test.Validity.Monoid+import Test.Validity.Ord++instance Arbitrary WordString where+ arbitrary = do+ len <- (4*) <$> arbitrary -- choose(1,16)+ fromBS <$> ABS.fastRandBs len+ shrink = shrinkWS++instance Validity WordString where+ validate ws = valid+ {-validate (WS ptr ofs len) = do+ check (ofs <= len) "Offset is less than WordString length"+ <> check (len >= 0) "Length of the WordString is greater than zero"+ <> check (ofs >= 0) "Offset is not less than zero"-}++instance GenUnchecked WordString where+ genUnchecked = arbitrary+ shrinkUnchecked = shrinkWS++shrinkWS ws =+ ((`WS.take` ws) <$> [1..WS.length ws])+ <> ((`WS.drop` ws) <$> [1..WS.length ws])++instance GenValid WordString where+ genValid = arbitrary+ shrinkValid = shrinkWS++spec :: Spec+spec = describe "Data.WordString" $ do+ eqSpec @WordString+ ordSpec @WordString+ monoidSpec @WordString+ describe "drop" $ do+ prop "decreases length" $ \ws (Positive d) ->+ d < WS.length ws && d >= 0 ==>+ WS.length (WS.drop d ws) == WS.length ws - d+ prop "shifts indices after N-th" $ \ws (Positive d) (Positive i) ->+ i+d < WS.length ws ==>+ WS.index ws (i+d) == WS.index (WS.drop d ws) i+ prop "of empty" $ \(Positive i) ->+ WS.take i empty == empty+ describe "take" $ do+ prop "decreases length" $ \ws d ->+ d < WS.length ws && d >= 0 ==>+ WS.length (WS.take d ws) `shouldBe` d+ prop "preserves initial indices" $ \ws (Positive d) (Positive i) ->+ d < WS.length ws && i < d ==>+ WS.index (WS.take d ws) i `shouldBe` WS.index ws i+ prop "of empty" $ \(Positive i) ->+ WS.take i empty == empty+ describe "append" $ do+ prop "length sums up" $ \ws1 ws2 ->+ WS.length (ws1 <> ws2) `shouldBe`+ WS.length ws1 + WS.length ws2+ prop "preserves initial indices" $ \ws1 ws2 (Positive i) ->+ i < WS.length ws1 ==>+ WS.index ws1 i `shouldBe` WS.index (ws1 <> ws2) i+ prop "shifts indices in the second argument" $ \ws1 ws2 (Positive i) ->+ i < WS.length ws2 ==>+ WS.index ws2 i `shouldBe` WS.index (ws1 <> ws2) (WS.length ws1 + i)+ describe "length" $ do+ it "of empty is zero" $ WS.length WS.empty == 0+ prop "null is always empty" $ \ws -> WS.null ws `shouldBe` WS.length ws == 0+ --arbitraryGeneratesOnlyValid @WordString
+ test/Test/Network/Pcap/NG/BlockType.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeApplications #-}+module Test.Network.Pcap.NG.BlockType(spec) where++import Network.Pcap.NG.BlockType+import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Test.Validity.Enum+import Test.Validity.Eq+import Test.Validity.Ord++instance Arbitrary BlockType where+ arbitrary = genValid+ shrink = shrinkValid++instance GenUnchecked BlockType where+ genUnchecked = toEnum <$> arbitrary+ shrinkUnchecked _ = []++instance Validity BlockType where+ validate (Reserved c) = invalid $ "Reserved block type " <> show c+ validate (Corruption c) = invalid $ "Corrupt block type " <> show c+ validate _ = valid++instance GenValid BlockType where++spec = describe "Network.Pcap.NG.BlockType" $ do+ eqSpec @BlockType+ ordSpec @BlockType+ enumSpec @BlockType
+ test/Test/Network/Pcap/NG/Endianness.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeApplications #-}+module Test.Network.Pcap.NG.Endianness where++import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Test.Validity.Enum+import Test.Validity.Eq+import Test.Validity.Ord++import Network.Pcap.NG.Endianness++instance Arbitrary Endianness where+ arbitrary = elements [LittleEndian .. BigEndian]++instance GenUnchecked Endianness where++spec = describe "Network.Pcap.NG.Endianness" $ do+ eqSpec @Endianness+ enumSpec @Endianness
+ test/Test/Network/Pcap/NG/Options.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Network.Pcap.NG.Options where++import Network.Pcap.NG.Options++import Data.WordString32 as WS++import qualified Data.ByteString as BS+import qualified Data.ByteString.Arbitrary as ABS+import Data.Typeable+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Test.Validity+import Test.Validity.Arbitrary+import Test.Validity.Enum+import Test.Validity.Eq+import Test.Validity.Functions.Inverse+import Test.Validity.Monoid+import Test.Validity.Ord+import Test.Validity.Utils++instance Arbitrary ReceptionType where+ arbitrary = elements [Unspecified+ .. Promiscuous]++instance Validity ReceptionType where++instance GenValid ReceptionType where++instance GenUnchecked ReceptionType where++spec = do+ fdescribe "ReceptionType" $ do+ eqSpec @ReceptionType+ ordSpec @ReceptionType+ enumSpec @ReceptionType
+ test/Test/Validity/Enum.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Validity.Enum where++import Data.WordString32 as WS++import qualified Data.ByteString as BS+import qualified Data.ByteString.Arbitrary as ABS+import Data.Typeable+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Test.Validity+import Test.Validity.Arbitrary+import Test.Validity.Eq+import Test.Validity.Functions.Inverse+import Test.Validity.Monoid+import Test.Validity.Ord+import Test.Validity.Utils++enumSpec :: forall a+ . (Arbitrary a+ ,Typeable a+ ,Enum a+ ,Show a+ ,Eq a+ ) => Spec+enumSpec = enumSpecOnGen (arbitrary :: Gen a)+ "arbitrary"+ (shrink :: a -> [a])++enumSpecOnGen :: (Enum a+ ,Eq a+ ,Show a+ ,Typeable a)+ => Gen a -- generator+ -> String -- generator name+ -> (a -> [a]) -- shrinker+ -> Spec+enumSpecOnGen (gen :: Gen a) genName shrinker =+ describe ("Enum " <> name <> " on " <> genName) $ do+ prop "toEnum . fromEnum == id" $+ inverseFunctionsOnGen fromEnum (toEnum :: Int -> a) gen shrinker+ --(toEnum :: Int -> a) fromEnum+ where+ name = nameOf @a++--toEnumInvertsFromEnumOnGen :: _+toEnumInvertsFromEnumOnGen gen = do+ x <- gen+ toEnum (fromEnum x) `shouldBe` x