module Net.Packet (module Data.Array.Unboxed,Word8,
		  InPacket,len,emptyInPack,toInPack,takeInPack,dropInPack,
		   byteAt,wordAt,toChunk,
		   OutPacket,outLen,chunks,Chunk,
		   emptyOutPack,addChunk,appendOutPack,
		   splitOutPack,outBytes,loopback,loopbackout
		  ) where

import Net.Bits
import Data.Array.Unboxed
import Net.Utils

-- | The buffers used to represent packet,
-- when they are received over the network.
data InPacket = InPack
              { InPacket -> Chunk
buffer  :: !Chunk
              , InPacket -> Int
from    :: !Int
              , InPacket -> Int
len     :: !Int     -- in bytes
              }
              -- ^Invariant: all (inRange (bounds buffer)) [from..from+len-1]

{-
inPack buf from len
    | len==0 || ok from && ok (from+len-1) = InPack buf from len
    | otherwise = error $ "inPack "++show (bounds buf,from,len)
  where
    ok = inRange (bounds buf)
-}

emptyInPack :: InPacket
emptyInPack = InPack{buffer :: Chunk
buffer=Chunk
empty,from :: Int
from=Int
0,len :: Int
len=Int
0}
  where empty :: Chunk
empty = (Int, Int) -> [Word8] -> Chunk
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,-Int
1) []

takeInPack :: Int -> InPacket -> InPacket
takeInPack Int
n (InPack Chunk
buf Int
from Int
len) = Chunk -> Int -> Int -> InPacket
InPack Chunk
buf Int
from (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
len)

dropInPack :: Int -> InPacket -> InPacket
dropInPack Int
n (InPack Chunk
buf Int
from Int
len) = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
len
				     then InPacket
emptyInPack
				     else Chunk -> Int -> Int -> InPacket
InPack Chunk
buf (Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)

instance Show InPacket where
  show :: InPacket -> String
show InPacket
p = String
"<<"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (InPacket -> Int
len InPacket
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" bytes>>"

-- | Get a byte at a certain offset.
byteAt             :: InPacket -> Int -> Word8
InPacket
p byteAt :: InPacket -> Int -> Word8
`byteAt` Int
x        = InPacket -> Chunk
buffer InPacket
p Chunk -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ InPacket -> Int
from InPacket
p)

