module Net.TCP where

-- Transmission Control Protocol
-- See http://www.networksorcery.com/enp/protocol/tcp.htm
--     http://www.networksorcery.com/enp/rfc/rfc793.txt

import Net.Bits
import Net.PacketParsing
import Net.PortNumber(Port(..))
import Net.Utils(Container(..))

data Packet content = Packet
                    { forall content. Packet content -> Port
sourcePort, forall content. Packet content -> Port
destPort :: !Port,
		      forall content. Packet content -> Word32
seqNr, forall content. Packet content -> Word32
ackNr :: !Word32,
		      forall content. Packet content -> Word8
dataOffset :: !Word8, -- 4 bits
		      -- 3 reserved bits
		      forall content. Packet content -> ECN
ecn :: !ECN, -- 3 bits
		      forall content. Packet content -> ControlBits
controlBits :: !ControlBits, -- 6 bits
		      forall content. Packet content -> Word16
window :: !Word16,
		      forall content. Packet content -> Word16
checksum :: !Word16,
		      forall content. Packet content -> Word16
urgentPointer :: !Word16,
		      forall content. Packet content -> [Word8]
options :: ![Option], -- 0-44 bytes
		      -- padding
		      forall content. Packet content -> content
content :: !content }
		    deriving (Int -> Packet content -> ShowS
[Packet content] -> ShowS
Packet content -> String
(Int -> Packet content -> ShowS)
-> (Packet content -> String)
-> ([Packet content] -> ShowS)
-> Show (Packet content)
forall content. Show content => Int -> Packet content -> ShowS
forall content. Show content => [Packet content] -> ShowS
forall content. Show content => Packet content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall content. Show content => Int -> Packet content -> ShowS
showsPrec :: Int -> Packet content -> ShowS
$cshow :: forall content. Show content => Packet content -> String
show :: Packet content -> String
$cshowList :: forall content. Show content => [Packet content] -> ShowS
showList :: [Packet content] -> ShowS
Show)

template :: Packet ()
template = Port
-> Port
-> Word32
-> Word32
-> Word8
-> ECN
-> ControlBits
-> Word16
-> Word16
-> Word16
-> [Word8]
-> ()
-> Packet ()
forall content.
Port
-> Port
-> Word32
-> Word32
-> Word8
-> ECN
-> ControlBits
-> Word16
-> Word16
-> Word16
-> [Word8]
-> content
-> Packet content
Packet (Word16 -> Port
Port Word16
0) (Word16 -> Port
Port Word16
0) Word32
0 Word32
0 Word8
5  ECN
forall a. Bounded a => a
minBound ControlBits
forall a. Bounded a => a
minBound Word16
1400 Word16
0 Word16
0 [] ()

instance Functor   Packet where fmap :: forall a b. (a -> b) -> Packet a -> Packet b
fmap a -> b
f Packet a
p = Packet a
p{content=f (content p)}
instance Container Packet where contents :: forall content. Packet content -> content
contents = Packet a -> a
forall content. Packet content -> content
content

data ECN = ECN { ECN -> Bool
n,ECN -> Bool
c,ECN -> Bool
e:: !Bool } -- Explicit Congestion Notification, RFC 3168
	 deriving (Int -> ECN -> ShowS
[ECN] -> ShowS
ECN -> String
(Int -> ECN -> ShowS)
-> (ECN -> String) -> ([ECN] -> ShowS) -> Show ECN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ECN -> ShowS
showsPrec :: Int -> ECN -> ShowS
$cshow :: ECN -> String
show :: ECN -> String
$cshowList :: [ECN] -> ShowS
showList :: [ECN] -> ShowS
Show,ECN
ECN -> ECN -> Bounded ECN
forall a. a -> a -> Bounded a
$cminBound :: ECN
minBound :: ECN
$cmaxBound :: ECN
maxBound :: ECN
Bounded)


data ControlBits = CB { ControlBits -> Bool
urg,ControlBits -> Bool
ack,ControlBits -> Bool
psh,ControlBits -> Bool
rst,ControlBits -> Bool
syn,ControlBits -> Bool
fin:: !Bool }
		   deriving (ControlBits -> ControlBits -> Bool
(ControlBits -> ControlBits -> Bool)
-> (ControlBits -> ControlBits -> Bool) -> Eq ControlBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControlBits -> ControlBits -> Bool
== :: ControlBits -> ControlBits -> Bool
$c/= :: ControlBits -> ControlBits -> Bool
/= :: ControlBits -> ControlBits -> Bool
Eq,ControlBits
ControlBits -> ControlBits -> Bounded ControlBits
forall a. a -> a -> Bounded a
$cminBound :: ControlBits
minBound :: ControlBits
$cmaxBound :: ControlBits
maxBound :: ControlBits
Bounded,Int -> ControlBits -> ShowS
[ControlBits] -> ShowS
ControlBits -> String
(Int -> ControlBits -> ShowS)
-> (ControlBits -> String)
-> ([ControlBits] -> ShowS)
-> Show ControlBits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControlBits -> ShowS
showsPrec :: Int -> ControlBits -> ShowS
$cshow :: ControlBits -> String
show :: ControlBits -> String
$cshowList :: [ControlBits] -> ShowS
showList :: [ControlBits] -> ShowS
Show)

type Option = Word8 -- not implemented yet

instance Parse content => Parse (Packet content) where
  parse :: PacketParser (Packet content)
parse = do (Port
sp,Port
dp,Word32
sqn,Word32
ackn) <- PacketParser (Port, Port, Word32, Word32)
forall a. Parse a => PacketParser a
parse
	     Word8
