You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
59 lines
1.8 KiB
59 lines
1.8 KiB
{-# 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 Test.Tasty |
|
import Test.Tasty.Hedgehog |
|
import Test.Tasty.HUnit |
|
|
|
tests :: TestTree |
|
tests = testGroup "MacAddress" [ unitTests, properties ] |
|
|
|
unitTests :: TestTree |
|
unitTests = testGroup "Unit tests" |
|
[ |
|
testSerialization |
|
, testParseFromString |
|
] |
|
|
|
testSerialization :: TestTree |
|
testSerialization = testCase "serialization" $ do |
|
let mac = MacAddress 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 |
|
b1 <- word8 range |
|
b2 <- word8 range |
|
b3 <- word8 range |
|
b4 <- word8 range |
|
b5 <- word8 range |
|
b6 <- word8 range |
|
return $ MacAddress b1 b2 b3 b4 b5 b6 |
|
|
|
properties :: TestTree |
|
properties = testGroup "Properties" [ propMacAddressLength ] |
|
|
|
propMacAddressLength :: TestTree |
|
propMacAddressLength = testProperty "Serialized MAC address length always equal to 6" $ |
|
property $ do |
|
mac <- forAll $ genMac Range.constantBounded |
|
BL.length (runPut $ putMacAddress mac) === 6
|
|
|