module Net.IPv4 where
import Data.Char
import Net.Bits
import Net.Utils
import Net.Packet
import Net.PacketParsing
data Addr = Addr !Word8 !Word8 !Word8 !Word8
deriving (Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
/= :: Addr -> Addr -> Bool
Eq,Eq Addr
Eq Addr =>
(Addr -> Addr -> Ordering)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> Ord Addr
Addr -> Addr -> Bool
Addr -> Addr -> Ordering
Addr -> Addr -> Addr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Addr -> Addr -> Ordering
compare :: Addr -> Addr -> Ordering
$c< :: Addr -> Addr -> Bool
< :: Addr -> Addr -> Bool
$c<= :: Addr -> Addr -> Bool
<= :: Addr -> Addr -> Bool
$c> :: Addr -> Addr -> Bool
> :: Addr -> Addr -> Bool
$c>= :: Addr -> Addr -> Bool
>= :: Addr -> Addr -> Bool
$cmax :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
min :: Addr -> Addr -> Addr
Ord)
loopbackAddr :: Addr
loopbackAddr = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr Word8
127 Word8
0 Word8
0 Word8
1
broadcastAddr :: Addr -> Addr
broadcastAddr Addr
a = Addr
a Addr -> Addr -> Addr
`orAddr` Addr -> Addr
complAddr (Addr -> Addr
defaultNetmask Addr
a)
type Netmask = Addr
netmaskA :: Addr
netmaskA = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr Word8
255 Word8
0 Word8
0 Word8
0
netmaskB :: Addr
netmaskB = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr Word8
255 Word8
255 Word8
0 Word8
0
netmaskC :: Addr
netmaskC = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr Word8
255 Word8
255 Word8
255 Word8
0
defaultNetmask :: Addr -> Addr
defaultNetmask (Addr Word8
b Word8
_ Word8
_ Word8
_)
| Word8
bWord8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<Word8
128 = Addr
netmaskA
| Word8
bWord8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<Word8
192 = Addr
netmaskB
| Word8
bWord8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<Word8
224 = Addr
netmaskC
sameNet :: (Addr, Addr) -> Addr -> Bool
sameNet (Addr
netIP,Addr
netmask) Addr
ip = Addr
ip Addr -> Addr -> Addr
`andAddr` Addr
netmask Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Addr
netIP Addr -> Addr -> Addr
`andAddr` Addr
netmask
liftA1 :: (Word8 -> Word8) -> Addr -> Addr
liftA1 Word8 -> Word8
f (Addr Word8
b1 Word8
b2 Word8
b3 Word8
b4) = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr (Word8 -> Word8
f Word8
b1) (Word8 -> Word8
f Word8
b2) (Word8 -> Word8
f Word8
b3) (Word8 -> Word8
f Word8
b4)
liftA2 :: (Word8 -> Word8 -> Word8) -> Addr -> Addr -> Addr
liftA2 Word8 -> Word8 -> Word8
f (Addr Word8
a1 Word8
a2 Word8
a3 Word8
a4) (Addr Word8
b1 Word8
b2 Word8
b3 Word8
b4) =
Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr (Word8 -> Word8 -> Word8
f Word8
a1 Word8
b1) (Word8 -> Word8 -> Word8
f Word8
a2 Word8
b2) (Word8 -> Word8 -> Word8
f Word8
a3 Word8
b3) (Word8 -> Word8 -> Word8
f Word8
a4 Word8
b4)
andAddr :: Addr -> Addr -> Addr
andAddr = (Word8 -> Word8 -> Word8) -> Addr -> Addr -> Addr
Net.IPv4.liftA2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.)
orAddr :: Addr -> Addr -> Addr
orAddr = (Word8 -> Word8 -> Word8) -> Addr -> Addr -> Addr
Net.IPv4.liftA2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.)
complAddr :: Addr -> Addr
complAddr = (Word8 -> Word8) -> Addr -> Addr
liftA1 Word8 -> Word8
forall a. Bits a => a -> a
complement
instance Parse Addr where
parse :: PacketParser Addr
parse = Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr (Word8 -> Word8 -> Word8 -> Word8 -> Addr)
-> PacketParser Word8
-> PacketParser (Word8 -> Word8 -> Word8 -> Addr)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
forall a. Parse a => PacketParser a
parse PacketParser (Word8 -> Word8 -> Word8 -> Addr)
-> PacketParser Word8 -> PacketParser (Word8 -> Word8 -> Addr)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse PacketParser (Word8 -> Word8 -> Addr)
-> PacketParser Word8 -> PacketParser (Word8 -> Addr)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse PacketParser (Word8 -> Addr)
-> PacketParser Word8 -> PacketParser Addr
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse
instance Unparse Addr where
unparse :: Addr -> UnparseS
unparse (Addr Word8
b1 Word8
b2 Word8
b3 Word8
b4) = (Word8, Word8, Word8, Word8) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word8
b1,Word8
b2,Word8
b3,Word8
b4)
instance Show Addr where
show :: Addr -> String
show (Addr Word8
a Word8
b Word8
c Word8
d)
= Word8 -> String
forall a. Show a => a -> String
show Word8
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
d
instance Read Addr where
readsPrec :: Int -> ReadS Addr
readsPrec Int
_ String
s = [(Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr Word8
a Word8
b Word8
c Word8
d,String
r)|(Word8
a,String
r1)<-String -> [(Word8, String)]
forall {a}. Read a => String -> [(a, String)]
num String
s, (()
_,String
r2)<-String -> [((), String)]
dot String
r1,
(Word8
b,String
r3)<-String -> [(Word8, String)]
forall {a}. Read a => String -> [(a, String)]
num String
r2, (()
_,String
r4)<-String -> [((), String)]
dot String
r3,
(Word8
c,String
r5)<-String -> [(Word8, String)]
forall {a}. Read a => String -> [(a, String)]
num String
r4, (()
_,String
r6)<-String -> [((), String)]
dot String
r5,
(Word8
d,String
r )<-String -> [(Word8, String)]
forall {a}. Read a => String -> [(a, String)]
num String
r6]
where dot :: String -> [((), String)]
dot String
s = [((),String
r)|Char
'.':String
r<-[String
s]]
num :: String -> [(a, String)]
num String
s = [(String -> a
forall a. Read a => String -> a
read String
n,String
r)|(n :: String
n@(Char
_:String
_),String
r)<-[(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s]]
data Precedence = Routine
| Priority
| Immediate
| Flash
| Flash_Override
| CRITIC_ECP
| Internetwork_Control
| Network_Control
deriving (Int -> Precedence -> ShowS
[Precedence] -> ShowS
Precedence -> String
(Int -> Precedence -> ShowS)
-> (Precedence -> String)
-> ([Precedence] -> ShowS)
-> Show Precedence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Precedence -> ShowS
showsPrec :: Int -> Precedence -> ShowS
$cshow :: Precedence -> String
show :: Precedence -> String
$cshowList :: [Precedence] -> ShowS
showList :: [Precedence] -> ShowS
Show,Int -> Precedence
Precedence -> Int
Precedence -> [Precedence]
Precedence -> Precedence
Precedence -> Precedence -> [Precedence]
Precedence -> Precedence -> Precedence -> [Precedence]
(Precedence -> Precedence)
-> (Precedence -> Precedence)
-> (Int -> Precedence)
-> (Precedence -> Int)
-> (Precedence -> [Precedence])
-> (Precedence -> Precedence -> [Precedence])
-> (Precedence -> Precedence -> [Precedence])
-> (Precedence -> Precedence -> Precedence -> [Precedence])
-> Enum Precedence
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Precedence -> Precedence
succ :: Precedence -> Precedence
$cpred :: Precedence -> Precedence
pred :: Precedence -> Precedence
$ctoEnum :: Int -> Precedence
toEnum :: Int -> Precedence
$cfromEnum :: Precedence -> Int
fromEnum :: Precedence -> Int
$cenumFrom :: Precedence -> [Precedence]
enumFrom :: Precedence -> [Precedence]
$cenumFromThen :: Precedence -> Precedence -> [Precedence]
enumFromThen :: Precedence -> Precedence -> [Precedence]
$cenumFromTo :: Precedence -> Precedence -> [Precedence]
enumFromTo :: Precedence -> Precedence -> [Precedence]
$cenumFromThenTo :: Precedence -> Precedence -> Precedence -> [Precedence]
enumFromThenTo :: Precedence -> Precedence -> Precedence -> [Precedence]
Enum)
instance Parse Precedence where
parse :: PacketParser Precedence
parse = Int -> Precedence
forall a. Enum a => Int -> a
toEnum (Int -> Precedence) -> PacketParser Int -> PacketParser Precedence
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Int -> PacketParser Int
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
3
data Packet content = Packet
{ forall content. Packet content -> Word8
version :: !Word8
, :: !Int
, forall content. Packet content -> TypeOfService
tos :: !TypeOfService
, forall content. Packet content -> Word16
totalLen :: !Word16
, forall content. Packet content -> Word16
identifier :: !Word16
, forall content. Packet content -> Flags
flags :: !Flags
, forall content. Packet content -> Word16
fragOff :: !Word16
, forall content. Packet content -> Word8
timeToLive :: !Word8
, forall content. Packet content -> Protocol
protocol :: !Protocol
, :: !Word16
, forall content. Packet content -> Addr
source, forall content. Packet content -> Addr
dest :: !Addr
, forall content. Packet content -> [Word8]
options :: ![Word8]
, 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
data TypeOfService = TOS
{ TypeOfService -> Precedence
precedence :: !Precedence
, TypeOfService -> Bool
lowDelay :: !Bool
, TypeOfService -> Bool
highThrough :: !Bool
, TypeOfService -> Bool
highReal :: !Bool
}
deriving Int -> TypeOfService -> ShowS
[TypeOfService] -> ShowS
TypeOfService -> String
(Int -> TypeOfService -> ShowS)
-> (TypeOfService -> String)
-> ([TypeOfService] -> ShowS)
-> Show TypeOfService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeOfService -> ShowS
showsPrec :: Int -> TypeOfService -> ShowS
$cshow :: TypeOfService -> String
show :: TypeOfService -> String
$cshowList :: [TypeOfService] -> ShowS
showList :: [TypeOfService] -> ShowS
Show
instance Parse TypeOfService where
parse :: PacketParser TypeOfService
parse = Precedence -> Bool -> Bool -> Bool -> TypeOfService
TOS (Precedence -> Bool -> Bool -> Bool -> TypeOfService)
-> PacketParser Precedence
-> PacketParser (Bool -> Bool -> Bool -> TypeOfService)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Precedence
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Bool -> Bool -> TypeOfService)
-> PacketParser Bool
-> PacketParser (Bool -> Bool -> TypeOfService)
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 -> TypeOfService)
-> PacketParser Bool -> PacketParser (Bool -> TypeOfService)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> TypeOfService)
-> PacketParser Bool -> PacketParser TypeOfService
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser TypeOfService
-> PacketParser Word32 -> PacketParser TypeOfService
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Int -> PacketParser Word32
skip Int
2
data Flags = Flags
{
Flags -> Bool
don'tFrag :: !Bool
, Flags -> Bool
moreFrags :: !Bool
}
deriving Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flags -> ShowS
showsPrec :: Int -> Flags -> ShowS
$cshow :: Flags -> String
show :: Flags -> String
$cshowList :: [Flags] -> ShowS
showList :: [Flags] -> ShowS
Show
instance Parse Flags where
parse :: PacketParser Flags
parse = (Bool -> Bool -> Flags) -> PacketParser (Bool -> Bool -> Flags)
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool -> Bool -> Flags
Flags PacketParser (Bool -> Bool -> Flags)
-> PacketParser Word32 -> PacketParser (Bool -> Bool -> Flags)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Int -> PacketParser Word32
skip Int
1 PacketParser (Bool -> Bool -> Flags)
-> PacketParser Bool -> PacketParser (Bool -> Flags)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse PacketParser (Bool -> Flags)
-> PacketParser Bool -> PacketParser Flags
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Bool
forall a. Parse a => PacketParser a
parse
skip :: Int -> PacketParser Word32
skip :: Int -> PacketParser Word32
skip = Int -> PacketParser Word32
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits
template :: Protocol -> Addr -> Addr -> content -> Packet content
template Protocol
proto Addr
src Addr
dst content
body =
Packet { version :: Word8
version = Word8
4
, headerLen :: Int
headerLen = Int
5
, tos :: TypeOfService
tos = Precedence -> Bool -> Bool -> Bool -> TypeOfService
TOS Precedence
Routine Bool
False Bool
False Bool
False
, totalLen :: Word16
totalLen = Word16
0
, identifier :: Word16
identifier = Word16
0
, flags :: Flags
flags = Bool -> Bool -> Flags
Flags Bool
False Bool
False
, fragOff :: Word16
fragOff = Word16
0
, timeToLive :: Word8
timeToLive = Word8
64
, protocol :: Protocol
protocol = Protocol
proto
, headerCheck :: Word16
headerCheck = Word16
0
, source :: Addr
source = Addr
src
, dest :: Addr
dest = Addr
dst
, options :: [Word8]
options = []
, content :: content
content = content
body
}
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 Protocol = ICMP
| TCP
| UDP
| Unknown !Word8
deriving (Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Protocol -> ShowS
showsPrec :: Int -> Protocol -> ShowS
$cshow :: Protocol -> String
show :: Protocol -> String
$cshowList :: [Protocol] -> ShowS
showList :: [Protocol] -> ShowS
Show,Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
/= :: Protocol -> Protocol -> Bool
Eq)
num_prot :: [(Int,Protocol)]
num_prot :: [(Int, Protocol)]
num_prot = [ (Int
1,Protocol
ICMP)
, (Int
6,Protocol
TCP)
, (Int
17,Protocol
UDP)
]
prot_num :: [(Protocol,Int)]
prot_num :: [(Protocol, Int)]
prot_num = ((Int, Protocol) -> (Protocol, Int))
-> [(Int, Protocol)] -> [(Protocol, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Protocol) -> (Protocol, Int)
forall {b} {a}. (b, a) -> (a, b)
swap [(Int, Protocol)]
num_prot
where swap :: (b, a) -> (a, b)
swap (b
x,a
y) = (a
y,b
x)
instance Enum Protocol where
fromEnum :: Protocol -> Int
fromEnum (Unknown Word8
x) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
fromEnum Protocol
x = case Protocol -> [(Protocol, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Protocol
x [(Protocol, Int)]
prot_num of
Just Int
n -> Int
n
Maybe Int
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String
"bug: Protcol number for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Protocol -> String
forall a. Show a => a -> String
show Protocol
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is missing.")
toEnum :: Int -> Protocol
toEnum Int
x = case Int -> [(Int, Protocol)] -> Maybe Protocol
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
x [(Int, Protocol)]
num_prot of
Maybe Protocol
Nothing -> Word8 -> Protocol
Unknown (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
Just Protocol
x -> Protocol
x
instance Parse Protocol where
parse :: PacketParser Protocol
parse = Int -> Protocol
forall a. Enum a => Int -> a
toEnum (Int -> Protocol) -> (Word8 -> Int) -> Word8 -> Protocol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Protocol) -> PacketParser Word8 -> PacketParser Protocol
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
word8
instance Unparse Protocol where
unparse :: Protocol -> UnparseS
unparse Protocol
p = Word8 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word8
b::Word8)
where b :: Word8
b = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Protocol -> Int
forall a. Enum a => a -> Int
fromEnum Protocol
p)
data Option = Short Word8
| Long
{ Option -> OptType
optType :: OptType
, Option -> Word8
optLen :: Word8
, Option -> [Word8]
optData :: [Word8] }
data OptType = OptType
{ OptType -> Bool
optCopied :: Bool
, OptType -> OptClass
optClass :: OptClass
, OptType -> Word8
optNumber :: Word8
}
data OptClass = Control | Reserved1 | DebugMeasure | Reserved4
deriving Int -> OptClass
OptClass -> Int
OptClass -> [OptClass]
OptClass -> OptClass
OptClass -> OptClass -> [OptClass]
OptClass -> OptClass -> OptClass -> [OptClass]
(OptClass -> OptClass)
-> (OptClass -> OptClass)
-> (Int -> OptClass)
-> (OptClass -> Int)
-> (OptClass -> [OptClass])
-> (OptClass -> OptClass -> [OptClass])
-> (OptClass -> OptClass -> [OptClass])
-> (OptClass -> OptClass -> OptClass -> [OptClass])
-> Enum OptClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OptClass -> OptClass
succ :: OptClass -> OptClass
$cpred :: OptClass -> OptClass
pred :: OptClass -> OptClass
$ctoEnum :: Int -> OptClass
toEnum :: Int -> OptClass
$cfromEnum :: OptClass -> Int
fromEnum :: OptClass -> Int
$cenumFrom :: OptClass -> [OptClass]
enumFrom :: OptClass -> [OptClass]
$cenumFromThen :: OptClass -> OptClass -> [OptClass]
enumFromThen :: OptClass -> OptClass -> [OptClass]
$cenumFromTo :: OptClass -> OptClass -> [OptClass]
enumFromTo :: OptClass -> OptClass -> [OptClass]
$cenumFromThenTo :: OptClass -> OptClass -> OptClass -> [OptClass]
enumFromThenTo :: OptClass -> OptClass -> OptClass -> [OptClass]
Enum
instance Parse contents => Parse (Packet contents) where
parse :: PacketParser (Packet contents)
parse =
do Word8
v <- Int -> PacketParser Word8
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
4
Int
hl <- Int -> PacketParser Int
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
4
let olen :: Int
olen = (Int
hlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
5)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4
TypeOfService
tos <- PacketParser TypeOfService
forall a. Parse a => PacketParser a
parse
Word16
totlen <- PacketParser Word16
forall a. Parse a => PacketParser a
parse
let datalen :: Int
datalen = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
totlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hl
Word8
-> Int
-> TypeOfService
-> Word16
-> Word16
-> Flags
-> Word16
-> Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents
forall content.
Word8
-> Int
-> TypeOfService
-> Word16
-> Word16
-> Flags
-> Word16
-> Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> content
-> Packet content
Packet Word8
v Int
hl TypeOfService
tos Word16
totlen
# parse -- identifier :: !Word16
PacketParser
(Flags
-> Word16
-> Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
-> PacketParser Flags
-> PacketParser
(Word16
-> Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Flags
forall a. Parse a => PacketParser a
parse
PacketParser
(Word16
-> Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
-> PacketParser Word16
-> PacketParser
(Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# Int -> PacketParser Word16
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
13
PacketParser
(Word8
-> Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
-> PacketParser Word8
-> PacketParser
(Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse
PacketParser
(Protocol
-> Word16
-> Addr
-> Addr
-> [Word8]
-> contents
-> Packet contents)
-> PacketParser Protocol
-> PacketParser
(Word16 -> Addr -> Addr -> [Word8] -> contents -> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Protocol
forall a. Parse a => PacketParser a
parse
PacketParser
(Word16 -> Addr -> Addr -> [Word8] -> contents -> Packet contents)
-> PacketParser Word16
-> PacketParser
(Addr -> Addr -> [Word8] -> contents -> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse
PacketParser
(Addr -> Addr -> [Word8] -> contents -> Packet contents)
-> PacketParser Addr
-> PacketParser (Addr -> [Word8] -> contents -> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
PacketParser (Addr -> [Word8] -> contents -> Packet contents)
-> PacketParser Addr
-> PacketParser ([Word8] -> contents -> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
PacketParser ([Word8] -> contents -> Packet contents)
-> PacketParser [Word8]
-> PacketParser (contents -> Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# Int -> PacketParser [Word8]
forall {t}. (Eq t, Num t) => t -> PacketParser [Word8]
bytes Int
olen
#! trunc datalen -- discard padding
PacketParser (contents -> Packet contents)
-> PacketParser contents -> PacketParser (Packet contents)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser contents
forall a. Parse a => PacketParser a
parse
instance Unparse a => Unparse (Packet a) where
unparse :: Packet a -> UnparseS
unparse Packet a
p = OutPacket -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Packet OutPacket -> OutPacket
ipv4unparse ((a -> OutPacket) -> Packet a -> Packet OutPacket
forall a b. (a -> b) -> Packet a -> Packet b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> OutPacket
forall {a}. Unparse a => a -> OutPacket
doUnparse Packet a
p))
ipv4unparse :: Packet OutPacket -> OutPacket
ipv4unparse :: Packet OutPacket -> OutPacket
ipv4unparse Packet OutPacket
p = Chunk -> OutPacketS
addChunk Chunk
realHeader (Packet OutPacket -> OutPacket
forall content. Packet content -> content
content Packet OutPacket
p)
where
hL :: Int
hL = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
optWords
optLen :: Int
optLen = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Packet OutPacket -> [Word8]
forall content. Packet content -> [Word8]
options Packet OutPacket
p)
optWords :: Int
optWords = (Int
optLenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
padLen :: Int
padLen = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
optWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
optLen
tL :: Int
tL = Int
hL Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OutPacket -> Int
outLen (Packet OutPacket -> OutPacket
forall content. Packet content -> content
content Packet OutPacket
p)
realHeader :: Chunk
realHeader = (Int, Int) -> [Word8] -> Chunk
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
hL Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word8 -> Word8 -> [Word8]
header Word8
c3 Word8
c4)
header :: Word8 -> Word8 -> [Word8]
header Word8
c3 Word8
c4 =
[ Word8
a1 , Word8
a2 , Word8
a3 , Word8
a4
, Word8
b1 , Word8
b2 , Word8
b3 , Word8
b4
, Word8
c1 , Word8
c2 , Word8
c3 , Word8
c4
, Word8
d1 , Word8
d2 , Word8
d3 , Word8
d4
, Word8
e1 , Word8
e2 , Word8
e3 , Word8
e4 ]
[Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Packet OutPacket -> [Word8]
forall content. Packet content -> [Word8]
options Packet OutPacket
p [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
padLen Word8
0
check :: Word16
check = [Word16] -> Word16
checksum ([Word8] -> [Word16]
bytes_to_words_big (Word8 -> Word8 -> [Word8]
header Word8
0 Word8
0))
t :: TypeOfService
t = Packet OutPacket -> TypeOfService
forall content. Packet content -> TypeOfService
tos Packet OutPacket
p
a1 :: Word8
a1 = (Word8
4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hL Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F)
a2 :: Word8
a2 = Int -> Bool -> Word8 -> Word8
forall {a}. Bits a => Int -> Bool -> a -> a
bit Int
4 (TypeOfService -> Bool
lowDelay TypeOfService
t)
(Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Word8 -> Word8
forall {a}. Bits a => Int -> Bool -> a -> a
bit Int
3 (TypeOfService -> Bool
highThrough TypeOfService
t)
(Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Word8 -> Word8
forall {a}. Bits a => Int -> Bool -> a -> a
bit Int
2 (TypeOfService -> Bool
highReal TypeOfService
t)
(Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Precedence -> Int
forall a. Enum a => a -> Int
fromEnum (TypeOfService -> Precedence
precedence TypeOfService
t)) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
5)
a3 :: Word8
a3 = Int
tL Int -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1
a4 :: Word8
a4 = Int
tL Int -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0
f :: Flags
f = Packet OutPacket -> Flags
forall content. Packet content -> Flags
flags Packet OutPacket
p
b1 :: Word8
b1 = Packet OutPacket -> Word16
forall content. Packet content -> Word16
identifier Packet OutPacket
p Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1
b2 :: Word8
b2 = Packet OutPacket -> Word16
forall content. Packet content -> Word16
identifier Packet OutPacket
p Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0
b3 :: Word8
b3 = Int -> Bool -> Word8 -> Word8
forall {a}. Bits a => Int -> Bool -> a -> a
bit Int
6 (Flags -> Bool
don'tFrag Flags
f)
(Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> Word8 -> Word8
forall {a}. Bits a => Int -> Bool -> a -> a
bit Int
5 (Flags -> Bool
moreFrags Flags
f)
(Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ (Packet OutPacket -> Word16
forall content. Packet content -> Word16
fragOff Packet OutPacket
p Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1)
b4 :: Word8
b4 = Packet OutPacket -> Word16
forall content. Packet content -> Word16
fragOff Packet OutPacket
p Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0
c1 :: Word8
c1 = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Packet OutPacket -> Word8
forall content. Packet content -> Word8
timeToLive Packet OutPacket
p)
c2 :: Word8
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Protocol -> Int
forall a. Enum a => a -> Int
fromEnum (Protocol -> Int) -> Protocol -> Int
forall a b. (a -> b) -> a -> b
$ Packet OutPacket -> Protocol
forall content. Packet content -> Protocol
protocol Packet OutPacket
p
c3 :: Word8
c3 = Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1
c4 :: Word8
c4 = Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0
Addr Word8
d1 Word8
d2 Word8
d3 Word8
d4 = Packet OutPacket -> Addr
forall content. Packet content -> Addr
source Packet OutPacket
p
Addr Word8
e1 Word8
e2 Word8
e3 Word8
e4 = Packet OutPacket -> Addr
forall content. Packet content -> Addr
dest Packet OutPacket
p
bit :: Int -> Bool -> a -> a
bit Int
n Bool
b a
a = if Bool
b then a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`setBit` Int
n else a
a