-- | Get a word from a certain offset (big endian).
wordAt             :: InPacket -> Int -> Word16
InPacket
p wordAt :: InPacket -> Int -> Word16
`wordAt` Int
x        = (Chunk
buf Chunk -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
off) Word8 -> Word8 -> Word16
forall {a1} {a2} {a3}.
(FiniteBits a1, Integral a2, Integral a1, Num a3, Bits a3) =>
a2 -> a1 -> a3
`nextTo` (Chunk
buf Chunk -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  where buf :: Chunk
buf         = InPacket -> Chunk
buffer InPacket
p
        off :: Int
off         = InPacket -> Int
from InPacket
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x

toChunk   :: InPacket -> Chunk
toChunk :: InPacket -> Chunk
toChunk InPack { buffer :: InPacket -> Chunk
buffer=Chunk
buf,from :: InPacket -> Int
from=Int
i,len :: InPacket -> Int
len=Int
n } =
    if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
lo Bool -> Bool -> Bool
&& Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
size
    then Chunk
buf
  --else listArray (0,n-1) (drop i $ elems $ buffer p)
    else (Int, Int) -> [Word8] -> Chunk
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Chunk
bufChunk -> Int -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
j|Int
j<-[Int
first..Int
firstInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
  where
    first :: Int
first=Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i
    size :: Int
size = Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    (Int
lo,Int
hi) = Chunk -> (Int, Int)
forall i. Ix i => UArray i Word8 -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Chunk
buf

toInPack :: Chunk -> InPacket
toInPack :: Chunk -> InPacket
toInPack Chunk
c = InPack {buffer :: Chunk
buffer=Chunk
c,from :: Int
from=(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Chunk -> (Int, Int)
forall i. Ix i => UArray i Word8 -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Chunk
c),len :: Int
len=Chunk -> Int
forall {a1} {a2 :: * -> * -> *} {e}.
(Num a1, IArray a2 e, Ix a1) =>
a2 a1 e -> a1
arraySize Chunk
c}


-- | The buffers for packets, that are to be sent over the network.
-- Each array contains a header of a layer in the network protocol stack.
data OutPacket = OutPack
               { OutPacket -> Int
outLen  :: !Int
               , OutPacket -> [Chunk]
chunks  :: ![Chunk]
               }
	       -- ^Invariant: outLen==sum (map arraySize chunks)

instance Show OutPacket where show :: OutPacket -> String
show OutPacket
p = String
"<<"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (OutPacket -> Int
outLen OutPacket
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" bytes>>"

type Chunk = UArray Int Word8
type OutPacketS = OutPacket -> OutPacket

addChunk           :: Chunk -> OutPacketS
addChunk :: Chunk -> OutPacketS
addChunk Chunk
a OutPacket
p        = OutPack { outLen :: Int
outLen = Chunk -> Int
forall {a1} {a2 :: * -> * -> *} {e}.
(Num a1, IArray a2 e, Ix a1) =>
a2 a1 e -> a1
arraySize Chunk
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OutPacket -> Int
outLen OutPacket
p , chunks :: [Chunk]
chunks = Chunk
a Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: OutPacket -> [Chunk]
chunks OutPacket
p }

emptyOutPack :: OutPacket
emptyOutPack        = OutPack { outLen :: Int
outLen = Int
0, chunks :: [Chunk]
chunks = [] }

toOutPack :: Chunk -> OutPacket
toOutPack :: Chunk -> OutPacket
toOutPack Chunk
c = Int -> [Chunk] -> OutPacket
OutPack (Chunk -> Int
forall {a1} {a2 :: * -> * -> *} {e}.
(Num a1, IArray a2 e, Ix a1) =>
a2 a1 e -> a1
arraySize Chunk
c) [Chunk
c]

appendOutPack :: OutPacket -> OutPacketS
appendOutPack OutPacket
p1               (OutPack Int
0  [Chunk]
_  ) = OutPacket
p1 -- optimize special case
appendOutPack (OutPack Int
0  [Chunk]
_  ) OutPacket
p2               = OutPacket
p2 -- optimize special case
appendOutPack (OutPack Int
n1 [Chunk]
cs1) (OutPack Int
n2 [Chunk]
cs2) = Int -> [Chunk] -> OutPacket
OutPack (Int
n1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n2) ([Chunk]
cs1[Chunk] -> [Chunk] -> [Chunk]
forall a. [a] -> [a] -> [a]
++[Chunk]
cs2)

{-# NOINLINE splitOutPack #-}
splitOutPack :: Int -> OutPacket -> (OutPacket, OutPacket)
splitOutPack Int
i p :: OutPacket
p@(OutPack Int
n [Chunk]
cs) =
    if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n
    then (OutPacket
p,OutPacket
emptyOutPack)
    else Int -> Int -> [Chunk] -> (OutPacket, OutPacket)
splitChunks Int
i Int
n [Chunk]
cs

{-# NOINLINE splitChunks #-}
splitChunks :: Int -> Int -> [Chunk] -> (OutPacket, OutPacket)
splitChunks Int
0 Int
n [Chunk]
cs = (OutPacket
emptyOutPack,Int -> [Chunk] -> OutPacket
OutPack Int
n [Chunk]
cs)
splitChunks Int
i Int
n [] = (OutPacket
emptyOutPack,OutPacket
emptyOutPack)
splitChunks Int
i Int
n (Chunk
c:[Chunk]
cs) =
    if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n1
    then (Chunk -> OutPacket
toOutPack Chunk
c,Int -> [Chunk] -> OutPacket
OutPack (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n1) [Chunk]
cs)
    else let (Chunk
c1,Chunk
c2) = Int -> Int -> Chunk -> (Chunk, Chunk)
forall {i} {a :: * -> * -> *} {e} {a :: * -> * -> *}
       {a :: * -> * -> *}.
(Num i, Enum i, IArray a e, IArray a e, IArray a e, Ix i) =>
i -> i -> a i e -> (a i e, a i e)
splitChunk Int
i Int
n1 Chunk
c
	 in (Chunk -> OutPacket
toOutPack Chunk
c1,Int -> [Chunk] -> OutPacket
OutPack (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) (Chunk
c2Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:[Chunk]
cs))
  where n1 :: Int
n1 = Chunk -> Int
forall {a1} {a2 :: * -> * -> *} {e}.
(Num a1, IArray a2 e, Ix a1) =>
a2 a1 e -> a1
arraySize Chunk
c

{-# NOINLINE splitChunk #-}
splitChunk :: i -> i -> a i e -> (a i e, a i e)
splitChunk i
i i
n a i e
c = ((i, i) -> [e] -> a i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i
0,i
ii -> i -> i
forall a. Num a => a -> a -> a
-i
1) [a i e
ca i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!i
j|i
j<-[i
lo..i
loi -> i -> i
forall a. Num a => a -> a -> a
+i
ii -> i -> i
forall a. Num a => a -> a -> a
-i
1]],
		    (i, i) -> [e] -> a i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i
0,i
ni -> i -> i
forall a. Num a => a -> a -> a
-i
ii -> i -> i
forall a. Num a => a -> a -> a
-i
1) [a i e
ca i e -> i -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!i
j|i
j<-[i
loi -> i -> i
forall a. Num a => a -> a -> a
+i
i..i
hi]])
  where (i
lo,i
hi) = a i e -> (i, i)
forall i. Ix i => a i e -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a i e
c

loopback :: OutPacket -> InPacket
loopback :: OutPacket -> InPacket
loopback p :: OutPacket
p@OutPack{outLen :: OutPacket -> Int
outLen=Int
size} = InPack {buffer :: Chunk
buffer=Chunk
a,from :: Int
from=(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Chunk -> (Int, Int)
forall i. Ix i => UArray i Word8 -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Chunk
a),len :: Int
len=Int
size}
  where a :: Chunk
a = case OutPacket -> [Chunk]
chunks OutPacket
p of
	      [Chunk
c] -> Chunk
c
	      [Chunk]
_ -> (Int, Int) -> [Word8] -> Chunk
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (OutPacket -> [Word8]
outBytes OutPacket
p)

outBytes :: OutPacket -> [Word8]
outBytes = (Chunk -> [Word8]) -> [Chunk] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Chunk -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems ([Chunk] -> [Word8])
-> (OutPacket -> [Chunk]) -> OutPacket -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPacket -> [Chunk]
chunks

loopbackout :: InPacket -> OutPacket
loopbackout :: InPacket -> OutPacket
loopbackout InPacket
inp = OutPack {outLen :: Int
outLen=InPacket -> Int
len InPacket
inp,chunks :: [Chunk]
chunks=[InPacket -> Chunk
toChunk InPacket
inp]}