make format

Fix ICMP test

WIP udp stack

Finish UDP

Update hardcoded mac in tests

Change problematic haddock comment

clash-eth.cabal

@@ -115,6 +115,7 @@ library
     Clash.Cores.Ethernet.Mac.PaddingInserter
     Clash.Cores.Ethernet.Mac.Preamble
     Clash.Cores.Ethernet.Icmp
+    Clash.Cores.Ethernet.Udp
     Clash.Lattice.ECP5.Colorlight.CRG
     Clash.Lattice.ECP5.Colorlight.TopEntity
     Clash.Lattice.ECP5.Prims

python_tests/test_arp_udp_echo.py

@@ -0,0 +1,17 @@
+import unittest
+import os
+import socket
+import random
+
+dst_ip = '192.168.1.123'
+
+class TestArpUdpEcho(unittest.TestCase):
+    def testArpUdpEcho(self):
+        with socket.socket(socket.AF_INET, socket.SOCK_DGRAM) as s:
+            s.settimeout(5)
+
+            for _ in range(50):
+                data = os.urandom(random.randint(0,1000))
+                port = random.randint(0, 65535)
+                s.sendto(data, (dst_ip, port))
+                self.assertEqual((data, (dst_ip, port)), s.recvfrom(1500))

src/Clash/Cores/Ethernet/Examples/EchoStack.hs

@@ -8,21 +8,23 @@ Description : Simple Ethernet echo stack.
 module Clash.Cores.Ethernet.Examples.EchoStack
   ( ipEchoStackC
   , fullStackC
-  , arpIcmpStackC
+  , arpIcmpUdpStackC
   ) where
 
+import Data.Bifunctor qualified as B
+
 -- import prelude
 import Clash.Prelude
 
 -- import ethernet
+import Clash.Cores.Ethernet.Arp
 import Clash.Cores.Ethernet.Examples.RxStacks
 import Clash.Cores.Ethernet.Examples.TxStacks
-import Clash.Cores.Ethernet.Mac.EthernetTypes ( EthernetHeader(..), MacAddress(..) )
-import Clash.Cores.Ethernet.Arp
 import Clash.Cores.Ethernet.IP.IPPacketizers
+import Clash.Cores.Ethernet.Mac.EthernetTypes ( EthernetHeader(..), MacAddress(..) )
 
-import Clash.Cores.Ethernet.IP.IPv4Types
 import Clash.Cores.Ethernet.IP.EthernetStream
+import Clash.Cores.Ethernet.IP.IPv4Types
 
 -- import protocols
 import Protocols
@@ -34,6 +36,7 @@ import Clash.Cores.Crc ( HardwareCrc )
 import Clash.Cores.Crc.Catalog ( Crc32_ethernet )
 
 import Clash.Cores.Ethernet.Icmp ( icmpEchoResponderC )
+import Clash.Cores.Ethernet.Udp
 
 
 -- | Processes IP packets and echoes them back
@@ -87,10 +90,15 @@ fullStackC
   -> Circuit (PacketStream domEthRx 1 ()) (PacketStream domEthTx 1 ())
 fullStackC rxClk rxRst rxEn txClk txRst txEn mac ip =
   macRxStack @4 rxClk rxRst rxEn mac
-  |> arpIcmpStackC mac ip
+  |> arpIcmpUdpStackC mac ip (mapMeta $ B.second swapPorts)
   |> macTxStack txClk txRst txEn
+  where
+    swapPorts hdr@UdpHeaderLite{..} = hdr
+                                        { _udplSrcPort = _udplDstPort
+                                        , _udplDstPort = _udplSrcPort
+                                        }
 
-arpIcmpStackC
+arpIcmpUdpStackC
   :: forall (dataWidth :: Nat) (dom :: Domain)
    . HiddenClockResetEnable dom
   => KnownNat dataWidth
@@ -99,17 +107,24 @@ arpIcmpStackC
   => DomainPeriod dom <= 5 * 10^11
   => KnownNat (DomainPeriod dom)
   => Signal dom MacAddress
+  -- ^ My MAC Address
   -> Signal dom (IPv4Address, IPv4Address)
+  -- ^ My IP address and the subnet
+  -> Circuit (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)) (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite))
+  -- ^ UDP handler circuit
   -> Circuit (PacketStream dom dataWidth EthernetHeader) (PacketStream dom dataWidth EthernetHeader)
