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/Data/Tox.hs | 279 -------------------------------------------------------- 1 file changed, 279 deletions(-) delete mode 100644 src/Data/Tox.hs (limited to 'src/Data') diff --git a/src/Data/Tox.hs b/src/Data/Tox.hs deleted file mode 100644 index b79e0b9a..00000000 --- a/src/Data/Tox.hs +++ /dev/null @@ -1,279 +0,0 @@ -{-# 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 Data.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