module Net.Test(module Net.Test,module Net.ClientInterface) where

--import qualified Net.Ethernet as Eth
import qualified Net.IPv4 as IP
import qualified Net.ICMP as ICMP
import qualified Net.ARP_Protocol as ARP
import qualified Net.EthernetClient as EC
import qualified Net.IPv4Client as IC
import Net.IPv4OverEthernet as IPv4oE
import Net.IPv4Link as IPv4Link
import qualified Net.UDP_Client as UC
import qualified Net.TCP_Client as TC
--import Net.Utils
import Net.Packet(listArray)
--import Net.PacketParsing(doUnparse)
import qualified Net.Interface as Net
import Monad.Util(loop)
import qualified Net.DHCP_Client as DHCP(init)
import Net.ClientInterface
import Net.Servers

import Net.Concurrent

initialize :: ([Char] -> m2 ())
-> Config
-> Interface m2 (Packet InPacket) (Packet OutPacket)
-> m2 ((Addr, Maybe Addr, Addr), Net m2)
initialize [Char] -> m2 ()
putStrLn Config
config Interface m2 (Packet InPacket) (Packet OutPacket)
eth =
    do iconfig :: (Addr, Maybe Addr, Addr)
iconfig@(Addr
myIP,Maybe Addr
routerIP,Addr
netmask) <-
	   case Config
config of
	     Config
DHCP -> ([Char] -> m2 ())
-> Interface m2 (Packet InPacket) (Packet OutPacket)
-> m2 (Addr, Maybe Addr, Addr)
forall {m :: * -> *} {r :: * -> *}.
(DelayIO m, ForkIO m, RefIO r m) =>
([Char] -> m ())
-> Interface m (Packet InPacket) (Packet OutPacket)
-> m (Addr, Maybe Addr, Addr)
DHCP.init [Char] -> m2 ()
putStrLn Interface m2 (Packet InPacket) (Packet OutPacket)
eth
	     Fixed Addr
me Addr
router Addr
netmask -> (Addr, Maybe Addr, Addr) -> m2 (Addr, Maybe Addr, Addr)
forall a. a -> m2 a
forall (m :: * -> *) a. Monad m => a -> m a
return (Addr
me,Addr -> Maybe Addr
forall a. a -> Maybe a
Just Addr
router,Addr
netmask)
       EC.Clients {ipv4 :: forall (m :: * -> *). Clients m -> Client m Packet
EC.ipv4=Client m2 Packet
ipv4Eth,arp :: forall (m :: * -> *). Clients m -> Client_ m Packet
EC.arp=Client_ m2 Packet
arpEth} <- ([Char] -> m2 ())
-> Interface m2 (Packet InPacket) (Packet OutPacket)
-> m2 (Clients m2)
forall {v :: * -> *} {m :: * -> *} {c :: * -> *}.
(MVarIO v m, ChannelIO c m, ForkIO m) =>
([Char] -> m ())
-> Interface m (Packet InPacket) (Packet OutPacket)
-> m (Clients m)
EC.initialize [Char] -> m2 ()
putStrLn Interface m2 (Packet InPacket) (Packet OutPacket)
eth
       Interface m2
arp <- ([Char] -> m2 ()) -> Client_ m2 Packet -> Addr -> m2 (Interface m2)
forall {m1 :: * -> *} {c :: * -> *} {m2 :: * -> *} {v :: * -> *}
       {a}.
(DelayIO m1, ForkIO m1, ChannelIO c m1, ChannelIO c m2,
 MVarIO v m1, MVarIO v m2) =>
([Char] -> m1 a)
-> Interface m1 Packet (Packet Packet) -> Addr -> m1 (Interface m2)
ARP.initialize [Char] -> m2 ()
putStrLn Client_ m2 Packet
arpEth Addr
myIP
       --iplink <- link ipv4Eth (ARP.lookup arp)
       Clients m2
ipv4clients <-
	  let ipoe :: Interface m2 (Packet InPacket) (Addr, Packet OutPacket)
ipoe = (Addr -> m2 (Maybe Addr))
-> Client m2 Packet
-> Interface m2 (Packet InPacket) (Addr, Packet OutPacket)
forall {m :: * -> *} {t} {i} {b}.
Monad m =>
(t -> m (Maybe Addr))
-> Interface m i (Packet b) -> Interface m i (t, b)
IPv4oE.initialize (Interface m2 -> Addr -> m2 (Maybe Addr)
forall (m :: * -> *). Interface m -> Addr -> m (Maybe Addr)
ARP.lookup Interface m2
arp) Client m2 Packet
ipv4Eth
              iplink :: Interface m2 (Packet InPacket) (Packet OutPacket)
