module Net.ICMP where

-- Internet Control Message Protocol
-- http://rfc.net/rfc792.html

import Net.Bits
import Net.Utils
import Net.Packet
import Net.PacketParsing

data Packet = EchoRequest EchoMsg
	    | EchoReply EchoMsg
	    | Other { Packet -> MessageType
type_    :: !MessageType,
		      Packet -> Word8
code     :: !Word8,
		      Packet -> Word16
chksum   :: !Word16,
		      Packet -> UArray Int Word8
content  :: UArray Int Word8
		    }
	    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 EchoMsg = Echo { EchoMsg -> Word16
ident       :: !Word16
                    , EchoMsg -> Word16
seqNum      :: !Word16
                    , EchoMsg -> UArray Int Word8
echoData    :: UArray Int Word8
                    } deriving Int -> EchoMsg -> ShowS
[EchoMsg] -> ShowS
EchoMsg -> String
(Int -> EchoMsg -> ShowS)
-> (EchoMsg -> String) -> ([EchoMsg] -> ShowS) -> Show EchoMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EchoMsg -> ShowS
showsPrec :: Int -> EchoMsg -> ShowS
$cshow :: EchoMsg -> String
show :: EchoMsg -> String
$cshowList :: [EchoMsg] -> ShowS
showList :: [EchoMsg] -> ShowS
Show

instance Parse Packet where
  parse :: PacketParser Packet
parse = do (MessageType
t,Word8
c,Word16
s) <- PacketParser (MessageType, Word8, Word16)
forall a. Parse a => PacketParser a
parse
	     case MessageType
t of
	       MessageType
Echo_Request -> EchoMsg -> Packet
EchoRequest (EchoMsg -> Packet) -> PacketParser EchoMsg -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser EchoMsg
forall a. Parse a => PacketParser a
parse
	       MessageType
Echo_Reply   -> EchoMsg -> Packet
EchoReply   (EchoMsg -> Packet) -> PacketParser EchoMsg -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser EchoMsg
forall a. Parse a => PacketParser a
parse
	       MessageType
_            -> MessageType -> Word8 -> Word16 -> UArray Int Word8 -> Packet
Other MessageType
t Word8
c Word16
s (UArray Int Word8 -> Packet)
-> PacketParser (UArray Int Word8) -> PacketParser Packet
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser (UArray Int Word8)
forall a. Parse a => PacketParser a
parse

instance Parse EchoMsg where parse :: PacketParser EchoMsg
parse = Word16 -> Word16 -> UArray Int Word8 -> EchoMsg
Echo (Word16 -> Word16 -> UArray Int Word8 -> EchoMsg)
-> PacketParser Word16
-> PacketParser (Word16 -> UArray Int Word8 -> EchoMsg)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser (Word16 -> UArray Int Word8 -> EchoMsg)
-> PacketParser Word16
-> PacketParser (UArray Int Word8 -> EchoMsg)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser (UArray Int Word8 -> EchoMsg)
-> PacketParser (UArray Int Word8) -> PacketParser EchoMsg
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser (UArray Int Word8)
forall a. Parse a => PacketParser a
parse

{-
-- XXX: Assuming only Echo messages
icmpParse              :: InPacket -> EchoMsg
icmpParse p             = Echo
                      { reply     = (p `byteAt` 0) == 0
                      , ident     = p `wordAt` 4
                      , seqNum    = fromIntegral (p `wordAt` 6)
                      , echoData  = toUArray (p { from = from p + 8, len = len p - 8 })
                      }
-}

instance Unparse Packet where unparse :: Packet -> UnparseS
unparse = OutPacket -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (OutPacket -> UnparseS)
-> (Packet -> OutPacket) -> Packet -> UnparseS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet -> OutPacket
icmpUnparse

icmpUnparse :: Packet -> OutPacket
icmpUnparse (EchoRequest EchoMsg
m) = Bool -> EchoMsg -> OutPacket
echoUnparse Bool
False EchoMsg
m
icmpUnparse (EchoReply EchoMsg
m) = Bool -> EchoMsg -> OutPacket
echoUnparse Bool
True EchoMsg
m
--icmpUnparse (Other ...) =

echoUnparse        :: Bool -> EchoMsg -> OutPacket
echoUnparse :: Bool -> EchoMsg -> OutPacket
echoUnparse Bool
reply EchoMsg
m = UArray Int Word8 -> OutPacketS
addChunk ((Int, Int) -> [(Int, Word8)] -> UArray Int Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0,Int
7) ([Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Word8
a1,Word8
a2,Word8
a3,Word8
a4,Word8
b1,Word8
b2,Word8
b3,Word8
b4]))
                    OutPacketS -> OutPacketS
forall a b. (a -> b) -> a -> b
$ UArray Int Word8 -> OutPacketS
addChunk (EchoMsg -> UArray Int Word8
echoData EchoMsg
m)
                    OutPacketS -> OutPacketS
forall a b. (a -> b) -> a -> b
$ OutPacket
emptyOutPack
  where a1 :: Word8
a1          = if Bool
reply then Word8
0 else Word8
8
        a2 :: Word8
