module Net.IPv4OverEthernet where
--import Control.Concurrent

import qualified Net.Ethernet as Eth
import Net.Interface
--import Net.PacketParsing(doParse,doUnparse)

initialize :: (t -> m (Maybe Addr))
-> Interface m i (Packet b) -> Interface m i (t, b)
initialize t -> m (Maybe Addr)
lookupMAC Interface m i (Packet b)
eth = m i -> ((t, b) -> m ()) -> Interface m i (t, b)
forall (m :: * -> *) i o. m i -> (o -> m ()) -> Interface m i o
Interface (Interface m i (Packet b) -> m i
forall {m :: * -> *} {i} {o}. Interface m i o -> m i
Eth.rx Interface m i (Packet b)
eth) (t, b) -> m ()
tx
  where
    tx :: (t, b) -> m ()
tx (t
nextIP,b
ip) = m () -> (Addr -> m ()) -> Maybe Addr -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
dropit Addr -> m ()
sendit (Maybe Addr -> m ()) -> m (Maybe Addr) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t -> m (Maybe Addr)
lookupMAC t
nextIP
      where
	dropit :: m ()
dropit = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        sendit :: Addr -> m ()
sendit Addr
nextMAC = Interface m i (Packet b) -> Packet b -> m ()
forall {m :: * -> *} {i} {o}. Interface m i o -> o -> m ()
Eth.tx Interface m i (Packet b)
eth Packet b
p
          where p :: Packet b
p = Addr -> Addr -> PacketType -> b -> Packet b
forall content.
Addr -> Addr -> PacketType -> content -> Packet content
Eth.Packet Addr
nextMAC (Interface m i (Packet b) -> Addr
forall (m :: * -> *) i o. Interface m i o -> Addr
Eth.myMAC Interface m i (Packet b)
eth) PacketType
Eth.IPv4 b
ip