module Net.TCP where
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,
forall content. Packet content -> ECN
ecn :: !ECN,
forall content. Packet content -> ControlBits
controlBits :: !ControlBits,
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],
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 }
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
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 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)