module Net.IPv6 where

-- IPv6, Internet Protocol version 6
-- See http://www.networksorcery.com/enp/protocol/ipv6.htm

import Net.Bits
import Net.IPv4(Protocol)
import Net.PacketParsing

data Addr = Addr !Word16 !Word16 !Word16 !Word16 !Word16 !Word16 !Word16 !Word16
          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)

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

instance Unparse Addr where
  unparse :: Addr -> UnparseS
unparse (Addr Word16
w1 Word16
w2 Word16
w3 Word16
w4 Word16
w5 Word16
w6 Word16
w7 Word16
w8) = ((Word16, Word16, Word16, Word16),
 (Word16, Word16, Word16, Word16))
-> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ((Word16
w1,Word16
w2,Word16
w3,Word16
w4),(Word16
w5,Word16
w6,Word16
w7,Word16
w8))

newtype Word4 = Word4 Word8 -- extra bits should be zero
newtype Word20 = Word20 Word32 -- extra bits should be zero

instance Parse Word4 where parse :: PacketParser Word4
parse = Word8 -> Word4
Word4 (Word8 -> Word4) -> PacketParser Word8 -> PacketParser Word4
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Int -> PacketParser Word8
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
4
instance Parse Word20 where parse :: PacketParser Word20
parse = Word32 -> Word20
Word20 (Word32 -> Word20) -> PacketParser Word32 -> PacketParser Word20
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# Int -> PacketParser Word32
forall {a}. (Integral a, Bits a) => Int -> PacketParser a
bits Int
20

data Packet content = Packet
                    { forall content. Packet content -> Word4
version        :: !Word4
		    , forall content. Packet content -> Word8
traffic_class  :: !Word8
		    , forall content. Packet content -> Word20
flow_label     :: !Word20
		    , forall content. Packet content -> Word16
payload_length :: !Word16
		    , forall content. Packet content -> Protocol
next_header    :: !Protocol -- 8 bits
		        -- Need to add extension header types to Protocol
		    , forall content. Packet content -> Word8
hop_limit      :: !Word8
		    , forall content. Packet content -> Addr
source         :: !Addr -- 128 bits
		    , forall content. Packet content -> Addr
dest           :: !Addr -- 128 bits
		      -- + extension headers!
		    , forall content. Packet content -> content
content        :: !content
                       -- The next_header field of the last extention header
                       -- determines the type of content!
		    }

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 Parse content => Parse (Packet content) where
  parse :: PacketParser (Packet content)
parse = Word4
-> Word8
-> Word20
-> Word16
-> Protocol
-> Word8
-> Addr
-> Addr
-> content
-> Packet content
forall content.
Word4
-> Word8
-> Word20
-> Word16
-> Protocol
-> Word8
-> Addr
-> Addr
-> content
-> Packet content
Packet (Word4
 -> Word8
 -> Word20
 -> Word16
 -> Protocol
 -> Word8
 -> Addr
 -> Addr
 -> content
 -> Packet content)
-> PacketParser Word4
-> PacketParser
     (Word8
      -> Word20
      -> Word16
      -> Protocol
      -> Word8
      -> Addr
      -> Addr
      -> content
      -> Packet content)
forall {f :: * -> *} {a} {b}. Functor f => (a -> b) -> f a -> f b
# PacketParser Word4
forall a. Parse a => PacketParser a
parse PacketParser
  (Word8
   -> Word20
   -> Word16
   -> Protocol
   -> Word8
   -> Addr
   -> Addr
   -> content
   -> Packet content)
-> PacketParser Word8
-> PacketParser
     (Word20
      -> Word16
      -> Protocol
      -> Word8
      -> Addr
      -> Addr
      -> content
      -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse PacketParser
  (Word20
   -> Word16
   -> Protocol
   -> Word8
   -> Addr
   -> Addr
   -> content
   -> Packet content)
-> PacketParser Word20
-> PacketParser
     (Word16
      -> Protocol -> Word8 -> Addr -> Addr -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word20
forall a. Parse a => PacketParser a
parse PacketParser
  (Word16
   -> Protocol -> Word8 -> Addr -> Addr -> content -> Packet content)
-> PacketParser Word16
-> PacketParser
     (Protocol -> Word8 -> Addr -> Addr -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word16
forall a. Parse a => PacketParser a
parse PacketParser
  (Protocol -> Word8 -> Addr -> Addr -> content -> Packet content)
-> PacketParser Protocol
-> PacketParser
     (Word8 -> Addr -> Addr -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Protocol
forall a. Parse a => PacketParser a
parse PacketParser (Word8 -> Addr -> Addr -> content -> Packet content)
-> PacketParser Word8
-> PacketParser (Addr -> Addr -> content -> Packet content)
forall {m :: * -> *} {a} {b}. Monad m => m (a -> b) -> m a -> m b
<# PacketParser Word8
forall a. Parse a => PacketParser a
parse PacketParser (Addr -> Addr -> content -> Packet content)
-> PacketParser Addr
-> PacketParser (Addr -> 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 (Addr -> content -> Packet content)
-> PacketParser Addr -> PacketParser (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 (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
{-
    where
       packet w1 = Packet v t f
          where v = fromIntegral (w1 `shiftR` 28)
		t = fromIntegral ((w1 `shiftR` 20) .&. 0xff)
		f = w1 .&. 0xfffff
-}

instance Unparse content => Unparse (Packet content) where
  unparse :: Packet content -> UnparseS
unparse (Packet (Word4 Word8
v) Word8
t (Word20 Word32
f) Word16
p Protocol
n Word8
h Addr
s Addr
d content
c) =
      ((Word32, Word16, Protocol, Word8), (Addr, Addr), content)
-> UnparseS
forall a. Unparse a => a -> UnparseS
unparse ((Word32
w1,Word16
p,Protocol
n,Word8
h),(Addr
s,Addr
d),content
c)
    where w1 :: Word32
w1 = Word8 -> Word32
ext Word8
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
28 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
ext Word8
t Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
20 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
f
          ext :: Word8 -> Word32
ext = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral