Add Ethernet core

clash-cores.cabal

@@ -108,8 +108,10 @@ common basic-config
   build-depends:
     base                      >= 4.10  && < 5,
     clash-prelude,
+    clash-protocols,
     constraints,
     containers                >=0.5    && <0.8,
+    deepseq,
     ghc-typelits-extra        >= 0.3.2,
     ghc-typelits-knownnat     >= 0.6,
     ghc-typelits-natnormalise >= 0.6,
@@ -126,6 +128,26 @@ library
     Clash.Cores.Crc
     Clash.Cores.Crc.Internal
     Clash.Cores.Crc.Catalog
+    Clash.Cores.Ethernet.Arp
+    Clash.Cores.Ethernet.Arp.ArpManager
+    Clash.Cores.Ethernet.Arp.ArpTable
+    Clash.Cores.Ethernet.Arp.ArpTypes
+    Clash.Cores.Ethernet.Examples.FullUdpStack
+    Clash.Cores.Ethernet.Examples.RxStacks
+    Clash.Cores.Ethernet.Examples.TxStacks
+    Clash.Cores.Ethernet.Icmp
+    Clash.Cores.Ethernet.IP.EthernetStream
+    Clash.Cores.Ethernet.IP.InternetChecksum
+    Clash.Cores.Ethernet.IP.IPPacketizers
+    Clash.Cores.Ethernet.IP.IPv4Types
+    Clash.Cores.Ethernet.Mac
+    Clash.Cores.Ethernet.Mac.EthernetTypes
+    Clash.Cores.Ethernet.Mac.FrameCheckSequence
+    Clash.Cores.Ethernet.Mac.InterpacketGapInserter
+    Clash.Cores.Ethernet.Mac.MacPacketizers
+    Clash.Cores.Ethernet.Mac.PaddingInserter
+    Clash.Cores.Ethernet.Mac.Preamble
+    Clash.Cores.Ethernet.Udp
     Clash.Cores.LatticeSemi.ECP5.Blackboxes.IO
     Clash.Cores.LatticeSemi.ECP5.IO
     Clash.Cores.LatticeSemi.ICE40.Blackboxes.IO
@@ -165,6 +187,9 @@ library
     Clash.Cores.Xilinx.Xpm.Cdc.SyncRst
 
   other-modules:
+    Clash.Signal.Extra
+    Clash.Sized.Vector.Extra
+    Data.Maybe.Extra
     Data.Text.Extra
 
   ghc-options:
@@ -197,6 +222,16 @@ test-suite unittests
 
   other-Modules:
     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
+    Test.Cores.Ethernet.IP.IPPacketizers
+    Test.Cores.Ethernet.Mac.FrameCheckSequence
+    Test.Cores.Ethernet.Mac.InterpacketGapInserter
+    Test.Cores.Ethernet.Mac.PaddingInserter
     Test.Cores.Internal.SampleSPI
     Test.Cores.LineCoding8b10b
     Test.Cores.Internal.Signals

nix/nixpkgs.nix

@@ -20,7 +20,7 @@ let
       };
     };
 