iplink = (Addr, Addr)
-> Maybe Addr
-> Interface m2 (Packet InPacket) (Addr, Packet OutPacket)
-> Interface m2 (Packet InPacket) (Packet OutPacket)
forall {m :: * -> *} {i} {content}.
Monad m =>
(Addr, Addr)
-> Maybe Addr
-> Interface m i (Addr, Packet content)
-> Interface m i (Packet content)
IPv4Link.initialize (Addr
myIP,Addr
netmask) Maybe Addr
routerIP Interface m2 (Packet InPacket) (Addr, Packet OutPacket)
ipoe
          in ([Char] -> m2 ())
-> Interface m2 (Packet InPacket) (Packet OutPacket)
-> m2 (Clients m2)
forall {v :: * -> *} {m :: * -> *} {c :: * -> *}.
(MVarIO v m, ChannelIO c m, ForkIO m) =>
([Char] -> m ())
-> Interface m (Packet InPacket) (Packet OutPacket)
-> m (Clients m)
IC.initialize [Char] -> m2 ()
putStrLn Interface m2 (Packet InPacket) (Packet OutPacket)
iplink
       let i :: Client_ m2 Packet
i = Clients m2 -> Client_ m2 Packet
forall (m :: * -> *). Clients m -> Client_ m Packet
IC.icmp Clients m2
ipv4clients
       ([Char] -> m2 ()) -> Addr -> Client_ m2 Packet -> m2 ThreadId
forall {io :: * -> *}.
ForkIO io =>
([Char] -> io ())
-> Addr
-> Interface io (Packet Packet) (Packet Packet)
-> io ThreadId
icmpHandler [Char] -> m2 ()
putStrLn Addr
myIP Client_ m2 Packet
i
       Interface m2
udpclient <- ([Char] -> m2 ())
-> Addr
-> Interface
     m2 (Packet (Packet InPacket)) (Packet (Packet OutPacket))
-> m2 (Interface m2)
forall {c :: * -> *} {m :: * -> *} {r :: * -> *} {v :: * -> *}.
(ChannelIO c m, DelayIO m, RefIO r m, Eq (r ()), ForkIO m,
 MVarIO v m) =>
([Char] -> m ())
-> Addr
-> Interface
     m (Packet (Packet InPacket)) (Packet (Packet OutPacket))
-> m (Interface m)
UC.initialize [Char] -> m2 ()
putStrLn Addr
myIP (Clients m2
-> Interface
     m2 (Packet (Packet InPacket)) (Packet (Packet OutPacket))
forall (m :: * -> *). Clients m -> Client m Packet
IC.udp Clients m2
ipv4clients)
       Interface m2
tcpclient <- ([Char] -> m2 ())
-> Addr
-> Interface m2 TCPPacketIn (Packet (Packet OutPacket))
-> m2 (Interface m2)
forall {io :: * -> *} {c :: * -> *} {v :: * -> *}.
(ChannelIO c io, ForkIO io, DelayIO io, MVarIO v io) =>
([Char] -> io ())
-> Addr
-> Interface io TCPPacketIn (Packet (Packet OutPacket))
-> io (Interface io)
TC.initialize [Char] -> m2 ()
putStrLn Addr
myIP (Clients m2 -> Interface m2 TCPPacketIn (Packet (Packet OutPacket))
forall (m :: * -> *). Clients m -> Client m Packet
IC.tcp Clients m2
ipv4clients)
       let net :: Net m2
net = Net { ping :: Addr -> Word16 -> Word16 -> m2 ()
ping = (Packet Packet -> m2 ())
-> Addr -> Addr -> Word16 -> Word16 -> m2 ()
forall {t}.
(Packet Packet -> t) -> Addr -> Addr -> Word16 -> Word16 -> t
sendPing (Client_ m2 Packet -> Packet Packet -> m2 ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Client_ m2 Packet
i) Addr
myIP,
		       dump :: m2 CacheDump
dump  = Interface m2 -> m2 CacheDump
forall (m :: * -> *). Interface m -> m CacheDump
ARP.dump Interface m2
arp,
		       udp :: Interface m2
udp  = Interface m2
udpclient,
		       tcp :: Interface m2
tcp  = Interface m2
tcpclient }
       m2 () -> m2 ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m2 () -> m2 ThreadId) -> m2 () -> m2 ThreadId
