module Net.Ethernet where
import Data.List(intersperse)
import Net.Bits
import Net.Packet
import Net.PacketParsing as P
import qualified Net.Interface as Net
import Net.Utils(Container(..))
data Interface m i o =
Interface { forall (m :: * -> *) i o. Interface m i o -> Addr
myMAC :: Addr,
forall (m :: * -> *) i o. Interface m i o -> Interface m i o
io :: Net.Interface m i o }
rx :: Interface m i o -> m i
rx = Interface m i o -> m i
forall (m :: * -> *) i o. Interface m i o -> m i
Net.rx (Interface m i o -> m i)
-> (Interface m i o -> Interface m i o) -> Interface m i o -> m i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface m i o -> Interface m i o
forall (m :: * -> *) i o. Interface m i o -> Interface m i o
io
tx :: Interface m i o -> o -> m ()
tx = Interface m i o -> o -> m ()
forall (m :: * -> *) i o. Interface m i o -> o -> m ()
Net.tx (Interface m i o -> o -> m ())
-> (Interface m i o -> Interface m i o)
-> Interface m i o
-> o
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface m i o -> Interface m i o
forall (m :: * -> *) i o. Interface m i o -> Interface m i o
io
data Addr = Addr !Word8 !Word8 !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,Addr
Addr -> Addr -> Bounded Addr
forall a. a -> a -> Bounded a
$cminBound :: Addr
minBound :: Addr
$cmaxBound :: Addr
maxBound :: Addr
Bounded)
broadcastAddr :: Addr
broadcastAddr = Addr
forall a. Bounded a => a
maxBound :: Addr
instance Parse Addr where
parse :: PacketParser Addr
parse = Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Addr
Addr (Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Addr)
-> PacketParser Word8
-> PacketParser (Word8 -> Word8 -> 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 -> Word8 -> Word8 -> Addr)
-> PacketParser Word8
-> PacketParser (Word8 -> Word8 -> 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 -> Word8 -> Word8 -> Addr)
-> PacketParser Word8
-> PacketParser (Word8 -> 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 -> 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
b5 Word8
b6) = ((Word8, Word8, Word8), (Word8, Word8, Word8)) -> UnparseS
forall a. Unparse a => a -> UnparseS
P.unparse ((Word8
b1,Word8
b2,Word8
b3),(Word8
b4,Word8
b5,Word8
b6))
instance Show Addr where
show :: Addr -> String
show (Addr Word8
x1 Word8
x2 Word8
x3 Word8
x4 Word8
x5 Word8
x6) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
":" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8 -> String
forall {a}. Integral a => Int -> a -> String
showHex' Int
2) [Word8
x1,Word8
x2,Word8
x3,Word8
x4,Word8
x5,Word8
x6]
data Packet content = Packet
{ forall content. Packet content -> Addr
dest :: Addr
, forall content. Packet content -> Addr
source :: Addr
, forall content. Packet content -> PacketType
packType :: PacketType
, 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
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 PacketType = Ethernet !Int
| IPv4
| IPv6
| ARP
| Unknown !Word16
deriving (PacketType -> PacketType -> Bool
(PacketType -> PacketType -> Bool)
-> (PacketType -> PacketType -> Bool) -> Eq PacketType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PacketType -> PacketType -> Bool
== :: PacketType -> PacketType -> Bool
$c/= :: PacketType -> PacketType -> Bool
/= :: PacketType -> PacketType -> Bool
Eq,Int -> PacketType -> ShowS
[PacketType] -> ShowS
PacketType -> String
(Int -> PacketType -> ShowS)
-> (PacketType -> String)
-> ([PacketType] -> ShowS)
-> Show PacketType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PacketType -> ShowS
showsPrec :: Int -> PacketType -> ShowS
$cshow :: PacketType -> String
show :: PacketType -> String
$cshowList :: [PacketType] -> ShowS
showList :: [PacketType] -> ShowS
Show)
instance Enum PacketType where
toEnum :: Int -> PacketType
toEnum Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x600 = Int -> PacketType
Ethernet Int
x
toEnum Int
x = case Int
x of
Int
0x0800 -> PacketType
IPv4
Int
0x86DD -> PacketType
IPv6
Int
0x0806 -> PacketType
ARP
Int
_ -> Word16 -> PacketType
Unknown (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
fromEnum :: PacketType -> Int
fromEnum PacketType
x = case PacketType
x of
Ethernet Int
x -> Int
x
PacketType
IPv4 -> Int
0x0800
PacketType
IPv6 -> Int
0x86DD
PacketType
ARP -> Int
0x0806
Unknown Word16
x -> Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x
instance Parse PacketType where parse :: PacketParser PacketType
parse = Int -> PacketType
forall a. Enum a => Int -> a
toEnum (Int -> PacketType) -> (Word16 -> Int) -> Word16 -> PacketType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> PacketType)
-> PacketParser Word16 -> PacketParser PacketType
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word16
word16
instance Parse content => Parse (Packet content) where
parse :: PacketParser (Packet content)
parse = Addr -> Addr -> PacketType -> content -> Packet content
forall content.
Addr -> Addr -> PacketType -> content -> Packet content
Packet (Addr -> Addr -> PacketType -> content -> Packet content)
-> PacketParser Addr
-> PacketParser (Addr -> PacketType -> content -> Packet content)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> PacketType -> content -> Packet content)
-> PacketParser Addr
-> PacketParser (PacketType -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser (PacketType -> content -> Packet content)
-> PacketParser PacketType
-> PacketParser (content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser PacketType
forall a. Parse a => PacketParser a
parse 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
unparse :: Packet OutPacket -> OutPacket
unparse :: Packet OutPacket -> OutPacket
unparse Packet OutPacket
p = Chunk -> OutPacketS
addChunk ((Int, Int) -> [Word8] -> Chunk
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
13) [Word8]
bytes) (Packet OutPacket -> OutPacket
forall content. Packet content -> content
content Packet OutPacket
p)
where bytes :: [Word8]
bytes = [ Word8
d1, Word8
d2, Word8
d3, Word8
d4, Word8
d5, Word8
d6
, Word8
s1, Word8
s2, Word8
s3, Word8
s4, Word8
s5, Word8
s6
, Int
ty Int -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, Int
ty Int -> 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 Word8
d5 Word8
d6 = Packet OutPacket -> Addr
forall content. Packet content -> Addr
dest Packet OutPacket
p
Addr Word8
s1 Word8
s2 Word8
s3 Word8
s4 Word8
s5 Word8
s6 = Packet OutPacket -> Addr
forall content. Packet content -> Addr
source Packet OutPacket
p
ty :: Int
ty = PacketType -> Int
forall a. Enum a => a -> Int
fromEnum (Packet OutPacket -> PacketType
forall content. Packet content -> PacketType
packType Packet OutPacket
p)