Skip to content

Commit 11e75dd

Browse files
t-walletrowanG077
authored andcommitted
Make full UDP stack example more flexible
See the discussion in #8 (comment) for more details. Co-authored-by: Rowan Goemans <[email protected]>
1 parent 52d6eae commit 11e75dd

File tree

1 file changed

+106
-98
lines changed

1 file changed

+106
-98
lines changed

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

Lines changed: 106 additions & 98 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# language FlexibleContexts #-}
2-
{-# language RecordWildCards #-}
32
{-# LANGUAGE ViewPatterns #-}
43
{-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
54

@@ -201,115 +200,124 @@ dummyRxPhy = undefined
201200
202201
203202
-}
204-
module Clash.Cores.Ethernet.Examples.FullUdpStack
205-
( fullStackC
206-
, arpIcmpUdpStackC
207-
, packetDispatcherC
208-
, routeBy
209-
, ipLitePacketizerC
210-
, packetFifoC
211-
, filterMetaS
212-
, ipDepacketizerLiteC
213-
, toEthernetStreamC
214-
, arpC
215-
, icmpEchoResponderC
216-
, packetArbiterC
217-
, udpDepacketizerC
218-
, udpPacketizerC
219-
, macRxStack
220-
, macTxStack
221-
) where
222-
223-
import qualified Data.Bifunctor as B
224-
225-
-- import prelude
226-
import Clash.Prelude
203+
module Clash.Cores.Ethernet.Examples.FullUdpStack (
204+
fullStackC,
205+
arpIcmpUdpStackC,
206+
icmpUdpStackC,
207+
) where
208+
209+
import Clash.Cores.Crc ( HardwareCrc )
210+
import Clash.Cores.Crc.Catalog ( Crc32_ethernet )
227211

228-
-- import ethernet
229212
import Clash.Cores.Ethernet.Arp
230213
import Clash.Cores.Ethernet.Examples.RxStacks
231214
import Clash.Cores.Ethernet.Examples.TxStacks
232-
import Clash.Cores.Ethernet.IP.IPPacketizers
233-
import Clash.Cores.Ethernet.Mac.EthernetTypes ( EthernetHeader(..), MacAddress(..) )
215+
import Clash.Cores.Ethernet.Mac
216+
import Clash.Cores.Ethernet.IPv4
217+
import Clash.Cores.Ethernet.Icmp ( icmpEchoResponderC )
218+
import Clash.Cores.Ethernet.Udp
234219

235-
import Clash.Cores.Ethernet.IP.EthernetStream
236-
import Clash.Cores.Ethernet.IP.IPv4Types
220+
import Clash.Prelude
237221

238-
-- import protocols
239222
import Protocols
240223
import Protocols.PacketStream
241224

242-
import Clash.Cores.Crc ( HardwareCrc )
243-
import Clash.Cores.Crc.Catalog ( Crc32_ethernet )
244-
245-
import Clash.Cores.Ethernet.Icmp ( icmpEchoResponderC )
246-
import Clash.Cores.Ethernet.Udp
247-
248225
-- | Full stack from ethernet to ethernet.
249-
fullStackC
250-
:: forall
251-
(dom :: Domain)
252-
(domEthRx :: Domain)
253-
(domEthTx :: Domain)
254-
. KnownDomain dom
255-
=> KnownDomain domEthRx
256-
=> KnownDomain domEthTx
257-
=> HardwareCrc Crc32_ethernet 8 1
258-
=> HardwareCrc Crc32_ethernet 8 4
259-
=> 1 <= DomainPeriod dom
260-
=> DomainPeriod dom <= 5 * 10^11
261-
=> KnownNat (DomainPeriod dom)
262-
=> HiddenClockResetEnable dom
263-
=> Clock domEthRx
264-
-> Reset domEthRx
265-
-> Enable domEthRx
266-
-> Clock domEthTx
267-
-> Reset domEthTx
268-
-> Enable domEthTx
269-
-> Signal dom MacAddress
270-
-- ^ My mac address
271-
-> Signal dom (IPv4Address, IPv4Address)
272-
-- ^ Tuple of my IP and subnet mask
273-
-> Circuit (PacketStream domEthRx 1 ()) (PacketStream domEthTx 1 ())
274-
fullStackC rxClk rxRst rxEn txClk txRst txEn mac ip =
275-
macRxStack @4 rxClk rxRst rxEn mac
276-
|> arpIcmpUdpStackC mac ip (mapMeta $ B.second swapPorts)
277-
|> macTxStack txClk txRst txEn
278-
where
279-
swapPorts hdr@UdpHeaderLite{..} = hdr
280-
{ _udplSrcPort = _udplDstPort
281-
, _udplDstPort = _udplSrcPort
282-
}
226+
fullStackC ::
227+
forall
228+
(dataWidth :: Nat)
229+
(dom :: Domain)
230+
(domEthRx :: Domain)
231+
(domEthTx :: Domain).
232+
(HiddenClockResetEnable dom) =>
233+
(KnownDomain domEthRx) =>
234+
(KnownDomain domEthTx) =>
235+
(HardwareCrc Crc32_ethernet 8 1) =>
236+
(HardwareCrc Crc32_ethernet 8 dataWidth) =>
237+
(KnownNat dataWidth) =>
238+
(1 <= dataWidth) =>
239+
Clock domEthRx ->
240+
Reset domEthRx ->
241+
Enable domEthRx ->
242+
Clock domEthTx ->
243+
Reset domEthTx ->
244+
Enable domEthTx ->
245+
-- | Our MAC address
246+
Signal dom MacAddress ->
247+
-- | (Our IPv4 address, Our subnet mask)
248+
Signal dom (IPv4Address, IPv4Address) ->
249+
-- | Input: (Packets from application layer, Packets from MAC RX Stack)
250+
--
251+
-- Output: (Packets to application layer, Packets to MAC TX stack)
252+
Circuit
253+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
254+
, PacketStream domEthRx 1 ()
255+
)
256+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
257+
, PacketStream domEthTx 1 ()
258+
)
259+
fullStackC rxClk rxRst rxEn txClk txRst txEn macS ipS = circuit $ \(udpOut, phyIn) -> do
260+
ethIn <- macRxStack @dataWidth rxClk rxRst rxEn macS -< phyIn
261+
udpOutBuffered <- packetFifoC d10 d4 Backpressure -< udpOut
262+
(udpIn, ethOut) <- arpIcmpUdpStackC macS ipS -< (udpOutBuffered, ethIn)
263+
udpInBuffered <- packetFifoC d10 d4 Backpressure -< udpIn
264+
phyOut <- macTxStack txClk txRst txEn -< ethOut
265+
idC -< (udpInBuffered, phyOut)
283266