-arpIcmpStackC macAddressS ipS = circuit $ \ethIn -> do
+arpIcmpUdpStackC macAddressS ipS udpCkt = circuit $ \ethIn -> do
   [arpEthIn, ipEthIn] <- packetDispatcherC (routeBy _etherType $ 0x0806 :> 0x0800 :> Nil) -< ethIn
-  ipTx <- ipLitePacketizerC <| icmpStack <| filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
+  ipTx <- ipLitePacketizerC <| packetBufferC d10 d4 <| icmpUdpStack <| packetBufferC d10 d4 <| filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
   (ipEthOut, arpLookup) <- toEthernetStreamC macAddressS -< ipTx
   arpEthOut <- arpC d10 d5 macAddressS (fst <$> ipS) -< (arpEthIn, arpLookup)
   packetArbiterC RoundRobin -< [arpEthOut, ipEthOut]
 
   where
-    icmpStack = filterMeta ((1 ==) . _ipv4lProtocol)
-                  |> packetBufferC d10 d4
-                  |> icmpEchoResponderC @dom @dataWidth (fst <$> ipS)
-    isForMyIp (ip, subnet) (_ipv4lDestination -> to) = to == ip || to == ipv4Broadcast ip subnet
+    icmpUdpStack = circuit $ \ipIn -> do
+      [icmpIn, udpIn] <- packetDispatcherC (routeBy _ipv4lProtocol $ 0x0001 :> 0x0011 :> Nil) -< ipIn
+      icmpOut <- icmpEchoResponderC @dom @dataWidth (fst <$> ipS) -< icmpIn
+      udpInParsed <- udpDepacketizerC -< udpIn
+      udpOutParsed <- udpPacketizerC (fst <$> ipS) <| udpCkt -< udpInParsed
+      packetArbiterC RoundRobin -< [icmpOut, udpOutParsed]
+    isForMyIp (ip, subnet) (_ipv4lDestination -> to) = to == ip || to == ipv4Broadcast ip subnet

src/Clash/Cores/Ethernet/Udp.hs

