{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} module Data.Tox where import Data.ByteString (ByteString) import Data.Data (Data) import Data.Word import Data.LargeWord import Data.IP import Data.Serialize import Network.BitTorrent.Address (NodeInfo(..)) -- Serialize IP import GHC.Generics (Generic) import Network.Socket import Network.RPC hiding (NodeId) import qualified Network.RPC as Envelope (NodeId) import Crypto.PubKey.ECC.Types type Key32 = Word256 -- 32 byte key type Nonce8 = Word64 -- 8 bytes type Nonce24 = Word192 -- 24 bytes type NodeId = Word256 -- 32 bytes (mainline uses only 20-byte node IDs) data NodeFormat = NodeFormat { nodePublicKey :: Key32 -- 32 byte public key , nodeIsTCP :: Bool -- This has no analog in mainline NodeInfo structure , nodeIP :: IP -- IPv4 or IPv6 address , nodePort :: PortNumber } deriving (Eq, Ord, Show) encodeFamily :: (Family, SocketType) -> Word8 encodeFamily (AF_INET , Datagram) = 2 encodeFamily (AF_INET6 , Datagram) = 10 encodeFamily (AF_INET , Stream ) = 130 encodeFamily (AF_INET6 , Stream ) = 138 encodeFamily _ = error "Unsupported protocol" newtype MessageType = MessageType Word8 deriving (Eq, Ord, Show, Read) instance Serialize MessageType where put (MessageType b) = put b get = MessageType <$> get pattern Ping = MessageType 0 pattern Pong = MessageType 1 pattern GetNodes = MessageType 2 pattern SendNodes = MessageType 4 {- #define NET_PACKET_PING_REQUEST 0 /* Ping request packet ID. */ #define NET_PACKET_PING_RESPONSE 1 /* Ping response packet ID. */ #define NET_PACKET_GET_NODES 2 /* Get nodes request packet ID. */ #define NET_PACKET_SEND_NODES_IPV6 4 /* Send nodes response packet ID for other addresses. */ #define NET_PACKET_COOKIE_REQUEST 24 /* Cookie request packet */ #define NET_PACKET_COOKIE_RESPONSE 25 /* Cookie response packet */ #define NET_PACKET_CRYPTO_HS 26 /* Crypto handshake packet */ #define NET_PACKET_CRYPTO_DATA 27 /* Crypto data packet */ #define NET_PACKET_CRYPTO 32 /* Encrypted data packet ID. */ #define NET_PACKET_LAN_DISCOVERY 33 /* LAN discovery packet ID. */ /* See: docs/Prevent_Tracking.txt and onion.{c, h} */ #define NET_PACKET_ONION_SEND_INITIAL 128 #define NET_PACKET_ONION_SEND_1 129 #define NET_PACKET_ONION_SEND_2 130 #define NET_PACKET_ANNOUNCE_REQUEST 131 #define NET_PACKET_ANNOUNCE_RESPONSE 132 #define NET_PACKET_ONION_DATA_REQUEST 133 #define NET_PACKET_ONION_DATA_RESPONSE 134 #define NET_PACKET_ONION_RECV_3 140 #define NET_PACKET_ONION_RECV_2 141 #define NET_PACKET_ONION_RECV_1 142 -} -- FIXME Orphan Serialize intance for large words instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where put (LargeKey lo hi) = put hi >> put lo get = flip LargeKey <$> get <*> get -- | Use with 'PingPayload', 'GetNodesPayload', or 'SendNodesPayload' data Message a = Message { msgType :: MessageType , msgClient :: NodeId , msgNonce :: Nonce24 , msgPayload :: a } deriving (Show, Generic, Functor, Foldable, Traversable) isQuery :: Message a -> Bool isQuery (Message { msgType = SendNodes }) = False isQuery (Message { msgType = MessageType typ }) | even typ = True isQuery _ = False isResponse :: Message a -> Bool isResponse m = not (isQuery m) isError :: Message a -> Bool isError _ = False data PingPayload = PingPayload { isPong :: Bool , pingId :: Nonce8 } data GetNodesPayload = GetNodesPayload { nodesForWho :: NodeId , nodesNonce :: Nonce8 } data SendNodesPayload = SendNodesPayload -- From: docs/updates/DHT.md -- -- Node format: -- [uint8_t family (2 == IPv4, 10 == IPv6, 130 == TCP IPv4, 138 == TCP IPv6)] -- [ip (in network byte order), length=4 bytes if ipv4, 16 bytes if ipv6] -- [port (in network byte order), length=2 bytes] -- [char array (node_id), length=32 bytes] -- -- see also: DHT.h (pack_nodes() and unpack_nodes()) instance Serialize NodeFormat where get = do typ <- get :: Get Word8 (ip,istcp) <- case typ :: Word8 of 2 -> (,False) . IPv4 <$> get 130 -> (,True) . IPv4 <$> get 10 -> (,False) . IPv6 <$> get 138 -> (,True) . IPv6 <$> get _ -> fail "Unsupported type of Tox node_format structure" port <- get pubkey <- get return $ NodeFormat { nodeIsTCP = istcp , nodeIP = ip , nodePort = port , nodePublicKey = pubkey } put (NodeFormat{..}) = do put $ case (# nodeIP, nodeIsTCP #) of (# IPv4 _, False #) -> 2 (# IPv4 _, True #) -> 130 (# IPv6 _, False #) -> 10 (# IPv6 _, True #) -> 138 :: Word8 put nodeIP put nodePort put nodePublicKey -- Note: the char array is a public key, the 32-bytes is provided by libsodium-dev -- in /usr/include/sodium/crypto_box.h as the symbol crypto_box_PUBLICKEYBYTES -- but toxcore/crypto_core.c will fail to compile if it is not 32. -- Ping(Request and response): -- -- [byte with value: 00 for request, 01 for response] -- [char array (client node_id), length=32 bytes] -- [random 24 byte nonce] -- [Encrypted with the nonce and private key of the sender: -- [1 byte type (0 for request, 1 for response)] -- [random 8 byte (ping_id)] -- ] -- -- ping_id = a random integer, the response must contain the exact same number as the request -- Get nodes (Request): -- -- [byte with value: 02] -- [char array (client node_id), length=32 bytes] -- [random 24 byte nonce] -- [Encrypted with the nonce and private key of the sender: -- [char array: requested_node_id (node_id of which we want the ip), length=32 bytes] -- [Sendback data (must be sent back unmodified by in the response), length=8 bytes] -- ] -- -- Valid replies: a send_nodes packet -- Send_nodes (response (for all addresses)): -- -- [byte with value: 04] -- [char array (client node_id), length=32 bytes] -- [random 24 byte nonce] -- [Encrypted with the nonce and private key of the sender: -- [uint8_t number of nodes in this packet] -- [Nodes in node format, length=?? * (number of nodes (maximum of 4 nodes)) bytes] -- [Sendback data, length=8 bytes] -- ] data ToxCipherContext = ToxCipherContext -- TODO newtype Ciphered = Ciphered { cipheredBytes :: ByteString } getMessage :: Get (Message Ciphered) getMessage = do typ <- get nid <- get tid <- get cnt <- remaining bs <- getBytes cnt return Message { msgType = typ , msgClient = nid , msgNonce = tid , msgPayload = Ciphered bs } putMessage :: Message Ciphered -> Put putMessage (Message {..}) = do put msgType put msgClient put msgNonce let Ciphered bs = msgPayload putByteString bs decipher :: ToxCipherContext -> Message Ciphered -> Either String (Message ByteString) decipher = error "TODO TOX: decipher" encipher :: ToxCipherContext -> Message ByteString -> Message Ciphered encipher = error "TODO TOX: encipher" -- see rfc7748 curve25519 :: Curve curve25519 = CurveFP (CurvePrime prime curvecommon) where prime = 2^255 - 19 -- (≅ 1 modulo 4) -- 1 * v^2 = u^3 + 486662*u^2 + u curvecommon = CurveCommon { ecc_a = 486662 , ecc_b = 1 , ecc_g = Point 9 14781619447589544791020593568409986887264606134616475288964881837755586237401 -- base point , ecc_n = 2^252 + 0x14def9dea2f79cd65812631a5cf5d3ed -- order , ecc_h = 8 -- cofactor } instance Envelope Message where type TransactionID Message = Nonce24 type NodeId Message = NodeId envelopePayload = msgPayload envelopeTransaction = msgNonce envelopeClass Message { msgType = Ping } = Query envelopeClass Message { msgType = Pong } = Response envelopeClass Message { msgType = GetNodes } = Query envelopeClass Message { msgType = SendNodes } = Response buildReply self addr qry payload = (fmap (const payload) qry) { msgClient = self } instance WireFormat ByteString Message where type SerializableTo ByteString = Serialize type CipherContext ByteString Message = ToxCipherContext decodePayload = mapM decode encodePayload = fmap encode decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx encodeHeaders ctx msg = runPut $ putMessage $ encipher ctx msg