module Hans.NetworkStack (
module Hans.NetworkStack
, UdpPort
, TcpPort
, Dns.HostName
, Dns.HostEntry(..)
, Tcp.Socket()
, Tcp.sockRemoteHost
, Tcp.sockRemotePort
, Tcp.sockLocalPort
, Tcp.accept
, Tcp.close
, Tcp.sendBytes
, Tcp.recvBytes
, Tcp.AcceptError(..)
, Tcp.CloseError(..)
, Tcp.ConnectError(..)
, Tcp.ListenError(..)
) where
import Hans.Address (getMaskComponents)
import Hans.Address.IP4 (IP4Mask,IP4)
import Hans.Address.Mac (Mac)
import Hans.Channel (newChannel)
import Hans.Message.Ip4 (IP4Protocol,IP4Header)
import Hans.Message.Tcp (TcpPort)
import Hans.Message.Udp (UdpPort)
import qualified Hans.Layer.Arp as Arp
import qualified Hans.Layer.Ethernet as Eth
import qualified Hans.Layer.Dns as Dns
import qualified Hans.Layer.Icmp4 as Icmp4
import qualified Hans.Layer.IP4 as IP4
import qualified Hans.Layer.Tcp as Tcp
import qualified Hans.Layer.Tcp.Socket as Tcp
import qualified Hans.Layer.Udp as Udp
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
data NetworkStack = NetworkStack
{ nsArp :: Arp.ArpHandle
, nsEthernet :: Eth.EthernetHandle
, nsIp4 :: IP4.IP4Handle
, nsIcmp4 :: Icmp4.Icmp4Handle
, nsUdp :: Udp.UdpHandle
, nsTcp :: Tcp.TcpHandle
, nsDns :: Dns.DnsHandle
}
instance HasArp NetworkStack where arpHandle = nsArp
instance HasEthernet NetworkStack where ethernetHandle = nsEthernet
instance HasIP4 NetworkStack where ip4Handle = nsIp4
instance HasIcmp4 NetworkStack where icmp4Handle = nsIcmp4
instance HasTcp NetworkStack where tcpHandle = nsTcp
instance HasUdp NetworkStack where udpHandle = nsUdp
instance HasDns NetworkStack where dnsHandle = nsDns
newNetworkStack :: IO NetworkStack
newNetworkStack = do
nsEthernet <- newChannel
nsArp <- newChannel
nsIp4 <- newChannel
nsIcmp4 <- newChannel
nsUdp <- newChannel
nsTcp <- newChannel
nsDns <- newChannel
let ns = NetworkStack { .. }
startEthernetLayer ns
startArpLayer ns
startIcmp4Layer ns
startIP4Layer ns
startUdpLayer ns
startTcpLayer ns
startDnsLayer ns
return ns
class HasEthernet stack where
ethernetHandle :: stack -> Eth.EthernetHandle
startEthernetLayer :: HasEthernet stack => stack -> IO ()
startEthernetLayer stack =
Eth.runEthernetLayer (ethernetHandle stack)
addDevice :: HasEthernet stack => stack -> Mac -> Eth.Tx -> Eth.Rx -> IO ()
addDevice stack = Eth.addEthernetDevice (ethernetHandle stack)
removeDevice :: HasEthernet stack => stack -> Mac -> IO ()
removeDevice stack = Eth.removeEthernetDevice (ethernetHandle stack)
deviceUp :: HasEthernet stack => stack -> Mac -> IO ()
deviceUp stack = Eth.startEthernetDevice (ethernetHandle stack)
deviceDown :: HasEthernet stack => stack -> Mac -> IO ()
deviceDown stack = Eth.stopEthernetDevice (ethernetHandle stack)
class HasArp stack where
arpHandle :: stack -> Arp.ArpHandle
startArpLayer :: (HasEthernet stack, HasArp stack) => stack -> IO ()
startArpLayer stack =
Arp.runArpLayer (arpHandle stack) (ethernetHandle stack)
class HasIcmp4 stack where
icmp4Handle :: stack -> Icmp4.Icmp4Handle
startIcmp4Layer :: (HasIcmp4 stack, HasIP4 stack) => stack -> IO ()
startIcmp4Layer stack =
Icmp4.runIcmp4Layer (icmp4Handle stack) (ip4Handle stack)
class HasIP4 stack where
ip4Handle :: stack -> IP4.IP4Handle
startIP4Layer :: (HasArp stack, HasEthernet stack, HasIP4 stack)
=> stack -> IO ()
startIP4Layer stack =
IP4.runIP4Layer (ip4Handle stack) (arpHandle stack) (ethernetHandle stack)
type Mtu = Int
addIP4Addr :: (HasArp stack, HasIP4 stack)
=> stack -> IP4Mask -> Mac -> Mtu -> IO ()
addIP4Addr stack mask mac mtu = do
let (addr,_) = getMaskComponents mask
Arp.addLocalAddress (arpHandle stack) addr mac
IP4.addIP4RoutingRule (ip4Handle stack) (IP4.Direct mask addr mtu)
routeVia :: HasIP4 stack => stack -> IP4Mask -> IP4 -> IO ()
routeVia stack mask addr =
IP4.addIP4RoutingRule (ip4Handle stack) (IP4.Indirect mask addr)
listenIP4Protocol :: HasIP4 stack
=> stack -> IP4Protocol -> IP4.Handler -> IO ()
listenIP4Protocol stack = IP4.addIP4Handler (ip4Handle stack)
ignoreIP4Protocol :: HasIP4 stack => stack -> IP4Protocol -> IO ()
ignoreIP4Protocol stack = IP4.removeIP4Handler (ip4Handle stack)
class HasUdp stack where
udpHandle :: stack -> Udp.UdpHandle
startUdpLayer :: (HasIP4 stack, HasIcmp4 stack, HasUdp stack) => stack -> IO ()
startUdpLayer stack =
Udp.runUdpLayer (udpHandle stack) (ip4Handle stack) (icmp4Handle stack)
addUdpHandler :: HasUdp stack => stack -> UdpPort -> Udp.Handler -> IO ()
addUdpHandler stack = Udp.addUdpHandler (udpHandle stack)
removeUdpHandler :: HasUdp stack => stack -> UdpPort -> IO ()
removeUdpHandler stack = Udp.removeUdpHandler (udpHandle stack)
queueUdp :: HasUdp stack => stack -> IP4Header -> S.ByteString -> IO ()
queueUdp stack = Udp.queueUdp (udpHandle stack)
sendUdp :: HasUdp stack
=> stack -> IP4 -> Maybe UdpPort -> UdpPort -> L.ByteString -> IO ()
sendUdp stack = Udp.sendUdp (udpHandle stack)
class HasIP4 stack => HasTcp stack where
tcpHandle :: stack -> Tcp.TcpHandle
startTcpLayer :: HasTcp stack => stack -> IO ()
startTcpLayer stack =
Tcp.runTcpLayer (tcpHandle stack) (ip4Handle stack)
listen :: HasTcp stack => stack -> IP4 -> TcpPort -> IO Tcp.Socket
listen stack = Tcp.listen (tcpHandle stack)
connect :: HasTcp stack => stack -> IP4 -> TcpPort -> Maybe TcpPort -> IO Tcp.Socket
connect stack = Tcp.connect (tcpHandle stack)
class HasUdp stack => HasDns stack where
dnsHandle :: stack -> Dns.DnsHandle
startDnsLayer :: HasDns stack => stack -> IO ()
startDnsLayer stack =
Dns.runDnsLayer (dnsHandle stack) (udpHandle stack)
addNameServer :: HasDns stack => stack -> IP4 -> IO ()
addNameServer stack = Dns.addNameServer (dnsHandle stack)
removeNameServer :: HasDns stack => stack -> IP4 -> IO ()
removeNameServer stack = Dns.removeNameServer (dnsHandle stack)
getHostByName :: HasDns stack => stack -> Dns.HostName -> IO Dns.HostEntry
getHostByName stack = Dns.getHostByName (dnsHandle stack)
getHostByAddr :: HasDns stack => stack -> IP4 -> IO Dns.HostEntry
getHostByAddr stack = Dns.getHostByAddr (dnsHandle stack)