{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections              #-}
module ToxPacket where

import ToxCrypto
import Data.Serialize as S
import Data.Aeson as JSON
import Data.IP
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString as B
import Data.Word
import qualified Data.ByteString.Base16 as Base16
import Network.Socket
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA
import Data.Hashable
import Data.Bits
import System.IO.Unsafe
import qualified Text.ParserCombinators.ReadP as RP
import Foreign.Storable
import ToxAddress -- import Network.Address hiding (nodePort,nodeInfo)
import Text.Read
import Control.Applicative
import Data.Char
import Control.Monad
import Crypto.Error.Types (throwCryptoError)

-- ## DHT Request packets
--
-- | Length | Contents                  |
-- |:-------|:--------------------------|
-- | `1`    | `uint8_t` (0x20)          |
-- | `32`   | receiver's DHT public key |
--   ...      ...

data DHTRequestPacket = DHTRequestPacket
    { requestTarget :: PublicKey
    , request       :: Assym (Encrypted DHTRequest)
    }

instance Serialize DHTRequestPacket where
    get = _todo
    put = _todo


data DHTRequest
    = NATPing Nonce8
    | NATPong Nonce8
    | DHTPK DHTPublicKey

-- | Length      | Contents                            |
-- |:------------|:------------------------------------|
-- | `1`         | `uint8_t` (0x9c)                    |
-- | `8`         | `uint64_t` `no_replay`              |
-- | `32`        | Our DHT public key                  |
-- | `[39, 204]` | Maximum of 4 nodes in packed format |
data DHTPublicKey = DHTPublicKey
    { dhtpkNonce :: Nonce8
    , dhtpk :: PublicKey
    , dhtpkNodes :: SendNodes
    }

-- | `32`   | sender's DHT public key   |
-- | `24`   | nonce                     |
-- | `?`    | encrypted message         |
data Assym a = Assym
    { senderKey :: PublicKey
    , assymNonce :: Nonce24
    , assymData :: a
    }

newtype GetNodes = GetNodes NodeId
    deriving (Eq,Ord,Show,Read,S.Serialize)

newtype SendNodes = SendNodes [NodeInfo]
    deriving (Eq,Ord,Show,Read)

instance S.Serialize SendNodes where
    get = do
        cnt <- S.get :: S.Get Word8
        ns <- sequence $ replicate (fromIntegral cnt) S.get
        return $ SendNodes ns

    put (SendNodes ns) = do
        let ns' = take 4 ns
        S.put (fromIntegral (length ns') :: Word8)
        mapM_ S.put ns'

data Ping = Ping deriving Show
data Pong = Pong deriving Show

instance S.Serialize Ping where
    get = do w8 <- S.get
             if (w8 :: Word8) /= 0
                then fail "Malformed ping."
                else return Ping
    put Ping = S.put (0 :: Word8)

instance S.Serialize Pong where
    get = do w8 <- S.get
             if (w8 :: Word8) /= 1
                then fail "Malformed pong."
                else return Pong
    put Pong = S.put (1 :: Word8)

newtype CookieRequest = CookieRequest PublicKey
newtype CookieResponse = CookieResponse Cookie

data Cookie = Cookie Nonce24 (Encrypted CookieData)

instance Sized Cookie where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data

data CookieData = CookieData   --   16 (mac)
    { cookieTime  :: Word64    --    8
    , longTermKey :: PublicKey --   32
    , dhtKey      :: PublicKey -- + 32
    }                          -- = 88 bytes when encrypted.

instance Sized CookieRequest where
    size = ConstSize 64 -- 32 byte key + 32 byte padding