hl <- Int -> PacketParser Word8
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
4
	     Int -> PacketParser Word32
skip Int
3
	     let olen :: Word8
olen = (Word8
hlWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
5)Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
*Word8
4
             Port
-> Port
-> Word32
-> Word32
-> Word8
-> ECN
-> ControlBits
-> Word16
-> Word16
-> Word16
-> [Word8]
-> content
-> Packet content
forall content.
Port
-> Port
-> Word32
-> Word32
-> Word8
-> ECN
-> ControlBits
-> Word16
-> Word16
-> Word16
-> [Word8]
-> content
-> Packet content
Packet Port
sp Port
dp Word32
sqn Word32
ackn Word8
hl
		    # parse
		   PacketParser
  (ControlBits
   -> Word16
   -> Word16
   -> Word16
   -> [Word8]
   -> content
   -> Packet content)
-> PacketParser ControlBits
-> PacketParser
     (Word16
      -> Word16 -> Word16 -> [Word8] -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser ControlBits
forall a. Parse a => PacketParser a
parse
		   PacketParser
  (Word16
   -> Word16 -> Word16 -> [Word8] -> content -> Packet content)
-> PacketParser Word16
-> PacketParser
     (Word16 -> Word16 -> [Word8] -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse
		   PacketParser
  (Word16 -> Word16 -> [Word8] -> content -> Packet content)
-> PacketParser Word16
-> PacketParser (Word16 -> [Word8] -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse
		   PacketParser (Word16 -> [Word8] -> content -> Packet content)
-> PacketParser Word16
-> PacketParser ([Word8] -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse
		   PacketParser ([Word8] -> content -> Packet content)
-> PacketParser [Word8] -> PacketParser (content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# Word8 -> PacketParser [Word8]
forall {t}. (Eq t, Num t) => t -> PacketParser [Word8]
bytes Word8
olen
		   PacketParser (content -> Packet content)
-> PacketParser content -> PacketParser (Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser content
forall a. Parse a => PacketParser a
parse
    where
      skip :: Int -> PacketParser Word32
      skip :: Int -> PacketParser Word32
skip = Int -> PacketParser Word32
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits

instance Parse ControlBits where
  parse :: PacketParser ControlBits
parse = Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ControlBits
CB (Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> ControlBits)
-> PacketParser Bool
-> PacketParser
     (Bool -> Bool -> Bool -> Bool -> Bool -> ControlBits)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> Bool -> Bool -> Bool -> ControlBits)
-> PacketParser Bool
-> PacketParser (Bool -> Bool -> Bool -> Bool -> ControlBits)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> Bool -> Bool -> ControlBits)
-> PacketParser Bool
-> PacketParser (Bool -> Bool -> Bool -> ControlBits)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> Bool -> ControlBits)
-> PacketParser Bool -> PacketParser (Bool -> Bool -> ControlBits)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> ControlBits)
-> PacketParser Bool -> PacketParser (Bool -> ControlBits)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> ControlBits)
-> PacketParser Bool -> PacketParser ControlBits
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse

instance Parse ECN where
  parse :: PacketParser ECN
parse = Bool -> Bool -> Bool -> ECN
ECN (Bool -> Bool -> Bool -> ECN)
-> PacketParser Bool -> PacketParser (Bool -> Bool -> ECN)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> ECN)
-> PacketParser Bool -> PacketParser (Bool -> ECN)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> ECN) -> PacketParser Bool -> PacketParser ECN
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse

--------------------------------------------------------------------------------

instance Unparse content => Unparse (Packet content) where
  unparse :: Packet content -> UnparseS
unparse (Packet Port
sp Port
dp Word32
snr Word32
anr Word8
hl {-3-} ECN
ecn ControlBits
cb Word16
w Word16
s Word16
u [Word8]
o content
c) =
      (Port, Port, Word32, Word32) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Port
sp,Port
dp,Word32
snr,Word32
anr) UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Word16 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ((Word8 -> Word16
ext Word8
hl Word16 -> Int -> Word16
<< Int
12 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. ECN -> Word16
forall {b}. Num b => ECN -> b
ecnB ECN
ecn Word16 -> Int -> Word16
<< Int
6 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. ControlBits -> Word16
forall {b}. Num b => ControlBits -> b
cbB ControlBits
cb)::Word16) UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (Word16, Word16, Word16, [Word8], content) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word16
w,Word16
s,Word16
u,[Word8]
o,content
c)
    where
      << :: Word16 -> Int -> Word16
(<<) = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL
      ext :: Word8 -> Word16
ext = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      ecnB :: ECN -> b
ecnB (ECN Bool
n Bool
c Bool
e) = [Bool] -> b
forall {b} {t :: * -> *}. (Num b, Foldable t) => t Bool -> b
toBits [Bool
n,Bool
c,Bool
e]
      cbB :: ControlBits -> b
cbB (CB Bool
u Bool
a Bool
p Bool
r Bool
s Bool
f) = [Bool] -> b
forall {b} {t :: * -> *}. (Num b, Foldable t) => t Bool -> b
toBits [Bool
u,Bool
a,Bool
p,Bool
r,Bool
s,Bool
f]

toBits :: t Bool -> b
toBits t Bool
bs = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> Bool -> Int) -> Int -> t Bool -> Int
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Bool -> Int
bit Int
0 t Bool
bs)
  where bit :: Int -> Bool -> Int
bit Int
w Bool
b = Int
w Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool
b::Bool)