Arp: fix timing issues and improve documentation

src/Clash/Cores/Ethernet/Arp.hs

@@ -1,12 +1,26 @@
 {-|
-Module      : Clash.Cores.Ethernet.Arp
-Description : Provides a fully functional ARP stack.
+Copyright   : (C) 2024, QBayLogic B.V.
+License     : BSD2 (see the file LICENSE)
+Maintainer  : QBayLogic B.V. <[email protected]>
+
+Provides a top-level ARP circuit sufficient for most use cases, along with
+the individual components it is composed of.
 -}
 
 {-# language FlexibleContexts #-}
-{-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
+{-# OPTIONS_GHC -fplugin=Protocols.Plugin #-}
+
+module Clash.Cores.Ethernet.Arp (
+  -- * Types, constants and simple operations
+  module Clash.Cores.Ethernet.Arp.ArpTypes,
+
+  -- * Top-level ARP stack
+  arpC,
 
-module Clash.Cores.Ethernet.Arp where
+  -- * Individual components
+  module Clash.Cores.Ethernet.Arp.ArpTable,
+  module Clash.Cores.Ethernet.Arp.ArpManager,
+) where
 
 import Clash.Prelude
 
@@ -20,29 +34,31 @@ import Clash.Cores.Ethernet.Arp.ArpTypes
 import Clash.Cores.Ethernet.IP.IPv4Types
 import Clash.Cores.Ethernet.Mac.EthernetTypes
 
+{- |
+A fully functional ARP stack which handles ARP lookups from client circuits.
+Maintains a single-entry ARP table which the client circuit can query via the
+`ArpLookup` input. If the client-supplied IPv4 address is not found in the table,
+it transmits an ARP request for this specific address. The circuit will assert
+backpressure until either a reply has been received, or a timeout occurs. The
+maximum number of seconds the stack will wait for a reply to this request is
+configurable. The timeout (in seconds) of ARP table entries is configurable as well.
+All timeouts may be up to a second inaccurate.
 
--- | A fully functional ARP stack which handles ARP lookups from client circuits.
---   Maintains a single-entry ARP table which the client circuit can query via the
---   `ArpLookup` input. If the client-supplied IPv4 address is not found in the table,
---   it transmits an ARP request for this specific address. The circuit will assert
---   backpressure until either a reply has been received, or a timeout occurs. The
---   maximum number of seconds the stack will wait for a reply to this request is
---   configurable. The timeout (in seconds) of ARP table entries is configurable as well.
---   All timeouts may be up to a second inaccurate.
---
---   Moreover, it takes in an Ethernet stream with the ARP
---   etherType (0x0806), and updates the ARP table upon receiving a valid ARP
---   reply or gratitious ARP request. Gratitious ARP replies are ignored for now.
---   If a normal ARP request is received, it transmits a reply.
---
---   Does not support Proxy ARP.
-arpC
-  :: forall
-     (dom :: Domain)
-     (maxAgeSeconds :: Nat)
-     (maxWaitSeconds :: Nat)
-     (dataWidth :: Nat)
-   . HiddenClockResetEnable dom
+Moreover, it takes in an Ethernet stream with the ARP
+etherType (0x0806), and updates the ARP table upon receiving a valid ARP
+reply or gratuitous ARP packet.
+If an ARP request directed to our IPv4 address is received, it transmits a reply.
+Outbound requests receive priority over outbound replies in the output stream.
+
+__NB__: does not support Proxy ARP.
+-}
+arpC ::
+  forall
+    (dom :: Domain)
+    (maxAgeSeconds :: Nat)
+    (maxWaitSeconds :: Nat)
+    (dataWidth :: Nat).
+  HiddenClockResetEnable dom
   => KnownNat dataWidth
   => KnownNat (DomainPeriod dom)
   => DomainPeriod dom <= 5 * 10^11
@@ -65,8 +81,22 @@ arpC maxAge maxWait ourMacS ourIPv4S =
   -- TODO waiting for an ARP reply in seconds is too coarse.
   -- Make this timer less coarse, e.g. milliseconds
   circuit $ \(ethStream, lookupIn) -> do
-    (entry, replyOut) <- arpReceiverC ourIPv4S -< ethStream
+    -- Add a skid buffer to improve timing. We don't need the metadata, so we
+    -- can throw it away.
+    bufferedStream <- mapMeta (const ()) |> registerBoth -< ethStream
+    (entry, replyOut) <- arpReceiverC ourIPv4S -< bufferedStream
     (lookupOut, requestOut) <- arpManagerC maxWait -< lookupIn
     () <- arpTable maxAge -< (lookupOut, entry)
-    arpPktOut <- Df.roundrobinCollect Df.Skip -< [replyOut, requestOut]
-    arpTransmitterC ourMacS ourIPv4S -< arpPktOut
+    -- Being biased towards outbound requests is favourable, as it
+    -- lessens the impact of ARP request DoS attacks. Moreover,
+    -- @CollectMode@ @Df.Parallel@ is not always more expensive
+    -- than @Df.Skip@ with two sources. Under certain circumstances
+    -- it may be cheaper.
+    arpPktOut <- Df.roundrobinCollect Df.Parallel -< [replyOut, requestOut]
+    arpStreamOut <- arpTransmitterC ourMacS ourIPv4S |> registerBoth -< arpPktOut
+    mapMetaS
+      (
+        (\ourMac targetMac ->
+          EthernetHeader targetMac ourMac arpEtherType
+        ) <$> ourMacS
+      ) -< arpStreamOut

src/Clash/Cores/Ethernet/Arp/ArpManager.hs

@@ -1,28 +1,31 @@
-{-# language FlexibleContexts #-}
 {-# language RecordWildCards #-}
 {-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
+{-# OPTIONS_HADDOCK hide #-}
 
 {-|
-Module      : Clash.Cores.Ethernet.Arp.ArpManager
-Description : Provides an ARP manager which handles ARP lookups from client circuits.
+Copyright   : (C) 2024, QBayLogic B.V.
+License     : BSD2 (see the file LICENSE)
+Maintainer  : QBayLogic B.V. <[email protected]>
+
+Provides individual components which handle the ARP protocol.
 -}
-module Clash.Cores.Ethernet.Arp.ArpManager
-  ( arpManagerC
-  , arpReceiverC
-  , arpTransmitterC
-  ) where
+module Clash.Cores.Ethernet.Arp.ArpManager (
+  arpManagerC,
+  arpReceiverC,
+  arpTransmitterC,
+) where
 
 import Clash.Prelude
-import Clash.Signal.Extra
-
-import Protocols
-import qualified Protocols.Df as Df
-import Protocols.PacketStream
+import Clash.Signal.Extra (secondTimer)
 
 import Clash.Cores.Ethernet.Arp.ArpTypes
 import Clash.Cores.Ethernet.IP.IPv4Types
 import Clash.Cores.Ethernet.Mac.EthernetTypes
 
+import Protocols
+import qualified Protocols.Df as Df
+import Protocols.PacketStream
+
 -- | State of the ARP manager.
 data ArpManagerState maxWaitSeconds
   = AwaitLookup {
@@ -91,7 +94,7 @@ arpManagerT st (Nothing, _,  _, _) = (st, (Nothing, (Nothing, Df.NoData)))
 -- | This component handles ARP lookup requests by client components. If a lookup IPv4 address is not found
 --   in the ARP table, it will broadcast an ARP request to the local network and wait at most @maxWaitSeconds@
 --   for a reply. If no reply was received within time, the lookup request is ignored. @maxWaitSeconds@ is inaccurate
---   for up to one second less. For example, if @maxWaitSeconds ~ 30@, then the component will wait for 29-30 seconds.
+--   for up to one second less. For example, if @maxWaitSeconds@ ~ 30, then the component will wait for 29-30 seconds.
 --   Does not support clock frequencies lower than 2 Hz.
 arpManagerC
   :: forall (dom :: Domain)
@@ -112,49 +115,66 @@ arpManagerC SNat = fromSignals ckt
         (bwdOut, fwdOut) =
           mealyB arpManagerT (AwaitLookup @maxWaitSeconds False) (lookupIPv4S, arpResponseInS, ackInS, secondTimer)
 
--- | Transmits ARP packets upon request.
-arpTransmitterC
-  :: forall (dom :: Domain)
-            (dataWidth :: Nat)
-   . HiddenClockResetEnable dom
-  => 1 <= dataWidth
-  => KnownNat dataWidth
-  => Signal dom MacAddress
-  -- ^ Our MAC address
-  -> Signal dom IPv4Address
-  -- ^ Our IPv4 address
-  -> Circuit (Df dom ArpLite) (PacketStream dom dataWidth EthernetHeader)
-arpTransmitterC ourMacS ourIPv4S = fromSignals bundleWithSrc |> packetizeFromDfC toEthernetHdr constructArpPkt
-  where
-    bundleWithSrc (fwdIn, bwdIn) = (bwdIn, go <$> bundle (ourMacS, ourIPv4S, fwdIn))
-    go (ourMac, ourIPv4, maybeArpLite) = maybeArpLite >>= \arpLite -> Df.Data (ourMac, ourIPv4, arpLite)
-
-    toEthernetHdr (ourMac, _, arpLite)
-      = EthernetHeader {
-        _macDst = _targetMac arpLite,
-        _macSrc = ourMac,
-        _etherType = arpEtherType
-      }
-
-    constructArpPkt (ourMac, ourIPv4, arpLite)
-      = newArpPacket ourMac ourIPv4 (_targetMac arpLite) (_targetIPv4 arpLite) (_isRequest arpLite)
-
--- | arpReceiverC takes the incoming PacketStream
---   with an ethernet header in the meta data and
---   creates an ARP entry or an ARP response.
---   - It outputs ARP entries for ARP responses (OPER == 2)
---     and GARP messages in the form of an ARP request (OPER == 1) with
---     TPA == SPA.
---   - It outputs ARP lite responses for any other ARP request (OPER == 1 and
---     TPA /= SPA).
-arpReceiverC
-  :: forall (dom :: Domain) (dataWidth :: Nat)
-   . HiddenClockResetEnable dom
-  => KnownNat dataWidth
-  => 1 <= dataWidth
-  => Signal dom IPv4Address
-  -> Circuit (PacketStream dom dataWidth EthernetHeader) (Df dom ArpEntry, Df dom ArpLite)
-arpReceiverC myIP = circuit $ \ethStream -> do
+{- |
+Transmits ARP packets upon request by creating a full 'ArpPacket' from the
+input 'ArpLite' and packetizing that into a new packet stream. Uses
+'packetizeFromDfC' internally to achieve this, and therefore inherits all of
+its properties related to latency and throughput.
+
+Because ARP's EtherType and our MAC address are known globally, we do not add
+it to the metadata here, only the target MAC address. This makes this circuit
+more flexible, because then the top-level ARP circuit decides where to add this
+metadata to the stream, allowing for cheaper potential buffers between components.
+-}
+arpTransmitterC ::
+  forall (dataWidth :: Nat) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (1 <= dataWidth) =>
+  -- | Our MAC address
+  Signal dom MacAddress ->
+  -- | Our IPv4 address
+  Signal dom IPv4Address ->
+  Circuit (Df dom ArpLite) (PacketStream dom dataWidth MacAddress)
+arpTransmitterC ourMacS ourIPv4S =
+  fromSignals (\(fwdIn, bwdIn) -> (bwdIn, go <$> bundle (ourMacS, ourIPv4S, fwdIn)))
+    |> packetizeFromDfC toTargetMac constructArpPkt
+ where
+  go (ourMac, ourIPv4, maybeArpLite) =
+    maybeArpLite >>= \arpLite -> Df.Data (ourMac, ourIPv4, arpLite)
+
+  toTargetMac (_, _, arpLite) = _targetMac arpLite
+
+  constructArpPkt (ourMac, ourIPv4, ArpLite{..})
+    = newArpPacket ourMac ourIPv4 _targetMac _targetIPv4 _isRequest
+
+{-|
+Parses the incoming packet stream into an @ArpPacket@, validates whether this
+is a correct IPv4 to Ethernet ARP packet and then throws away all the redundant
+information to create either an ARP entry or an ARP (lite) response:
+
+- Outputs ARP entries for any gratuitous ARP packets (@TPA == SPA@) and
+  ARP replies (@OPER == 2@).
+- Outputs ARP (lite) responses for ARP requests (@OPER == 1@) where
+  @TPA@ is our IPv4 address.
+
+Uses 'depacketizeToDfC' internally to do the parsing, so all padding will be
+consumed and packets will be dropped if they were aborted.
+
+Assumes that the input stream is either a broadcast or directed towards us, and
+that it is routed by the ARP EtherType.
+-}
+arpReceiverC ::
+  forall (dataWidth :: Nat) (dom :: Domain).
+  (HiddenClockResetEnable dom) =>
+  (KnownNat dataWidth) =>
+  (1 <= dataWidth) =>
+  -- Our IPv4 address
+  Signal dom IPv4Address ->
+  Circuit
+    (PacketStream dom dataWidth ())
+    (Df dom ArpEntry, Df dom ArpLite)
+arpReceiverC myIP = circuit $ \stream -> do
   -- TODO:
   -- when backpressure is asserted on `arpTransmitter`,
   -- the entire arp stack will stall and this will lead
@@ -164,11 +184,18 @@ arpReceiverC myIP = circuit $ \ethStream -> do
   -- Solution: putting abortOnBackpressure (Packetbuffer) to
   -- before `depacketizetoDfC` should work, as depacketizeToDfC already
   -- implements dropping of
-  arpDf <- depacketizeToDfC const -< ethStream
-  arpDf' <- Df.filterS (isValidArp <$> myIP) -< arpDf
+  arpDf <- depacketizeToDfC const -< stream
+  arpDf' <- Df.filterS (validArp <$> myIP) -< arpDf
   (arpRequests, arpEntries) <- Df.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

src/Clash/Cores/Ethernet/Arp/ArpTable.hs

@@ -1,4 +1,5 @@
 {-# language FlexibleContexts #-}
+{-# OPTIONS_HADDOCK hide #-}
 
 {-|
 Module      : Clash.Cores.Ethernet.Arp.ArpTable

src/Clash/Cores/Ethernet/Arp/ArpTypes.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_HADDOCK hide #-}
 
 {-|
 Module      : Clash.Cores.Ethernet.Arp.ArpTypes

src/Clash/Cores/Ethernet/Mac.hs

@@ -1,7 +1,7 @@
 {- |
-Copyright   :  (C) 2024, QBayLogic B.V.
-License     :  BSD2 (see the file LICENSE)
-Maintainer  :  QBayLogic B.V. <[email protected]>
+Copyright   : (C) 2024, QBayLogic B.V.
+License     : BSD2 (see the file LICENSE)
+Maintainer  : QBayLogic B.V. <[email protected]>
 
 Provides various components to handle the Ethernet protocol, both the physical-
 and link-layer.

test/Test/Cores/Ethernet/Arp/ArpManager.hs

@@ -24,7 +24,7 @@ import Protocols.Hedgehog
 import Protocols.PacketStream
 import Protocols.PacketStream.Hedgehog
 
-import Test.Cores.Ethernet.Base (genEthernetHeader, genIPv4Addr, genMacAddr)
+import Test.Cores.Ethernet.Base (genIPv4Addr, genMacAddr)
 
 import Test.Tasty
 import Test.Tasty.Hedgehog (HedgehogTestLimit (HedgehogTestLimit))
@@ -152,16 +152,11 @@ arpTransmitterPropertyGenerator SNat =
     (exposeClockResetEnable @System (arpTransmitterC (pure ourMac) (pure ourIPv4)))
     (===)
  where
-  model :: [ArpLite] -> [PacketStreamM2S dataWidth EthernetHeader]
-  model = packetizeFromDfModel (arpLiteToEthernetHeader ourMac) toArpPkt
+  model :: [ArpLite] -> [PacketStreamM2S dataWidth MacAddress]
+  model = packetizeFromDfModel _targetMac toArpPkt
 
-  toArpPkt arpLite =
-    newArpPacket
-      ourMac
-      ourIPv4
-      (_targetMac arpLite)
-      (_targetIPv4 arpLite)
-      (_isRequest arpLite)
+  toArpPkt ArpLite{..} =
+    newArpPacket ourMac ourIPv4 _targetMac _targetIPv4 _isRequest
 
 arpReceiverPropertyGenerator ::
   forall (dataWidth :: Nat).
@@ -188,18 +183,18 @@ arpReceiverPropertyGenerator SNat =
   genPkt am =
     Gen.choice
       [ -- Random packet
-        genValidPacket genEthernetHeader (Range.linear 0 20) am
+        genValidPacket (pure ()) (Range.linear 0 20) am
       , -- Valid ARP reply/request
         do
           arpPkt <- genArpPacket False
-          pure (packetizeFromDfModel arpToEthernetHeader id [arpPkt])
+          pure (packetizeFromDfModel (pure ()) id [arpPkt])
       , -- Valid gratuitous ARP reply/request
         do
           arpPkt <- genArpPacket True
-          pure (packetizeFromDfModel arpToEthernetHeader id [arpPkt])
+          pure (packetizeFromDfModel (pure ()) id [arpPkt])
       ]
 
-  model :: [PacketStreamM2S dataWidth EthernetHeader] -> ([ArpEntry], [ArpLite])
+  model :: [PacketStreamM2S dataWidth ()] -> ([ArpEntry], [ArpLite])
   model ethStr = (entries, lites)
    where
     arpDf = L.filter (isValidArp ourIPv4) (depacketizeToDfModel const ethStr)

test/unittests.hs

@@ -22,15 +22,15 @@ import qualified Test.Cores.Xilinx.DnaPortE2
 
 tests :: TestTree
 tests = testGroup "Unittests"
-  [ Test.Cores.Crc.tests
-  , Test.Cores.Ethernet.tests
-  , Test.Cores.LineCoding8b10b.tests
-  , Test.Cores.SPI.tests
-  , Test.Cores.SPI.MultiSlave.tests
-  , Test.Cores.UART.tests
-  , Test.Cores.Xilinx.BlockRam.tests
-  , Test.Cores.Xilinx.DcFifo.tests
-  , Test.Cores.Xilinx.DnaPortE2.tests
+  [ --Test.Cores.Crc.tests
+   Test.Cores.Ethernet.tests
+  --, Test.Cores.LineCoding8b10b.tests
+  --, Test.Cores.SPI.tests
+  --, Test.Cores.SPI.MultiSlave.tests
+  --, Test.Cores.UART.tests
+  --, Test.Cores.Xilinx.BlockRam.tests
+  --, Test.Cores.Xilinx.DcFifo.tests
+  --, Test.Cores.Xilinx.DnaPortE2.tests
   ]
 
 main :: IO ()