Handlers.hs

module Hans.Layer.Tcp.Handlers (
    handleIncomingTcp
  , handleOutgoing
  ) where

import Hans.Address.IP4 (IP4,convertFromWord32)
import Hans.Channel (send)
import Hans.Layer (output,liftRight)
import Hans.Layer.IP4 (sendIP4Packet,withIP4Source)
import Hans.Layer.Tcp.Monad
    (Tcp,TcpState(..),ip4Handle,ip4Handle,ip4Handle,ip4Handle)
import Hans.Layer.Timer (udelay)
import Hans.Message.Tcp
    (tcpProtocol,renderWithTcpChecksumIP4,TcpPacket(..),getTcpPacket
    ,recreateTcpChecksumIP4,TcpHeader(..))

import Network.TCP.LTS.In (tcp_deliver_in_packet)
import Network.TCP.Type.Base (get_ip,bufferchain_collapse,IPAddr(..))
import Network.TCP.Type.Datagram
    (ICMPDatagram(..),UDPDatagram(..),TCPSegment(..),IPMessage(..)
    ,mkTCPSegment)
import Network.TCP.Type.Socket (Host(..))

import Control.Monad (unless,guard)
import Data.Serialize (runGet)
import MonadLib (get,set)
import qualified Data.ByteString as S


-- | Handle a TCP message from the IP4 layer.
handleIncomingTcp :: IP4 -> IP4 -> S.ByteString -> Tcp ()
handleIncomingTcp src dst bytes = do
  let cs = recreateTcpChecksumIP4 src dst bytes
  pkt@(TcpPacket hdr _body) <- liftRight (runGet getTcpPacket bytes)
  guard (tcpChecksum hdr == cs)
  tcp_deliver_in_packet (mkTCPSegment src dst pkt)

-- | Force packets out of the pure layer.
handleOutgoing :: Tcp ()
handleOutgoing  = do
  s <- get
  let h = tcpHost s
  set (s { tcpHost = h { output_queue = [], ready_list = [] } })
  let msgs = output_queue h
  unless (null msgs) (mapM_ deliverIPMessage msgs)
  let ready = ready_list h
  unless (null ready) (mapM_ output ready)

deliverIPMessage :: IPMessage -> Tcp ()
deliverIPMessage msg =
  case msg of
    TCPMessage  seg  -> deliverTCPSegment   seg
    ICMPMessage icmp -> deliverICMPDatagram icmp
    UDPMessage  udp  -> deliverUDPDatagram  udp

deliverTCPSegment :: TCPSegment -> Tcp ()
deliverTCPSegment seg = do
  let hdr        = tcp_header seg
      IPAddr dst = get_ip (tcp_dst seg)
      dstAddr    = convertFromWord32 dst
  ip4 <- ip4Handle
  output $ withIP4Source ip4 dstAddr $ \ srcAddr -> do
    body <- bufferchain_collapse (tcp_data seg)
    let pkt = renderWithTcpChecksumIP4 srcAddr dstAddr (TcpPacket hdr body)
    sendIP4Packet ip4 tcpProtocol dstAddr pkt

deliverICMPDatagram :: ICMPDatagram -> Tcp ()
deliverICMPDatagram _icmp = do
  output (putStrLn "Ignoring TCP icmp packet")

deliverUDPDatagram :: UDPDatagram -> Tcp ()
deliverUDPDatagram _udp = do
  output (putStrLn "Ignoring TCP udp packet")