From cb2bd0bf4b5977ef6ec7ca7ab9ac0189457c2250 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 8 Jun 2017 13:53:37 -0400 Subject: Renamed Data.Tox -> Network.DatagramServer.Tox --- src/Network/DatagramServer/Mainline.hs | 2 +- src/Network/DatagramServer/Tox.hs | 279 +++++++++++++++++++++++++++++++++ 2 files changed, 280 insertions(+), 1 deletion(-) create mode 100644 src/Network/DatagramServer/Tox.hs (limited to 'src/Network/DatagramServer') diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs index 2177d076..70b9b184 100644 --- a/src/Network/DatagramServer/Mainline.hs +++ b/src/Network/DatagramServer/Mainline.hs @@ -65,7 +65,7 @@ import Control.Exception.Lifted as Lifted #ifdef VERSION_bencoding import Data.BEncode as BE #else -import qualified Data.Tox as Tox +import qualified Network.DatagramServer.Tox as Tox #endif import Data.ByteString as B import Data.ByteString.Char8 as BC diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs new file mode 100644 index 00000000..ad376c68 --- /dev/null +++ b/src/Network/DatagramServer/Tox.hs @@ -0,0 +1,279 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} +module Network.DatagramServer.Tox where + +import Data.Bits +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.DatagramServer.Types +import qualified Network.DatagramServer.Types as Envelope (NodeId) +import Crypto.PubKey.ECC.Types + +type Key32 = Word256 -- 32 byte key +type Nonce8 = Word64 -- 8 bytes +type Nonce24 = Word192 -- 24 bytes + + +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 Message + , msgNonce :: Nonce24 + , msgPayload :: a + } + deriving (Show, Generic, Functor, Foldable, Traversable) + +deriving instance Show (NodeId Message) -- TODO: print as hex + +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 Message + , 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 + newtype NodeId Message = NodeId Word256 + deriving (Serialize, Eq, Ord, Bits, FiniteBits) + + 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 -- cgit v1.2.3