module Net.Ethernet where

-- Ethernet protocol
-- reference: http://www.techfest.com/networking/lan/ethernet.htm
--            http://www.iana.org/assignments/ethernet-numbers

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(..))

-- Ethernet card drivers should provide the following interface:
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
--zeroAddr = minBound :: 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]

-- We omit the preambe, startframe delimeter & frame check sequence as
-- we assume that they will be dealt with by the hardware.
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

{-
parse              :: InPacket -> Packet InPacket
parse p             = let ty          = toEnum (fromIntegral (p `wordAt` 12))
                      in Packet
                          { dest      = Addr d1 d2 d3 d4 d5 d6
                          , source    = Addr s1 s2 s3 s4 s5 s6
                          , packType  = ty
                          , content   = case ty of
                                          Ethernet n  -> p { from = 14, len = n }
                                          _           -> p { from = 14, len = len p - 14 }
                          }
  where d1          = p `byteAt` 0
        d2          = p `byteAt` 1
        d3          = p `byteAt` 2
        d4          = p `byteAt` 3
        d5          = p `byteAt` 4
        d6          = p `byteAt` 5

        s1          = p `byteAt` 6
        s2          = p `byteAt` 7
        s3          = p `byteAt` 8
        s4          = p `byteAt` 9
        s5          = p `byteAt` 10
        s6          = p `byteAt` 11
-}



-- Packets should be paddded elsewhere to satisfy minimum length requirement
-- (46 bytes of data, 64 bytes including headers and CRC)
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)