NetworkStack.hs

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

module Hans.NetworkStack (
    module Hans.NetworkStack

    -- * Re-exported Types
  , UdpPort
  , TcpPort

    -- * DNS
  , Dns.HostName
  , Dns.HostEntry(..)

    -- * Sockets
  , Tcp.Socket()

    -- ** Socket Functions
  , Tcp.sockRemoteHost
  , Tcp.sockRemotePort
  , Tcp.sockLocalPort
  , Tcp.accept
  , Tcp.close
  , Tcp.sendBytes
  , Tcp.recvBytes

    -- ** Socket Exceptions
  , 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


-- Generic Network Stack -------------------------------------------------------

-- | An example implementation of the whole network stack.
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



-- Ethernet Layer Interface ----------------------------------------------------

class HasEthernet stack where
  ethernetHandle :: stack -> Eth.EthernetHandle

-- | Start the ethernet layer in a network stack.
startEthernetLayer :: HasEthernet stack => stack -> IO ()
startEthernetLayer stack =
  Eth.runEthernetLayer (ethernetHandle stack)

-- | Add an ethernet device to the ethernet layer.
addDevice :: HasEthernet stack => stack -> Mac -> Eth.Tx -> Eth.Rx -> IO ()
addDevice stack = Eth.addEthernetDevice (ethernetHandle stack)

-- | Remove a device from the ethernet layer.
removeDevice :: HasEthernet stack => stack -> Mac -> IO ()
removeDevice stack = Eth.removeEthernetDevice (ethernetHandle stack)

-- | Bring an ethernet device in the ethernet layer up.
deviceUp :: HasEthernet stack => stack -> Mac -> IO ()
deviceUp stack = Eth.startEthernetDevice (ethernetHandle stack)

-- | Bring an ethernet device in the ethernet layer down.
deviceDown :: HasEthernet stack => stack -> Mac -> IO ()
deviceDown stack = Eth.stopEthernetDevice (ethernetHandle stack)


-- Arp Layer Interface ---------------------------------------------------------

class HasArp stack where
  arpHandle :: stack -> Arp.ArpHandle

-- | Start the arp layer in a network stack.
startArpLayer :: (HasEthernet stack, HasArp stack) => stack -> IO ()
startArpLayer stack =
  Arp.runArpLayer (arpHandle stack) (ethernetHandle stack)


-- Icmp4 Layer Interface -------------------------------------------------------

class HasIcmp4 stack where
  icmp4Handle :: stack -> Icmp4.Icmp4Handle

-- | Start the icmp4 layer in a network stack..
startIcmp4Layer :: (HasIcmp4 stack, HasIP4 stack) => stack -> IO ()
startIcmp4Layer stack =
  Icmp4.runIcmp4Layer (icmp4Handle stack) (ip4Handle stack)


-- IP4 Layer Interface ---------------------------------------------------------

class HasIP4 stack where
  ip4Handle :: stack -> IP4.IP4Handle

-- | Start the IP4 layer in a network stack.
startIP4Layer :: (HasArp stack, HasEthernet stack, HasIP4 stack)
              => stack -> IO ()
startIP4Layer stack =
  IP4.runIP4Layer (ip4Handle stack) (arpHandle stack) (ethernetHandle stack)

type Mtu = Int

-- | Add an IP4 address to a network stack.
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)

-- | Add a route for a network, via an address.
routeVia :: HasIP4 stack => stack -> IP4Mask -> IP4 -> IO ()
routeVia stack mask addr =
  IP4.addIP4RoutingRule (ip4Handle stack) (IP4.Indirect mask addr)

-- | Register a handler for an IP4 protocol
listenIP4Protocol :: HasIP4 stack
                  => stack -> IP4Protocol -> IP4.Handler -> IO ()
listenIP4Protocol stack = IP4.addIP4Handler (ip4Handle stack)

-- | Register a handler for an IP4 protocol
ignoreIP4Protocol :: HasIP4 stack => stack -> IP4Protocol -> IO ()
ignoreIP4Protocol stack = IP4.removeIP4Handler (ip4Handle stack)


-- Udp Layer Interface ---------------------------------------------------------

class HasUdp stack where
  udpHandle :: stack -> Udp.UdpHandle

-- | Start the UDP layer of a network stack.
startUdpLayer :: (HasIP4 stack, HasIcmp4 stack, HasUdp stack) => stack -> IO ()
startUdpLayer stack =
  Udp.runUdpLayer (udpHandle stack) (ip4Handle stack) (icmp4Handle stack)

-- | Add a handler for a UDP port.
addUdpHandler :: HasUdp stack => stack -> UdpPort -> Udp.Handler -> IO ()
addUdpHandler stack = Udp.addUdpHandler (udpHandle stack)

-- | Remove a handler for a UDP port.
removeUdpHandler :: HasUdp stack => stack -> UdpPort -> IO ()
removeUdpHandler stack = Udp.removeUdpHandler (udpHandle stack)

-- | Inject a packet into the UDP layer.
queueUdp :: HasUdp stack => stack -> IP4Header -> S.ByteString -> IO ()
queueUdp stack = Udp.queueUdp (udpHandle stack)

-- | Send a UDP packet.
sendUdp :: HasUdp stack
        => stack -> IP4 -> Maybe UdpPort -> UdpPort -> L.ByteString -> IO ()
sendUdp stack = Udp.sendUdp (udpHandle stack)


-- Tcp Layer Interface ---------------------------------------------------------

class HasIP4 stack => HasTcp stack where
  tcpHandle :: stack -> Tcp.TcpHandle

-- | Start the TCP layer of a network stack.
startTcpLayer :: HasTcp stack => stack -> IO ()
startTcpLayer stack =
  Tcp.runTcpLayer (tcpHandle stack) (ip4Handle stack)

-- | Listen for incoming connections.
listen :: HasTcp stack => stack -> IP4 -> TcpPort -> IO Tcp.Socket
listen stack = Tcp.listen (tcpHandle stack)

-- | Make a remote connection.
connect :: HasTcp stack => stack -> IP4 -> TcpPort -> Maybe TcpPort -> IO Tcp.Socket
connect stack = Tcp.connect (tcpHandle stack)


-- Dns Layer Interface ---------------------------------------------------------

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)