module Data.TCP
( TCPPort
, TCPHeader (..)
) where
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.CSum
import Data.Bits
import Data.List
newtype TCPPort = TCPPort Word16 deriving (Eq, Ord, Show, Read, Num, Bounded)
instance Binary TCPPort where
put (TCPPort p) = putWord16be p
get = getWord16be >>= return . TCPPort
newtype SeqNumber = SN Word32 deriving (Eq, Ord, Show, Read, Num, Bounded)
newtype AckNumber = AN Word32 deriving (Eq, Ord, Show, Read, Num, Bounded)
instance Binary SeqNumber where
put (SN n) = putWord32be n
get = getWord32be >>= return . SN
instance Binary AckNumber where
put (AN n) = putWord32be n
get = getWord32be >>= return . AN
data TCPFlag = FIN | SYN | RST | PSH | ACK | URG | ECE | CWR deriving (Eq, Ord, Show, Enum)
instance Enum [TCPFlag] where
fromEnum fs = foldl' (+) 0 $ map (bit . fromEnum) fs
toEnum i = map (toEnum . snd) . filter fst . flip zip [0..7] . map (testBit i) $ [0..7]
data TCPHeader =
TCPHdr { srcPort :: TCPPort
, dstPort :: TCPPort
, seqNumber :: SeqNumber
, ackNumber :: AckNumber
, dataOffset :: Int
, res :: Int
, flags :: [TCPFlag]
, windowSize :: Int
, checksum :: CSum
, urgentPtr :: Int
} deriving (Eq, Ord, Show)
instance Binary TCPHeader where
put (TCPHdr s d seq ack dat res fs w c u) = do
put s
put d
put seq
put ack
let datRes = ((dat .&. 0xF) `shiftL` 4) .|. (res .&. 0xF)
put datRes
put (fromEnum fs)
putWord16be (fromIntegral w .&. 0xFFFF)
put c
putWord16be (fromIntegral u .&. 0xFFFF)
get = do
s <- get
d <- get
seq <- get
ack <- get
datRes <- get
let dat = (datRes `shiftR` 4) .&. 0xF
res = datRes .&. 0xF
fs <- get >>= return . toEnum
w <- getWord16be >>= return . fromIntegral
c <- get
u <- getWord16be >>= return . fromIntegral
return $ TCPHdr s d seq ack dat res fs w c u