Signicantly overhaul the Ethernet tests

Mostly includes improvements in packet generation, and reuse of models and generators. Aside from that, most test files have also been formatted with fourmolu.
clash-lang · Sep 2, 2024 · a73282a · a73282a
1 parent 669673f
commit a73282a
Show file tree

Hide file tree

Showing 15 changed files with 847 additions and 919 deletions.
diff --git a/clash-cores.cabal b/clash-cores.cabal
@@ -224,6 +224,7 @@ test-suite unittests
     Test.Cores.Crc
     Test.Cores.Ethernet
     Test.Cores.Ethernet.Arp.ArpManager
+    Test.Cores.Ethernet.Base
     Test.Cores.Ethernet.Icmp
     Test.Cores.Ethernet.IP.EthernetStream
     Test.Cores.Ethernet.IP.InternetChecksum

diff --git a/nix/sources.json b/nix/sources.json
@@ -18,10 +18,10 @@
         "homepage": null,
         "owner": "clash-lang",
         "repo": "clash-protocols",
-        "rev": "3c88c305668b08671e7ea7fbc1f88633388d85d2",
-        "sha256": "167is7j8x55sqdwwln1ysv4m2b94lh46ks9v699rrqb2li6ybhj4",
+        "rev": "a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4",
+        "sha256": "0b219y7nxaxcr3xrk6dq5qj5hl9ggaxqpysk8rwmjh9nmkvzxifa",
         "type": "tarball",
-        "url": "https://github.com/clash-lang/clash-protocols/archive/3c88c305668b08671e7ea7fbc1f88633388d85d2.tar.gz",
+        "url": "https://github.com/clash-lang/clash-protocols/archive/a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "doctest-parallel": {

diff --git a/src/Clash/Cores/Ethernet/Arp/ArpManager.hs b/src/Clash/Cores/Ethernet/Arp/ArpManager.hs
@@ -168,19 +168,12 @@ arpReceiverC myIP = circuit $ \ethStream -> do
   -- before `depacketizetoDfC` should work, as depacketizeToDfC already
   -- implements dropping of
   arpDf <- depacketizeToDfC const -< ethStream
-  arpDf' <- Df.filterS (validArp <$> myIP) -< arpDf
+  arpDf' <- Df.filterS (isValidArp <$> myIP) -< arpDf
   (arpRequests, arpEntries) <- partitionS (isRequest <$> myIP) -< arpDf'
   lites <- Df.map (\p -> ArpLite (_sha p) (_spa p) False) -< arpRequests
   entries <- Df.map (\p -> ArpEntry (_sha p) (_spa p)) -< arpEntries
   idC -< (entries, lites)
   where
-    validArp ip ArpPacket{..} =
-            _htype == 1
-          && _ptype == 0x0800
-          && _hlen  == 6
-          && _plen  == 4
-          &&(_oper == 1 && (_tpa == ip || _tpa == _spa) || _oper == 2)
-
     isRequest ip ArpPacket{..} = _oper == 1 && _tpa == ip
 
 -- TODO upstream to clash-protocols

diff --git a/src/Clash/Cores/Ethernet/Arp/ArpTypes.hs b/src/Clash/Cores/Ethernet/Arp/ArpTypes.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+
 {-|
 Module      : Clash.Cores.Ethernet.Arp.ArpTypes
 Description : Provides various data types, aliases, constructors and constants for the Address Resolution Protocol. This module only provides the most common use case of ARP, which is mapping IPv4 addresses to MAC addresses.
@@ -95,3 +97,41 @@ newArpPacket myMac myIP targetMac targetIP isRequest
       _tha = targetMac,
       _tpa = targetIP
     }
