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.
74 lines
2.9 KiB
74 lines
2.9 KiB
2 years ago
|
|
||
|
|
module Test.Packets.Icmp
|
||
|
|
(
|
||
|
|
tests
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Data.Binary (decode, encode)
|
||
|
|
import qualified Data.ByteString as B
|
||
|
|
import Data.Word (Word8 (..))
|
||
|
|
import Hedgehog (MonadGen (..), forAll, property, (===))
|
||
|
|
import Hedgehog.Gen
|
||
|
|
import qualified Hedgehog.Range as Range
|
||
|
|
import Packets.Icmp
|
||
|
|
import Test.Tasty
|
||
|
|
import Test.Tasty.Hedgehog
|
||
|
|
import Test.Tasty.HUnit
|
||
|
|
|
||
|
|
tests :: TestTree
|
||
|
|
tests = testGroup "Icmp" [ unitTests, properties ]
|
||
|
|
|
||
|
|
unitTests :: TestTree
|
||
|
|
unitTests = testGroup "Unit tests" [ testIpChecksum
|
||
|
|
, testSerializeEchoRequest
|
||
|
|
, testSerializeEchoResponse ]
|
||
|
|
properties :: TestTree
|
||
|
|
properties = testGroup "Properties" [ icmpGetPut ]
|
||
|
|
|
||
|
|
testIpChecksum :: TestTree
|
||
|
|
testIpChecksum = testCase "ipChecksum case 1" $ do
|
||
|
|
let testIcmp = B.pack [
|
||
|
|
0x08, 0x00, 0x00, 0x00, 0xfc, 0x6b, 0x59, 0xfb,
|
||
|
|
0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68]
|
||
|
|
let checksum = ipChecksum testIcmp
|
||
|
|
checksum @?= 0x1003
|
||
|
|
|
||
|
|
testSerializeEchoRequest :: TestTree
|
||
|
|
testSerializeEchoRequest = testCase "serialize IcmpEchoRequest" $ do
|
||
|
|
let payload = B.pack [
|
||
|
|
0x1c, 0x25, 0x31, 0x65, 0x00, 0x00, 0x00, 0x00,
|
||
|
|
0x72, 0x51, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
|
||
|
|
0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
|
||
|
|
0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37
|
||
|
|
]
|
||
|
|
let testIcmp = B.pack [ 0x08, 0x00, 0xd8, 0x7c, 0x9d, 0xd2, 0x00, 0x02] <> payload
|
||
|
|
let icmp = IcmpEchoRequest (IcmpId 40402) (IcmpSqnum 2) payload
|
||
|
|
(B.toStrict . encode) icmp @=? testIcmp
|
||
|
|
|
||
|
|
testSerializeEchoResponse :: TestTree
|
||
|
|
testSerializeEchoResponse = testCase "serialize IcmpEchoResponse" $ do
|
||
|
|
let payload = B.pack [
|
||
|
|
0x1c, 0x25, 0x31, 0x65, 0x00, 0x00, 0x00, 0x00,
|
||
|
|
0x72, 0x51, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
|
||
|
|
0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
|
||
|
|
0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37
|
||
|
|
]
|
||
|
|
let testIcmp = B.pack [ 0x00, 0x00, 0xe0, 0x7c, 0x9d, 0xd2, 0x00, 0x02] <> payload
|
||
|
|
let icmp = IcmpEchoResponse (IcmpId 40402) (IcmpSqnum 2) payload
|
||
|
|
(B.toStrict . encode) icmp @=? testIcmp
|
||
|
|
|
||
|
|
|
||
|
|
genIcmp :: (MonadGen m) => m IcmpPacket
|
||
|
|
genIcmp = do
|
||
|
|
sqnum <- word16 (Range.linearBounded)
|
||
|
|
id' <- word16 (Range.linearBounded)
|
||
|
|
payload <- bytes (Range.linear 10 500)
|
||
|
|
constructor <- element [IcmpEchoRequest, IcmpEchoResponse]
|
||
|
|
pure $ constructor (IcmpId id') (IcmpSqnum sqnum) payload
|
||
|
|
|
||
|
|
icmpGetPut :: TestTree
|
||
|
|
icmpGetPut = testProperty "get . put = id" $
|
||
|
|
property $ do
|
||
|
|
icmp <- forAll $ genIcmp
|
||
|
|
(decode . encode) icmp === icmp
|