284267
-- | Wraps a circuit that handles UDP packets into a stack that handles IP, ICMP
285268
-- and ARP.
286-
arpIcmpUdpStackC
287-
:: forall (dataWidth :: Nat) (dom :: Domain)
288-
. HiddenClockResetEnable dom
289-
=> KnownNat dataWidth
290-
=> 1 <= dataWidth
291-
=> 1 <= DomainPeriod dom
292-
=> DomainPeriod dom <= 5 * 10^11
293-
=> KnownNat (DomainPeriod dom)
294-
=> Signal dom MacAddress
295-
-- ^ My MAC Address
296-
-> Signal dom (IPv4Address, IPv4Address)
297-
-- ^ My IP address and the subnet
298-
-> Circuit (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)) (PacketStream dom dataWidth (IPv4Address, UdpHeaderLite))
299-
-- ^ UDP handler circuit
300-
-> Circuit (PacketStream dom dataWidth EthernetHeader) (PacketStream dom dataWidth EthernetHeader)
301-
arpIcmpUdpStackC macAddressS ipS udpCkt = circuit $ \ethIn -> do
269+
arpIcmpUdpStackC ::
270+
forall (dataWidth :: Nat) (dom :: Domain).
271+
(HiddenClockResetEnable dom) =>
272+
(KnownNat dataWidth) =>
273+
(1 <= dataWidth) =>
274+
-- | Our MAC address
275+
Signal dom MacAddress ->
276+
-- | (Our IPv4 address, Our subnet mask)
277+
Signal dom (IPv4Address, IPv4Address) ->
278+
-- | Input: (Packets from application layer, Packets from MAC RX Stack)
279+
--
280+
-- Output: (Packets to application layer, Packets to MAC TX stack)
281+
Circuit
282+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
283+
, PacketStream dom dataWidth EthernetHeader
284+
)
285+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
286+
, PacketStream dom dataWidth EthernetHeader
287+
)
288+
arpIcmpUdpStackC ourMacS ipS = circuit $ \(udpOut, ethIn) -> do
302289
[arpEthIn, ipEthIn] <- packetDispatcherC (routeBy _etherType $ 0x0806 :> 0x0800 :> Nil) -< ethIn
303-
ipTx <- ipLitePacketizerC <| packetFifoC d10 d4 Backpressure <| icmpUdpStack <| packetFifoC d10 d4 Backpressure <| filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
304-
(ipEthOut, arpLookup) <- toEthernetStreamC macAddressS -< ipTx
305-
arpEthOut <- arpC d300 d500 d6 macAddressS (fst <$> ipS) -< (arpEthIn, arpLookup)
306-
packetArbiterC RoundRobin -< [arpEthOut, ipEthOut]
307290

