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.
40 lines
1.1 KiB
40 lines
1.1 KiB
{-# 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|]
|
|
|