Mac & Ip parsing and putting

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
       }
 

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"

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
+          _        -> []

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

src/Packets/L2.hs

@@ -1,6 +1,7 @@
 
 module Packets.L2
   (
+    L2Header(..)
   ) where
 
 import           Packets.MacAddress (MacAddress (..))

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
+
+
+-}

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"
+

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"
+

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 -}]
 

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

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|]

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

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