308-
where
309-
icmpUdpStack = circuit $ \ipIn -> do
310-
[icmpIn, udpIn] <- packetDispatcherC (routeBy _ipv4lProtocol $ 0x0001 :> 0x0011 :> Nil) -< ipIn
311-
icmpOut <- icmpEchoResponderC (fst <$> ipS) -< icmpIn
312-
udpInParsed <- udpDepacketizerC -< udpIn
313-
udpOutParsed <- udpPacketizerC (fst <$> ipS) <| udpCkt -< udpInParsed
314-
packetArbiterC RoundRobin -< [icmpOut, udpOutParsed]
315-
isForMyIp (ip, subnet) (_ipv4lDestination -> to) = to == ip || to == ipv4Broadcast ip subnet
291+
arpEthOut <- arpC d300 d500 d6 ourMacS (fst <$> ipS) -< (arpEthIn, arpLookup)
292+
ipIn <- filterMetaS (isForMyIp <$> ipS) <| ipDepacketizerLiteC -< ipEthIn
293+
(udpIn, ipOut) <- icmpUdpStackC ipS -< (udpOut, ipIn)
294+
(ipEthOut, arpLookup) <- toEthernetStreamC ourMacS <| ipLitePacketizerC -< ipOut
295+
ethOut <- packetArbiterC RoundRobin -< [arpEthOut, ipEthOut]
296+
idC -< (udpIn, ethOut)
297+
where
298+
isForMyIp (ip, subnet) (_ipv4lDestination -> to) = to == ip || to == ipv4Broadcast ip subnet
299+
300+
icmpUdpStackC ::
301+
forall (dataWidth :: Nat) (dom :: Domain).
302+
(HiddenClockResetEnable dom) =>
303+
(KnownNat dataWidth) =>
304+
(1 <= dataWidth) =>
305+
-- | (Our IPv4 address, Our subnet mask)
306+
Signal dom (IPv4Address, IPv4Address) ->
307+
-- | Input: (Packets from application layer, Packets from IP RX Stack)
308+
--
309+
-- Output: (Packets to application layer, Packets to IP TX stack)
310+
Circuit
311+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
312+
, PacketStream dom dataWidth IPv4HeaderLite
313+
)
314+
( PacketStream dom dataWidth (IPv4Address, UdpHeaderLite)
315+
, PacketStream dom dataWidth IPv4HeaderLite
316+
)
317+
icmpUdpStackC ipS = circuit $ \(udpOut, ipIn) -> do
318+
[icmpIn, udpIn] <- packetDispatcherC (routeBy _ipv4lProtocol $ 0x0001 :> 0x0011 :> Nil) -< ipIn
319+
icmpOut <- icmpEchoResponderC (fst <$> ipS) -< icmpIn
320+
udpInParsed <- udpDepacketizerC -< udpIn
321+
udpOutParsed <- udpPacketizerC (fst <$> ipS) -< udpOut
322+
ipOut <- packetArbiterC RoundRobin -< [icmpOut, udpOutParsed]
323+
idC -< (udpInParsed, ipOut)

0 commit comments

Comments
 (0)