{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TupleSections #-} module ToxPacket where import Crypto.Tox 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 Network.Tox.Address -- 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