-    # Haskell overrides
+   # Haskell overrides
     haskellPackages = pkgs.haskell.packages.${haskell_compiler}.override {
       overrides = self: super: {
         # Ignore dependency bounds for tasty < 1.5
@@ -42,6 +42,11 @@ let
           self.callCabal2nix "doctest-parallel" sources.doctest-parallel {};
         clash-prelude =
           self.callCabal2nix "clash-prelude" (sources.clash-compiler + "/clash-prelude") {};
+        # clash-protocols also requires tasty < 1.5, so we need to jailbreak.
+        clash-protocols-base =
+          pkgs.haskell.lib.doJailbreak (self.callCabal2nix "clash-protocols-base" (sources.clash-protocols + "/clash-protocols-base") {});
+        clash-protocols =
+          pkgs.haskell.lib.doJailbreak (self.callCabal2nix "clash-protocols" (sources.clash-protocols + "/clash-protocols") {});
         clash-lib =
           self.callCabal2nix "clash-lib" (sources.clash-compiler + "/clash-lib") {};
         clash-ghc =

nix/sources.json

@@ -5,13 +5,25 @@
         "homepage": "https://clash-lang.org/",
         "owner": "clash-lang",
         "repo": "clash-compiler",
-        "rev": "b14ff0ef2ccfad8854210a9035e9db1e32b3be07",
-        "sha256": "00gq0v4fi2dy13xchllxxhhjfpvvj0ig8cgp5y65c7zb7qw5b30y",
+        "rev": "f946617561565440d82f67747acb2486f6526a66",
+        "sha256": "0924xzzwzrpjb1yid9mvy2imxwrzyxfdmkd2l1wfrsdwgrc53dpg",
         "type": "tarball",
-        "url": "https://github.com/clash-lang/clash-compiler/archive/b14ff0ef2ccfad8854210a9035e9db1e32b3be07.tar.gz",
+        "url": "https://github.com/clash-lang/clash-compiler/archive/f946617561565440d82f67747acb2486f6526a66.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
         "version": "1.8.1"
     },
+    "clash-protocols": {
+        "branch": "packetstream",
+        "description": "a battery-included library for dataflow protocols",
+        "homepage": null,
+        "owner": "clash-lang",
+        "repo": "clash-protocols",
+        "rev": "a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4",
+        "sha256": "0b219y7nxaxcr3xrk6dq5qj5hl9ggaxqpysk8rwmjh9nmkvzxifa",
+        "type": "tarball",
+        "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": {
         "branch": "main",
         "description": "Test interactive Haskell examples",

src/Clash/Cores/Ethernet/Arp.hs

@@ -0,0 +1,72 @@
+{-|
+Module      : Clash.Cores.Ethernet.Arp
+Description : Provides a fully functional ARP stack.
+-}
+
+{-# language FlexibleContexts #-}
+{-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
+
+module Clash.Cores.Ethernet.Arp where
+
+import Clash.Prelude
+
+import Protocols
+import qualified Protocols.Df as Df
+import Protocols.PacketStream
+
+import Clash.Cores.Ethernet.Arp.ArpManager
+import Clash.Cores.Ethernet.Arp.ArpTable
+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.
+--
+--   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
+  => KnownNat dataWidth
+  => KnownNat (DomainPeriod dom)
+  => DomainPeriod dom <= 5 * 10^11
+  => 1 <= DomainPeriod dom
+  => 1 <= maxAgeSeconds
+  => 1 <= maxWaitSeconds
+  => 1 <= dataWidth
+  => SNat maxAgeSeconds
+  -- ^ ARP entries will expire after this many seconds
+  -> SNat maxWaitSeconds
+  -- ^ The maximum amount of seconds we wait for an incoming ARP reply
+  --   if the lookup IPv4 address was not found in our ARP table
+  -> Signal dom MacAddress
+  -- ^ Our MAC address
+  -> Signal dom IPv4Address
+  -- ^ Our IPv4 address
+  -> Circuit (PacketStream dom dataWidth EthernetHeader, ArpLookup dom)
+             (PacketStream dom dataWidth EthernetHeader)
+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
+    (lookupOut, requestOut) <- arpManagerC maxWait -< lookupIn
+    () <- arpTable maxAge -< (lookupOut, entry)
+    arpPktOut <- Df.roundrobinCollect Df.Skip -< [replyOut, requestOut]
+    arpTransmitterC ourMacS ourIPv4S -< arpPktOut

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

@@ -0,0 +1,187 @@
+{-# language FlexibleContexts #-}
+{-# language RecordWildCards #-}
+{-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
+
+{-|
+Module      : Clash.Cores.Ethernet.Arp.ArpManager
+Description : Provides an ARP manager which handles ARP lookups from client circuits.
+-}
+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.Cores.Ethernet.Arp.ArpTypes
+import Clash.Cores.Ethernet.IP.IPv4Types
+import Clash.Cores.Ethernet.Mac.EthernetTypes
+
+import qualified Data.Bifunctor as B
+
+
+-- | State of the ARP manager.
+data ArpManagerState maxWaitSeconds
+  = AwaitLookup {
+    -- | Whether we need to keep driving the same ARP request to the transmitter,
+    --   because it asserted backpressure.
+    _awaitTransmission :: Bool
+  }
+  | AwaitArpReply {
+    -- | The maximum number of seconds to keep waiting for an ARP reply.
+    _secondsLeft :: Index (maxWaitSeconds + 1)
+  } deriving (Generic, NFDataX, Show, ShowX)
+
+-- | ARP manager transition function.
+arpManagerT
+  :: forall (maxWaitSeconds :: Nat)
+   . 1 <= maxWaitSeconds
+  => KnownNat maxWaitSeconds
+  => ArpManagerState maxWaitSeconds
+  -> (Maybe IPv4Address, Maybe ArpResponse, Ack, Bool)
+  -> (ArpManagerState maxWaitSeconds
+     , (Maybe ArpResponse, (Maybe IPv4Address, Df.Data ArpLite)))
+-- User issues a lookup request. We don't have a timeout, because the ARP table should
+-- always respond within a reasonable time frame. If not, there is a bug in the ARP table.
+arpManagerT AwaitLookup{..} (Just lookupIPv4, arpResponseIn, Ack readyIn, _) =
+  (nextSt, (arpResponseOut, (Just lookupIPv4, arpRequestOut)))
+    where
+      (arpResponseOut, arpRequestOut, nextSt) = case arpResponseIn of
+        Nothing
+          -> ( Nothing
+             , if _awaitTransmission then Df.Data (ArpLite broadcastMac lookupIPv4 True) else Df.NoData
+             , if readyIn && _awaitTransmission then AwaitArpReply maxBound else AwaitLookup False
+             )
+        Just ArpEntryNotFound
+          -> ( Nothing
+             , Df.Data (ArpLite broadcastMac lookupIPv4 True)
+             , if readyIn then AwaitArpReply maxBound else AwaitLookup True
+             )
+        Just (ArpEntryFound _)
+          -> ( arpResponseIn
+             , Df.NoData
+             , AwaitLookup False
+             )
+
+-- We don't care about incoming backpressure, because we do not send ARP requests in this state.
+-- We keep polling the ARP table until either a timeout occurs or the entry is found.
+-- This requires the ARP table to handle read and write requests in parallel.
+arpManagerT AwaitArpReply{..} (Just lookupIPv4, arpResponseIn, _, secondPassed) =
+  (nextSt, (arpResponseOut, (Just lookupIPv4, Df.NoData)))
+    where
+      newTimer = if secondPassed then satPred SatBound _secondsLeft else _secondsLeft
+
+      (arpResponseOut, nextSt) =
+        case (arpResponseIn, _secondsLeft == 0) of
+          (Just (ArpEntryFound _), _)
+            -> (arpResponseIn, AwaitLookup False)
+          (Just ArpEntryNotFound, True)
+            -> (arpResponseIn, AwaitLookup False)
+          -- Note that we keep driving the same lookup request when the ARP table has not acknowledged
+          -- our request yet, even if the time is up. If we don't, we violate protocol invariants.
+          -- Therefore timer can be slightly inaccurate, depending on the latency of the ARP table.
+          (_, _)
+            -> (Nothing, AwaitArpReply newTimer)
+
+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.
+--   Does not support clock frequencies lower than 2 Hz.
+arpManagerC
+  :: forall (dom :: Domain)
+            (maxWaitSeconds :: Nat)
+   . HiddenClockResetEnable dom
+  => KnownDomain dom
+  => KnownNat (DomainPeriod dom)
+  => 1 <= DomainPeriod dom
+  => DomainPeriod dom <= 5 * 10^11
+  => 1 <= maxWaitSeconds
+  => SNat maxWaitSeconds
+  -- ^ The amount of seconds we wait for an incoming ARP reply
+  -> Circuit (ArpLookup dom) (ArpLookup dom, Df dom ArpLite)
+arpManagerC SNat = fromSignals ckt
+  where
+    ckt (lookupIPv4S, (arpResponseInS, ackInS)) = (bwdOut, unbundle fwdOut)
+      where
+        (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
+  -- TODO:
+  -- when backpressure is asserted on `arpTransmitter`,
+  -- the entire arp stack will stall and this will lead
+  -- to corruption on the `arpReceiver` side.
+  -- This only happens when the outlink is saturated, but
+  -- in the future we want to handle this.
+  -- 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
+  (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
+    isRequest ip ArpPacket{..} = _oper == 1 && _tpa == ip
+
+-- TODO upstream to clash-protocols
+-- | Like 'partition', but can reason over signals.
+partitionS ::  forall dom a. Signal dom (a -> Bool) -> Circuit (Df dom a) (Df dom a, Df dom a)
+partitionS fS = Circuit (B.second unbundle . unbundle . liftA2 go fS . bundle . B.second bundle)
+ where
+  go f (Df.Data a, (ackT, ackF))
+    | f a = (ackT, (Df.Data a, Df.NoData))
+    | otherwise = (ackF, (Df.NoData, Df.Data a))
+  go _ _ = (Ack False, (Df.NoData, Df.NoData))