module Net.IPv4Client where

import Net.Concurrent

import Net.IPv4
--import qualified Net.Ethernet as Eth
import qualified Net.UDP  as UDP(Packet)
import qualified Net.TCP  as TCP(Packet)
import qualified Net.ICMP as ICMP(Packet)
--import Net.Packet(loopback)
import Net.PacketParsing(InPacket,OutPacket,doParse,doUnparse)
import Net.Interface as Net
import Net.Wire
import Net.Utils(emap)
import Monad.Util(loop)

type Client m p = Client' m (p InPacket) (p OutPacket)
type Client_ m p =  Client' m p p
type Client' m i o = Net.Interface m (Packet i) (Packet o)

data Clients m
    = Clients {
        forall (m :: * -> *). Clients m -> Client_ m Packet
icmp     :: Client_ m ICMP.Packet,
        forall (m :: * -> *). Clients m -> Client m Packet
udp      :: Client m UDP.Packet,
        forall (m :: * -> *). Clients m -> Client m Packet
tcp      :: Client m TCP.Packet{-,
        unknown  :: Client' m InPacket OutPacket-}
      }

initialize :: ([Char] -> m ())
-> Interface m (Packet InPacket) (Packet OutPacket)
-> m (Clients m)
initialize [Char] -> m ()
debug Interface m (Packet InPacket) (Packet OutPacket)
link =
  do Interface{rx :: forall (m :: * -> *) i o. Interface m i o -> m i
rx=m (Packet Packet)
rxICMP,tx :: forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx=Packet Packet -> m ()
toICMP} <- () -> m (Interface m (Packet Packet) (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()
     Interface{rx :: forall (m :: * -> *) i o. Interface m i o -> m i
rx=m (Packet (Packet InPacket))
rxUDP, tx :: forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx=Packet (Packet InPacket) -> m ()
toUDP}  <- ()
-> m (Interface
        m (Packet (Packet InPacket)) (Packet (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()
     Interface{rx :: forall (m :: * -> *) i o. Interface m i o -> m i
rx=m (Packet (Packet InPacket))
rxTCP, tx :: forall (m :: * -> *) i o. Interface m i o -> o -> m ()
tx=Packet (Packet InPacket) -> m ()
toTCP}  <- ()
-> m (Interface
        m (Packet (Packet InPacket)) (Packet (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()
     let rx :: m ()
rx = do Packet InPacket
ip <- Interface m (Packet InPacket) (Packet OutPacket)
-> m (Packet InPacket)
forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx Interface m (Packet InPacket) (Packet OutPacket)
link
                 let t :: Protocol
t = Packet InPacket -> Protocol
forall content. Packet content -> Protocol
protocol Packet InPacket
ip
		     conv :: (Packet a -> m ()) -> m ()
conv Packet a -> m ()
to = m () -> (Packet a -> m ()) -> Maybe (Packet a) -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
warning Packet a -> m ()
to ((InPacket -> Maybe a) -> Packet InPacket -> Maybe (Packet a)
forall {f1 :: * -> *} {f2 :: * -> *} {t} {a}.
(Functor f1, Container f2) =>
(t -> f1 a) -> f2 t -> f1 (f2 a)
emap InPacket -> Maybe a
forall {a}. Parse a => InPacket -> Maybe a
doParse Packet InPacket
ip)
		     warning :: m ()
warning = [Char] -> m ()
debug (Protocol -> [Char]
forall a. Show a => a -> [Char]
show Protocol
t[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" packet parser failed")
		 --debug (show t++" received")
		 case Protocol
t of
		   Protocol
ICMP       -> (Packet Packet -> m ()) -> m ()
forall {a}. Parse a => (Packet a -> m ()) -> m ()
conv Packet Packet -> m ()
toICMP
		   Protocol
UDP        -> (Packet (Packet InPacket) -> m ()) -> m ()
forall {a}. Parse a => (Packet a -> m ()) -> m ()
conv Packet (Packet InPacket) -> m ()
toUDP
		   Protocol
TCP        -> (Packet (Packet InPacket) -> m ()) -> m ()
forall {a}. Parse a => (Packet a -> m ()) -> m ()
conv Packet (Packet InPacket) -> m ()
toTCP
--		   Unknown n  -> to unknown
		   Protocol
_ -> [Char] -> m ()
debug (Protocol -> [Char]
forall a. Show a => a -> [Char]
show Protocol
t[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" packet dropped")
     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 ()
rx
     let client :: m i -> Interface m i (Packet a)
client m i
rx = m i -> (Packet a -> m ()) -> Interface m i (Packet a)
forall (m :: * -> *) i o. m i -> (o -> m ()) -> Interface m i o
Interface m i
rx (Interface m (Packet InPacket) (Packet OutPacket)
-> Packet OutPacket -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Interface m (Packet InPacket) (Packet OutPacket)
link (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)
     Clients m -> m (Clients m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Clients { icmp :: Interface m (Packet Packet) (Packet Packet)
icmp = m (Packet Packet) -> Interface m (Packet Packet) (Packet Packet)
forall {a} {i}. Unparse a => m i -> Interface m i (Packet a)
client m (Packet Packet)
rxICMP,
		      udp :: Client m Packet
udp = m (Packet (Packet InPacket)) -> Client m Packet
forall {a} {i}. Unparse a => m i -> Interface m i (Packet a)
client m (Packet (Packet InPacket))
rxUDP,
		      tcp :: Client m Packet
tcp = m (Packet (Packet InPacket)) -> Client m Packet
forall {a} {i}. Unparse a => m i -> Interface m i (Packet a)
client m (Packet (Packet InPacket))
rxTCP }
--     return (client rxICMP)