module Net.IPv4Link where

-- Routing of IP packets in the simple where there is a single
-- link which has a router.

import Net.Interface as Net
import Net.IPv4

initialize :: (Addr, Addr)
-> Maybe Addr
-> Interface m i (Addr, Packet content)
-> Interface m i (Packet content)
initialize (Addr, Addr)
net Maybe Addr
optRouter Interface m i (Addr, Packet content)
link = Interface { rx :: m i
rx=Interface m i (Addr, Packet content) -> m i
forall (m :: * -> *) i o. Interface m i o -> m i
rx Interface m i (Addr, Packet content)
link, tx :: Packet content -> m ()
tx=Packet content -> m ()
tx }
  where
    tx :: Packet content -> m ()
tx = (Packet content -> m ())
-> (Addr -> Packet content -> m ())
-> Maybe Addr
-> Packet content
-> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Packet content -> m ()
txlocal Addr -> Packet content -> m ()
txr Maybe Addr
optRouter
    txr :: Addr -> Packet content -> m ()
txr Addr
routerIP Packet content
ip = Interface m i (Addr, Packet content)
-> (Addr, Packet content) -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Interface m i (Addr, Packet content)
link ((Addr, Packet content) -> m ()) -> (Addr, Packet content) -> m ()
forall a b. (a -> b) -> a -> b
$ if (Addr, Addr) -> Addr -> Bool
sameNet (Addr, Addr)
net Addr
destIP
	                            then (Addr
destIP,Packet content
ip)
		 	            else (Addr
routerIP,Packet content
ip)
      where destIP :: Addr
destIP = Packet content -> Addr
forall content. Packet content -> Addr
dest Packet content
ip
    txlocal :: Packet content -> m ()
txlocal Packet content
ip = if (Addr, Addr) -> Addr -> Bool
sameNet (Addr, Addr)
net Addr
destIP
		 then Interface m i (Addr, Packet content)
-> (Addr, Packet content) -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Interface m i (Addr, Packet content)
link (Addr
destIP,Packet content
ip)
		 else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no route, dropping packet
      where destIP :: Addr
destIP = Packet content -> Addr
forall content. Packet content -> Addr
dest Packet content
ip