forall a b. (a -> b) -> a -> b
$ ([Char] -> m2 ()) -> Net m2 -> m2 ()
forall {m :: * -> *} {a} {b}.
Monad m =>
([Char] -> m a) -> Net m -> m b
udpEchoServer [Char] -> m2 ()
putStrLn Net m2
net
       m2 () -> m2 ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (m2 () -> m2 ThreadId) -> m2 () -> m2 ThreadId
forall a b. (a -> b) -> a -> b
$ ([Char] -> m2 ()) -> Net m2 -> m2 ()
forall {m :: * -> *} {a} {b}.
ForkIO m =>
([Char] -> m a) -> Net m -> m b
tcpEchoServer [Char] -> m2 ()
putStrLn Net m2
net
       ((Addr, Maybe Addr, Addr), Net m2)
-> m2 ((Addr, Maybe Addr, Addr), Net m2)
forall a. a -> m2 a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Addr, Maybe Addr, Addr)
iconfig,Net m2
net)

{-
ignore putStrLn iface =
    fork $ loop $ callback =<< Net.rx iface
  where
    callback ipPack =
      putStrLn $ "Ignored a packet: "++show ipPack
-}
icmpHandler :: ([Char] -> io ())
-> Addr
-> Interface io (Packet Packet) (Packet Packet)
-> io ThreadId
icmpHandler [Char] -> io ()
putStrLn Addr
myIP Interface io (Packet Packet) (Packet Packet)
iface =
    io () -> io ThreadId
forall (io :: * -> *). ForkIO io => io () -> io ThreadId
fork (io () -> io ThreadId) -> io () -> io ThreadId
forall a b. (a -> b) -> a -> b
$ io () -> io ()
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b
loop (io () -> io ()) -> io () -> io ()
forall a b. (a -> b) -> a -> b
$ Packet Packet -> io ()
icmpCallback (Packet Packet -> io ()) -> io (Packet Packet) -> io ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Interface io (Packet Packet) (Packet Packet) -> io (Packet Packet)
forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx Interface io (Packet Packet) (Packet Packet)
iface
  where
    txIP :: Packet Packet -> io ()
txIP = Interface io (Packet Packet) (Packet Packet)
-> Packet Packet -> io ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx Interface io (Packet Packet) (Packet Packet)
iface
    icmpCallback :: Packet Packet -> io ()
icmpCallback Packet Packet
ipPack =
      let icmpPack :: Packet
icmpPack = Packet Packet -> Packet
forall content. Packet content -> content
IP.content Packet Packet
ipPack in
      case Packet
icmpPack of
	ICMP.EchoRequest EchoMsg
echoMsg ->
            do [Char] -> io ()
putStrLn ([Char] -> io ()) -> [Char] -> io ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Replying to ping from "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
srcIP
	       Packet Packet -> io ()
txIP Packet Packet
ipRep
	  where
	    icmpRep :: Packet
icmpRep = EchoMsg -> Packet
ICMP.EchoReply EchoMsg
echoMsg
	    srcIP :: Addr
srcIP   = Packet Packet -> Addr
forall content. Packet content -> Addr
IP.source Packet Packet
ipPack
	    ipRep :: Packet Packet
ipRep   = Packet Packet
ipPack
			{ IP.source  = myIP
			, IP.dest    = srcIP
			, IP.content = icmpRep
			}
	Packet
_  -> -- forward ping reply to ping client!
	      [Char] -> io ()
putStrLn ((Addr, Packet) -> [Char]
forall a. Show a => a -> [Char]
show (Packet Packet -> Addr
forall content. Packet content -> Addr
IP.source Packet Packet
ipPack,Packet
icmpPack))

sendPing :: (Packet Packet -> t) -> Addr -> Addr -> Word16 -> Word16 -> t
sendPing Packet Packet -> t
txIP Addr
myIP Addr
dstIP Word16
unique Word16
n = Packet Packet -> t
txIP Packet Packet
p
  where
    p :: Packet Packet
p = Protocol -> Addr -> Addr -> Packet -> Packet Packet
forall {content}.
Protocol -> Addr -> Addr -> content -> Packet content
IP.template Protocol
IP.ICMP Addr
myIP Addr
dstIP Packet
icmpReq
    icmpReq :: Packet
icmpReq = EchoMsg -> Packet
ICMP.EchoRequest
	      ICMP.Echo { ident :: Word16
ICMP.ident    = Word16
unique
                        , seqNum :: Word16
ICMP.seqNum   = Word16
n
                        , echoData :: UArray Int Word8
ICMP.echoData = (Int, Int) -> [Word8] -> UArray Int Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
5) [Word8
0..Word8
5]
                        }