module Net.ARP where

-- Address Resolution Protocol, limited to IPv4 over Ethernet
-- See http://www.networksorcery.com/enp/protocol/arp.htm

import Net.Bits(Word8,Word16)
import Net.Ethernet as Eth(Addr)
import Net.IPv4 as IPv4(Addr)
import Net.PacketParsing

data Packet = Packet
            { --hwType       :: !Word16,   -- Always 0x0001 (Ethernet)
              --protocolType :: !Eth.PacketType,   -- Always 0x0800 (IPv4)
	      --hLen, pLen   :: !Word8,    -- Always 0x06, 0x04
	      Packet -> Operation
opcode    :: Operation, -- 16 bits, see below
	      Packet -> Addr
senderHA  :: Eth.Addr,
	      Packet -> Addr
senderIP  :: IPv4.Addr,
	      Packet -> Addr
targetHA  :: Eth.Addr,
	      Packet -> Addr
targetIP  :: IPv4.Addr }
            deriving (Int -> Packet -> ShowS
[Packet] -> ShowS
Packet -> String
(Int -> Packet -> ShowS)
-> (Packet -> String) -> ([Packet] -> ShowS) -> Show Packet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packet -> ShowS
showsPrec :: Int -> Packet -> ShowS
$cshow :: Packet -> String
show :: Packet -> String
$cshowList :: [Packet] -> ShowS
showList :: [Packet] -> ShowS
Show)

data Operation = Request   -- 0x0001, RFC 826
               | Reply     -- 0x0002, RFC 826
               deriving (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
/= :: Operation -> Operation -> Bool
Eq,Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation -> ShowS
showsPrec :: Int -> Operation -> ShowS
$cshow :: Operation -> String
show :: Operation -> String
$cshowList :: [Operation] -> ShowS
showList :: [Operation] -> ShowS
Show)

instance Parse Packet where
    parse :: PacketParser Packet
parse =
       (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
-> PacketParser
     (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
forall a. a -> PacketParser a
forall (m :: * -> *) a. Monad m => a -> m a
return Operation -> Addr -> Addr -> Addr -> Addr -> Packet
Packet PacketParser (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
-> PacketParser ()
-> PacketParser
     (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word16 -> PacketParser ()
check16 Word16
0x0001 PacketParser (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
-> PacketParser ()
-> PacketParser
     (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
forall {m :: * -> *} {b} {a}. Monad m => m b -> m a -> m b
#! Word16 -> PacketParser ()
check16 Word16
0x0800
	             #! check8 0x06 #! check8 0x04
	             PacketParser (Operation -> Addr -> Addr -> Addr -> Addr -> Packet)
-> PacketParser Operation
-> PacketParser (Addr -> Addr -> Addr -> Addr -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Operation
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> Addr -> Addr -> Addr -> Packet)
-> PacketParser Addr
-> PacketParser (Addr -> Addr -> Addr -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> Addr -> Addr -> Packet)
-> PacketParser Addr -> PacketParser (Addr -> Addr -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> Addr -> Packet)
-> PacketParser Addr -> PacketParser (Addr -> Packet)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> Packet)
-> PacketParser Addr -> PacketParser Packet
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Addr
forall a. Parse a => PacketParser a
parse
		     #! therest

instance Unparse Packet where
   unparse :: Packet -> UnparseS
unparse (Packet Operation
op Addr
sHA Addr
sIP Addr
tHA Addr
tIP) =
      (Word16, Word16, Word8, Word8) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Word16
1::Word16,Word16
0x800::Word16,Word8
6::Word8,Word8
4::Word8) UnparseS -> UnparseS -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (Operation, Addr, Addr, Addr, Addr) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Operation
op,Addr
sHA,Addr
sIP,Addr
tHA,Addr
tIP)

instance Parse Operation where
    parse :: PacketParser Operation
parse = Maybe Operation -> PacketParser Operation
forall {m :: * -> *} {a}. MonadFail m => Maybe a -> m a
lift (Maybe Operation -> PacketParser Operation)
-> (Word16 -> Maybe Operation) -> Word16 -> PacketParser Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Maybe Operation
forall {a}. (Eq a, Num a) => a -> Maybe Operation
conv (Word16 -> PacketParser Operation)
-> PacketParser Word16 -> PacketParser Operation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PacketParser Word16
word16
      where conv :: a -> Maybe Operation
conv a
1 = Operation -> Maybe Operation
forall a. a -> Maybe a
Just Operation
Request
	    conv a
2 = Operation -> Maybe Operation
forall a. a -> Maybe a
Just Operation
Reply
	    conv a
w = Maybe Operation
forall a. Maybe a
Nothing

instance Unparse Operation where
  unparse :: Operation -> UnparseS
unparse Operation
op = Word16 -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Operation -> Word16
conv Operation
op)
    where conv :: Operation -> Word16
conv Operation
Request = Word16
1::Word16
          conv Operation
Reply = Word16
2