+
+
+-- | Construct a link-layer `EthernetHeader` from an ARP packet.
+arpToEthernetHeader :: ArpPacket -> EthernetHeader
+arpToEthernetHeader ArpPacket{..} =
+  EthernetHeader
+    { _macDst = _tha
+    , _macSrc = _sha
+    , _etherType = arpEtherType
+    }
+
+-- | Construct a link-layer `EthernetHeader` from a reduced ARP packet.
+arpLiteToEthernetHeader ::
+  -- | Our MAC address
+  MacAddress ->
+  ArpLite ->
+  EthernetHeader
+arpLiteToEthernetHeader ourMac ArpLite{..} =
+  EthernetHeader
+    { _macDst = _targetMac
+    , _macSrc = ourMac
+    , _etherType = arpEtherType
+    }
+
+-- | Whether we should accept an incoming ARP packet or not.
+isValidArp ::
+  -- | Our IPv4 address
+  IPv4Address ->
+  -- | Incoming ARP packet
+  ArpPacket ->
+  Bool
+isValidArp ourIPv4 ArpPacket{..} =
+  _htype == 1 &&
+  _ptype == 0x0800 &&
+  _hlen  == 6 &&
+  _plen  == 4 &&
+  -- If TPA == SPA, the ARP packet is gratuitous.
+  (_oper == 1 && (_tpa == ourIPv4 || _tpa == _spa) || _oper == 2)
diff --git a/src/Clash/Cores/Ethernet/Examples/FullUdpStack.hs b/src/Clash/Cores/Ethernet/Examples/FullUdpStack.hs
@@ -307,7 +307,7 @@ arpIcmpUdpStackC macAddressS ipS udpCkt = circuit $ \ethIn -> do
   where
     icmpUdpStack = circuit $ \ipIn -> do
       [icmpIn, udpIn] <- packetDispatcherC (routeBy _ipv4lProtocol $ 0x0001 :> 0x0011 :> Nil) -< ipIn
-      icmpOut <- icmpEchoResponderC @dom @dataWidth (fst <$> ipS) -< icmpIn
+      icmpOut <- icmpEchoResponderC (fst <$> ipS) -< icmpIn
       udpInParsed <- udpDepacketizerC -< udpIn
       udpOutParsed <- udpPacketizerC (fst <$> ipS) <| udpCkt -< udpInParsed
       packetArbiterC RoundRobin -< [icmpOut, udpOutParsed]

diff --git a/test/Test/Cores/Ethernet.hs b/test/Test/Cores/Ethernet.hs
@@ -4,10 +4,10 @@ module Test.Cores.Ethernet (
 
 import Test.Tasty
 import qualified Test.Cores.Ethernet.Arp.ArpManager
---import qualified Test.Cores.Ethernet.Icmp
+import qualified Test.Cores.Ethernet.Icmp
 import qualified Test.Cores.Ethernet.IP.EthernetStream
 import qualified Test.Cores.Ethernet.IP.InternetChecksum
---import qualified Test.Cores.Ethernet.IP.IPPacketizers
+import qualified Test.Cores.Ethernet.IP.IPPacketizers
 import qualified Test.Cores.Ethernet.Mac.FrameCheckSequence
 import qualified Test.Cores.Ethernet.Mac.InterpacketGapInserter
 import qualified Test.Cores.Ethernet.Mac.PaddingInserter
@@ -17,10 +17,10 @@ tests =
   testGroup
     "Ethernet"
     [ Test.Cores.Ethernet.Arp.ArpManager.tests
-    --, Test.Cores.Ethernet.Icmp.tests
+    , Test.Cores.Ethernet.Icmp.tests
     , Test.Cores.Ethernet.IP.EthernetStream.tests
     , Test.Cores.Ethernet.IP.InternetChecksum.tests
-    --, Test.Cores.Ethernet.IP.IPPacketizers.tests
+    , Test.Cores.Ethernet.IP.IPPacketizers.tests
     , Test.Cores.Ethernet.Mac.FrameCheckSequence.tests
     , Test.Cores.Ethernet.Mac.InterpacketGapInserter.tests
     , Test.Cores.Ethernet.Mac.PaddingInserter.tests