module Net.UDP(module Net.UDP,Port(..)) where

-- User Datagram Protocol
-- See http://www.networksorcery.com/enp/protocol/udp.htm

import Net.PacketParsing
import Net.Packet(outLen)
import Net.Bits(Word16)
import Net.PortNumber(Port(..))
import Net.Utils(Container(..))

data Packet content = Packet
                    { forall content. Packet content -> Port
sourcePort, forall content. Packet content -> Port
destPort :: !Port,
		      forall content. Packet content -> Word16
len :: !Word16, -- length of header (i.e. 8) + data
                      forall content. Packet content -> Word16
checksum :: !Word16, -- don't store?
                      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)

template :: Port -> Port -> content -> Packet content
template Port
sp Port
dp content
c = Port -> Port -> Word16 -> Word16 -> content -> Packet content
forall content.
Port -> Port -> Word16 -> Word16 -> content -> Packet content
Packet Port
sp Port
dp Word16
0 Word16
0 content
c

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

instance Parse a => Parse (Packet a) where
  parse :: PacketParser (Packet a)
parse = do (Port
sp,Port
dp,Word16
len,Word16
sum) <- PacketParser (Port, Port, Word16, Word16)
forall a. Parse a => PacketParser a
parse
	     Int -> PacketParser ()
trunc (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) -- discard padding
	     Port -> Port -> Word16 -> Word16 -> a -> Packet a
forall content.
Port -> Port -> Word16 -> Word16 -> content -> Packet content
Packet Port
sp Port
dp Word16
len Word16
sum (a -> Packet a) -> PacketParser a -> PacketParser (Packet a)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser a
forall a. Parse a => PacketParser a
parse
  -- Should also check the checksum.

instance Unparse a => Unparse (Packet a) where
  unparse :: Packet a -> UnparseS
unparse (Packet Port
sp Port
dp Word16
l0 Word16
s a
c) = (Port, Port, Word16, Word16, OutPacket) -> UnparseS
forall a. Unparse a => a -> UnparseS
unparse (Port
sp,Port
dp,Word16
l,Word16
nosum,OutPacket
uc)
    where
      uc :: OutPacket
uc=a -> OutPacket
forall {a}. Unparse a => a -> OutPacket
doUnparse a
c
      l :: Word16
l=Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
+OutPacket -> Int
outLen OutPacket
uc) Word16 -> Word16 -> Word16
forall a. a -> a -> a
`asTypeOf` Word16
l0

      -- If the checksum is cleared to zero, then checksumming is disabled
      nosum :: Word16
nosum=Word16
0::Word16