|
1 | 1 | {-# language FlexibleContexts #-}
|
2 |
| -{-# language RecordWildCards #-} |
3 | 2 | {-# LANGUAGE ViewPatterns #-}
|
4 | 3 | {-# OPTIONS_GHC -fplugin Protocols.Plugin #-}
|
5 | 4 |
|
@@ -201,115 +200,124 @@ dummyRxPhy = undefined
|
201 | 200 |
|
202 | 201 |
|
203 | 202 | -}
|
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 ) |
227 | 211 |
|
228 |
| --- import ethernet |
229 | 212 | import Clash.Cores.Ethernet.Arp
|
230 | 213 | import Clash.Cores.Ethernet.Examples.RxStacks
|
231 | 214 | 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 |
234 | 219 |
|
235 |
| -import Clash.Cores.Ethernet.IP.EthernetStream |
236 |
| -import Clash.Cores.Ethernet.IP.IPv4Types |
| 220 | +import Clash.Prelude |
237 | 221 |
|
238 |
| --- import protocols |
239 | 222 | import Protocols
|
240 | 223 | import Protocols.PacketStream
|
241 | 224 |
|
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 |
| - |
248 | 225 | -- | 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) |
283 | 266 |
|
284 | 267 | -- | Wraps a circuit that handles UDP packets into a stack that handles IP, ICMP
|
285 | 268 | -- 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 |
302 | 289 | [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] |
307 | 290 |
|
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