module Net.EthernetClient where

import Net.Concurrent(fork)
import Net.Ethernet as Eth(Interface(..),Packet,PacketType(..),rx,tx,packType,content)
import qualified Net.IPv4 as IPv4(Packet)
import qualified Net.ARP as ARP(Packet)
import Net.PacketParsing
import Net.Wire
import qualified Net.Interface as Net
import Monad.Util(loop)

type Client_ m p = Eth.Interface m p (Packet p)
type Client m p = Eth.Interface m (p InPacket) (Packet (p OutPacket))

data Clients m
    = Clients {
--        ethernet,
--        unknown   :: Client m Packet,
        forall (m :: * -> *). Clients m -> Client m Packet
ipv4      :: Client m IPv4.Packet,
--      ipv6      :: Client m IPv6.Packet,
	forall (m :: * -> *). Clients m -> Client_ m Packet
arp       :: Client_ m ARP.Packet
      }

initialize :: ([Char] -> m ())
-> Interface m (Packet InPacket) (Packet OutPacket)
-> m (Clients m)
initialize [Char] -> m ()
debug Interface m (Packet InPacket) (Packet OutPacket)
eth =
  do Net.Interface{rx :: forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx=m (Packet InPacket)
rxIPv4,tx :: forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx=Packet InPacket -> m ()
toIPv4} <- () -> m (Interface m (Packet InPacket) (Packet InPacket))
forall {v :: * -> *} {m1 :: * -> *} {m2 :: * -> *} {c :: * -> *}
       {o}.
(MVarIO v m1, MVarIO v m2, ChannelIO c m1, ChannelIO c m2) =>
() -> m1 (Interface m2 o o)
newWire()
     Net.Interface{rx :: forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx=m Packet
rxARP,tx :: forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx=Packet -> m ()
toARP}   <- () -> m (Interface m Packet Packet)
forall {v :: * -> *} {m1 :: * -> *} {m2 :: * -> *} {c :: * -> *}
       {o}.
(MVarIO v m1, MVarIO v m2, ChannelIO c m1, ChannelIO c m2) =>
() -> m1 (Interface m2 o o)
newWire()
     let demultiplex :: m ()
demultiplex =
	   do Packet InPacket
p <- Interface m (Packet InPacket) (Packet OutPacket)
-> m (Packet InPacket)
forall {m :: * -> *} {i} {o}. Interface m i o -> m i
rx Interface m (Packet InPacket) (Packet OutPacket)
eth
	      let t :: PacketType
t = Packet InPacket -> PacketType
forall content. Packet content -> PacketType
packType Packet InPacket
p
		  conv :: (a -> m ()) -> m ()
conv a -> m ()
dest = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
warning a -> m ()
dest (InPacket -> Maybe a
forall {a}. Parse a => InPacket -> Maybe a
doParse (Packet InPacket -> InPacket
forall content. Packet content -> content
content Packet InPacket
p))
		  warning :: m ()
warning = [Char] -> m ()
debug (PacketType -> [Char]
forall a. Show a => a -> [Char]
show PacketType
t[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" packet parser failed "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Packet InPacket -> [Char]
forall a. Show a => a -> [Char]
show Packet InPacket
p)
	      --debug (show t++" received")
	      case PacketType
t of
		--Ethernet n -> to' ethernet
		PacketType
IPv4       -> (Packet InPacket -> m ()) -> m ()
forall {a}. Parse a => (a -> m ()) -> m ()
conv Packet InPacket -> m ()
toIPv4
		--IPv6       -> return () -- not implemented yet
		PacketType
ARP        -> (Packet -> m ()) -> m ()
forall {a}. Parse a => (a -> m ()) -> m ()
conv Packet -> m ()
toARP
		--Unknown n  -> to' unknown
		PacketType
_ -> [Char] -> m ()
debug ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ PacketType -> [Char]
forall a. Show a => a -> [Char]
show PacketType
t[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" packet dropped"
         --client :: IO (...) -> Net.IOInterface ... ...
	 client :: m i -> Interface m i (Packet a)
client m i
rx = Interface m (Packet InPacket) (Packet OutPacket)
eth {io=io}
           where
	     io :: Interface m i (Packet a)
io = Net.Interface {rx :: m i
Net.rx=m i
rx,
				 tx :: Packet a -> m ()
Net.tx=Interface m (Packet InPacket) (Packet OutPacket)
-> Packet OutPacket -> m ()
forall {m :: * -> *} {i} {o}. Interface m i o -> o -> m ()
tx Interface m (Packet InPacket) (Packet OutPacket)
eth (Packet OutPacket -> m ())
-> (Packet a -> Packet OutPacket) -> Packet a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> OutPacket) -> Packet a -> Packet OutPacket
forall a b. (a -> b) -> Packet a -> Packet b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> OutPacket
forall {a}. Unparse a => a -> OutPacket
doUnparse}
     m () -> m ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ m () -> m ()
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b
loop m ()
demultiplex
     Clients m -> m (Clients m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Clients {ipv4 :: Client m Packet
ipv4 =m (Packet InPacket) -> Client m Packet
forall {a} {i}. Unparse a => m i -> Interface m i (Packet a)
client m (Packet InPacket)
rxIPv4, arp :: Client_ m Packet
arp=m Packet -> Client_ m Packet
forall {a} {i}. Unparse a => m i -> Interface m i (Packet a)
client m Packet
rxARP}
     --return (client rxIPv4,client rxARP)