@@ -0,0 +1,88 @@
+{-# language RecordWildCards #-}
+
+{-|
+Module      : Clash.Cores.Ethernet.Udp
+Description : Circuits and data types to handle the UDP protocol
+-}
+module Clash.Cores.Ethernet.Udp
+  ( UdpHeaderLite(..)
+  , udpDepacketizerC
+  , udpPacketizerC
+  )
+  where
+
+import Clash.Cores.Ethernet.IP.IPv4Types
+import Clash.Prelude
+import Protocols
+import Protocols.Extra.PacketStream
+import Protocols.Extra.PacketStream.Packetizers ( depacketizerC, packetizerC )
+
+-- | The full UDP header
+data UdpHeader = UdpHeader
+  { _udpSrcPort :: Unsigned 16
+  -- ^ Source port
+  , _udpDstPort :: Unsigned 16
+  -- ^ Destination port
+  , _udpLength :: Unsigned 16
+  -- ^ length of header + payload
+  , _udpChecksum :: Unsigned 16
+  -- ^ UDP Checksum, We do not validate or generate it
+  } deriving (Generic, NFDataX, BitPack, Eq, Show, ShowX)
+
+-- | UDP header
+data UdpHeaderLite = UdpHeaderLite
+  { _udplSrcPort :: Unsigned 16
+  -- ^ Source port
+  , _udplDstPort :: Unsigned 16
+  -- ^ Destination port
+  , _udplPayloadLength :: Unsigned 16
+  -- ^ Length of payload
+  } deriving (Generic, NFDataX, BitPack, Eq, Show, ShowX)
+
+fromUdpLite :: UdpHeaderLite -> UdpHeader
+fromUdpLite UdpHeaderLite{..} = UdpHeader
+  { _udpSrcPort = _udplSrcPort
+  , _udpDstPort = _udplDstPort
+  , _udpLength = _udplPayloadLength + 8
+  , _udpChecksum = 0
+  }
+
+toUdpLite :: UdpHeader -> UdpHeaderLite
+toUdpLite UdpHeader{..} = UdpHeaderLite
+  { _udplSrcPort = _udpSrcPort
+  , _udplDstPort = _udpDstPort
+  , _udplPayloadLength = _udpLength - 8
+  }
+
+-- | Parses out the UDP header from an IP stream.
+--   The first element of the tuple is the source IP.
+udpDepacketizerC
+  :: HiddenClockResetEnable dom
+  => KnownNat n
+  => 1 <= n
+  => Circuit
+       (PacketStream dom n IPv4HeaderLite)
+       (PacketStream dom n (IPv4Address, UdpHeaderLite))
+udpDepacketizerC = depacketizerC (\udph ipv4lh -> (_ipv4lSource ipv4lh, toUdpLite udph))
+
+-- Serializes the UDP packet to an IP stream.
+-- The first element of the tuple is the destination IP.
+udpPacketizerC
+  :: HiddenClockResetEnable dom
+  => KnownNat n
+  => 1 <= n
+  => Signal dom IPv4Address
+  -> Circuit
+      (PacketStream dom n (IPv4Address, UdpHeaderLite))
+      (PacketStream dom n IPv4HeaderLite)
+udpPacketizerC myIp = mapMetaS (toIp <$> myIp) |> packetizerC fst snd
+  where
+    toIp srcIp (dstIp, udpLite) = (ipLite, udpHeader)
+      where
+        udpHeader = fromUdpLite udpLite
+        ipLite = IPv4HeaderLite
+                   { _ipv4lSource = srcIp
+                   , _ipv4lDestination = dstIp
+                   , _ipv4lProtocol = 0x0011
+                   , _ipv4lPayloadLength = _udpLength udpHeader
+                   }

src/Clash/Lattice/ECP5/Colorlight/TopEntity.hs

@@ -18,7 +18,6 @@ import Clash.Prelude ( exposeClockResetEnable )
 
 import Clash.Cores.Crc ( deriveHardwareCrc )
 import Clash.Cores.Crc.Catalog ( Crc32_ethernet )
-import Clash.Cores.Ethernet.Examples.ArpStack
 import Clash.Cores.Ethernet.IP.IPv4Types ( IPv4Address(IPv4Address) )
 import Clash.Cores.Ethernet.Mac.EthernetTypes ( MacAddress(MacAddress) )
 import Clash.Lattice.ECP5.Colorlight.CRG

src/Protocols/Extra/PacketStream/Routing.hs

@@ -80,14 +80,8 @@ packetDispatcherC fs = Circuit (second unbundle . unbundle . fmap go . bundle .
       _ -> (PacketStreamS2M True, repeat Nothing)
     go _ = (PacketStreamS2M False, repeat Nothing)
 
--- | Routing function for `packetDispatcherC` that matches against values with an `Eq` instance.
--- >>> :{
--- dispatcher
---   :: KnownDomain dom
---   => HiddenClockResetEnable dom
---   => Circuit (PacketStream dom n Bool) (Vec 2 (PacketStream dom n Bool))
--- dispatcher = packetDispatcherC (routeBy id $ True :> False :> Nil)
--- :}
+-- | Routing function for `packetDispatcherC` that matches against values with
+-- an `Eq` instance. Useful to route according to a record field.
 routeBy
   :: Eq b
   => (a -> b)

tests/Test/Cores/Ethernet/Icmp.hs

@@ -47,7 +47,7 @@ genIpAddr :: Gen IPv4Address
 genIpAddr = IPv4Address <$> C.sequence (C.repeat @4 Gen.enumBounded)
 
 genIPv4HeaderLite :: Gen IPv4HeaderLite
-genIPv4HeaderLite = IPv4HeaderLite <$> genIpAddr <*> genIpAddr <*> pure 0
+genIPv4HeaderLite = IPv4HeaderLite <$> genIpAddr <*> genIpAddr <*> Gen.enumBounded <*> pure 0
 
 packetize
   :: 1 C.<= dataWidth

tests/Test/Cores/Ethernet/Mac/EthernetTypes.hs

@@ -60,7 +60,7 @@ toEthernetTest C.SNat macSrc =
     model src = map $ fmap (toEthernet src)
 
     hardCodedMac :: MacAddress
-    hardCodedMac = MacAddress (0x8C C.:> 0x8C C.:> 0xAA C.:> 0xC8 C.:> 0x2B C.:> 0xEE C.:> C.Nil)
+    hardCodedMac = MacAddress (0x00 C.:> 0xe0 C.:> 0x6c C.:> 0x38 C.:> 0xd0 C.:> 0x2c C.:> C.Nil)
 
     toEthernet :: MacAddress -> IPv4Address -> EthernetHeader
     toEthernet src _ = EthernetHeader {