diff --git a/examples/Traffic.hs b/examples/Traffic.hs index 44491b3..a2bdbb1 100644 --- a/examples/Traffic.hs +++ b/examples/Traffic.hs @@ -1,18 +1,69 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TemplateHaskell #-} module Traffic where ( ) +data Endpoints = EUplink | EClient1 | EClient2 + +connections = compileConnections + [ Mes.GE 1 0 1 <-> PC.Uplink + , Mes.GE 1 0 21 <-> Ltp.FrontPort 1 + , Mes.GE 1 0 22 <-> Ltp.FrontPort 3 + , Mes.GE 1 0 23 <-> Ltp.FrontPort 5 + , Mes.GE 1 0 7 <-> Ont.Port 3 1 1 + , Mes.GE 1 0 8 <-> Ont.Port 3 6 1 + ] + +endpoints = compileEndpoints + [ + EUplink <-> Ltp.FrontPort 1 + , EClient1 <-> Ont.Port 3 1 1 + , EClient2 <-> Ont.Port 3 6 1 + ] + testBroadcast = testCase "Broadcast" $ do - ltpConfig = Ltp.Config.makeDefault - { - profilesCrossConnect = [cc] - , profilesPorts = [ports] - , interfaceOnt = [ interfaceOnt 3 6 { services = [ service ], profilePorts = ports} ] + let ltpConfig = DeviceConfig.Ltp.makeDefault { + profilesCrossConnect = [ cc ] + , profilesPorts = [ ports ] + , interfaceOnt = + [ ontConfig 3 1 { services = [ Ltp.Config.makeService "test1" ], profilePorts = "ports1" } + , ontConfig 3 6 { services = [ Ltp.Config.makeService "test1" ], profilePorts = "ports1" } + ] + } + let baseMesConfig = Mes.Config.makeDefault { + interfaces = + [ Mes.makeInterfaceConfig (Mes.GE 1 0 12) + { + switchPortMode = Access + , allowedVlan = [ VlanId 3465 ] + } + ] } + let (standMesConfig, standLtpConfig) = generateConfig connections ltpConfig endpoints + let mesConfig = baseMesConfig <> standMesConfig + mesConfigurator <- makeMesConfigurator { line = "/dev/ttyUSB1" } + ltpConfigurator <- makeLtpConfigurator { line = "/dev/ttyUSB0" } + uploadConfig mesConfigurator mesConfig + uploadConfig ltpConfigurator standLtpConfig + sendPacket (broadcastPing `addTag` VlanId 200) EUplink + awaitPacket (broadcastPing `addTag` VlanId 1000) EClient1 + awaitPacket (broadcastPing `addTag` VlanId 1000) EClient2 where cc = - ProfileCrossConnect + Ltp.Config.makeCrossConnect "test1" { + replaceSide = ReplaceSideOnt + , trafficModel = OneToOne + , bridgeGroup = 10 + , outerVid = 200 + , userVid = Just 1000 } - + ports = + Ltp.Config.makePorfilePorts "test1" + { + name = "ports1" + , bridgeGroup = 10 + } + diff --git a/src/DeviceConfig/Ltp.hs b/src/DeviceConfig/Ltp.hs new file mode 100644 index 0000000..dca9d00 --- /dev/null +++ b/src/DeviceConfig/Ltp.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE QuasiQuotes #-} + +module DeviceConfig.Ltp + ( + ReplaceSide(..) + , TrafficModel(..) + , ProfileCrossConnect(..) + , makeCrossConnect + , ProfilePorts(..) + , Service(..) + , OntConfig(..) + , Config(..) + ) + where + +import Control.Monad.State (StateT) +import Control.Monad.State.Class +import Data.Foldable (forM_) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Data.Text.Lazy.Builder +import Types (IpAddress, VlanId, vlanId) + +data ReplaceSide = ReplaceSideOnt | ReplaceSideOlt + deriving (Show, Eq) + +data TrafficModel = TrafficModelOneToOne | TrafficModelNToOne + deriving (Show, Eq) + +data ProfileCrossConnect = ProfileCrossConnect + { + name :: T.Text + , replaceSide :: ReplaceSide + , trafficModel :: TrafficModel + , bridgeGroup :: Int + , outerVid :: VlanId + , innerVid :: Maybe VlanId + } deriving (Show, Eq) + +makeCrossConnect :: T.Text -> ProfileCrossConnect +makeCrossConnect n = + ProfileCrossConnect + { + name = n + , replaceSide = ReplaceSideOnt + , trafficModel = TrafficModelNToOne + , bridgeGroup = 0 + , outerVid = [vlanId|1|] + , innerVid = Nothing + } + +data ProfilePorts = ProfilePorts + { + name :: T.Text + , bridgeGroup :: Int + , igmpDynamicEntries :: [()] + } deriving (Show, Eq) + +makeProfilePorts :: T.Text -> ProfilePorts +makeProfilePorts n = ProfilePorts + { + name = n + , bridgeGroup = 0 + , igmpDynamicEntries = [] + } + +data Service = Service + { + crossConnect :: T.Text + , dba :: () + } deriving (Show, Eq) + +makeService :: T.Text -> Service +makeService ccName = Service + { + crossConnect = ccName + , dba = () + } + +data OntConfig = OntConfig + { + ponPortId :: Int + , ontId :: Int + , services :: [Service] + , profilePorts :: Maybe ProfilePorts + } deriving (Show, Eq) + +data ManagementConfig = ManagementConfig + { + managementIp :: IpAddress + , managementMask :: IpAddress + , managementVid :: VlanId + } deriving (Show, Eq) + +data Config = Config + { + management :: ManagementConfig + , profilesCrossConnect :: [ProfileCrossConnect] + , profilesPorts :: [ProfilePorts] + , interfaceOnt :: [OntConfig] + } deriving (Show, Eq) + +data ConfigRenderState = ConfigRenderState + { + currentIndent :: Int + , result :: Builder + } + +newtype ConfigRenderM m a = ConfigRenderM (StateT ConfigRenderState m a) + deriving (Functor, Applicative, Monad, MonadState ConfigRenderState) + +class ConfigChunk a where + render :: (Monad m) => a -> ConfigRenderM m () + +instance (ConfigChunk a, Foldable f) => ConfigChunk (f a) where + render fa = forM_ fa render + +instance ConfigChunk ManagementConfig where + render mgmt = undefined + +instance ConfigChunk ProfileCrossConnect where + render cc = undefined + +instance ConfigChunk ProfilePorts where + render ports = undefined + +instance ConfigChunk OntConfig where + render ont = undefined + +instance ConfigChunk Config where + render cfg = withIndent 2 $ do + render $ management cfg + render $ profilesCrossConnect cfg + render $ profilesPorts cfg + render $ interfaceOnt cfg + +printLine :: (Monad m) => T.Text -> ConfigRenderM m () +printLine t = do + indent <- gets currentIndent + modify' (\s -> s { result = result s + <> (fromLazyText . TL.replicate (fromIntegral indent) . TL.singleton) ' ' + <> (fromLazyText . TL.fromStrict) t + <> singleton '\n' }) + +addBuilder :: (Monad m) => Builder -> ConfigRenderM m () +addBuilder b = do + indent <- gets currentIndent + modify' (\s -> s { result = result s + <> (fromLazyText . TL.replicate (fromIntegral indent) . TL.singleton) ' ' + <> b + <> singleton '\n' }) + +changeIndent :: (Monad m) => Int -> ConfigRenderM m () +changeIndent i = modify' $ \s -> s { currentIndent = currentIndent s + i } + +withIndent :: (Monad m) => Int -> ConfigRenderM m a -> ConfigRenderM m a +withIndent i f = do + changeIndent i + r <- f + changeIndent (-i) + return r + +renderConfig :: Config -> T.Text +renderConfig cfg = undefined + -- printLine "configure terminal" + -- render cfg + -- printLine "exit" + -- printLine "commit" + -- printLine "exit" diff --git a/src/Packets/Checksum.hs b/src/Packets/Checksum.hs new file mode 100644 index 0000000..2da1057 --- /dev/null +++ b/src/Packets/Checksum.hs @@ -0,0 +1,25 @@ + +module Packets.Checksum + ( + ipChecksum + ) where + +import Data.Bits (shiftR, (.&.)) +import qualified Data.ByteString as B +import Data.Word (Word16) +import Prelude hiding (words) + +ipChecksum :: B.ByteString -> Word16 +ipChecksum bytes = 0xffff - (fromIntegral . adjustedSum . sum . words) bytes + where + adjustedSum x = if x > 0xffff + then adjustedSum $ x .&. 0xffff + x `shiftR` 16 + else x + + words :: B.ByteString -> [Int] + words bs = + let (h, t) = B.splitAt 2 bs in + case (B.unpack . B.take 2) h of + [x1, x2] -> (fromIntegral x1 * 0x100 + fromIntegral x2) : words t + [x1] -> (fromIntegral x1 * 0x100) : words t + _ -> [] diff --git a/src/Packets/Icmp.hs b/src/Packets/Icmp.hs index dfd602b..552dc71 100644 --- a/src/Packets/Icmp.hs +++ b/src/Packets/Icmp.hs @@ -6,17 +6,16 @@ module Packets.Icmp , IcmpId(..) , IcmpSqnum(..) , IcmpPacket(..) - , ipChecksum ) where -import Data.Binary (Binary (..), putWord8) -import Data.Binary.Get (getRemainingLazyByteString, getWord16be, - getWord8) -import Data.Binary.Put (putByteString, putWord16be, runPut) -import Data.Bits (shiftR, (.&.)) -import qualified Data.ByteString as B -import Data.Word (Word16, Word8) -import Prelude hiding (words) +import Data.Binary (Binary (..), putWord8) +import Data.Binary.Get (getRemainingLazyByteString, getWord16be, + getWord8) +import Data.Binary.Put (putByteString, putWord16be, runPut) +import Data.Bits (shiftR, (.&.)) +import qualified Data.ByteString as B +import Data.Word (Word16, Word8) +import Packets.Checksum (ipChecksum) data IcmpType = IcmpTypeEchoRequest @@ -39,21 +38,6 @@ data IcmpPacket = | IcmpUnknown IcmpType IcmpCode B.ByteString deriving (Show, Eq) -ipChecksum :: B.ByteString -> Word16 -ipChecksum bs = 0xffff - (fromIntegral . adjustedSum . sum . words) bs - where - adjustedSum x = if x > 0xffff - then adjustedSum $ x .&. 0xffff + x `shiftR` 16 - else x - - words :: B.ByteString -> [Int] - words bs = - let (h, t) = B.splitAt 2 bs in - case (B.unpack . B.take 2) h of - [x1, x2] -> (fromIntegral x1 * 0x100 + fromIntegral x2) : words t - [x1] -> (fromIntegral x1 * 0x100) : words t - _ -> [] - instance Binary IcmpType where put IcmpTypeEchoRequest = putWord8 8 put IcmpTypeEchoResponse = putWord8 0 diff --git a/src/Packets/L2.hs b/src/Packets/L2.hs index 6d3dd9f..5addf4f 100644 --- a/src/Packets/L2.hs +++ b/src/Packets/L2.hs @@ -1,6 +1,7 @@ module Packets.L2 ( + L2Header(..) ) where import Packets.MacAddress (MacAddress (..)) diff --git a/src/Packets/L3.hs b/src/Packets/L3.hs index 2f911ca..36d6707 100644 --- a/src/Packets/L3.hs +++ b/src/Packets/L3.hs @@ -1,5 +1,106 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} module Packets.L3 ( + Ipv4Address(..) + , putIpv4Address + , parseIpv4Address + , ipv4 ) where +import Control.Error (hush) +import Data.Binary (putWord8) +import Data.Binary.Put (Put) +import Data.Char (digitToInt) +import Data.Data (Data) +import Data.List (foldl') +import Data.Word (Word8) +import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Text.Parsec (ParsecT) +import Text.Parsec (Stream, parse) +import Text.Parsec (sepBy) +import Text.Parsec (char) +import Text.Parsec.Char (digit) +import Text.Parsec.Combinator (many1) +--import Packets.Icmp (IcmpPacket) + +data Ipv4Address = Ipv4Address Word8 Word8 Word8 Word8 + deriving (Show, Eq, Ord, Data) + +putIpv4Address :: Ipv4Address -> Put +putIpv4Address (Ipv4Address a b c d) = do + putWord8 a + putWord8 b + putWord8 c + putWord8 d + +positiveNatural :: Stream s m Char => ParsecT s u m Word8 +positiveNatural = + foldl' (\a i -> a * 10 + (toEnum . digitToInt) i) 0 <$> many1 digit + +parseIpv4Address :: String -> Maybe Ipv4Address +parseIpv4Address = hush . parse parser "" + where + parser = do + octets <- positiveNatural `sepBy` char '.' + case octets of + [a, b, c, d] -> return $ Ipv4Address a b c d + _ -> fail "Unable to parse IPv4 address" + +ipv4 :: QuasiQuoter +ipv4 = QuasiQuoter + { + quoteExp = quoteIpv4 + , quotePat = undefined + , quoteDec = undefined + , quoteType = undefined + } + where + quoteIpv4 s = + case parseIpv4Address s of + Just m' -> dataToExpQ (const Nothing) m' + _ -> fail "Unable to parse IPv4 address" + +{- +newtype Ipv4Id = Ipv4Id { unIpv4Id :: Word16 } + deriving (Show, Eq) + +newtype Ipv4ProtocolType = Ipv4ProtocolType { unIpv4ProtocolType :: Word8 } + deriving (Show, Eq) + +data Ipv4Packet = + Ipv4Packet + { + sourceIp :: Ipv4Address + , destIp :: Ipv4Address + , payload :: Ipv4Payload + , ipv4Id :: Ipv4Id + , ttl :: Word8 + } deriving (Show, Eq) + +data Ipv4Payload = + IcmpPayload IcmpPacket + | Ipv4RawPayload Ipv4ProtocolType B.ByteString + deriving (Show, Eq) + +getProtocolTypeFromPayload :: Ipv4Payload -> Ipv4ProtocolType +getProtocolTypeFromPayload (IcmpPayload _) = Ipv4ProtocolType 0x01 +getProtocolTypeFromPayload (Ipv4RawPayload t _) = t + +instance Put Ipv4Packet where + put ipv4 = do + let serializedPayload = encode . payload $ ipv4 + putWord8 0x45 -- protocol v4, header length 20 + putDscp 0x00 -- TODO + putWord16be $ 20 + fromIntegral . B.length $ serializedPayload + putWord16be $ unIpv4Id . ipv4Id $ ipv4 + putWord8 0x40 -- Flags + putWord8 $ ttl ipv4 + putWord8 $ unIpv4ProtocolType . getProtocolTypeFromPayload . payload $ ipv4 + putWord16 0 -- Header checksum + put $ sourceIp ipv4 + put $ destIp ipv4 + + +-} diff --git a/src/Packets/MacAddress.hs b/src/Packets/MacAddress.hs index 7d0e3d5..7158189 100644 --- a/src/Packets/MacAddress.hs +++ b/src/Packets/MacAddress.hs @@ -1,20 +1,62 @@ +{-# LANGUAGE DeriveDataTypeable #-} module Packets.MacAddress ( MacAddress(..) , broadcastMac + , putMacAddress + , parseMac + , mac ) where -import qualified Data.ByteString as B -import Data.Word (Word8) -import Packets.Serializable (Serializable (..)) +import Control.Error.Util (hush) +import Data.Binary (putWord8) +import Data.Binary.Put (PutM) +import Data.Char (digitToInt) +import Data.Data (Data) +import Data.Word (Word8) +import Language.Haskell.TH.Quote (QuasiQuoter (..), dataToExpQ) +import Text.Parsec (count, hexDigit, parse) +import Text.Parsec.Char (char) data MacAddress = MacAddress Word8 Word8 Word8 Word8 Word8 Word8 - deriving (Show, Eq) + deriving (Show, Eq, Data) -instance Serializable MacAddress where - serialize (MacAddress b1 b2 b3 b4 b5 b6) = B.pack [b1, b2, b3, b4, b5, b6] +putMacAddress :: MacAddress -> PutM () +putMacAddress (MacAddress b1 b2 b3 b4 b5 b6) = + mapM_ putWord8 [b1, b2, b3, b4, b5, b6] broadcastMac :: MacAddress broadcastMac = MacAddress 0xff 0xff 0xff 0xff 0xff 0xff + +parseMac :: String -> Maybe MacAddress +parseMac = hush . parse macParser "" + where + macParser = do + b1 <- parseHexByte + rest <- count 5 $ do + _ <- char ':' + parseHexByte + case rest of + [b2, b3, b4, b5, b6] -> return $ MacAddress b1 b2 b3 b4 b5 b6 + _ -> fail "Unable to parse MAC address" + parseHexByte = do + d1 <- hexDigit + d2 <- hexDigit + return $ toEnum (digitToInt d1) * 16 + toEnum (digitToInt d2) + +mac :: QuasiQuoter +mac = QuasiQuoter + { + quoteExp = quoteMac + , quotePat = undefined + , quoteDec = undefined + , quoteType = undefined + } + where + quoteMac s = + case parseMac s of + Just m' -> dataToExpQ (const Nothing) m' + _ -> fail "Unable to parse MAC address" + diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..e2bd031 --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Types + ( + mkVlanId + , vlanId + , VlanId + , IpAddress + , ip + ) where + +import Control.Error (hush) +import Data.Data (Data) +import GHC.Word (Word8) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) +import Language.Haskell.TH.Syntax (dataToExpQ) +import Text.Parsec (char, digit, many1, parse) +import Text.Read (readMaybe) + +newtype VlanId = VlanId Int + deriving (Show, Eq, Data) + +mkVlanId :: Int -> Maybe VlanId +mkVlanId i = + if i >= minVlanId && i <= maxVlanId + then Just $ VlanId i + else Nothing + where + minVlanId = 1 + maxVlanId = 4094 + +vlanId :: QuasiQuoter +vlanId = QuasiQuoter + { + quoteExp = parseVlanId + , quotePat = undefined + , quoteType = undefined + , quoteDec = undefined + } + where + parseVlanId s = + case readMaybe s >>= mkVlanId of + Just vid -> dataToExpQ (const Nothing) vid + Nothing -> fail "Invalid VlanId" + + +newtype IpAddress = IpAddress (Word8, Word8, Word8, Word8) + deriving (Eq, Data) + +instance Show IpAddress where + show (IpAddress (a, b, c, d)) = show a <> "." <> show b <> "." <> show c <> "." <> show d + +parseIp :: String -> Maybe IpAddress +parseIp = hush . parse ipParser "" + where + ipParser = do + a <- read <$> many1 digit + _ <- char '.' + b <- read <$> many1 digit + _ <- char '.' + c <- read <$> many1 digit + _ <- char '.' + d <- read <$> many1 digit + return $ IpAddress (a, b, c, d) + +ip :: QuasiQuoter +ip = QuasiQuoter + { + quoteExp = doParseIp + , quotePat = undefined + , quoteType = undefined + , quoteDec = undefined + } + where + doParseIp s = do + case parseIp s of + Just m' -> dataToExpQ (const Nothing) m' + _ -> fail "Unable to parse MAC address" + diff --git a/test/Test.hs b/test/Test.hs index 94d4b4e..77230c4 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE QuasiQuotes #-} module Main ( @@ -5,13 +6,17 @@ module Main ) where import qualified Test.Packets.Icmp +import qualified Test.Packets.L3 import qualified Test.Packets.MacAddress import Test.Tasty + main = defaultMain tests tests :: TestTree -tests = testGroup "Tests" [ +tests = testGroup "Tests" + [ Test.Packets.MacAddress.tests - , Test.Packets.Icmp.tests ] + , Test.Packets.L3.tests + {-, Test.Packets.Icmp.tests -}] diff --git a/test/Test/Packets/Icmp.hs b/test/Test/Packets/Icmp.hs index 0fa5372..7503815 100644 --- a/test/Test/Packets/Icmp.hs +++ b/test/Test/Packets/Icmp.hs @@ -10,6 +10,7 @@ import Data.Word (Word8 (..)) import Hedgehog (MonadGen (..), forAll, property, (===)) import Hedgehog.Gen import qualified Hedgehog.Range as Range +import Packets.Checksum import Packets.Icmp import Test.Tasty import Test.Tasty.Hedgehog diff --git a/test/Test/Packets/L3.hs b/test/Test/Packets/L3.hs index 627d8a8..8461c2f 100644 --- a/test/Test/Packets/L3.hs +++ b/test/Test/Packets/L3.hs @@ -1,4 +1,40 @@ +{-# LANGUAGE QuasiQuotes #-} module Test.Packets.L3 ( + tests ) where + +import Data.Binary +import Data.Binary.Put +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.Word (Word8 (..)) +import Hedgehog (MonadGen (..), forAll, property, (===)) +import Hedgehog.Gen +import qualified Hedgehog.Range as Range +import Packets.L3 +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "Ip address" [ unitTests ] + +unitTests :: TestTree +unitTests = testGroup "Unit tests" + [ + testSerialization + , testParseFromString + ] + +testSerialization :: TestTree +testSerialization = testCase "serialization" $ do + let ip = Ipv4Address 192 168 1 10 + let bs = runPut $ putIpv4Address ip + bs @?= BL.pack [192, 168, 1, 10] + +testParseFromString :: TestTree +testParseFromString = testCase "parse from string" $ do + Just (Ipv4Address 192 168 1 10) @?= parseIpv4Address "192.168.1.10" + Ipv4Address 192 168 1 10 @?= [ipv4|192.168.1.10|] diff --git a/test/Test/Packets/MacAddress.hs b/test/Test/Packets/MacAddress.hs index 259d987..a24dbf3 100644 --- a/test/Test/Packets/MacAddress.hs +++ b/test/Test/Packets/MacAddress.hs @@ -1,16 +1,19 @@ +{-# LANGUAGE QuasiQuotes #-} module Test.Packets.MacAddress ( tests ) where +import Data.Binary +import Data.Binary.Put import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import Data.Word (Word8 (..)) import Hedgehog (MonadGen (..), forAll, property, (===)) import Hedgehog.Gen import qualified Hedgehog.Range as Range import Packets.MacAddress -import Packets.Serializable import Test.Tasty import Test.Tasty.Hedgehog import Test.Tasty.HUnit @@ -19,14 +22,22 @@ tests :: TestTree tests = testGroup "MacAddress" [ unitTests, properties ] unitTests :: TestTree -unitTests = testGroup "Unit tests" [ testSerialization ] +unitTests = testGroup "Unit tests" + [ + testSerialization + , testParseFromString + ] testSerialization :: TestTree testSerialization = testCase "serialization" $ do let mac = MacAddress 0x01 0x00 0x5e 0x01 0x02 0x03 - let bs = serialize mac - bs @?= B.pack [0x01, 0x00, 0x5e, 0x01, 0x02, 0x03] + let bs = runPut $ putMacAddress mac + bs @?= BL.pack [0x01, 0x00, 0x5e, 0x01, 0x02, 0x03] +testParseFromString :: TestTree +testParseFromString = testCase "parse from string" $ do + Just (MacAddress 0x01 0x00 0x5e 0x01 0x02 0x03) @?= parseMac "01:00:5e:01:02:03" + MacAddress 0x01 0x00 0x5e 0x01 0x02 0x03 @?= [mac|01:00:5e:01:02:03|] genMac :: (MonadGen m) => Range.Range Word8 -> m MacAddress genMac range = do @@ -44,5 +55,5 @@ properties = testGroup "Properties" [ propMacAddressLength ] propMacAddressLength :: TestTree propMacAddressLength = testProperty "Serialized MAC address length always equal to 6" $ property $ do - mac <- forAll $ genMac (Range.constantBounded) - (B.length . serialize) mac === 6 + mac <- forAll $ genMac Range.constantBounded + BL.length (runPut $ putMacAddress mac) === 6 diff --git a/theta.cabal b/theta.cabal index c7b7833..39ecb4f 100644 --- a/theta.cabal +++ b/theta.cabal @@ -16,13 +16,24 @@ extra-source-files: README.md library theta-lib hs-source-dirs: src + extensions: DuplicateRecordFields exposed-modules: Packets.L2 , Packets.L3 , Packets.MacAddress + , Packets.Icmp + , Packets.Checksum + , Packets.Serializable + , DeviceConfig.Ltp + , Types default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , bytestring , binary + , template-haskell + , parsec + , errors + , text + , mtl ghc-options: -Wall -Wcompat -Widentities @@ -35,10 +46,12 @@ library theta-lib Test-Suite test-theta type: exitcode-stdio-1.0 + extensions: DuplicateRecordFields hs-source-dirs: src test main-is: Test.hs other-modules: Test.Packets.MacAddress , Test.Packets.L3 + , Packets.MacAddress build-depends: base , theta-lib , tasty @@ -47,3 +60,7 @@ Test-Suite test-theta , hedgehog , bytestring , binary + , template-haskell + , errors + , parsec + , text