a2          = Word8
0
        (Word8
a3,Word8
a4)     = (Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, Word16
check Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
        (Word8
b1,Word8
b2)     = (EchoMsg -> Word16
ident EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, EchoMsg -> Word16
ident EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
        (Word8
b3,Word8
b4)     = (EchoMsg -> Word16
seqNum EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
1, EchoMsg -> Word16
seqNum EchoMsg
m Word16 -> Int -> Word8
forall {p} {b}.
(Integral p, FiniteBits b, Bits p, Num b) =>
p -> Int -> b
.!. Int
0)
        check :: Word16
check       = [Word16] -> Word16
checksum ([Word16] -> Word16) -> [Word16] -> Word16
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word16]
bytes_to_words_big ([Word8
a1,Word8
a2,Word8
0,Word8
0,Word8
b1,Word8
b2,Word8
b3,Word8
b4] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ UArray Int Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (EchoMsg -> UArray Int Word8
echoData EchoMsg
m))



data MessageType    = Echo_Reply
                    | Unknown1
                    | Unknown2
                    | Destination_Unreachable
                    | Source_Quench
                    | Redirect
                    | Unknown6
                    | Unknown7
                    | Echo_Request
                    | Unknown9
                    | Unknown10
                    | Time_Exceeded
                    | Parameter_Problem
                    | Timestamp
                    | Timestamp_Reply
                    | Information_Request
                    | Information_Reply
		    | UnknownOther
                      deriving (MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq,Int -> MessageType
MessageType -> Int
MessageType -> [MessageType]
MessageType -> MessageType
MessageType -> MessageType -> [MessageType]
MessageType -> MessageType -> MessageType -> [MessageType]
(MessageType -> MessageType)
-> (MessageType -> MessageType)
-> (Int -> MessageType)
-> (MessageType -> Int)
-> (MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> [MessageType])
-> (MessageType -> MessageType -> MessageType -> [MessageType])
-> Enum MessageType
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 :: MessageType -> MessageType
succ :: MessageType -> MessageType
$cpred :: MessageType -> MessageType
pred :: MessageType -> MessageType
$ctoEnum :: Int -> MessageType
toEnum :: Int -> MessageType
$cfromEnum :: MessageType -> Int
fromEnum :: MessageType -> Int
$cenumFrom :: MessageType -> [MessageType]
enumFrom :: MessageType -> [MessageType]
$cenumFromThen :: MessageType -> MessageType -> [MessageType]
enumFromThen :: MessageType -> MessageType -> [MessageType]
$cenumFromTo :: MessageType -> MessageType -> [MessageType]
enumFromTo :: MessageType -> MessageType -> [MessageType]
$cenumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
enumFromThenTo :: MessageType -> MessageType -> MessageType -> [MessageType]
Enum,MessageType
MessageType -> MessageType -> Bounded MessageType
forall a. a -> a -> Bounded a
$cminBound :: MessageType
minBound :: MessageType
$cmaxBound :: MessageType
maxBound :: MessageType
Bounded,Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> String
show :: MessageType -> String
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show)

instance Parse MessageType where
  parse :: PacketParser MessageType
parse = Word8 -> MessageType
forall {p}. Enum p => p -> MessageType
toEnum' (Word8 -> MessageType)
-> PacketParser Word8 -> PacketParser MessageType
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word8
word8
    where toEnum' :: p -> MessageType
toEnum' p
w = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
lo Bool -> Bool -> Bool
|| Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>MessageType -> Int
forall a. Enum a => a -> Int
fromEnum MessageType
hi
		      then MessageType
UnknownOther
		      else Int -> MessageType
forall a. Enum a => Int -> a
toEnum (Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
n)
	    where n :: Int
n=p -> Int
forall a. Enum a => a -> Int
fromEnum p
w
	  lo,hi::MessageType
	  lo :: MessageType
lo=MessageType
forall a. Bounded a => a
minBound
	  hi :: MessageType
hi=MessageType
forall a. Bounded a => a
maxBound

{-

-- dependent type, the type determines the shape of
-- code & content
data Header         = Header
                    { msgType     :: !MessageType
                    , msgCode     :: !Word8
                    , msgChecksum :: !Word16
                    , msgContent  :: ![Word8]
                    }











--------------------------------------------------------------------------------
-- Destination unreachable
--------------------------------------------------------------------------------

data Dest           = Net_unreachable
                    | Host_unreachable
                    | Protocol_unreachable
                    | Port_unreachable
                    | Fragmentation_needed_and_DF_set
                    | Source_route_failed
                      deriving (Show,Enum)


--------------------------------------------------------------------------------
-- Time exceeded
--------------------------------------------------------------------------------

data TimeExceeded   = Time_to_live_exceeded_in_transit
                    | Fragment_reassembly_time_exceeded
                      deriving (Show,Enum)


--------------------------------------------------------------------------------
-- Parameter problem
--------------------------------------------------------------------------------


--------------------------------------------------------------------------------
-- Source quench
--------------------------------------------------------------------------------


--------------------------------------------------------------------------------
-- Redirect message
--------------------------------------------------------------------------------

data RedirectMsg    = Netwrok
                    | Host
                    | ToS_Network
                    | ToS_Host

--------------------------------------------------------------------------------
-- Echo & echo reply messages
--------------------------------------------------------------------------------


--------------------------------------------------------------------------------
-- Time stamp & time stamp reply reply messages
--------------------------------------------------------------------------------


--------------------------------------------------------------------------------
-- Information request & information reply message
--------------------------------------------------------------------------------

-}